File Coverage

lib/DBD/Mock/Session/GenerateFixtures.pm
Criterion Covered Total %
statement 438 446 98.2
branch 59 66 89.3
condition 18 30 60.0
subroutine 66 68 97.0
pod 4 4 100.0
total 585 614 95.2


line stmt bran cond sub pod time code
1             package DBD::Mock::Session::GenerateFixtures;
2              
3 16     16   11614010 use strict;
  16         54  
  16         726  
4 16     16   90 use warnings;
  16         41  
  16         1026  
5              
6 16     16   99 use Carp 'croak';
  16         27  
  16         1101  
7 16     16   11253 use DBD::Mock;
  16         434449  
  16         119  
8              
9 16     16   868 use feature 'say';
  16         44  
  16         2745  
10              
11 16     16   8955 use Sub::Override;
  16         39646  
  16         753  
12 16     16   9003 use English qw ( -no_match_vars );
  16         55958  
  16         121  
13 16     16   7083 use File::Path qw(make_path);
  16         45  
  16         1302  
14 16     16   18075 use Cpanel::JSON::XS;
  16         58664  
  16         1580  
15 16     16   9829 use File::Slurper qw (read_text);
  16         321080  
  16         1513  
16 16     16   150 use File::Spec;
  16         101  
  16         534  
17 16     16   9759 use Readonly;
  16         81376  
  16         1325  
18 16     16   9404 use Data::Walk;
  16         22797  
  16         1370  
19 16     16   3544 use Try::Tiny;
  16         13150  
  16         111956  
20              
21             our $VERSION = 1.11;
22              
23             our $override;
24             my $JSON_OBJ = Cpanel::JSON::XS->new()->utf8->pretty();
25              
26             Readonly::Hash my %MOCKED_DBI_METHODS => (
27             execute => 'DBI::st::execute',
28             bind_param => 'DBI::st::bind_param',
29             fetchrow_hashref => 'DBI::st::fetchrow_hashref',
30             fetchrow_arrayref => 'DBI::st::fetchrow_arrayref',
31             fetchrow_array => 'DBI::st::fetchrow_array',
32             selectall_arrayref => 'DBI::db::selectall_arrayref',
33             selectall_hashref => 'DBI::db::selectall_hashref',
34             selectcol_arrayref => 'DBI::db::selectcol_arrayref',
35             selectrow_array => 'DBI::db::selectrow_array',
36             selectrow_arrayref => 'DBI::db::selectrow_arrayref',
37             selectrow_hashref => 'DBI::db::selectrow_hashref',
38             fetch => 'DBI::st::fetch',
39             prepare_cached => 'DBI::db::prepare_cached',
40             prepare => 'DBI::db::prepare',
41             mocked_prepare => 'DBD::Mock::db::prepare',
42             begin_work => 'DBI::db::begin_work',
43             commit => 'DBI::db::commit',
44             rollback => 'DBI::db::rollback',
45             );
46              
47             sub new {
48 23     23 1 5363118 my ( $class, $args_for ) = @_;
49 23         72 my $self = bless {}, $class;
50              
51 23 100       88 if ($args_for) {
52 21         112 $self->_validate_args($args_for);
53 18         89 $self->_initialize($args_for);
54             }
55             else {
56 2         10 $self->_initialize();
57             }
58              
59 19         85 return $self;
60             }
61              
62             sub _initialize {
63 20     20   44 my $self = shift;
64 20         36 my $args_for = shift;
65              
66 20         48 my %args_for = ();
67              
68 20 100       85 if ($args_for) {
69 18         30 %args_for = %{$args_for};
  18         61  
70             }
71              
72 20         186 $self->_set_fixtures_file( $args_for{file} );
73 20         60 $self->{override_flag} = 0;
74 20         233 $override = Sub::Override->new();
75 20         230 $self->{override} = $override;
76              
77 20 100       417 if ( my $dbh = $args_for{dbh} ) {
    100          
    100          
78 9         51 $self->{dbh} = $dbh;
79 9         30 $self->{bind_params} = [];
80 9         27 $self->{override_flag} = 1;
81 9         163 $self->_override_dbi_methods();
82 9         33 $self->{result} = [];
83             }
84             elsif ( my $fixtures = $args_for{data} ) {
85 1         3 $self->_process_mock_data($fixtures);
86 1         2 $self->_set_mock_dbh($fixtures);
87             }
88             elsif ( -e $self->{fixture_file} ) {
89 9         76 my $data = $JSON_OBJ->decode( read_text( $self->{fixture_file} ) );
90 9         2189 $self->_process_mock_data($data);
91 9         40 $self->_set_mock_dbh($data);
92             }
93             else {
94 1         168 croak "No mocked data is available, you can resolve this by providing the 'dbh'
95             argument to the 'new' method to generate it. Alternatively, you can pass either
96             a file or data argument to the 'new' method";
97             }
98              
99 19         77 return $self;
100             }
101              
102             sub _set_mock_dbh {
103 10     10   28 my ( $self, $data ) = @_;
104              
105 10         170 my $dbh = DBI->connect(
106             'dbi:Mock:',
107             '', '',
108             {
109             RaiseError => 1,
110             PrintError => 0
111             }
112             );
113              
114 10         12288 my $dbh_session = DBD::Mock::Session->new( $PROGRAM_NAME => @{$data} );
  10         108  
115 10         918 $self->_override_dbi_mocked_prepare( $MOCKED_DBI_METHODS{mocked_prepare} );
116              
117 10         78 $dbh->{mock_session} = $dbh_session;
118 10         277 $self->{dbh} = $dbh;
119              
120 10         36 return $self;
121             }
122              
123             sub _override_dbi_methods {
124 9     9   79 my $self = shift;
125              
126 9         68 $self->_override_dbi_execute( $MOCKED_DBI_METHODS{execute} );
127 9         51 $self->_override_dbi_bind_param( $MOCKED_DBI_METHODS{bind_param} );
128 9         50 $self->_override_dbi_fetchrow_hashref( $MOCKED_DBI_METHODS{fetchrow_hashref} );
129 9         71 $self->_override_dbi_fetchrow_arrayref( $MOCKED_DBI_METHODS{fetchrow_arrayref} );
130 9         56 $self->_override_dbi_fetchrow_array( $MOCKED_DBI_METHODS{fetchrow_array} );
131 9         93 $self->_override_dbi_selectall_arrayref( $MOCKED_DBI_METHODS{selectall_arrayref} );
132 9         88 $self->_override_dbi_selectall_hashref( $MOCKED_DBI_METHODS{selectall_hashref} );
133 9         50 $self->_override_dbi_selectcol_arrayref( $MOCKED_DBI_METHODS{selectcol_arrayref} );
134 9         49 $self->_override_dbi_selectrow_array( $MOCKED_DBI_METHODS{selectrow_array} );
135 9         63 $self->_override_dbi_selectrow_arrayref( $MOCKED_DBI_METHODS{selectrow_arrayref} );
136 9         93 $self->_override_dbi_selectrow_hashref( $MOCKED_DBI_METHODS{selectrow_hashref} );
137 9         62 $self->_override_dbi_fecth( $MOCKED_DBI_METHODS{fetch} );
138 9         58 $self->_override_dbi_prepare_cached( $MOCKED_DBI_METHODS{prepare_cached} );
139 9         43 $self->_override_dbi_prepare( $MOCKED_DBI_METHODS{prepare} );
140 9         58 $self->_override_dbi_begin_work( $MOCKED_DBI_METHODS{begin_work} );
141 9         316 $self->_override_dbi_commit( $MOCKED_DBI_METHODS{commit} );
142 9         291 $self->_override_dbi_rollback( $MOCKED_DBI_METHODS{rollback} );
143              
144 9         247 return $self;
145             }
146              
147             sub get_dbh {
148 18     18 1 82 my $self = shift;
149              
150 18         66 return $self->{dbh};
151             }
152              
153             sub get_override_object {
154 180     180 1 273 my $self = shift;
155              
156 180         1632 return $self->{override};
157             }
158              
159             sub restore_all {
160 1     1 1 588 my $self = shift;
161              
162 1         11 foreach my $key ( keys %MOCKED_DBI_METHODS ) {
163 18 100       787 next if $key eq 'mocked_prepare';
164 17         37 $self->get_override_object()->restore( $MOCKED_DBI_METHODS{$key} );
165             }
166              
167 1         46 return $self;
168             }
169              
170             sub _override_dbi_execute {
171 9     9   44 my $self = shift;
172 9         42 my $dbi_execute = shift;
173              
174 9         105 my $orig_execute = \&$dbi_execute;
175              
176             $self->get_override_object()->replace(
177             $dbi_execute,
178             sub {
179 60     60   9857 my ( $sth, @args ) = @_;
180              
181 60   33     598 my $sql = $sth->{Statement} // $sth->{Database}->{Statement} // '';
      0        
182 60         285 $sql = $self->_normalize_sql($sql);
183 60         80878 my $retval = $orig_execute->( $sth, @args );
184              
185 60         5328 my $col_names;
186             try {
187             $col_names = $sth->{NAME}
188 60 100   56   5390 if $sql !~ m/^INSERT|^UPDATE|^DELETE/i;
189             }
190             catch {
191 0     0   0 my $error = $_;
192              
193             # say STDERR $error;
194 60         771 };
195              
196 60         1806 my $rows = $sth->rows();
197 60         921 my $query_data = {
198             statement => $sql,
199             bound_params => \@args,
200             col_names => $col_names,
201             };
202              
203 60         126 my $result = [];
204 60 100 66     899 if ( $sql =~ m/^INSERT|^UPDATE|^DELETE/i && $retval ) {
205 14         46 push @$result, ['rows'];
206 14         51 foreach my $row ( 1 .. $rows ) {
207 16         27 push @{$result}, [];
  16         40  
208             }
209 14         49 $query_data->{results} = $result;
210             }
211              
212             $query_data->{bound_params} = $self->{bind_params}
213             if ref $self->{bind_params}
214 60 100 66     261 && scalar @{ $self->{bind_params} } > 0;
  60         261  
215              
216             # query failed:
217 60 50       236 if ( !$retval ) {
218 0         0 $query_data->{failure} = [ 5, 'Ooops!' ];
219 0         0 $query_data->{results} = undef;
220             }
221              
222 60 100       440 push @{ $self->{result} }, $query_data
  58         219  
223             if $sql !~ m/BEGIN|COMMIT/;
224 60         345 $self->_write_to_file();
225 60         281 $self->{bind_params} = [];
226 60         1442 $self->{sth} = $sth;
227 60         443 return $retval;
228             }
229 9         41 );
230              
231 9         449 return $self;
232             }
233              
234             sub _override_dbi_bind_param {
235 9     9   50 my $self = shift;
236 9         31 my $bind_param = shift;
237              
238 9         93 my $orig_execute = \&$bind_param;
239              
240             $self->get_override_object()->replace(
241             $bind_param,
242             sub {
243 12     12   1011 my ( $sth, $bind, $val ) = @_;
244              
245 12         22 push @{ $self->{bind_params} }, $val;
  12         37  
246              
247 12         105 my $retval = $orig_execute->( $sth, $bind, $val );
248 12         32 return $retval;
249             }
250 9         35 );
251              
252 9         319 return $self;
253             }
254              
255             sub _override_dbi_fetchrow_hashref {
256 9     9   20 my $self = shift;
257 9         28 my $fetchrow_hashref = shift;
258              
259 9         88 my $orig_selectrow_hashref = \&$fetchrow_hashref;
260              
261             $self->get_override_object()->replace(
262             $fetchrow_hashref,
263             sub {
264 20     20   216 my ($sth) = @_;
265              
266 20         213 my $retval = $orig_selectrow_hashref->($sth);
267 20         461 $self->{result}->[-1]->{col_names} = $sth->{NAME};
268 20 100 100     162 if ( ref $retval && !defined $self->{result}->[-1]->{results} ) {
269 2         6 my $query_results = $self->_set_hashref_response( $sth, $retval );
270 2         3 push @{ $self->{result}->[-1]->{results} }, $query_results;
  2         5  
271 2         5 $self->_write_to_file();
272             }
273              
274 20         82 return $retval;
275             }
276 9         41 );
277              
278 9         236 return $self;
279             }
280              
281             sub _override_dbi_fetchrow_arrayref {
282 9     9   17 my $self = shift;
283 9         28 my $fetchrow_arrayref = shift;
284              
285 9         71 my $orig_selectrow_arrayref = \&$fetchrow_arrayref;
286              
287             $self->get_override_object()->replace(
288             $fetchrow_arrayref,
289             sub {
290 20     20   242 my ($sth) = @_;
291              
292 20         222 my $retval = $orig_selectrow_arrayref->($sth);
293 20         664 $self->{result}->[-1]->{col_names} = $sth->{NAME};
294 20         198 my @retval = ();
295 20 100       54 if ( ref $retval ) {
296 14         23 @retval = @{$retval};
  14         39  
297 14         20 push @{ $self->{result}->[-1]->{results} }, \@retval;
  14         54  
298 14         41 $self->_write_to_file();
299             }
300              
301 20         78 return $retval;
302             }
303 9         33 );
304              
305 9         252 return $self;
306             }
307              
308             sub _override_dbi_fetchrow_array {
309 9     9   16 my $self = shift;
310 9         29 my $fetchrow_array = shift;
311              
312 9         70 my $orig_selectrow_array = \&$fetchrow_array;
313              
314             $self->get_override_object()->replace(
315             $fetchrow_array,
316             sub {
317 16     16   124 my ($sth) = @_;
318              
319 16         231 my @retval = $orig_selectrow_array->($sth);
320 16         268 $self->{result}->[-1]->{col_names} = $sth->{NAME};
321              
322 16 100       118 if ( scalar @retval ) {
323 11         18 push @{ $self->{result}->[-1]->{results} }, \@retval;
  11         41  
324 11         31 $self->_write_to_file();
325             }
326              
327 16         72 return @retval;
328             }
329 9         30 );
330              
331 9         244 return $self;
332             }
333              
334             sub _override_dbi_selectall_arrayref {
335 9     9   16 my $self = shift;
336 9         27 my $selectall_arrayref = shift;
337              
338 9         184 my $result = $self->{result};
339 9         88 my $orig_selectall_arrayref = \&$selectall_arrayref;
340              
341             $self->get_override_object()->replace(
342             $selectall_arrayref,
343             sub {
344 3     3   12192 my ( $dbh, $sql, $slice, @parmas ) = @_;
345              
346 3         61 my $retval = $orig_selectall_arrayref->( $dbh, $sql, $slice, @parmas );
347 3         45 my $data = [];
348              
349 3 50       11 if ( ref $retval ) {
350 3         14 my $col_names = $self->_get_current_record_column_names();
351              
352 3         5 foreach my $row_as_hash ( @{$retval} ) {
  3         9  
353 5         11 my $row_as_array = [];
354 5         7 foreach my $col_name ( @{$col_names} ) {
  5         12  
355 10         15 push @{$row_as_array}, $row_as_hash->{$col_name};
  10         55  
356             }
357              
358 5         6 push @{$data}, $row_as_array;
  5         13  
359             }
360 3         15 $self->{result}->[-1]->{results} = $data;
361 3         10 $self->_write_to_file();
362             }
363              
364 3         17 return $retval;
365             }
366 9         68 );
367              
368 9         326 return $self;
369             }
370              
371             sub _override_dbi_selectall_hashref {
372 9     9   17 my $self = shift;
373 9         34 my $selectall_hashref = shift;
374              
375 9         82 my $orig_selectall_hashref = \&$selectall_hashref;
376              
377             $self->get_override_object()->replace(
378             $selectall_hashref,
379             sub {
380 3     3   17410 my ( $dbh, $statement, $key_field, $attr, @bind_values ) = @_;
381              
382 3         52 my $retval = $orig_selectall_hashref->( $dbh, $statement, $key_field, $attr, @bind_values );
383              
384 3         36 my $col_names = $self->_get_current_record_column_names();
385 3         7 my $mock_data = [];
386              
387             walk sub {
388 45     45   1951 my $rows = $_;
389 45 100 100     135 if ( ref $rows && scalar keys %{$rows} == scalar @{$col_names} ) {
  12         26  
  12         48  
390 6         28 my %data = %$rows;
391 6         13 push @{$mock_data}, [ @data{ @{$col_names} } ];
  6         11  
  6         28  
392 6         21 $self->_write_to_file();
393             }
394              
395 45         111 return;
396 3         32 }, $retval;
397              
398 3         134 $self->{result}->[-1]->{results} = $mock_data;
399 3         16 return $retval;
400             }
401 9         48 );
402              
403 9         281 return $self;
404             }
405              
406             sub _override_dbi_selectcol_arrayref {
407 9     9   18 my $self = shift;
408 9         47 my $selectcol_arrayref = shift;
409              
410 9         71 my $orig_selectcol_arrayref = \&$selectcol_arrayref;
411              
412             $self->get_override_object()->replace(
413             $selectcol_arrayref,
414             sub {
415 3     3   15733 my ( $dbh, $statement, $attr, @bind_values ) = @_;
416 3         25 my $mocked_data = [];
417              
418 3         33 my $retval = $orig_selectcol_arrayref->( $dbh, $statement, $attr, @bind_values );
419 3         24 my @db_data = @{$retval};
  3         10  
420              
421 3         6 my $length = 1;
422 3 100 66     22 $length = scalar @{ $attr->{Columns} }
  2         6  
423             if $attr && ref $attr eq 'HASH';
424              
425 3         13 foreach my $row ( 0 .. $#db_data ) {
426 10         27 my $query_data = [ splice( @db_data, 0, $length ) ];
427 10 100       32 last if scalar @{$query_data} == 0;
  10         26  
428 9         14 push @{$mocked_data}, $query_data;
  9         21  
429             }
430              
431 3         19 $self->{result}->[-1]->{results} = $mocked_data;
432 3         11 $self->_write_to_file();
433 3         13 return $retval;
434             }
435 9         61 );
436              
437 9         295 return $self;
438             }
439              
440             sub _override_dbi_selectrow_array {
441 9     9   28 my $self = shift;
442 9         29 my $selectrow_array = shift;
443              
444 9         71 my $original_selectrow_array = \&$selectrow_array;
445              
446             $self->get_override_object()->replace(
447             $selectrow_array,
448             sub {
449 6     6   3595 my ( $dbh, $statement, $attr, @bind_values ) = @_;
450 6         11 my $sth;
451              
452 6 100       16 if ( !ref $statement ) {
453 4         13 $sth = $dbh->prepare($statement);
454             }
455             else {
456 2         4 $sth = $statement;
457             }
458              
459 6         618 my $sql = $sth->{Statement};
460 6         274 my @retval = $original_selectrow_array->( $dbh, $statement, $attr, @bind_values );
461              
462             my $query_data = {
463             statement => $sql,
464             bound_params => \@bind_values,
465             col_names => $sth->{NAME},
466 6         605 results => [ \@retval ],
467             };
468              
469 6         98 push @{ $self->{result} }, $query_data;
  6         19  
470              
471 6         19 $self->_write_to_file();
472 6         70 return @retval;
473             }
474 9         45 );
475              
476 9         307 return $self;
477             }
478              
479             sub _override_dbi_selectrow_arrayref {
480 9     9   17 my $self = shift;
481 9         28 my $selectrow_arrayref = shift;
482              
483 9         117 my $original_selectrow_arrayref = \&$selectrow_arrayref;
484              
485             $self->get_override_object()->replace(
486             $selectrow_arrayref,
487             sub {
488 6     6   5178 my ( $dbh, $statement, $attr, @bind_values ) = @_;
489 6         9 my $sth;
490              
491 6 100       16 if ( !ref $statement ) {
492 4         10 $sth = $dbh->prepare($statement);
493             }
494             else {
495 2         4 $sth = $statement;
496             }
497              
498 6         523 my $sql = $sth->{Statement};
499 6         86 my $retval = $original_selectrow_arrayref->( $dbh, $statement, $attr, @bind_values );
500              
501             my $query_data = {
502             statement => $sql,
503             bound_params => \@bind_values,
504             col_names => $sth->{NAME},
505 6         401 results => [$retval],
506             };
507              
508 6         71 push @{ $self->{result} }, $query_data;
  6         17  
509 6         17 $self->_write_to_file();
510              
511 6         66 return $retval;
512             }
513 9         29 );
514              
515 9         295 return $self;
516             }
517              
518             sub _override_dbi_selectrow_hashref {
519 9     9   22 my $self = shift;
520 9         31 my $selectrow_hashref = shift;
521              
522 9         79 my $original_selectrow_hashref = \&$selectrow_hashref;
523              
524             $self->get_override_object()->replace(
525             $selectrow_hashref,
526             sub {
527 6     6   5267 my ( $dbh, $statement, $attr, @bind_values ) = @_;
528 6         11 my $sth;
529              
530 6 100       18 if ( !ref $statement ) {
531 4         12 $sth = $dbh->prepare($statement);
532             }
533             else {
534 2         4 $sth = $statement;
535             }
536              
537 6         600 my $sql = $sth->{Statement};
538 6         48 my $retval = $original_selectrow_hashref->( $dbh, $statement, $attr, @bind_values );
539              
540             $self->{result}->[-1]->{results} =
541 6         127 [ $self->_set_hashref_response( $sth, $retval ) ];
542              
543 6         37 return $retval;
544             }
545 9         34 );
546              
547 9         277 return $self;
548             }
549              
550             sub _override_dbi_fecth {
551 9     9   29 my $self = shift;
552 9         29 my $fetch = shift;
553              
554 9         76 my $original_fetch = \&$fetch;
555 9         24 my $result = [];
556             $self->get_override_object()->replace(
557             $fetch,
558             sub {
559 62     62   11341 my ( $sth, @args ) = @_;
560 62         904 my $row = $original_fetch->( $sth, @args );
561 62   33     1314 my $sql = $sth->{Statement} // $sth->{Database}->{Statement} // '';
      0        
562 62 100       200 if ( ref $row ) {
563 41         64 my @shallow_copy = @{$row};
  41         133  
564 41 100 100     471 if ( $sql =~ /WHERE/i
565             && $sql !~ /ORDER BY/i )
566             {
567 8         17 unshift @{ $self->{result}->[-1]->{results} }, \@shallow_copy;
  8         38  
568             }
569             else {
570 33         58 push @{ $self->{result}->[-1]->{results} }, \@shallow_copy;
  33         147  
571             }
572 41         131 $self->_write_to_file();
573             }
574              
575 62         299 return $row;
576             }
577 9         30 );
578              
579 9         298 return $self;
580             }
581              
582             sub _override_dbi_prepare_cached {
583 9     9   18 my $self = shift;
584 9         27 my $prepare_cached = shift;
585              
586 9         76 my $original_prepare_cached = \&$prepare_cached;
587             $self->get_override_object()->replace(
588             $prepare_cached,
589             sub {
590 4     4   10333 my ( $dbh, $sql, $attr, $if_active ) = @_;
591              
592 4         17 $sql = $self->_normalize_sql($sql);
593 4         35 return $original_prepare_cached->( $dbh, $sql, $attr, $if_active );
594             }
595 9         30 );
596 9         267 return $self;
597             }
598              
599             sub _override_dbi_prepare {
600 9     9   145 my $self = shift;
601 9         37 my $prepare = shift;
602              
603 9         85 my $original_prepare = \&$prepare;
604             $self->get_override_object()->replace(
605             $prepare,
606             sub {
607 73     73   173827 my ( $dbh, $sql, $attr ) = @_;
608              
609 73         283 $sql = $self->_normalize_sql($sql);
610 73         562 return $original_prepare->( $dbh, $sql, $attr );
611             }
612 9         53 );
613              
614 9         266 return $self;
615             }
616              
617             sub _override_dbi_mocked_prepare {
618 10     10   24 my $self = shift;
619 10         49 my $mocked_prepare = shift;
620              
621 10         112 my $original_mocked_prepare = \&$mocked_prepare;
622             $self->get_override_object()->replace(
623             $mocked_prepare,
624             sub {
625 57     57   129190 my ( $dbh, $sql ) = @_;
626              
627 57         208 $sql = $self->_normalize_sql($sql);
628 57         207 return $original_mocked_prepare->( $dbh, $sql );
629             }
630 10         84 );
631              
632 10         469 return $self;
633             }
634              
635             sub _override_dbi_begin_work {
636 9     9   22 my $self = shift;
637 9         24 my $mocked_begin_work = shift;
638              
639 9         81 my $original_begin_work = \&$mocked_begin_work,;
640             $self->get_override_object()->replace(
641             $mocked_begin_work,
642             sub {
643 2     2   3182 my $dbh = shift;
644              
645 2         4 push @{ $self->{result} },
  2         15  
646             {
647             statement => 'BEGIN WORK',
648             col_names => undef,
649             results => [ [] ]
650             };
651 2         6 $self->_write_to_file();
652 2         28 return $original_begin_work->($dbh);
653             }
654 9         55 );
655             }
656              
657             sub _override_dbi_commit {
658 9     9   19 my $self = shift;
659 9         46 my $mocked_commit = shift;
660              
661 9         68 my $original_commit = \&$mocked_commit;
662             $self->get_override_object()->replace(
663             $mocked_commit,
664             sub {
665 2     2   184 my $dbh = shift;
666              
667 2         4 push @{ $self->{result} }, { statement => 'COMMIT', col_names => undef, results => [ [] ] };
  2         17  
668 2         8 $self->_write_to_file();
669 2         12181 return $original_commit->($dbh);
670             }
671 9         28 );
672             }
673              
674             sub _override_dbi_rollback {
675 9     9   17 my $self = shift;
676 9         27 my $mocked_rollback = shift;
677              
678 9         76 my $original_rollback = \&$mocked_rollback;
679             $self->get_override_object()->replace(
680             $mocked_rollback,
681             sub {
682 0     0   0 my $dbh = shift;
683              
684 0         0 push @{ $self->{result} },
  0         0  
685             {
686             statement => 'ROLLBACK',
687             col_names => undef,
688             results => [ [] ]
689             };
690 0         0 $self->_write_to_file();
691 0         0 return $original_rollback->($dbh);
692             }
693 9         42 );
694             }
695              
696             sub _normalize_sql {
697 194     194   410 my ( $self, $sql ) = @_;
698              
699             # 1. remove multi-linie comments /* ... */
700 194         524 $sql =~ s/\/\*.*?\*\///gs;
701              
702             # 2. remove single-line comments -- ...
703 194         339 $sql =~ s/--.*$//gm;
704              
705 194         2403 $sql =~ s/\s+/ /g;
706 194         3307 $sql =~ s/^\s+|\s+$//g;
707              
708 194         516 return $sql;
709             }
710              
711             sub _get_current_record_column_names {
712 6     6   15 my $self = shift;
713              
714 6         27 return $self->{result}->[-1]->{col_names};
715             }
716              
717             sub _process_mock_data {
718 10     10   49 my ( $self, $data ) = @_;
719              
720 10         27 while ( my ( $index, $row ) = each( @{$data} ) ) {
  59         200  
721              
722 49 100       125 if ( $row->{col_names} ) {
723 38         111 my $cols = delete $row->{col_names};
724 38         78 unshift @{ $row->{results} }, $cols;
  38         115  
725             }
726             }
727              
728 10         25 return $self;
729             }
730              
731             sub _set_fixtures_file {
732 20     20   45 my $self = shift;
733 20         68 my $file = shift;
734              
735 20         141 Readonly::Scalar my $FIXTURE_DIR => 'db_fixtures/';
736              
737 20 100       765 if ( defined $file ) {
738 8         51 $self->{fixture_file} = $file;
739             }
740             else {
741 12         419 my ( $volume, $directory, $test_file ) = File::Spec->splitpath($PROGRAM_NAME);
742 12         1944 make_path( $directory . $FIXTURE_DIR );
743 12         58 my $default_fixture_file = $directory . $FIXTURE_DIR . "$test_file.json";
744 12         97 $self->{fixture_file} = $default_fixture_file;
745             }
746              
747 20         46 return $self;
748             }
749              
750             sub _validate_args {
751 21     21   112 my $self = shift;
752 21         43 my $args_for = shift;
753              
754 21 100       201 croak 'arguments to new must be hashref'
755             if ref $args_for ne 'HASH';
756              
757 20         158 Readonly::Hash my %ALLOWED_KEYS => (
758             dbh => 1,
759             file => 1,
760             data => 1,
761             override => 1,
762             );
763              
764 20 100       1814 croak 'to many args to new' if scalar keys %{$args_for} > 1;
  20         188  
765              
766 19         40 foreach my $key ( keys %{$args_for} ) {
  19         93  
767             croak "Key not allowed: $key"
768 19 100       120 unless $ALLOWED_KEYS{$key};
769             }
770              
771 18         420 return $self;
772             }
773              
774             sub _write_to_file {
775 156     156   274 my $self = shift;
776              
777 156         315 my $result = $self->{result};
778 156         298 my $override_flag = $self->{override_flag};
779 156         292 my $fixture_file = $self->{fixture_file};
780              
781 156 50       394 return unless defined $result;
782 156 50       390 return unless $override_flag;
783              
784 156 50 50     378 if ( $override_flag && scalar @{$result} ) {
  156         464  
785 156         5481 my $json_data = $JSON_OBJ->encode($result);
786 156 50       2348 my $fh = IO::File->new( $fixture_file, 'w' )
787             or croak "cannot open file:$fixture_file $!\n";
788 156         151880 say $fh $json_data;
789 156 50       741 $fh->close or croak "cannot close file:$fixture_file $!\n";
790 156         56803 undef $fh;
791             }
792              
793 156         488 return $self;
794             }
795              
796             sub _set_hashref_response {
797 8     8   10 my $self = shift;
798 8         10 my $sth = shift;
799 8         10 my $retval = shift;
800              
801 8         9 my $result = [];
802 8         39 my $cols = $sth->{NAME};
803 8         105 foreach my $col ( @{$cols} ) {
  8         39  
804 16         13 push @{$result}, $retval->{$col};
  16         33  
805             }
806              
807 8         25 return $result;
808             }
809              
810             sub DESTROY {
811 5     5   195 my $self = shift;
812              
813 5         11 my $result = delete $self->{result};
814 5         7 my $override_flag = delete $self->{override_flag};
815              
816 5         12 $override = delete $self->{override};
817 5         17 my $dbh = delete $self->{dbh};
818 5         20 my $fixture_file = delete $self->{fixture_file};
819              
820 5         101 return $self;
821             }
822              
823             1;
824              
825             =head1 NAME
826              
827             DBD::Mock::Session::GenerateFixtures - A module to generate fixtures for DBD::Mock::Session
828              
829             =head1 SYNOPSIS
830              
831             # Case 1: Providing a pre-existing DBI database handle for genereting a mocked data files
832             # with the test name
833             my $mock_dumper = DBD::Mock::Session::GenerateFixtures->new({ dbh => $dbh });
834             my $real_dbh = $mock_dumper->get_dbh();
835              
836             # Case 2: Read data from the same file as current test
837             my $mock_dumper = DBD::Mock::Session::GenerateFixtures->new();
838             my $dbh = $mock_dumper->get_dbh();
839             # Your code using the mock DBD
840              
841             # Case 3: Read data from a coustom file
842             my $mock_dumper = DBD::Mock::Session::GenerateFixtures->new({ file => 'path/to/fixture.json' });
843             my $dbh = $mock_dumper->get_dbh();
844             # Your code using the mock DBD
845              
846             # Case 4: Providing an array reference containing mock data
847             my $mock_dumper = DBD::Mock::Session::GenerateFixtures->new({ data => \@mock_data });
848             my $dbh = $mock_dumper->get_dbh();
849             # Your code using the mock DBD
850              
851             # or with Rose::DB
852              
853             my $mock_dumper = DBD::Mock::Session::GenerateFixtures->new();
854              
855             my $override = Sub::Override->new();
856             my $dbh = $mock_dumper->get_dbh();
857             $dbh->{mock_start_insert_id} = 3;
858              
859             $override->replace('Rose::DB::dbh' => sub {return $dbh});
860             $override->inject('DBD::Mock::db::last_insert_rowid', sub {$dbh->{mock_last_insert_id}});
861              
862             my $num_rows_updated = DB::Media::Manager->update_media(
863             set => {
864             location => '/data/music/claire_de_lune.ogg',
865             },
866             where => [
867             id => 2,
868             ],
869             );
870              
871             # support for begin_work, autocommit and rollback
872             my $login_history = DB::UserLoginHistory->new( user_id => 1 );
873             $login_history->db()->dbh()->begin_work();
874             try {
875             $login_history->save();
876             $login_history->db()->dbh()->commit();
877             }
878             catch {
879             $login_history->db()->dbh()->rollback();
880             };
881              
882             =head1 DESCRIPTION
883              
884             When a real DBI database handle ($dbh) is provided, the module generates C<DBD::Mock::Session> data and stores it in a JSON file.
885             After the data is generated, remove the 'dbh' argument from the constructor, and it will use the previously generated data to create a 'DBD::Mock::Session' database handle.
886             Mocked data can also be loaded from a custom file or as a data structure.
887             This is not a part of the DBD::Mock::Session distribution; it's just a wrapper around it."
888              
889             =head1 METHODS
890              
891             =head2 new(\%args_for)
892              
893             Constructor method to create a new C<DBD::Mock::Session::GenerateFixtures> object.
894              
895             Accepts an optional hash reference C<\%args_for> with the following keys:
896              
897             =over 4
898              
899             =item * C<file>: File path to the fixture file containing mocked data.
900              
901             =item * C<data>: Reference to an array containing mock data.
902              
903             =item * C<dbh>: Database handle used for reading the data required to genereate a mocked dbh. This should used first time you are runnig the tests.
904              
905             =back
906              
907             =head2 get_dbh()
908              
909             Returns the mocked database handle object.
910              
911             =head2 get_override_object()
912              
913             Returns the override object used for mocking DBI methods.
914              
915             =head2 restore_all()
916              
917             Restores all overridden DBI methods to their original implementations.
918              
919             This method is used to revert all DBI method overrides set up for mocking database interactions back to their original implementations.
920              
921             Returns the current object.
922              
923             =head1 PRIVATE METHODS
924              
925             These methods are not intended to be called directly from outside the module.
926              
927             =head2 _initialize(\%args_for)
928              
929             Initializes the C<DBD::Mock::Session::GenerateFixtures> object with the provided arguments.
930              
931             =head2 _set_mock_dbh(\@data)
932              
933             Sets up the mocked database handle based on the provided data.
934              
935             =head2 _override_dbi_methods()
936              
937             Overrides various DBI methods for mocking database interactions.
938              
939             =head2 _override_dbi_execute($dbi_execute)
940              
941             Overrides the C<execute> method of C<DBI::st> in order to capture the sql statement, bound_params and column names.
942              
943             =head2 _override_dbi_bind_param($bind_param)
944              
945             Overrides the C<bind_param> method of C<DBI::st> in order to capture the bound params.
946              
947             =head2 _override_dbi_fetchrow_hashref($fetchrow_hashref)
948              
949             Overrides the C<fetchrow_hashref> method of C<DBI::st> in order to capture the rows returned.
950              
951             =head2 _override_dbi_fetchrow_arrayref($fetchrow_arrayref)
952              
953             Overrides the C<fetchrow_arrayref> method of C<DBI::st> in order to capture the rows returned.
954              
955             =head2 _override_dbi_fetchrow_array($fetchrow_array)
956              
957             Overrides the C<fetchrow_array> method of C<DBI::st> in order to capture the rows returned.
958              
959             =head2 _override_dbi_selectall_arrayref($selectall_arrayref)
960              
961             Overrides the C<selectall_arrayref> method of C<DBI::db> in order to capture the rows returned.
962              
963             =head2 _override_dbi_selectall_hashref($selectall_hashref)
964              
965             Overrides the C<selectall_hashref> method of C<DBI::db> in order to capture the rows returned.
966              
967             =head2 _override_dbi_selectcol_arrayref($selectcol_arrayref)
968              
969             Overrides the C<selectcol_arrayref> method of C<DBI::db> in order to capture the rows returned.
970              
971             =head2 _override_dbi_selectrow_array($selectrow_array)
972              
973             Overrides the C<selectrow_array> method of C<DBI::db> in order to capture the rows returned.
974              
975             =head2 _override_dbi_selectrow_arrayref($selectrow_arrayref)
976              
977             Overrides the C<selectrow_arrayref> method of C<DBI::db> in order to capture the rows returned.
978              
979             =head2 _override_dbi_selectrow_hashref($selectrow_hashref)
980              
981             Overrides the C<selectrow_hashref> method of C<DBI::db> in order to capture the rows returned.
982              
983             =head2 _override_dbi_fecth($sth, @args)
984              
985             Overrides the C<fetch> method of C<DBI::st>
986              
987             =head2 _override_dbi_prepare
988              
989             _override_dbi_prepare($prepare);
990              
991             This method overrides the `DBI::db::prepare` method. It customizes how SQL statements are prepared for execution
992              
993             =head2 _override_dbi_prepare_cached
994              
995             _override_dbi_prepare_cached($prepare_cached);
996              
997             This method overrides the `DBI::db::prepare_cached` method. It provides a mechanism for caching prepared statements to optimize repeated queries.
998              
999             =head2 _override_dbi_mocked_prepare
1000              
1001             _override_dbi_mocked_prepare($mocked_prepare);
1002              
1003             This method overrides the `DBD::Mock::db::prepare` method. It is used for testing purposes to mock the behavior of statement preparation.
1004              
1005             =head2 _override_dbi_begin_work
1006              
1007             _override_dbi_begin_work($dbi_begin_work);
1008              
1009             This method overrides the `DBD::Mock::db::begin` method. It is used for testing purposes to add in fxtures an 'BEGIN WORK' statement.
1010              
1011             =head2 _override_dbi_commit
1012              
1013             _override_dbi_commit($commit);
1014              
1015             This method overrides the `DBD::Mock::db::commit` method. It is used for testing purposes to add in fxtures an 'COMMIT' statement.
1016              
1017             =head2 _override_dbi_rollback
1018              
1019             _override_dbi_rollback($rollback);
1020              
1021             This method overrides the `DBD::Mock::db::rollback` method. It is used for testing purposes to add in fxtures an 'ROLLBACK' statement.
1022              
1023             =head2 _normalize_sql
1024              
1025             _normalize_sql($sql);
1026              
1027             This method normalizes an SQL query string by removing extra whitespace and trimming leading or trailing spaces.
1028              
1029             =head2 _get_current_record_column_names()
1030              
1031             Returns the column names of the current record being processed.
1032              
1033             =head2 _process_mock_data(\@data)
1034              
1035             Processes the mock data before setting up the mocked database handle.
1036              
1037             =head2 _set_fixtures_file($file)
1038              
1039             Sets the file path for the fixture file containing mocked data.
1040              
1041             =head2 _validate_args(\%args_for)
1042              
1043             Validates the arguments passed to the constructor.
1044              
1045             =head2 _write_to_file()
1046              
1047             Writes the current results to the fixture file if override flag is set.
1048              
1049             =head2 _set_hashref_response($sth, $retval)
1050              
1051             Sets the response for hash references fetched from the database.
1052              
1053             =head1 Support
1054              
1055             Bugs should be reported via the CPAN bug tracker at
1056              
1057             https://rt.cpan.org/Public/Bug/Report.html?Queue=DBD-Mock-Session-GenerateFixtures
1058              
1059             For other issues, contact the author.
1060              
1061             =head1 REPOSITORY
1062              
1063             L<DBD-Fixtures|https://github.com/DragosTrif/DBD-Fixtures>
1064              
1065             =head1 AUTHOR
1066              
1067             Dragos Trif <drd.trif@gmail.com>
1068              
1069             =head1 LICENSE
1070              
1071             This library is free software and may be distributed under the same terms
1072             as perl itself.
1073              
1074             =cut