File Coverage

blib/lib/Anansi/DatabaseComponent.pm
Criterion Covered Total %
statement 8 603 1.3
branch 0 426 0.0
condition n/a
subroutine 3 18 16.6
pod 15 16 93.7
total 26 1063 2.4


line stmt bran cond sub pod time code
1             package Anansi::DatabaseComponent;
2              
3              
4             =head1 NAME
5              
6             Anansi::DatabaseComponent - A manager template for database drivers.
7              
8             =head1 SYNOPSIS
9              
10             package Anansi::Database::Example;
11              
12             use base qw(Anansi::DatabaseComponent);
13              
14             sub connect {
15             my ($self, $channel, %parameters) = @_;
16             return $self->SUPER::connect(
17             undef,
18             INPUT => [
19             'some text',
20             {
21             NAME => 'someParameter',
22             }, {
23             INPUT => [
24             'more text',
25             {
26             NAME => 'anotherParameter',
27             },
28             'yet more text',
29             ]
30             }, {
31             DEFAULT => 'abc',
32             NAME => 'yetAnotherParameter',
33             },
34             ],
35             (%parameters),
36             );
37             }
38              
39             sub validate {
40             my ($self, $channel, %parameters) = @_;
41             $parameters{DRIVER} = 'Example';
42             return Anansi::DatabaseComponent::validate(undef, %parameters);
43             }
44              
45             Anansi::DatabaseComponent::addChannel('Anansi::Database::Example', 'AUTOCOMMIT' => 'Anansi::DatabaseComponent::autocommit');
46             Anansi::DatabaseComponent::addChannel('Anansi::Database::Example', 'COMMIT' => 'Anansi::DatabaseComponent::commit');
47             Anansi::DatabaseComponent::addChannel('Anansi::Database::Example', 'CONNECT' => 'connect');
48             Anansi::DatabaseComponent::addChannel('Anansi::Database::Example', 'DISCONNECT' => 'Anansi::DatabaseComponent::disconnect');
49             Anansi::DatabaseComponent::addChannel('Anansi::Database::Example', 'FINISH' => 'Anansi::DatabaseComponent::finish');
50             Anansi::DatabaseComponent::addChannel('Anansi::Database::Example', 'HANDLE' => 'Anansi::DatabaseComponent::handle');
51             Anansi::DatabaseComponent::addChannel('Anansi::Database::Example', 'PREPARE' => 'Anansi::DatabaseComponent::prepare');
52             Anansi::DatabaseComponent::addChannel('Anansi::Database::Example', 'ROLLBACK' => 'Anansi::DatabaseComponent::rollback');
53             Anansi::DatabaseComponent::addChannel('Anansi::Database::Example', 'STATEMENT' => 'Anansi::DatabaseComponent::statement');
54             Anansi::DatabaseComponent::addChannel('Anansi::Database::Example', 'VALIDATE_AS_APPROPRIATE' => 'validate');
55              
56             1;
57              
58             package main;
59              
60             use Anansi::Database;
61              
62             my $database = Anansi::Database->new();
63             my $component = $database->addComponent(undef,
64             DRIVER => 'Example',
65             );
66             if(defined($component)) {
67             if($database->connect(
68             undef,
69             $component,
70             someParameter => 'some data',
71             anotherParameter => 'more data',
72             yetAnotherParameter => 'further data',
73             )) {
74             my $result = $database->statement(
75             undef,
76             $component,
77             SQL => 'SELECT someThing FROM someTable where modified = ?;',
78             INPUT => [
79             {
80             NAME => 'modified',
81             },
82             ],
83             modified => '2011-02-22 00:21:46',
84             );
85             if(!defined($result)) {
86             } elsif(ref($result) =~ /^ARRAY$/i) {
87             foreach my $record (@{$result}) {
88             next if(ref($record) !~ /^HASH$/i);
89             print 'someThing: "'.${$record}{someThing}.'"'."\n";
90             }
91             }
92             }
93             }
94              
95             1;
96              
97             =head1 DESCRIPTION
98              
99             Manages a database connection providing generic processes to allow it's opening,
100             closing and various SQL interactions. Uses L.
101              
102             =cut
103              
104              
105             our $VERSION = '0.05';
106              
107 1     1   67691 use base qw(Anansi::Component);
  1         3  
  1         558  
108              
109 1     1   25573 use Anansi::Actor;
  1         3  
  1         4  
110              
111              
112             =head1 METHODS
113              
114             =cut
115              
116              
117             =head2 Anansi::Class
118              
119             See L for details. A parent module of L.
120              
121             =cut
122              
123              
124             =head3 DESTROY
125              
126             See L for details.
127              
128             =cut
129              
130              
131             =head3 finalise
132              
133             See L for details. Overridden by L. A virtual method.
134              
135             =cut
136              
137              
138             =head3 implicate
139              
140             See L for details. A virtual method.
141              
142             =cut
143              
144              
145             =head3 import
146              
147             See L for details.
148              
149             =cut
150              
151              
152             =head3 initialise
153              
154             See L for details. Overridden by L. A virtual method.
155              
156             =cut
157              
158              
159             =head3 new
160              
161             See L for details.
162              
163             =cut
164              
165              
166             =head3 old
167              
168             See L for details.
169              
170             =cut
171              
172              
173             =head3 used
174              
175             See L for details.
176              
177             =cut
178              
179              
180             =head3 uses
181              
182             See L for details.
183              
184             =cut
185              
186              
187             =head3 using
188              
189             See L for details.
190              
191             =cut
192              
193              
194             =head2 Anansi::Component
195              
196             See L for details. A parent module of L.
197              
198             =cut
199              
200              
201             =head3 Anansi::Class
202              
203             See L for details. A parent module of L.
204              
205             =cut
206              
207              
208             =head3 addChannel
209              
210             See L for details. Overridden by L.
211              
212             =cut
213              
214              
215             =head3 channel
216              
217             See L for details.
218              
219             =cut
220              
221              
222             =head3 componentManagers
223              
224             See L for details.
225              
226             =cut
227              
228              
229             =head3 removeChannel
230              
231             See L for details. Overridden by L.
232              
233             =cut
234              
235              
236             =head2 addChannel
237              
238             Overrides L.
239              
240             =cut
241              
242              
243             sub addChannel {
244 10     10 1 31 my ($self, %parameters) = @_;
245 10         34 return $self->SUPER::addChannel((%parameters));
246             }
247              
248              
249             =head2 autoCommit
250              
251             if(1 == Anansi::DatabaseComponent::autocommit($OBJECT, undef));
252              
253             if(1 == Anansi::DatabaseComponent::channel($OBJECT, 'AUTOCOMMIT'));
254              
255             if(1 == $OBJECT->autocommit(undef));
256              
257             if(1 == $OBJECT->channel('AUTOCOMMIT'));
258              
259             =over 4
260              
261             =item self I<(Blessed Hash, Required)>
262              
263             An object of this namespace.
264              
265             =item channel I<(String, Required)>
266              
267             The abstract identifier of a subroutine.
268              
269             =item parameters I<(Hash, Optional)>
270              
271             Named parameters.
272              
273             =back
274              
275             Attempts to perform a database autocommit. Returns B<1> I<(one)> on success and
276             B<0> I<(zero)> on failure.
277              
278             =cut
279              
280              
281             sub autocommit {
282 0     0 0   my ($self, $channel, %parameters) = @_;
283 0 0         return 0 if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
284 0           my $autocommit;
285             eval {
286 0           $autocommit = $self->{HANDLE}->autocommit();
287 0           1;
288 0 0         } or do {
289 0           return 0;
290             };
291 0 0         return 0 if(!defined($autocommit));
292 0 0         return 0 if(ref($autocommit) !~ /^$/);
293 0 0         return 0 if($autocommit !~ /^[\+\-]?\d+$/);
294 0 0         return 1 if($autocommit);
295 0           return 0;
296             }
297              
298             Anansi::DatabaseComponent::addChannel('Anansi::DatabaseComponent', 'AUTOCOMMIT' => 'autocommit');
299              
300              
301             =head2 bind
302              
303             if(Anansi::DatabaseComponent::bind($OBJECT,
304             HANDLE => $HANDLE,
305             INPUT => [
306             {
307             NAME => 'someParameter'
308             }, {
309             DEFAULT => 123,
310             NAME => 'anotherParameter'
311             }
312             ],
313             VALUE => {
314             someParameter => 'abc'
315             }
316             ));
317              
318             if($OBJECT->bind(
319             HANDLE => $HANDLE,
320             INPUT => [
321             {
322             NAME => 'yetAnotherParameter',
323             TYPE => 'TEXT'
324             }
325             ],
326             VALUE => [
327             yetAnotherParameter => 456
328             ]
329             ));
330              
331             =over 4
332              
333             =item self I<(Blessed Hash B String, Required)>
334              
335             Either an object or a string of this namespace.
336              
337             =item parameters I<(Hash, Optional)>
338              
339             Named parameters.
340              
341             =over 4
342              
343             =item HANDLE I<(DBI::st, Required)>
344              
345             The database statement handle.
346              
347             =item INPUT I<(Array, Required)>
348              
349             An array of hashes. Each element of the array corresponds to an equivalent B
350             I<(Question mark)> within the prepared SQL statement. Each hash contains a
351             I key with a value that represents a possible key within the I
352             parameter. Each hash may also contain a I key which contains the value
353             to use if the equivalent I parameter does not exist and a I key
354             which contains the SQL type to associate with the assigned value. When no
355             corresponding I parameter key exists and no I key has been
356             defined then an empty string is used for the value.
357              
358             =item VALUE I<(Hash, Required)>
359              
360             A hash of values to assign in the order specified by the I parameter.
361              
362             =back
363              
364             =back
365              
366             Attempts to use the supplied parameters to assign values to a SQL statement that
367             has already been prepared to accept them. Returns B<0> I<(zero)> on failure and
368             the database statement handle on success.
369              
370             =cut
371              
372              
373             sub bind {
374 0     0 1   my ($self, %parameters) = @_;
375 0 0         return 0 if(!defined($parameters{HANDLE}));
376 0 0         return 0 if(!defined($parameters{INPUT}));
377 0 0         return 0 if(ref($parameters{INPUT}) !~ /^ARRAY$/i);
378 0 0         return 0 if(!defined($parameters{VALUE}));
379 0 0         return 0 if(ref($parameters{VALUE}) !~ /^HASH$/i);
380 0           my $index = 1;
381 0           foreach my $input (@{$parameters{INPUT}}) {
  0            
382 0 0         if(defined(${$parameters{VALUE}}{${$input}{NAME}})) {
  0 0          
  0 0          
383 0 0         if(defined(${$input}{TYPE})) {
  0            
384 0           $parameters{HANDLE}->bind_param($index, ${$parameters{VALUE}}{${$input}{NAME}}, ${$input}{TYPE});
  0            
  0            
  0            
385             } else {
386 0           $parameters{HANDLE}->bind_param($index, ${$parameters{VALUE}}{${$input}{NAME}});
  0            
  0            
387             }
388 0           } elsif(defined(${$input}{DEFAULT})) {
389 0 0         if(defined(${$input}{TYPE})) {
  0            
390 0           $parameters{HANDLE}->bind_param($index, ${$input}{DEFAULT}, ${$input}{TYPE});
  0            
  0            
391             } else {
392 0           $parameters{HANDLE}->bind_param($index, ${$input}{DEFAULT});
  0            
393             }
394 0           } elsif(defined(${$input}{TYPE})) {
395 0           $parameters{HANDLE}->bind_param($index, '', ${$input}{TYPE});
  0            
396             } else {
397 0           $parameters{HANDLE}->bind_param($index, '');
398             }
399 0           $index++;
400             }
401 0           return $parameters{HANDLE};
402             }
403              
404              
405             =head2 binding
406              
407             if(1 == Anansi::DatabaseComponent::binding($OBJECT));
408              
409             if(1 == $OBJECT->binding());
410              
411             =over 4
412              
413             =item self I<(Blessed Hash B String, Required)>
414              
415             Either an object or a string of this namespace.
416              
417             =item parameters I<(Array, Optional)>
418              
419             An array of hashes. Each hash should contain a I key with a string value.
420              
421             =back
422              
423             Verifies that the supplied parameters are all hashes and that they each contain
424             a I key with a string value. Returns B<1> I<(one)> when validity is
425             confirmed and B<0> I<(zero)> when an invalid structure is determined. Used to
426             validate the I parameter of the B method.
427              
428             =cut
429              
430              
431             sub binding {
432 0     0 1   my ($self, @parameters) = @_;
433 0           foreach my $parameter (@parameters) {
434 0 0         return 0 if(ref($parameter) !~ /^HASH$/i);
435 0 0         return 0 if(!defined(${$parameter}{NAME}));
  0            
436 0 0         return 0 if(ref(${$parameter}{NAME}) !~ /^$/);
  0            
437 0 0         return 0 if(${$parameter}{NAME} !~ /^[a-zA-Z_]+(\s*[a-zA-Z0-9_]+)*$/);
  0            
438             }
439 0           return 1;
440             }
441              
442              
443             =head2 commit
444              
445             if(1 == Anansi::DatabaseComponent::commit($OBJECT, undef));
446              
447             if(1 == Anansi::DatabaseComponent::channel($OBJECT, 'COMMIT'));
448              
449             if(1 == $OBJECT->commit(undef));
450              
451             if(1 == $OBJECT->channel('COMMIT'));
452              
453             =over 4
454              
455             =item self I<(Blessed Hash B String, Required)>
456              
457             Either an object or a string of this namespace.
458              
459             =item channel I<(String, Required)>
460              
461             The abstract identifier of a subroutine.
462              
463             =item parameters I<(Hash, Optional)>
464              
465             Named parameters.
466              
467             =back
468              
469             Attempts to perform a database commit. Returns B<1> I<(one)> on success and
470             B<0> I<(zero)> on failure.
471              
472             =cut
473              
474              
475             sub commit {
476 0     0 1   my ($self, $channel, %parameters) = @_;
477 0 0         return 0 if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
478 0 0         return 0 if(!defined($self->{HANDLE}));
479 0 0         return 1 if($self->autocommit());
480 0           my $commit;
481             eval {
482 0           $commit = $self->{HANDLE}->commit();
483 0           1;
484 0 0         } or do {
485 0           $self->rollback();
486 0           return 0;
487             };
488 0 0         return 0 if(!defined($commit));
489 0 0         return 0 if(ref($commit) !~ /^$/);
490 0 0         return 0 if($commit !~ /^[\+\-]?\d+$/);
491 0 0         return 1 if($commit);
492 0           return 0;
493             }
494              
495             Anansi::DatabaseComponent::addChannel('Anansi::DatabaseComponent', 'COMMIT' => 'commit');
496              
497              
498             =head2 connect
499              
500             if(1 == Anansi::DatabaseComponent::connect($OBJECT, undef
501             INPUT => [
502             'some text',
503             {
504             NAME => 'someParameter'
505             }, {
506             INPUT => [
507             'more text',
508             {
509             NAME => 'anotherParameter'
510             },
511             'yet more text'
512             ]
513             }, {
514             DEFAULT => 'abc',
515             NAME => 'yetAnotherParameter'
516             }
517             ],
518             someParameter => 12345,
519             anotherParameter => 'blah blah blah'
520             ));
521              
522             if(1 == Anansi::DatabaseComponent::channel($OBJECT, 'CONNECT',
523             INPUT => [
524             'blah blah blah',
525             {
526             DEFAULT => 123,
527             NAME => 'someParameter',
528             }
529             ],
530             someParameter => 'some text'
531             ));
532              
533             if(1 == $OBJECT->connect(undef,
534             INPUT => [
535             {
536             INPUT => [
537             'some text',
538             {
539             NAME => 'someParameter'
540             },
541             'more text'
542             ]
543             }
544             ],
545             someParameter => 'in between'
546             ));
547              
548             if(1 == $OBJECT->channel('CONNECT',
549             INPUT => [
550             {
551             INPUT => [
552             {
553             NAME => 'abc'
554             }, {
555             NAME => 'def'
556             }
557             },
558             REF => 'HASH'
559             }
560             ]
561             ));
562              
563             =over 4
564              
565             =item self I<(Blessed Hash, Required)>
566              
567             An object of this namespace.
568              
569             =item channel I<(String, Required)>
570              
571             The abstract identifier of a subroutine.
572              
573             =item parameters I<(Hash, Required)>
574              
575             Named parameters.
576              
577             =over 4
578              
579             =item HANDLE I<(DBI::db, Optional)>
580              
581             The database handle of an existing database connection. Used in preference to
582             the I parameter.
583              
584             =item INPUT I<(Array B Scalar, Optional)>
585              
586             An array or single value containing a description of each parameter in the order
587             that it is passed to the database driver's I method. Used when the
588             I parameter does not exist.
589              
590             =over 4
591              
592             =item I<(Non-Hash)>
593              
594             An element that does not contain a hash value will be used as the corresponding
595             I method's parameter value.
596              
597             =item I<(Hash)>
598              
599             An element that contains a hash value is assumed to be a description of how to
600             generate the corresponding I method's parameter value. when a value
601             can not be generated, an B value will be used.
602              
603             =over 4
604              
605             =item DEFAULT I<(Optional)>
606              
607             The value to use if no other value can be determined.
608              
609             =item INPUT I<(Array B Scalar, Optional)>
610              
611             Contains a structure like that given in I above with the exception that
612             any further I keys will be ignored. As this key is only valid when
613             I is undefined and I either specifies a string or a hash, it's value
614             will be either a concatenation of all the calculated strings or a hash
615             containing all of the specified keys and values.
616              
617             =item NAME I<(String, Optional)>
618              
619             The name of the parameter that contains the value to use.
620              
621             =item REF I<(Array B String, Optional)>
622              
623             The data types used to validate the value to use.
624              
625             =back
626              
627             =back
628              
629             =back
630              
631             =back
632              
633             Either uses an existing database connection or attempts to perform a database
634             connection using the supplied parameters. Returns B<1> I<(one)> on success and
635             B<0> I<(zero)> on failure.
636              
637             =cut
638              
639              
640             sub connect {
641 0     0 1   my ($self, $channel, %parameters) = @_;
642 0 0         return 0 if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
643 0           $self->disconnect();
644 0 0         if(defined($parameters{HANDLE})) {
    0          
    0          
645 0 0         return 0 if(ref($parameters{HANDLE}) !~ /^DBI::db$/);
646 0           $self->{HANDLE} = $parameters{HANDLE};
647 0           $self->{MANAGE_HANDLE} = 0;
648             } elsif(!defined($parameters{INPUT})) {
649 0           return 0;
650             } elsif(ref($parameters{INPUT}) !~ /^ARRAY$/i) {
651 0           return 0;
652             } else {
653 0           my @inputs;
654 0           foreach my $input (@{$parameters{INPUT}}) {
  0            
655 0 0         if(ref($input) !~ /^HASH$/i) {
656 0           push(@inputs, $input);
657 0           next;
658             }
659 0           my $value = undef;
660 0 0         $value = ${$input}{DEFAULT} if(defined(${$input}{DEFAULT}));
  0            
  0            
661 0 0         if(!defined(${$input}{NAME})) {
  0 0          
    0          
662 0 0         if(!defined(${$input}{INPUT})) {
  0 0          
    0          
    0          
    0          
    0          
663 0           } elsif(ref(${$input}{INPUT}) !~ /^ARRAY$/i) {
664 0           } elsif(!defined(${$input}{REF})) {
665 0           } elsif(ref(${$input}{REF}) !~ /^$/i) {
666 0           } elsif('' eq ${$input}{REF}) {
667 0           my @subInputs;
668 0           for(my $index = 0; $index < scalar(@{${$input}{INPUT}}); $index++) {
  0            
  0            
669 0 0         if(ref(${${$input}{INPUT}}[$index]) =~ /^$/i) {
  0 0          
  0            
670 0           push(@subInputs, ${${$input}{INPUT}}[$index]);
  0            
  0            
671 0           next;
672 0           } elsif(ref(${${$input}{INPUT}}[$index]) !~ /^HASH$/) {
  0            
673 0           next;
674             }
675 0           my $subValue = '';
676 0 0         $subValue = ${${${$input}{INPUT}}[$index]}{DEFAULT} if(defined(${${${$input}{INPUT}}[$index]}{DEFAULT}));
  0            
  0            
  0            
  0            
  0            
  0            
677 0 0         if(!defined(${${${$input}{INPUT}}[$index]}{NAME})) {
  0 0          
  0 0          
  0            
678 0           } elsif(ref(${${${$input}{INPUT}}[$index]}{NAME}) !~ /^$/) {
  0            
  0            
679 0           } elsif(defined($parameters{${${${$input}{INPUT}}[$index]}{NAME}})) {
  0            
  0            
680 0 0         if(!defined(${${${$input}{INPUT}}[$index]}{REF})) {
  0 0          
  0 0          
  0 0          
681 0 0         $subValue = $parameters{${${${$input}{INPUT}}[$index]}{NAME}} if('' eq ref($parameters{${${${$input}{INPUT}}[$index]}{NAME}}));
  0            
  0            
  0            
  0            
  0            
  0            
682 0           } elsif(ref(${${${$input}{INPUT}}[$index]}{REF}) !~ /^$/) {
  0            
  0            
683 0           } elsif('' ne ${${${$input}{INPUT}}[$index]}{REF}) {
  0            
  0            
684 0           } elsif('' ne ref($parameters{${${${$input}{INPUT}}[$index]}{NAME}})) {
  0            
  0            
685             } else {
686 0           $subValue = $parameters{${${${$input}{INPUT}}[$index]}{NAME}};
  0            
  0            
  0            
687             }
688             }
689 0           push(@subInputs, $subValue);
690             }
691 0           $value = join('', @subInputs);
692 0           } elsif(${$input}{REF} =~ /^HASH$/i) {
693 0           my %subInputs;
694 0           foreach my $subInput (@{${$input}{INPUT}}) {
  0            
  0            
695 0 0         next if(ref($subInput) !~ /^HASH$/i);
696 0           my $subValue = undef;
697 0 0         $subValue = ${$subInput}{DEFAULT} if(defined(${$subInput}{DEFAULT}));
  0            
  0            
698 0 0         if(!defined(${$subInput}{NAME})) {
  0 0          
    0          
699 0           } elsif(ref(${$subInput}{NAME}) !~ /^$/) {
700 0           } elsif(defined($parameters{${$subInput}{NAME}})) {
701 0 0         if(!defined(${$subInput}{REF})) {
  0 0          
    0          
    0          
702 0           } elsif(ref(${$subInput}{REF}) =~ /^ARRAY$/i) {
703 0           my %refs = map { $_ => 1 } (@{${$subInput}{REF}});
  0            
  0            
  0            
704 0 0         $subValue = $parameters{${$subInput}{NAME}} if(defined($refs{ref($parameters{${$subInput}{NAME}})}));
  0            
  0            
705 0           } elsif(ref(${$subInput}{REF}) !~ /^$/) {
706 0           } elsif(${$subInput}{REF} ne ref($parameters{${$subInput}{NAME}})) {
  0            
707             } else {
708 0           $subValue = $parameters{${$subInput}{NAME}};
  0            
709             }
710             }
711 0           $subInputs{${$subInput}{NAME}} = $subValue;
  0            
712             }
713 0           $value = \%subInputs;
714             }
715 0           } elsif(ref(${$input}{NAME}) !~ /^$/) {
716 0           } elsif(defined($parameters{${$input}{NAME}})) {
717 0 0         if(!defined(${$input}{REF})) {
  0 0          
    0          
    0          
    0          
718 0           } elsif(ref(${$input}{REF}) =~ /^ARRAY$/i) {
719 0           my %refs = map { $_ => 1 } (@{${$input}{REF}});
  0            
  0            
  0            
720 0 0         if(!defined($refs{ref($parameters{${$input}{NAME}})})) {
  0 0          
721 0           } elsif(ref($parameters{${$input}{NAME}}) !~ /^HASH$/i) {
722 0           $value = $parameters{${$input}{NAME}};
  0            
723             } else {
724 0 0         if(!defined(${$input}{INPUT})) {
  0 0          
725 0           $value = $parameters{${$input}{NAME}};
  0            
726 0           } elsif(ref(${$input}{INPUT}) !~ /^HASH$/i) {
727 0           $value = $parameters{${$input}{NAME}};
  0            
728             } else {
729 0           my %subInputs;
730 0           foreach my $subInput (keys(%{${$input}{INPUT}})) {
  0            
  0            
731 0 0         if(ref($subInput) !~ /^HASH$/i) {
732 0           $subInputs{$subInput} = $subInput;
733 0           next;
734             }
735 0           my $subValue = undef;
736 0 0         $value = ${${${$input}{INPUT}}{$subInput}}{DEFAULT} if(defined(${${${$input}{INPUT}}{$subInput}}{DEFAULT}));
  0            
  0            
  0            
  0            
  0            
  0            
737 0 0         if(!defined(${${${$input}{INPUT}}{$subInput}}{NAME})) {
  0 0          
  0 0          
  0            
738 0           } elsif(ref(${${${$input}{INPUT}}{$subInput}}{NAME}) !~ /^$/) {
  0            
  0            
739 0           } elsif(defined($parameters{${${${$input}{INPUT}}{$subInput}}{NAME}})) {
  0            
  0            
740 0 0         if(!defined(${${${$input}{INPUT}}{$subInput}}{REF})) {
  0 0          
  0 0          
  0 0          
741 0           } elsif(ref(${${${$input}{INPUT}}{$subInput}}{REF}) =~ /^ARRAY$/i) {
  0            
  0            
742 0           my %refs = map { $_ => 1 } (@{${${${$input}{INPUT}}{$subInput}}{REF}});
  0            
  0            
  0            
  0            
  0            
743 0 0         $subValue = $parameters{${${${$input}{INPUT}}{$subInput}}{NAME}} if(defined($refs{ref($parameters{${${${$input}{INPUT}}{$subInput}}{NAME}})}));
  0            
  0            
  0            
  0            
  0            
  0            
744 0           } elsif(ref(${${${$input}{INPUT}}{$subInput}}{REF}) !~ /^$/) {
  0            
  0            
745 0           } elsif(${${${$input}{INPUT}}{$subInput}}{REF} ne ref($parameters{${${${$input}{INPUT}}{$subInput}}{NAME}})) {
  0            
  0            
  0            
  0            
  0            
746             } else {
747 0           $subValue = $parameters{${${${$input}{INPUT}}{$subInput}}{NAME}};
  0            
  0            
  0            
748             }
749             }
750 0           $subInputs{$subInput} = $subValue;
751             }
752 0           $value = \%subInputs;
753             }
754             }
755 0           } elsif(ref(${$input}{REF}) !~ /^$/) {
756 0           } elsif(${$input}{REF} ne ref($parameters{${$input}{NAME}})) {
  0            
757 0           } elsif(ref($parameters{${$input}{NAME}}) !~ /^HASH$/i) {
758 0           $value = $parameters{${$input}{NAME}};
  0            
759             } else {
760 0 0         if(!defined(${$input}{INPUT})) {
  0 0          
761 0           $value = $parameters{${$input}{NAME}};
  0            
762 0           } elsif(ref(${$input}{INPUT}) !~ /^HASH$/i) {
763 0           $value = $parameters{${$input}{NAME}};
  0            
764             } else {
765 0           my %subInputs;
766 0           foreach my $key (keys(%{${$input}{INPUT}})) {
  0            
  0            
767 0 0         if(ref($subInput) !~ /^HASH$/i) {
768 0           push(@subInputs, $subInput);
769 0           next;
770             }
771 0           my $subValue = undef;
772 0 0         $value = ${${${$input}{INPUT}}{$subInput}}{DEFAULT} if(defined(${${${$input}{INPUT}}{$subInput}}{DEFAULT}));
  0            
  0            
  0            
  0            
  0            
  0            
773 0 0         if(!defined(${${${$input}{INPUT}}{$subInput}}{NAME})) {
  0 0          
  0 0          
  0            
774 0           } elsif(ref(${${${$input}{INPUT}}{$subInput}}{NAME}) !~ /^$/) {
  0            
  0            
775 0           } elsif(defined($parameters{${${${$input}{INPUT}}{$subInput}}{NAME}})) {
  0            
  0            
776 0 0         if(!defined(${${${$input}{INPUT}}{$subInput}}{REF})) {
  0 0          
  0 0          
  0 0          
777 0           } elsif(ref(${${${$input}{INPUT}}{$subInput}}{REF}) =~ /^ARRAY$/i) {
  0            
  0            
778 0           my %refs = map { $_ => 1 } (@{${${${$input}{INPUT}}{$subInput}}{REF}});
  0            
  0            
  0            
  0            
  0            
779 0 0         $subValue = $parameters{${${${$input}{INPUT}}{$subInput}}{NAME}} if(defined($refs{ref($parameters{${${${$input}{INPUT}}{$subInput}}{NAME}})}));
  0            
  0            
  0            
  0            
  0            
  0            
780 0           } elsif(ref(${${${$input}{INPUT}}{$subInput}}{REF}) !~ /^$/) {
  0            
  0            
781 0           } elsif(${${${$input}{INPUT}}{$subInput}}{REF} ne ref($parameters{${${${$input}{INPUT}}{$subInput}}{NAME}})) {
  0            
  0            
  0            
  0            
  0            
782             } else {
783 0           $subValue = $parameters{${${${$input}{INPUT}}{$subInput}}{NAME}};
  0            
  0            
  0            
784             }
785             }
786 0           $subInputs{$subInput} = $subValue;
787             }
788 0           $value = \%subInputs;
789             }
790             }
791             }
792 0           push(@inputs, $value);
793             }
794 0 0         return 0 if(0 == scalar(@inputs));
795 0           my $handle = DBI->connect(@inputs);
796 0 0         return 0 if(!defined($handle));
797 0           $self->{HANDLE} = $handle;
798 0           $self->{MANAGE_HANDLE} = 1;
799             }
800 0           return 1;
801             }
802              
803             Anansi::DatabaseComponent::addChannel('Anansi::DatabaseComponent', 'CONNECT' => 'connect');
804              
805              
806             =head2 disconnect
807              
808             if(1 == Anansi::DatabaseComponent::disconnect($OBJECT, undef));
809              
810             if(1 == Anansi::DatabaseComponent::channel($OBJECT, 'DISCONNECT'));
811              
812             if(1 == $OBJECT->disconnect(undef));
813              
814             if(1 == $OBJECT->channel('DISCONNECT'));
815              
816             =over 4
817              
818             =item self I<(Blessed Hash B String, Required)>
819              
820             Either an object or a string of this namespace.
821              
822             =item channel I<(String, Required)>
823              
824             The abstract identifier of a subroutine.
825              
826             =item parameters I<(Hash, Optional)>
827              
828             Named parameters.
829              
830             =back
831              
832             Attempts to perform a database disconnection. Returns B<1> I<(one)> on success
833             and B<0> I<(zero)> on failure.
834              
835             =cut
836              
837              
838             sub disconnect {
839 0     0 1   my ($self, $channel, %parameters) = @_;
840 0 0         return 0 if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
841 0 0         return 0 if(!defined($self->{HANDLE}));
842 0 0         if(!defined($self->{MANAGE_HANDLE})) {
    0          
843 0           $self->{MANAGE_HANDLE} = 0;
844             } elsif(1 == $self->{MANAGE_HANDLE}) {
845 0           $self->{HANDLE}->disconnect();
846 0           $self->{MANAGE_HANDLE} = 0;
847 0           delete $self->{HANDLE};
848             } else {
849 0           delete $self->{HANDLE};
850             }
851 0           return 1;
852             }
853              
854             Anansi::DatabaseComponent::addChannel('Anansi::DatabaseComponent', 'DISCONNECT' => 'disconnect');
855              
856              
857             =head2 finalise
858              
859             Overrides L. A virtual method.
860              
861             =cut
862              
863              
864             sub finalise {
865 0     0 1   my ($self, %parameters) = @_;
866 0           $self->finish();
867 0           $self->disconnect();
868             }
869              
870              
871             =head2 finish
872              
873             if(1 == Anansi::DatabaseComponent::finish($OBJECT, undef));
874              
875             if(1 == Anansi::DatabaseComponent::channel($OBJECT, 'FINISH'));
876              
877             if(1 == $OBJECT->finish(undef));
878              
879             if(1 == $OBJECT->channel('FINISH'));
880              
881             =over 4
882              
883             =item self I<(Blessed Hash, Required)>
884              
885             Either an object or a string of this namespace.
886              
887             =item channel I<(String, Required)>
888              
889             The abstract identifier of a subroutine.
890              
891             =item parameters I<(Hash, Optional)>
892              
893             Named parameters.
894              
895             =over 4
896              
897             =item STATEMENT I<(String, Optional)>
898              
899             The name associated with a prepared SQL statement.
900              
901             =back
902              
903             =back
904              
905             Either releases the named SQL statement preparation or all of the SQL statement
906             preparations. Returns B<1> I<(one)> on success and B<0> I<(zero)> on failure.
907              
908             =cut
909              
910              
911             sub finish {
912 0     0 1   my ($self, $channel, %parameters) = @_;
913 0 0         return 0 if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
914 0 0         if(!defined($self->{STATEMENTS})) {
    0          
915 0           return 0;
916 0           } elsif(0 == scalar(keys(%{$self->{STATEMENTS}}))) {
917 0           return 0;
918             }
919 0 0         if(!defined($parameters{STATEMENT})) {
    0          
    0          
    0          
920 0           foreach my $statement (keys(%{$self->{STATEMENTS}})) {
  0            
921 0 0         if(defined(${${$self->{STATEMENTS}}{$statement}}{HANDLE})) {
  0            
  0            
922 0           eval {
923 0           ${${$self->{STATEMENTS}}{$statement}}{HANDLE}->finish();
  0            
  0            
924 0           1;
925             };
926             }
927 0           delete ${$self->{STATEMENTS}}{$statement};
  0            
928             }
929             } elsif(ref($parameters{STATEMENT}) !~ /^$/) {
930 0           return 0;
931 0           } elsif(!defined(${$self->{STATEMENTS}}{$parameters{STATEMENT}})) {
932 0           return 0;
933 0           } elsif(!defined(${${$self->{STATEMENTS}}{$parameters{STATEMENT}}}{HANDLE})) {
  0            
934 0           return 0;
935             } else {
936 0           eval {
937 0           ${${$self->{STATEMENTS}}{$parameters{STATEMENT}}}{HANDLE}->finish();
  0            
  0            
938 0           1;
939             };
940 0           delete ${$self->{STATEMENTS}}{$parameters{STATEMENT}};
  0            
941             }
942 0 0         delete $self->{STATEMENTS} if(0 == scalar(keys(%{$self->{STATEMENTS}})));
  0            
943 0           return 1;
944             }
945              
946             Anansi::DatabaseComponent::addChannel('Anansi::DatabaseComponent', 'FINISH' => 'finish');
947              
948              
949             =head2 handle
950              
951             my $HANDLE = Anansi::DatabaseComponent::handle($OBJECT, undef);
952              
953             my $HANDLE = Anansi::DatabaseComponent::channel($OBJECT, 'HANDLE');
954              
955             my $HANDLE = $OBJECT->handle(undef);
956              
957             my $dbh = DBI->connect('DBI:mysql:database=someDatabase', 'someUser', 'somePassword');
958             my $HANDLE = $OBJECT->channel('HANDLE', $dbh);
959             if(defined($HANDLE));
960              
961             =over 4
962              
963             =item self I<(Blessed Hash, Required)>
964              
965             An object of this namespace.
966              
967             =item channel I<(String, Required)>
968              
969             The abstract identifier of a subroutine.
970              
971             =item handle I<(DBI::db, Optional)>
972              
973             A replacement database handle.
974              
975             =back
976              
977             Attempts to redefine an existing database handle when a handle is supplied.
978             Either returns the database handle or B on failure.
979              
980             =cut
981              
982              
983             sub handle {
984 0     0 1   my ($self, $channel, $handle) = @_;
985 0 0         return if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
986 0 0         if(defined($handle)) {
987 0 0         if(defined($self->{HANDLE})) {
988 0           $self->finish();
989 0           $self->disconnect();
990             }
991 0 0         return if(ref($handle) !~ /^DBI::db$/);
992 0           $self->{HANDLE} = $handle;
993 0           $self->{MANAGE_HANDLE} = 0;
994             }
995 0 0         return $self->{HANDLE} if(defined($self->{HANDLE}));
996 0           return;
997             }
998              
999             Anansi::DatabaseComponent::addChannel('Anansi::DatabaseComponent', 'HANDLE' => 'handle');
1000              
1001              
1002             =head2 initialise
1003              
1004             Overrides L. A virtual method.
1005              
1006             =cut
1007              
1008              
1009             sub initialise {
1010 0     0 1   my ($self, %parameters) = @_;
1011 0           Anansi::Actor->new(
1012             PACKAGE => 'DBI',
1013             );
1014 0           $self->{STATEMENT} = {};
1015             }
1016              
1017              
1018             =head2 prepare
1019              
1020             my $PREPARATION = if(1 == Anansi::DatabaseComponent::prepare($OBJECT, undef,
1021             STATEMENT => 'an associated name'
1022             );
1023             if(defined($PREPARATION));
1024              
1025             if(1 == Anansi::DatabaseComponent::channel($OBJECT, 'PREPARE',
1026             INPUT => [
1027             {
1028             NAME => 'someParameter'
1029             }
1030             ],
1031             SQL => 'SELECT abc, def FROM some_table WHERE ghi = ?',
1032             STATEMENT => 'another associated name'
1033             ));
1034              
1035             if(1 == $OBJECT->prepare(undef,
1036             INPUT => [
1037             {
1038             NAME => 'abc'
1039             }, {
1040             NAME => 'def'
1041             }, {
1042             NAME => 'ghi'
1043             }
1044             ],
1045             SQL => 'INSERT INTO some_table (abc, def, ghi) VALUES (?, ?, ?);',
1046             STATEMENT => 'yet another name'
1047             ));
1048              
1049             if(1 == $OBJECT->channel('PREPARE',
1050             INPUT => [
1051             {
1052             NAME => ''
1053             }
1054             ],
1055             SQL => '',
1056             STATEMENT => 'and another',
1057             ));
1058              
1059             =over 4
1060              
1061             =item self I<(Blessed Hash, Required)>
1062              
1063             Either an object or a string of this namespace.
1064              
1065             =item channel I<(String, Required)>
1066              
1067             The abstract identifier of a subroutine.
1068              
1069             =item parameters I<(Hash, Required)>
1070              
1071             Named parameters.
1072              
1073             =over 4
1074              
1075             =item INPUT I
1076              
1077             An array of hashes. Each hash should contain a I key with a string value
1078             that represents the name of a parameter to associate with the corresponding B
1079             I<(Question mark)>. See the I method for details.
1080              
1081             =item SQL I<(String, Optional)>
1082              
1083             The SQL statement to prepare.
1084              
1085             =item STATEMENT I<(String, Required)>
1086              
1087             The name to associate with the prepared SQL statement.
1088              
1089             =back
1090              
1091             =back
1092              
1093             Attempts to prepare a SQL statement to accept named parameters in place of B
1094             I<(Question mark)>s as required. Either returns all of the preparation data
1095             required to fulfill the SQL statement when called as a namespace method or B<1>
1096             I<(one)> when called through a channel on success and B<0> I<(zero)> on failure.
1097              
1098             =cut
1099              
1100              
1101             sub prepare {
1102 0     0 1   my ($self, $channel, %parameters) = @_;
1103 0 0         return 0 if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
1104 0 0         $self->{STATEMENTS} = {} if(!defined($self->{STATEMENTS}));
1105 0 0         return 0 if(!defined($parameters{STATEMENT}));
1106 0 0         return 0 if(ref($parameters{STATEMENT}) !~ /^$/);
1107 0 0         if(!defined(${$self->{STATEMENTS}}{$parameters{STATEMENT}})) {
  0            
1108 0 0         return 0 if(!defined($parameters{SQL}));
1109 0 0         return 0 if(ref($parameters{SQL}) !~ /^$/);
1110 0           $parameters{SQL} =~ s/^\s*(.*)|(.*)\s*$/$1/g;
1111 0           my $questionMarks = $parameters{SQL};
1112 0           my $questionMarks = $questionMarks =~ s/\?/$1/sg;
1113 0 0         if(0 == $questionMarks) {
    0          
    0          
    0          
1114 0 0         return 0 if(defined($parameters{INPUT}));
1115             } elsif(!defined($parameters{INPUT})) {
1116 0           return 0;
1117             } elsif(ref($parameters{INPUT}) !~ /^ARRAY$/i) {
1118 0           return 0;
1119 0           } elsif(scalar(@{$parameters{INPUT}}) != $questionMarks) {
1120 0           return 0;
1121             } else {
1122 0 0         return 0 if(!$self->binding((@{$parameters{INPUT}})));
  0            
1123             }
1124 0           my $handle;
1125             eval {
1126 0           $handle = $self->{HANDLE}->prepare($parameters{SQL});
1127 0           1;
1128 0 0         } or do {
1129 0           $self->rollback();
1130 0           return 0;
1131             };
1132             my %statement = (
1133             HANDLE => $handle,
1134             SQL => $parameters{SQL},
1135 0           );
1136 0 0         $statement{INPUT} = $parameters{INPUT} if(defined($parameters{INPUT}));
1137 0           ${$self->{STATEMENTS}}{$parameters{STATEMENT}} = \%statement;
  0            
1138             }
1139 0 0         return 1 if(defined($channel));
1140 0           return ${$self->{STATEMENTS}}{$parameters{STATEMENT}};
  0            
1141             }
1142              
1143             Anansi::DatabaseComponent::addChannel('Anansi::DatabaseComponent', 'PREPARE' => 'prepare');
1144              
1145              
1146             =head2 removeChannel
1147              
1148             Overrides L.
1149              
1150             =cut
1151              
1152              
1153             sub removeChannel {
1154 0     0 1   my ($self, %parameters) = @_;
1155 0           return $self->SUPER::removeChannel((%parameters));
1156             }
1157              
1158              
1159             =head2 rollback
1160              
1161             if(1 == Anansi::DatabaseComponent::rollback($OBJECT, undef));
1162              
1163             if(1 == Anansi::DatabaseComponent::channel($OBJECT, 'ROLLBACK'));
1164              
1165             if(1 == $OBJECT->rollback(undef));
1166              
1167             if(1 == $OBJECT->channel('ROLLBACK'));
1168              
1169             =over 4
1170              
1171             =item self I<(Blessed Hash, Required)>
1172              
1173             Either an object or a string of this namespace.
1174              
1175             =item channel I<(String, Required)>
1176              
1177             The abstract identifier of a subroutine.
1178              
1179             =item parameters I<(Hash, Optional)>
1180              
1181             Named parameters.
1182              
1183             =back
1184              
1185             Attempts to undo all of the database changes since the last database I.
1186             Returns B<1> I<(one)> on success and B<0> I<(zero)> on failure.
1187              
1188             =cut
1189              
1190              
1191             sub rollback {
1192 0     0 1   my ($self, $channel, %parameters) = @_;
1193 0 0         return 0 if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
1194 0 0         return 0 if($self->autocommit());
1195 0           my $rollback;
1196             eval {
1197 0           $rollback = $self->{HANDLE}->rollback();
1198 0           1;
1199 0 0         } or do {
1200 0           return 0;
1201             };
1202 0 0         return 0 if(!defined($rollback));
1203 0 0         return 0 if(ref($rollback) !~ /^$/);
1204 0 0         return 0 if($rollback !~ /^[\+\-]?\d+$/);
1205 0 0         return 1 if($rollback);
1206 0           return 0;
1207             }
1208              
1209             Anansi::DatabaseComponent::addChannel('Anansi::DatabaseComponent', 'ROLLBACK' => 'rollback');
1210              
1211              
1212             =begin comment
1213              
1214             ################################################################################
1215              
1216             =head2 script
1217              
1218             my $result = $object->script(
1219             undef,
1220             SCRIPT => [
1221             {
1222             COMMAND => 'LOOP',
1223             TEST => '',
1224             }, [
1225             {
1226             },
1227             ],
1228             ],
1229             );
1230              
1231             =over 4
1232              
1233             =item self I<(Blessed Hash, Required)>
1234              
1235             Either an object or a string of this namespace.
1236              
1237             =item channel I<(String, Required)>
1238              
1239             The abstract identifier of a subroutine.
1240              
1241             =item parameters I<(Hash, Required)>
1242              
1243             Named parameters.
1244              
1245             =over 4
1246              
1247             =item SCRIPT I<(Array, Required)>
1248              
1249             The SQL statements, control structures and external process triggers that are
1250             iterated through in sequence.
1251              
1252             =over 4
1253              
1254             =item I<(Array)>
1255              
1256             A sequence of statements like the I