File Coverage

blib/lib/Template/Pure/Iterator.pm
Criterion Covered Total %
statement 56 122 45.9
branch 15 58 25.8
condition 0 11 0.0
subroutine 12 55 21.8
pod 0 19 0.0
total 83 265 31.3


line stmt bran cond sub pod time code
1 26     26   91 use warnings;
  26         30  
  26         664  
2 26     26   81 use strict;
  26         23  
  26         650  
3              
4             package Template::Pure::Iterator;
5              
6             ## Please not everything here is internal code... it will likely change a
7             ## lot so please rely only on the public interface.
8              
9 26     26   84 use Scalar::Util 'blessed';
  26         24  
  26         29505  
10              
11             sub from_proto {
12 16     16 0 25 my ($class, $proto, $pure, $options) = @_;
13 16         22 my $sort_cb = delete $options->{'sort'};
14 16         70 my $grep_cb = delete $options->{'grep'};
15 16         18 my $filter_cb = delete $options->{'filter'};
16              
17             #sorry about this mess but I don't have time for a total redo right now
18 16         23 $options->{pure} = $pure;
19              
20 16 50       41 if(blessed $proto) {
21 0         0 return $class->from_object($proto, $filter_cb, $grep_cb, $sort_cb, $options);
22             } else {
23 16         36 my $type = 'from_' .lc ref $proto;
24 16         57 return $class->$type($proto, $filter_cb, $grep_cb, $sort_cb, $options);
25             }
26             }
27              
28             sub from_object {
29 0     0 0 0 my ($class, $obj, $filter_cb, $grep_cb, $sort_cb, $options) = @_;
30 0         0 my ($index, $current) = (0);
31            
32 0 0 0     0 if(
      0        
      0        
33             (my $next = $obj->can('next')) &&
34             (my $all = $obj->can('all')) &&
35             (my $reset = $obj->can('reset')) &&
36             (my $count = $obj->can('count'))
37             ) {
38              
39 0 0       0 $obj = $filter_cb->($options->{pure}, $obj) if defined $filter_cb;
40 0 0       0 $obj = $grep_cb->($options->{pure}, $obj) if defined $grep_cb;
41 0 0       0 $obj = $sort_cb->($options->{pure}, $obj) if defined $sort_cb;
42              
43             return bless +{
44 0     0   0 _index => sub { return $index },
45 0     0   0 _current_value => sub { return $current },
46 0     0   0 _max_index => sub { return $obj->$count - 1 },
47 0     0   0 _count => sub { return $obj->$count },
48             _next => sub {
49 0 0   0   0 if(my $next = $obj->$next) {
50 0         0 $current = $next;
51 0         0 $index++;
52 0         0 return \$next;
53             } else {
54 0         0 return undef;
55             }
56             },
57 0     0   0 _reset => sub { $reset->($obj) },
58 0     0   0 _all => sub { return $all->($obj) },
59 0 0   0   0 _is_first => sub { return (($index - 1) == 0 ? 1:0) },
60 0 0   0   0 _is_last => sub { return $index == $count->($obj) ? 1:0 },
61 0 0   0   0 _is_even => sub { return $index % 2 ? 0:1 },
62 0 0   0   0 _is_odd => sub { return $index % 2 ? 1:0 },
63 0         0 }, $class;
64             } else {
65 0         0 my %hash;
66 0 0 0     0 if(my $fields = $obj->can($options->{fields_method} ||'display_fields')) {
67 0         0 %hash = map { $_ => $obj->$_ } ($fields->($obj));
  0         0  
68             } else {
69 0         0 %hash = %{$obj};
  0         0  
70             }
71              
72 0         0 return $class->from_hash(\%hash, $filter_cb, $grep_cb, $sort_cb, $options);
73             }
74              
75             }
76              
77             sub from_hash {
78 1     1 0 1 my ($class, $hashref, $filter_cb, $grep_cb, $sort_cb, $options) = @_;
79              
80             my %hash = defined $filter_cb ?
81 0         0 map { $filter_cb->($options->{pure}, $_, $hashref->{$_}) } keys %{$hashref} :
  0         0  
82 1 50       3 %{$hashref};
  1         4  
83            
84             my @keys = defined $grep_cb ?
85 1 0       4 grep { $grep_cb->($options->{pure}, $_, $hash{$_}) ? $_ : undef } keys %hash :
  0 50       0  
86             keys %hash;
87              
88 1 50       3 if(defined $sort_cb) {
89 1         3 @keys = sort { $sort_cb->($options->{pure},\%hash, $a, $b) } @keys;
  5         16  
90             }
91              
92 1         4 my $index = 0;
93 1         1 my $current;
94 1         2 my $current_key = $keys[$index];
95             return bless +{
96 4     4   9 _index => sub { return $current_key },
97 0     0   0 _current_value => sub { return $current },
98 0     0   0 _max_index => sub { return undef; },
99 0     0   0 _count => sub { return scalar @keys },
100             _next => sub {
101 5 100   5   11 return undef if $index > $#keys;
102 4         6 $current_key = $keys[$index];
103 4         5 my $value = $hash{$current_key};
104 4         4 $index++;
105 4         4 $current = $value;
106 4         12 return \$value;
107             },
108 0     0   0 _reset => sub { $index = 0 },
109 0     0   0 _all => sub { return %hash },
110 0 0   0   0 _is_first => sub { return $index-1 == 0 ? 1:0 },
111 0 0   0   0 _is_last => sub { return $index-1 == $#keys ? 1:0 },
112 0 0   0   0 _is_even => sub { return $index % 2 ? 0:1 },
113 0 0   0   0 _is_odd => sub { return $index % 2 ? 1:0 },
114 1         24 }, $class;
115             }
116              
117             sub from_array {
118 15     15 0 20 my ($class, $arrayref, $filter_cb, $grep_cb, $sort_cb, $options) = @_;
119             my @array = defined $filter_cb ?
120 15 50       46 map { $filter_cb->($options->{pure}, $_) } @$arrayref :
  0         0  
121             @$arrayref;
122              
123 15 100       30 if(defined $grep_cb) {
124 1 100       2 @array = grep { $grep_cb->($options->{pure}, $_) ? $_ : undef } @array;
  3         13  
125             }
126              
127 15 100       29 if(defined $sort_cb) {
128 1         7 @array = sort { $sort_cb->($options->{pure}, $arrayref, $a, $b) } @array;
  1         3  
129             }
130              
131 15         22 my $index = 0;
132 15         12 my $current;
133             return bless +{
134 5     5   7 _index => sub { return $index },
135 0     0   0 _current_value => sub { return $current },
136 0     0   0 _max_index => sub { return $#array },
137 0     0   0 _count => sub { return scalar @array },
138             _next => sub {
139 53 100   53   146 return undef if $index > $#array;
140 37         44 my $value = $array[$index];
141 37         29 $index++;
142 37         30 $current = $value;
143 37         106 return \$value;
144             },
145 0     0   0 _reset => sub { $index = 0 },
146 0     0   0 _all => sub { return @array },
147 0 0   0   0 _is_first => sub { return $index-1 == 0 ? 1:0 },
148 0 0   0   0 _is_last => sub { return $index-1 == $#array ? 1:0 },
149 0 0   0   0 _is_even => sub { return $index % 2 ? 0:1 },
150 0 0   0   0 _is_odd => sub { return $index % 2 ? 1:0 },
151 15         292 }, $class;
152             }
153              
154             sub current_value {
155 0     0 0 0 my ($self) = @_;
156 0         0 return $self->{_current_value}->($self);
157             }
158              
159             sub next {
160 58     58 0 12406 my ($self) = @_;
161 58         117 return $self->{_next}->($self);
162             }
163              
164             sub reset {
165 0     0 0 0 my ($self) = @_;
166 0         0 return $self->{_reset}->($self);
167             }
168              
169             sub all {
170 0     0 0 0 my ($self) = @_;
171 0         0 return $self->{_all}->($self);
172             }
173              
174             sub count {
175 0     0 0 0 my ($self) = @_;
176 0         0 return $self->{_count}->($self);
177             }
178              
179             sub index {
180 9     9 0 10 my ($self) = @_;
181 9         49 return $self->{_index}->($self);
182             }
183              
184             sub max_index {
185 0     0 0   my ($self) = @_;
186 0           return $self->{_max_index}->($self);
187             }
188              
189 0     0 0   sub is_first { $_[0]->{_is_first}->($_[0]) }
190 0     0 0   sub is_last { $_[0]->{_is_last}->($_[0]) }
191 0     0 0   sub is_even { $_[0]->{_is_even}->($_[0]) }
192 0     0 0   sub is_odd { $_[0]->{_is_odd}->($_[0]) }
193              
194       0 0   sub is_paged { }
195              
196       0 0   sub pager { }
197              
198       0 0   sub page { }
199              
200       0 0   sub is_ordered { }
201              
202             1;