File Coverage

blib/lib/DBD/Mock/StatementTrack.pm
Criterion Covered Total %
statement 124 136 91.1
branch 46 54 85.1
condition 22 24 91.6
subroutine 26 28 92.8
pod 0 26 0.0
total 218 268 81.3


line stmt bran cond sub pod time code
1             package DBD::Mock::StatementTrack;
2              
3 40     40   299 use strict;
  40         84  
  40         1241  
4 40     40   213 use warnings;
  40         73  
  40         65083  
5              
6             sub new {
7 147     147 0 9846 my ( $class, %params ) = @_;
8              
9             # these params have default values
10             # but can be overridden
11 147   100     660 $params{return_data} ||= [];
12 147 100 100     623 $params{fields} ||= $DBD::Mock::DefaultFieldsToUndef ? undef : [];
13 147   100     730 $params{bound_params} ||= [];
14 147   50     694 $params{bound_param_attrs} ||= [];
15 147   100     362 $params{statement} ||= "";
16 147   100     695 $params{failure} ||= undef;
17 147   100     586 $params{callback} ||= undef;
18 147   100     643 $params{driver_attributes} ||= {};
19 147   100     614 $params{execute_attributes} ||= {};
20              
21             # these params should never be overridden
22             # and should always start out in a default
23             # state to assure the sanity of this class
24 147         288 $params{is_executed} = 'no';
25 147         269 $params{is_finished} = 'no';
26 147         265 $params{current_record_num} = 0;
27              
28             # NOTE:
29             # changed from \%params here because that
30             # would bind the hash sent in so that it
31             # would reflect alterations in the object
32             # this violates encapsulation
33 147         1143 my $self = bless {%params}, $class;
34 147         675 return $self;
35             }
36              
37             sub has_failure {
38 149     149 0 278 my ($self) = @_;
39 149 100       643 $self->{failure} ? 1 : 0;
40             }
41              
42             sub get_failure {
43 3     3 0 8 my ($self) = @_;
44 3         4 @{ $self->{failure} };
  3         69  
45             }
46              
47             sub num_fields {
48 4     4 0 997 my ($self) = @_;
49 4 100       22 return $self->{fields} ? scalar @{ $self->{fields} } : $self->{fields};
  3         18  
50             }
51              
52             sub num_rows {
53 48     48 0 99 my ($self) = @_;
54 48         72 return scalar @{ $self->{return_data} };
  48         337  
55             }
56              
57             sub num_params {
58 143     143 0 309 my ($self) = @_;
59 143         219 return scalar @{ $self->{bound_params} };
  143         544  
60             }
61              
62             sub bind_col {
63 13     13 0 20 my ( $self, $param_num, $ref ) = @_;
64 13         35 $self->{bind_cols}->[ $param_num - 1 ] = $ref;
65             }
66              
67             sub bound_param {
68 17     17 0 38 my ( $self, $param_num, $value, $attr ) = @_;
69              
70             # Basic support for named parameters
71 17 100       82 if ( $param_num !~ /^\d+/ ) {
72 2         4 $param_num = $self->num_params + 1;
73             }
74              
75 17         53 $self->{bound_params}->[ $param_num - 1 ] = $value;
76 17 100       59 $self->{bound_param_attrs}->[ $param_num - 1 ] = ref $attr eq "HASH" ? { %$attr } : $attr;
77              
78 17         38 return $self->bound_params;
79             }
80              
81             sub bound_param_trailing {
82 1     1 0 4 my ( $self, @values ) = @_;
83 1         3 push @{ $self->{bound_params} }, @values;
  1         5  
84             }
85              
86             sub bind_cols {
87 123     123 0 187 my $self = shift;
88 123 100       156 return @{ $self->{bind_cols} || [] };
  123         603  
89             }
90              
91             sub bind_params {
92 46     46 0 109 my ( $self, @values ) = @_;
93 46         93 @{ $self->{bound_params} } = @values;
  46         114  
94 46         120 @{ $self->{bound_param_attrs} } = map { undef } @values;
  46         130  
  64         151  
95             }
96              
97             # Rely on the DBI's notion of Active: a statement is active if it's
98             # currently in a SELECT and has more records to fetch
99              
100             sub is_active {
101 10     10 0 25 my ($self) = @_;
102 10 100       23 return 0 unless $self->statement =~ /^\s*select/ism;
103 7 100       21 return 0 unless $self->is_executed eq 'yes';
104 6 100       15 return 0 if $self->is_depleted;
105 3         22 return 1;
106             }
107              
108             sub is_finished {
109 50     50 0 113 my ( $self, $value ) = @_;
110 50 100 100     237 if ( defined $value && $value eq 'yes' ) {
    100          
111 39         80 $self->{is_finished} = 'yes';
112 39         103 $self->current_record_num(0);
113 39         89 $self->{return_data} = [];
114             }
115             elsif ( defined $value ) {
116 1         3 $self->{is_finished} = 'no';
117             }
118 50         271 return $self->{is_finished};
119             }
120              
121             ####################
122             # RETURN VALUES
123              
124             sub mark_executed {
125 138     138 0 933 my ($self) = @_;
126              
127              
128 138         899 push @{$self->{execution_history} }, {
129 138         311 params => [ @{ $self->{bound_params} } ],
130 138         249 attrs => [ @{ $self->{bound_param_attrs} } ],
  138         515  
131             };
132              
133 138         468 $self->is_executed('yes');
134 138         417 $self->current_record_num(0);
135              
136 138         187 $self->{driver_attributes} = { %{ $self->{driver_attributes} }, %{ $self->{execute_attributes} } };
  138         698  
  138         331  
137              
138 138 100       578 if (ref $self->{callback} eq "CODE") {
139 12         18 my %recordSet = $self->{callback}->(@{ $self->{bound_params} });
  12         35  
140              
141 12 100       173 if (ref $recordSet{fields} eq "ARRAY") {
142 9         23 $self->{fields} = $recordSet{fields};
143             }
144              
145 12 50       34 if (ref $recordSet{rows} eq "ARRAY") {
146 12         18 $self->{return_data} = $recordSet{rows};
147             }
148              
149 12 100       32 if (defined $recordSet{last_insert_id}) {
150 2         5 $self->{last_insert_id} = $recordSet{last_insert_id};
151             }
152              
153 12 100       38 if (defined $recordSet{execute_attributes}) {
154 1         2 $self->{driver_attributes} = { %{ $self->{driver_attributes} }, %{ $recordSet{execute_attributes} } };
  1         3  
  1         5  
155             }
156             }
157             }
158              
159             sub next_record {
160 171     171 0 940 my ($self) = @_;
161 171 100       308 return if $self->is_depleted;
162 142         300 my $rec_num = $self->current_record_num;
163 142         251 my $rec = $self->return_data->[$rec_num];
164 142         335 $self->current_record_num( $rec_num + 1 );
165 142         372 return $rec;
166             }
167              
168             sub is_depleted {
169 190     190 0 1595 my ($self) = @_;
170 190         342 return ( $self->current_record_num >= scalar @{ $self->return_data } );
  190         339  
171             }
172              
173             # DEBUGGING AID
174              
175             sub to_string {
176 0     0 0 0 my ($self) = @_;
177             return join "\n" => (
178             $self->{statement},
179 0         0 "Values: [" . join( '] [', @{ $self->{bound_params} } ) . "]",
180             "Records: on $self->{current_record_num} of "
181 0         0 . scalar( @{ $self->return_data } ) . "\n",
  0         0  
182             "Executed? $self->{is_executed}; Finished? $self->{is_finished}"
183             );
184             }
185              
186             # PROPERTIES
187              
188             # boolean
189              
190             sub is_executed {
191 152     152 0 311 my ( $self, $yes_no ) = @_;
192 152 100       420 $self->{is_executed} = $yes_no if defined $yes_no;
193 152 100       449 return ( $self->{is_executed} eq 'yes' ) ? 'yes' : 'no';
194             }
195              
196             # single-element fields
197              
198             sub statement {
199 29     29 0 4034 my ( $self, $value ) = @_;
200 29 100       91 $self->{statement} = $value if defined $value;
201 29         158 return $self->{statement};
202             }
203              
204             sub current_record_num {
205 668     668 0 1050 my ( $self, $value ) = @_;
206 668 100       1299 $self->{current_record_num} = $value if defined $value;
207 668         1065 return $self->{current_record_num};
208             }
209              
210             sub callback {
211 0     0 0 0 my ( $self, $callback ) = @_;
212 0 0       0 $self->{callback} = $callback if defined $callback;
213 0         0 return $self->{callback};
214             }
215              
216             # multi-element fields
217              
218             sub return_data {
219 335     335 0 501 my ( $self, @values ) = @_;
220 335 50       604 push @{ $self->{return_data} }, @values if scalar @values;
  0         0  
221 335         926 return $self->{return_data};
222             }
223              
224             sub fields {
225 163     163 0 340 my ( $self, @values ) = @_;
226              
227 163   50     441 $self->{fields} ||= [];
228              
229 163 50       385 push @{ $self->{fields} }, @values if scalar @values;
  0         0  
230              
231 163         448 return $self->{fields};
232             }
233              
234             sub bound_params {
235 83     83 0 5548 my ( $self, @values ) = @_;
236 83 50       217 push @{ $self->{bound_params} }, @values if scalar @values;
  0         0  
237 83         333 return $self->{bound_params};
238             }
239              
240             sub bound_param_attrs {
241 6     6 0 6322 my ( $self, @values ) = @_;
242 6 50       20 push @{ $self->{bound_param_attrs} }, @values if scalar @values;
  0         0  
243 6         23 return $self->{bound_param_attrs};
244             }
245              
246             sub execution_history {
247 1     1 0 4 my ( $self, @values ) = @_;
248 1 50       5 push @{ $self->{execution_history} }, @values if scalar @values;
  0         0  
249 1         36 return $self->{execution_history};
250             }
251              
252             1;