File Coverage

blib/lib/Circle/Rule/Resultset.pm
Criterion Covered Total %
statement 9 36 25.0
branch 0 12 0.0
condition n/a
subroutine 3 7 42.8
pod 0 4 0.0
total 12 59 20.3


line stmt bran cond sub pod time code
1             # You may distribute under the terms of the GNU General Public License
2             #
3             # (C) Paul Evans, 2008-2010 -- leonerd@leonerd.org.uk
4              
5             package Circle::Rule::Resultset;
6              
7 4     4   20 use strict;
  4         7  
  4         90  
8 4     4   14 use warnings;
  4         7  
  4         118  
9              
10             our $VERSION = '0.173320';
11              
12 4     4   16 use Carp;
  4         13  
  4         1482  
13              
14             sub new
15             {
16 0     0 0   my $class = shift;
17              
18 0           return bless {}, $class;
19             }
20              
21             sub get_result
22             {
23 0     0 0   my $self = shift;
24 0           my ( $name ) = @_;
25              
26 0 0         carp "No result '$name'" unless exists $self->{$name};
27              
28 0           return $self->{$name};
29             }
30              
31             sub push_result
32             {
33 0     0 0   my $self = shift;
34 0           my ( $name, $value ) = @_;
35              
36 0 0         if( !exists $self->{$name} ) {
    0          
37 0           $self->{$name} = [ $value ];
38             }
39             elsif( ref $self->{$name} eq "ARRAY" ) {
40 0           push @{ $self->{$name} }, $value;
  0            
41             }
42             else {
43 0           croak "Expected '$name' to be an ARRAY result";
44             }
45             }
46              
47             sub merge_from
48             {
49 0     0 0   my $self = shift;
50 0           my ( $other ) = @_;
51              
52 0           foreach my $name ( %$other ) {
53 0           my $otherval = $other->{$name};
54              
55 0 0         if( !$self->{$name} ) {
56 0           $self->{$name} = $otherval;
57 0           next;
58             }
59              
60 0           my $myval = $self->{$name};
61              
62             # Already had it - type matches?
63 0 0         if( ref $myval ne ref $otherval ) {
64 0           croak "Cannot merge; '$name' has different result types";
65             }
66              
67 0           my $type = ref $myval;
68              
69 0 0         if( ref $myval eq "ARRAY" ) {
70 0           push @$myval, @$otherval;
71             }
72             else {
73 0           croak "Don't know how to handle result type '$name' ($type)";
74             }
75             }
76             }
77              
78             0x55AA;