File Coverage

blib/lib/POE/Component/EasyDBI/SubProcess.pm
Criterion Covered Total %
statement 21 686 3.0
branch 0 396 0.0
condition 0 111 0.0
subroutine 7 60 11.6
pod 0 21 0.0
total 28 1274 2.2


line stmt bran cond sub pod time code
1             package POE::Component::EasyDBI::SubProcess;
2              
3 2     2   15 use strict;
  2         4  
  2         68  
4 2     2   11 use warnings FATAL => 'all';
  2         4  
  2         119  
5              
6             # Initialize our version
7             our $VERSION = '1.30';
8              
9 2     2   1002 use Try::Tiny qw( try catch );
  2         6539  
  2         116  
10              
11             # We pass in data to POE::Filter::Reference
12 2     2   16 use POE::Filter::Reference;
  2         5  
  2         39  
13              
14             # We run the actual DB connection here
15 2     2   10 use DBI;
  2         4  
  2         4711  
16              
17             sub new {
18 0     0 0   my ($class, $opts) = @_;
19 0           my $obj = bless($opts, $class);
20 0           $obj->{queue} = [];
21 0   0       $obj->{ping_timeout} = $obj->{ping_timeout} || 0;
22 0           return $obj;
23             }
24              
25             # This is the subroutine that will get executed upon the fork() call by our parent
26             sub main {
27 0 0   0 0   if ( $^O eq 'MSWin32' ) {
28 0           binmode(STDIN); binmode(STDOUT);
  0            
29             }
30             # Autoflush to avoid weirdness
31             #select((select(STDOUT), $| = 1)[0]);
32 0           select(STDOUT); $|++;
  0            
33 0           select(STDERR); $|++;
  0            
34              
35 0           $SIG{__WARN__} = 'DEFAULT';
36 0           $SIG{__DIE__} = 'DEFAULT';
37              
38 0           my $self;
39             # check for alternate fork
40 0 0         if ($_[0] == 1) {
41             # we need to read in the first
42 0           my $filter = POE::Filter::Reference->new();
43 0           my $opts;
44             # get our first option hashref
45 0           while ( sysread( STDIN, my $buffer = '', 1024 ) ) {
46 0           $opts = $filter->get( [ $buffer ] );
47 0 0         last if (defined $opts);
48             }
49 0           $self = __PACKAGE__->new(splice(@{$opts},0,1));
  0            
50 0           $self->{filter} = $filter;
51 0 0         if (@{$opts}) {
  0            
52 0           push(@{$self->{queue}},@{$opts});
  0            
  0            
53             }
54 0           undef $filter;
55             } else {
56 0           $self = __PACKAGE__->new(shift);
57 0           $self->{filter} = POE::Filter::Reference->new();
58             }
59              
60 0           $self->{0} = $0 = "$0 ".__PACKAGE__;
61              
62 0           $self->{lastpingtime} = time();
63              
64 0 0         unless (defined($self->{sig_ignore_off})) {
65 0           $SIG{INT} = $SIG{TERM} = $SIG{HUP} = 'IGNORE';
66             }
67              
68             # if (defined($self->{use_cancel})) {
69             # Signal INT causes query cancel
70             # XXX disabled for now
71             #$SIG{INT} = sub { if ($sth) { $sth->cancel; } };
72             # }
73              
74 0           while (!$self->connect()) { }
75              
76 0           $self->pt("connected at ".localtime());
77              
78 0 0         return if ($self->{done});
79              
80             # check for data in queue first
81 0           $self->process();
82              
83 0 0         if ($self->{done}) {
84 0           $self->pt("disconnected at ".localtime());
85 0 0         if ($self->{dbh}) {
86 0           $self->{dbh}->disconnect();
87             }
88 0           return;
89             }
90              
91             # listen for commands from our parent
92 0           READ: while ( sysread( STDIN, my $buffer = '', 1024 ) ) {
93             # Feed the line into the filter
94             # and put the data in the queue
95 0           my $d = $self->{filter}->get( [ $buffer ] );
96 0 0         push(@{$self->{queue}},@$d) if ($d);
  0            
97              
98             # INPUT STRUCTURE IS:
99             # $d->{action} = SCALAR -> WHAT WE SHOULD DO
100             # $d->{sql} = SCALAR -> THE ACTUAL SQL
101             # $d->{placeholders} = ARRAY -> PLACEHOLDERS WE WILL USE
102             # $d->{id} = SCALAR -> THE QUERY ID ( FOR PARENT TO KEEP TRACK OF WHAT IS WHAT )
103             # $d->{primary_key} = SCALAR -> PRIMARY KEY FOR A HASH OF HASHES
104             # $d->{last_insert_id} = SCALAR|HASH -> HASH REF OF TABLE AND FIELD OR SCALAR OF A QUERY TO RUN AFTER
105             # and others..
106              
107             # process all in the queue until a problem occurs or done
108             REDO:
109 0 0         unless ($self->process()) {
110 0 0         last READ if ($self->{done});
111             # oops problem...
112 0 0         if ($self->{reconnect}) {
113             # need to reconnect
114 0           delete $self->{reconnect};
115             # keep trying to connect
116 0           while (!$self->connect()) { }
117             # and bail when we are told
118 0 0         last READ if ($self->{done});
119 0           goto REDO;
120             }
121             }
122             }
123             # Arrived here due to error in sysread/etc
124 0 0         if ($self->{dbh}) {
125 0           $self->{dbh}->disconnect();
126 0           delete $self->{dbh};
127             }
128              
129             # debug
130             # require POE::API::Peek;
131             # my $p = POE::API::Peek->new();
132             # my @sessions = $p->session_list();
133             # require Data::Dumper;
134             # open(FH,">db.txt");
135             # print FH Data::Dumper->Dump([\@sessions]);
136             # close(FH);
137             }
138              
139             sub pt {
140 0     0 0   $0 = shift->{0}.' '.shift;
141             }
142              
143             sub connect {
144 0     0 0   my $self = shift;
145              
146 0           $self->{output} = undef;
147 0           $self->{error} = undef;
148              
149             # Actually make the connection
150             try {
151             $self->{dbh} = DBI->connect(
152             # The DSN we just set up
153 0           (map { $self->{$_} } qw( dsn username password )),
154              
155             # We set some configuration stuff here
156             {
157 0 0   0     ((ref($self->{options}) eq 'HASH') ? %{$self->{options}} : ()),
  0            
158              
159             # quiet!!
160             'PrintError' => 0,
161             'PrintWarn' => 0,
162              
163             # Automatically raise errors so we can catch them with try/catch
164             'RaiseError' => 1,
165              
166             # Disable the DBI tracing
167             'TraceLevel' => 0,
168             },
169             );
170              
171             # Check for undefined-ness
172 0 0         if (!defined($self->{dbh})) {
173 0           die "Error Connecting to Database: $DBI::errstr";
174             }
175             } catch {
176 0     0     $self->output( $self->make_error( 'DBI', shift ) );
177 0           };
178              
179             # Catch errors!
180 0 0 0       if ($self->{error} && $self->{no_connect_failures} && kill(0, $self->{parent_pid})) {
    0 0        
181 0 0         sleep($self->{reconnect_wait}) if ($self->{reconnect_wait});
182 0           return 0;
183             } elsif ($self->{error}) {
184             # QUIT
185 0           $self->{done} = 1;
186 0           return 1;
187             }
188              
189             # if ($self->{dsn} =~ m/SQLite/ && $self->{options}
190             # && ref($self->{options}) eq 'HASH' && $self->{options}->{AutoCommit}) {
191             # # TODO error checking
192             # $self->db_do({ sql => 'BEGIN', id => -1 });
193             # delete $self->{output};
194             # }
195              
196             # send connect notice
197 0           $self->output({ id => 'DBI-CONNECTED' });
198              
199 0           return 1;
200             }
201              
202             sub process {
203 0     0 0   my $self = shift;
204              
205 0 0         return 0 unless (@{$self->{queue}});
  0            
206              
207             # Process each data structure
208 0           foreach my $input (shift(@{$self->{queue}})) {
  0            
209 0 0         next unless $input->{'action'};
210 0           $input->{action} = lc($input->{action});
211              
212             # Now, we do the actual work depending on what kind of query it was
213 0 0         if ($input->{action} eq 'exit') {
214             # Disconnect!
215 0           $self->{done} = 1;
216 0           return 0;
217             }
218              
219 0           my $now = time();
220             my $needping = (($self->{ping_timeout} == 0 or $self->{ping_timeout} > 0)
221 0 0 0       and (($now - $self->{lastpingtime}) >= $self->{ping_timeout})) ? 1 : 0;
222              
223 0 0         if ($self->{dbh}) {
224             # Don't work:
225             # unless ($self->{dbh}->{Active}) {
226             # # put the query back on the stack
227             # unshift(@{$self->{queue}},$input);
228             # # and reconnect
229             # $self->{dbh}->disconnect();
230             # $self->{reconnect} = 1;
231             # return 0;
232             # }
233 0 0         if ($needping) {
234 0 0         if (eval{ $self->{dbh}->ping(); }) {
  0            
235 0           $self->pt("pinged at ".localtime());
236 0           $self->{lastpingtime} = $now;
237             } else {
238             # put the query back on the stack
239 0           unshift(@{$self->{queue}},$input);
  0            
240             # and reconnect
241 0           $self->{dbh}->disconnect();
242 0           $self->{reconnect} = 1;
243 0           return 0;
244             }
245             }
246             #} elsif (!$self->{dbh}) {
247             } else {
248             #die "Database gone? : $DBI::errstr";
249             # put the query back on the stack
250 0           unshift(@{$self->{queue}},$input);
  0            
251             # and reconnect
252 0           eval { $self->{dbh}->disconnect(); };
  0            
253 0           $self->{reconnect} = 1;
254 0           return 0;
255             }
256              
257 0 0 0       if (defined($self->{no_cache}) && !defined($input->{no_cache})) {
258 0           $input->{no_cache} = $self->{no_cache};
259             }
260              
261 0 0         if (defined($input->{sql})) {
262             # remove beginning whitespace
263 0           $input->{sql} =~ s/^\s*//;
264             }
265              
266 0 0         if ( $input->{action} =~ m/^(func|commit|rollback|begin_work)$/ ) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
267 0           $input->{method} = $input->{action};
268 0           $self->do_method( $input );
269             } elsif ( $input->{action} eq 'method') {
270             # Special command to do $dbh->$method->()
271 0           $self->do_method( $input );
272             } elsif ( $input->{action} eq 'insert' ) {
273             # Fire off the SQL and return success/failure + rows affected and insert id
274 0           $self->db_insert( $input );
275             } elsif ( $input->{action} eq 'do' ) {
276             # Fire off the SQL and return success/failure + rows affected
277 0           $self->db_do( $input );
278             } elsif ( $input->{action} eq 'single' ) {
279             # Return a single result
280 0           $self->db_single( $input );
281             } elsif ( $input->{action} eq 'quote' ) {
282 0           $self->db_quote( $input );
283             } elsif ( $input->{action} eq 'arrayhash' ) {
284             # Get many results, then return them all at the same time in a array of hashes
285 0           $self->db_arrayhash( $input );
286             } elsif ( $input->{action} eq 'hashhash' ) {
287             # Get many results, then return them all at the same time in a hash of hashes
288             # on a primary key of course. the columns are returned in the cols key
289 0           $self->db_hashhash( $input );
290             } elsif ( $input->{action} eq 'hasharray' ) {
291             # Get many results, then return them all at the same time in a hash of arrays
292             # on a primary key of course. the columns are returned in the cols key
293 0           $self->db_hasharray( $input );
294             } elsif ( $input->{action} eq 'array' ) {
295             # Get many results, then return them all at the same time in an array of comma seperated values
296 0           $self->db_array( $input );
297             } elsif ( $input->{action} eq 'arrayarray' ) {
298             # Get many results, then return them all at the same time in an array of arrays
299 0           $self->db_arrayarray( $input );
300             } elsif ( $input->{action} eq 'hash' ) {
301             # Get many results, then return them all at the same time in a hash keyed off the
302             # on a primary key
303 0           $self->db_hash( $input );
304             } elsif ( $input->{action} eq 'keyvalhash' ) {
305             # Get many results, then return them all at the same time in a hash with
306             # the first column being the key and the second being the value
307 0           $self->db_keyvalhash( $input );
308             } else {
309             # Unrecognized action!
310 0           $self->{output} = $self->make_error( $input->{id}, "Unknown action sent '$input->{id}'" );
311             }
312             # XXX another way?
313 0 0 0       if ($input->{id} eq 'DBI' || ($self->{output}->{error}
      0        
      0        
314             && ($self->{output}->{error} =~ m/no connection to the server/i
315             || $self->{output}->{error} =~ m/server has gone away/i
316             || $self->{output}->{error} =~ m/server closed the connection/i
317             || $self->{output}->{error} =~ m/connect failed/i))) {
318              
319 0           unshift(@{$self->{queue}},$input);
  0            
320 0           eval { $self->{dbh}->disconnect(); };
  0            
321 0           $self->{reconnect} = 1;
322 0           return 0;
323             }
324 0           $self->output;
325             }
326 0           return 1;
327             }
328              
329             sub commit {
330 0     0 0   my $self = shift;
331 0           my $id = shift->{id};
332             try {
333 0     0     $self->{dbh}->commit;
334             } catch {
335 0     0     $self->{output} = $self->make_error( $id, shift );
336 0           };
337 0 0         return ($self->{output}) ? 0 : 1;
338             }
339              
340             sub begin_work {
341 0     0 0   my $self = shift;
342 0           my $id = shift->{id};
343             try {
344 0     0     $self->{dbh}->begin_work;
345             } catch {
346 0     0     $self->{output} = $self->make_error( $id, shift );
347 0           };
348 0 0         return ($self->{output}) ? 0 : 1;
349             }
350              
351             # This subroutine makes a generic error structure
352             sub make_error {
353 0     0 0   my $self = shift;
354              
355             # Make the structure
356 0           my $data = { id => shift };
357              
358             # Get the error, and stringify it in case of Error::Simple objects
359 0           my $error = shift;
360              
361 0 0 0       if (ref($error) && ref($error) eq 'Error::Simple') {
362 0           $data->{error} = $error->text;
363             } else {
364 0           $data->{error} = $error;
365             }
366              
367 0 0 0       if ($data->{error} =~ m/has gone away/i || $data->{error} =~ m/lost connection/i) {
368 0           $data->{id} = 'DBI';
369             }
370              
371 0           $self->{error} = $data;
372              
373             # All done!
374 0           return $data;
375             }
376              
377             # This subroute is for supporting any type of $dbh->$method->() calls
378             sub do_method {
379             # Get the dbi handle
380 0     0 0   my $self = shift;
381              
382             # Get the input structure
383 0           my $data = shift;
384              
385             # The result
386 0           my $result = undef;
387              
388 0           my $method = $data->{method};
389 0           my $dbh = $self->{dbh};
390              
391             SWITCH: {
392              
393 0 0         if ($data->{begin_work}) {
  0            
394 0 0         $self->begin_work($data) or last SWITCH;
395             }
396              
397             # Catch any errors
398             try {
399 0 0 0 0     if ($data->{args} && ref($data->{args}) eq 'ARRAY') {
400 0           $result = $dbh->$method(@{$data->{args}});
  0            
401             } else {
402 0           $result = $dbh->$method();
403             }
404              
405             } catch {
406 0     0     $self->{output} = $self->make_error( $data->{id}, shift );
407 0           };
408              
409             }
410              
411             # Check if we got any errors
412 0 0         if (!defined($self->{output})) {
413             # Make output include the results
414 0           $self->{output} = { result => $result, id => $data->{id} };
415             }
416              
417 0           return;
418             }
419              
420             # This subroutine does a DB QUOTE
421             sub db_quote {
422 0     0 0   my $self = shift;
423              
424             # Get the input structure
425 0           my $data = shift;
426              
427             # The result
428 0           my $quoted = undef;
429              
430             # Quote it!
431             try {
432 0     0     $quoted = $self->{dbh}->quote( $data->{sql} );
433             } catch {
434 0     0     $self->{output} = $self->make_error( $data->{id}, shift );
435 0           };
436              
437             # Check for errors
438 0 0         if (!defined($self->{output})) {
439             # Make output include the results
440 0           $self->{output} = { result => $quoted, id => $data->{id} };
441             }
442 0           return;
443             }
444              
445             # This subroutine runs a 'SELECT ... LIMIT 1' style query on the db
446             sub db_single {
447             # Get the dbi handle
448 0     0 0   my $self = shift;
449              
450             # Get the input structure
451 0           my $data = shift;
452              
453             # Variables we use
454 0           my $sth = undef;
455 0           my $result = undef;
456              
457             # Check if this is a non-select statement
458             # if ( $data->{sql} !~ /^SELECT/i ) {
459             # $self->{output} = $self->make_error( $data->{id}, "SINGLE is for SELECT queries only! ( $data->{sql} )" );
460             # return;
461             # }
462              
463             SWITCH: {
464 0 0         if ($data->{begin_work}) {
  0            
465 0 0         $self->begin_work($data) or last SWITCH;
466             }
467              
468             # Catch any errors
469             try {
470             # Make a new statement handler and prepare the query
471 0 0   0     if ($data->{no_cache}) {
472 0           $sth = $self->{dbh}->prepare( $data->{sql} );
473             } else {
474             # We use the prepare_cached method in hopes of hitting a cached one...
475 0           $sth = $self->{dbh}->prepare_cached( $data->{sql} );
476             }
477              
478             # Check for undef'ness
479 0 0         if (!defined($sth)) {
480 0           die 'Did not get a statement handler';
481             } else {
482             # Execute the query
483             try {
484 0           $sth->execute( @{ $data->{placeholders} } );
  0            
485             } catch {
486 0 0         die ( defined($sth->errstr) ? $sth->errstr : $@ );
487 0           };
488 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
489             }
490              
491             # Actually do the query!
492             try {
493             # There are warnings when joining a NULL field, which is undef
494 2     2   25 no warnings;
  2         7  
  2         8218  
495 0 0         if (exists($data->{separator})) {
496 0           $result = join($data->{separator},$sth->fetchrow_array());
497             } else {
498 0           $result = $sth->fetchrow_array();
499             }
500             } catch {
501 0           die $sth->errstr;
502 0           };
503              
504 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
505             } catch {
506 0     0     $self->{output} = $self->make_error( $data->{id}, shift );
507 0           };
508             }
509              
510             # Check if we got any errors
511 0 0         if (!defined($self->{output})) {
512             # Make output include the results
513 0           $self->{output} = { result => $result, id => $data->{id} };
514             }
515              
516             # Finally, we clean up this statement handle
517 0 0         if (defined($sth)) {
518 0           $sth->finish();
519             }
520              
521 0           return;
522             }
523              
524             # This subroutine does an insert into the db
525             sub db_insert {
526             # Get the dbi handle
527 0     0 0   my $self = shift;
528              
529             # Get the input structure
530 0           my $data = shift;
531              
532 0   0       my $dsn = $self->{dsn} || '';
533              
534             # Variables we use
535 0           my $sth = undef;
536 0           my $rows = undef;
537              
538 0           my @queries;
539             my @placeholders;
540              
541             # XXX depricate hash for insert
542 0 0 0       if (defined($data->{hash}) && !defined($data->{insert})) {
543 0           $data->{insert} = delete $data->{hash};
544             }
545              
546 0 0 0       if (defined($data->{insert}) && ref($data->{insert}) eq 'HASH') {
547 0           $data->{insert} = [$data->{insert}];
548             }
549              
550             # Check if this is a non-insert statement
551 0 0 0       if (defined($data->{insert}) && ref($data->{insert}) eq 'ARRAY') {
    0 0        
552 0           delete $data->{placeholders};
553 0           delete $data->{sql};
554 0           foreach my $hash (@{$data->{insert}}) {
  0            
555             # sort so we always get a consistant list of fields in the errors and placeholders
556 0           my @fields = sort keys %{$hash};
  0            
557             # adjust the placeholders, they should know that placeholders passed in are irrelevant
558             # XXX subtypes when a hash value is a HASH or ARRAY?
559 0           push(@placeholders,[ map { $hash->{$_} } @fields ]);
  0            
560             push(@queries,"INSERT INTO $data->{table} ("
561 0           .join(',',@fields).") VALUES (".join(',',(map { '?' } @fields)).")");
  0            
562             }
563             } elsif (!defined($data->{sql}) || $data->{sql} !~ /^INSERT/i ) {
564 0           $self->{output} = $self->make_error( $data->{id}, "INSERT is for INSERTS only! ( $data->{sql} )" );
565 0           return;
566             } else {
567 0           push(@queries,$data->{sql});
568 0           push(@placeholders,$data->{placeholders});
569             }
570              
571 0           for my $i ( 0 .. $#queries ) {
572 0           $data->{sql} = $queries[$i];
573 0           $data->{placeholders} = $placeholders[$i];
574 0           my $do_last = 0;
575              
576 0 0 0       if ($data->{begin_work} && $i == 0) {
577 0 0         $self->begin_work($data) or last;
578             }
579              
580             # Catch any errors
581             try {
582             # Make a new statement handler and prepare the query
583 0 0   0     if ($data->{no_cache}) {
584 0           $sth = $self->{dbh}->prepare( $data->{sql} );
585             } else {
586             # We use the prepare_cached method in hopes of hitting a cached one...
587 0           $sth = $self->{dbh}->prepare_cached( $data->{sql} );
588             }
589              
590             # Check for undef'ness
591 0 0         if (!defined($sth)) {
592 0           die 'Did not get a statement handler';
593             } else {
594             # Execute the query
595             try {
596 0           $rows += $sth->execute( @{ $data->{placeholders} } );
  0            
597             } catch {
598 0 0         if (defined($sth->errstr)) {
599 0           die $sth->errstr;
600             } else {
601 0           die "error when trying to execute bind of placeholders in insert: $_[0]";
602             }
603 0           };
604 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
605             }
606             } catch {
607 0     0     my $e = shift;
608 0           $self->{output} = $self->make_error( $data->{id}, "failed at query #$i : $e" );
609 0           $do_last = 1; # can't use last here
610 0           };
611 0 0         last if ($do_last);
612             }
613              
614 0 0 0       if ($data->{commit} && defined($rows) && !defined($self->{output})) {
      0        
615 0           $self->commit($data);
616             }
617              
618             # If rows is not undef, that means we were successful
619 0 0 0       if (defined($rows) && !defined($self->{output})) {
    0 0        
620             # Make the data structure
621 0           $self->{output} = { rows => $rows, result => $rows, id => $data->{id} };
622              
623 0 0         unless ($data->{last_insert_id}) {
624 0 0         if (defined($sth)) {
625 0           $sth->finish();
626             }
627 0           return;
628             }
629             # get the last insert id
630             try {
631 0     0     my $qry = '';
632 0 0         if (ref($data->{last_insert_id}) eq 'HASH') {
633 0           my $l = $data->{last_insert_id};
634             # checks for different database types
635 0 0         if ($dsn =~ m/dbi:pg/i) {
    0          
    0          
    0          
636 0           $qry = "SELECT $l->{field} FROM $l->{table} WHERE oid='".$sth->{'pg_oid_status'}."'";
637             } elsif ($dsn =~ m/dbi:mysql/i) {
638 0 0         if (defined($self->{dbh}->{'mysql_insertid'})) {
639 0           $self->{output}->{insert_id} = $self->{dbh}->{'mysql_insertid'};
640             } else {
641 0           $qry = 'SELECT LAST_INSERT_ID()';
642             }
643             } elsif ($dsn =~ m/dbi:oracle/i) {
644 0           $qry = "SELECT $l->{field} FROM $l->{table}";
645             } elsif ($dsn =~ /dbi:sqlite/i) {
646 0           $self->{output}->{insert_id} = $self->{dbh}->func('last_insert_rowid');
647             } else {
648 0           die "EasyDBI doesn't know how to handle a last_insert_id with your dbi, contact the author.";
649             }
650             } else {
651             # they are supplying thier own query
652 0           $qry = $data->{last_insert_id};
653             }
654              
655 0 0         if (defined($sth)) {
656 0           $sth->finish();
657             }
658              
659 0 0         if ($qry) {
660             try {
661 0           $self->{output}->{insert_id} = $self->{dbh}->selectrow_array($qry);
662             } catch {
663 0           die $sth->error;
664 0           };
665              
666 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
667             }
668             } catch {
669             # special case, insert was ok, but last_insert_id errored
670 0     0     $self->{output}->{error} = shift;
671 0           };
672             } elsif (!defined($rows) && !defined($self->{output})) {
673             # Internal error...
674 0           $self->{output} = $self->make_error( $data->{id}, 'Internal Error in db_do of EasyDBI Subprocess' );
675             #die 'Internal Error in db_do';
676             }
677              
678             # Finally, we clean up this statement handle
679 0 0         if (defined($sth)) {
680 0           $sth->finish();
681             }
682              
683 0           return;
684             }
685              
686             # This subroutine runs a 'DO' style query on the db
687             sub db_do {
688             # Get the dbi handle
689 0     0 0   my $self = shift;
690              
691             # Get the input structure
692 0           my $data = shift;
693              
694             # Variables we use
695 0           my $sth = undef;
696 0           my $rows = undef;
697              
698             # Check if this is a non-select statement
699             # if ( $data->{sql} =~ /^SELECT/i ) {
700             # $self->{output} = $self->make_error( $data->{id}, "DO is for non-SELECT queries only! ( $data->{sql} )" );
701             # return;
702             # }
703              
704             SWITCH: {
705              
706 0 0         if ($data->{begin_work}) {
  0            
707 0 0         $self->begin_work($data) or last SWITCH;
708             }
709              
710             # Catch any errors
711             try {
712             # Make a new statement handler and prepare the query
713 0 0   0     if ($data->{no_cache}) {
714 0           $sth = $self->{dbh}->prepare( $data->{sql} );
715             } else {
716             # We use the prepare_cached method in hopes of hitting a cached one...
717 0           $sth = $self->{dbh}->prepare_cached( $data->{sql} );
718             }
719              
720             # Check for undef'ness
721 0 0         if (!defined($sth)) {
722 0           die 'Did not get a statement handler';
723             } else {
724             # Execute the query
725             try {
726 0           $rows += $sth->execute( @{ $data->{placeholders} } );
  0            
727             } catch {
728 0 0         die ( defined($sth->errstr) ? $sth->errstr : $@ );
729 0           };
730 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
731             }
732             } catch {
733 0     0     $self->{output} = $self->make_error( $data->{id}, shift );
734 0           };
735              
736             }
737              
738 0 0 0       if ($data->{commit} && defined($rows) && !defined($self->{output})) {
      0        
739 0           $self->commit($data);
740             }
741              
742             # If rows is not undef, that means we were successful
743 0 0 0       if (defined($rows) && !defined($self->{output})) {
    0 0        
744             # Make the data structure
745 0           $self->{output} = { rows => $rows, result => $rows, id => $data->{id} };
746             } elsif (!defined($rows) && !defined($self->{output})) {
747             # Internal error...
748 0           $self->{output} = $self->make_error( $data->{id}, 'Internal Error in db_do of EasyDBI Subprocess' );
749             #die 'Internal Error in db_do';
750             }
751              
752             # Finally, we clean up this statement handle
753 0 0         if (defined($sth)) {
754 0           $sth->finish();
755             }
756              
757 0           return;
758             }
759              
760             sub db_arrayhash {
761             # Get the dbi handle
762 0     0 0   my $self = shift;
763              
764             # Get the input structure
765 0           my $data = shift;
766              
767             # Variables we use
768 0           my $sth = undef;
769 0           my $result = [];
770 0           my $rows = 0;
771              
772             # Check if this is a non-select statement
773             # if ( $data->{sql} !~ /^SELECT/i ) {
774             # $self->{output} = $self->make_error( $data->{id}, "ARRAYHASH is for SELECT queries only! ( $data->{sql} )" );
775             # return;
776             # }
777              
778             SWITCH: {
779              
780 0 0         if ($data->{begin_work}) {
  0            
781 0 0         $self->begin_work($data) or last SWITCH;
782             }
783              
784             # Catch any errors
785             try {
786             # Make a new statement handler and prepare the query
787 0 0   0     if ($data->{no_cache}) {
788 0           $sth = $self->{dbh}->prepare( $data->{sql} );
789             } else {
790             # We use the prepare_cached method in hopes of hitting a cached one...
791 0           $sth = $self->{dbh}->prepare_cached( $data->{sql} );
792             }
793              
794             # Check for undef'ness
795 0 0         if (!defined($sth)) {
796 0           die 'Did not get a statement handler';
797             } else {
798             # Execute the query
799             try {
800 0           $sth->execute( @{ $data->{placeholders} } );
  0            
801             } catch {
802 0 0         die ( defined($sth->errstr) ? $sth->errstr : $@ );
803 0           };
804 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
805             }
806              
807             # my $newdata;
808             #
809             # # Bind the columns
810             # try {
811             # $sth->bind_columns( \( @$newdata{ @{ $sth->{'NAME_lc'} } } ) );
812             # } catch {
813             # die $sth->errstr;
814             # };
815              
816             # Actually do the query!
817             try {
818 0           while ( my $hash = $sth->fetchrow_hashref() ) {
819 0 0 0       if (exists($data->{chunked}) && defined($self->{output})) {
820             # chunk results ready to send
821 0           $self->output();
822 0           $result = [];
823 0           $rows = 0;
824             }
825 0           $rows++;
826             # Copy the data, and push it into the array
827 0           push( @{ $result }, { %{ $hash } } );
  0            
  0            
828 0 0 0       if (exists($data->{chunked}) && $data->{chunked} == $rows) {
829             # Make output include the results
830 0           $self->{output} = { rows => $rows, id => $data->{id}, result => $result, chunked => $data->{chunked} };
831             }
832             }
833             # in the case that our rows == chunk
834 0           $self->{output} = undef;
835              
836             } catch {
837 0           die $sth->errstr;
838 0           };
839              
840             # XXX is dbh->err the same as sth->err?
841 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
842              
843             # Check for any errors that might have terminated the loop early
844 0 0         if ( $sth->err() ) {
845             # Premature termination!
846 0           die $sth->errstr;
847             }
848             } catch {
849 0     0     $self->{output} = $self->make_error( $data->{id}, shift );
850 0           };
851              
852             }
853              
854             # Check if we got any errors
855 0 0         if (!defined($self->{output})) {
856             # Make output include the results
857 0           $self->{output} = { rows => $rows, id => $data->{id}, result => $result };
858 0 0         if (exists($data->{chunked})) {
859 0           $self->{output}->{last_chunk} = 1;
860 0           $self->{output}->{chunked} = $data->{chunked};
861             }
862             }
863              
864             # Finally, we clean up this statement handle
865 0 0         if (defined($sth)) {
866 0           $sth->finish();
867             }
868              
869 0           return;
870             }
871              
872             sub db_hashhash {
873             # Get the dbi handle
874 0     0 0   my $self = shift;
875              
876             # Get the input structure
877 0           my $data = shift;
878              
879             # Variables we use
880 0           my $sth = undef;
881 0           my $result = {};
882 0           my $rows = 0;
883              
884             # Check if this is a non-select statement
885             # if ( $data->{sql} !~ /^SELECT/i ) {
886             # $self->{output} = $self->make_error( $data->{id}, "HASHHASH is for SELECT queries only! ( $data->{sql} )" );
887             # return;
888             # }
889              
890 0           my (@cols, %col);
891              
892             SWITCH: {
893              
894 0 0         if ($data->{begin_work}) {
  0            
895 0 0         $self->begin_work($data) or last SWITCH;
896             }
897              
898             # Catch any errors
899             try {
900             # Make a new statement handler and prepare the query
901 0 0   0     if ($data->{no_cache}) {
902 0           $sth = $self->{dbh}->prepare( $data->{sql} );
903             } else {
904             # We use the prepare_cached method in hopes of hitting a cached one...
905 0           $sth = $self->{dbh}->prepare_cached( $data->{sql} );
906             }
907              
908             # Check for undef'ness
909 0 0         if (!defined($sth)) {
910 0           die 'Did not get a statement handler';
911             } else {
912             # Execute the query
913             try {
914 0           $sth->execute( @{ $data->{placeholders} } );
  0            
915             } catch {
916 0 0         die ( defined($sth->errstr) ? $sth->errstr : $@ );
917 0           };
918 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
919             }
920              
921             # The result hash
922 0           my $newdata = {};
923              
924             # Check the primary key
925 0           my $foundprimary = 0;
926              
927             # default to the first one
928 0 0         unless (defined($data->{primary_key})) {
929 0           $data->{primary_key} = 1;
930             }
931              
932 0 0         if ($data->{primary_key} =~ m/^\d+$/) {
933             # primary_key can be a 1 based index
934 0 0         if ($data->{primary_key} > $sth->{NUM_OF_FIELDS}) {
935             # die "primary_key ($data->{primary_key}) is out of bounds (".$sth->{NUM_OF_FIELDS}.")";
936 0           die "primary_key ($data->{primary_key}) is out of bounds";
937             }
938              
939 0           $data->{primary_key} = $sth->{NAME}->[($data->{primary_key}-1)];
940             }
941              
942             # Find the column names
943 0           for my $i ( 0 .. $sth->{NUM_OF_FIELDS}-1 ) {
944 0           $col{$sth->{NAME}->[$i]} = $i;
945 0           push(@cols, $sth->{NAME}->[$i]);
946 0 0         $foundprimary = 1 if ($sth->{NAME}->[$i] eq $data->{primary_key});
947             }
948              
949 0 0         unless ($foundprimary == 1) {
950 0           die "primary key ($data->{primary_key}) not found";
951             }
952              
953             # Actually do the query!
954             try {
955 0           while ( my @row = $sth->fetchrow_array() ) {
956 0 0 0       if (exists($data->{chunked}) && defined($self->{output})) {
957             # chunk results ready to send
958 0           $self->output();
959 0           $result = {};
960 0           $rows = 0;
961             }
962 0           $rows++;
963 0           foreach (@cols) {
964 0           $result->{$row[$col{$data->{primary_key}}]}{$_} = $row[$col{$_}];
965             }
966 0 0 0       if (exists($data->{chunked}) && $data->{chunked} == $rows) {
967             # Make output include the results
968             $self->{output} = {
969             rows => $rows,
970             result => $result,
971             id => $data->{id},
972             cols => [ @cols ],
973             chunked => $data->{chunked},
974             primary_key => $data->{primary_key}
975 0           };
976             }
977             }
978             # in the case that our rows == chunk
979 0           $self->{output} = undef;
980              
981             } catch {
982 0           die $sth->errstr;
983 0           };
984              
985 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
986              
987             # Check for any errors that might have terminated the loop early
988 0 0         if ( $sth->err() ) {
989             # Premature termination!
990 0           die $sth->errstr;
991             }
992             } catch {
993 0     0     $self->{output} = $self->make_error( $data->{id}, shift );
994 0           };
995              
996             }
997              
998             # Check if we got any errors
999 0 0         if (!defined($self->{output})) {
1000             # Make output include the results
1001 0           $self->{output} = { rows => $rows, id => $data->{id}, result => $result, cols => [ @cols ], primary_key => $data->{primary_key} };
1002 0 0         if (exists($data->{chunked})) {
1003 0           $self->{output}->{last_chunk} = 1;
1004 0           $self->{output}->{chunked} = $data->{chunked};
1005             }
1006             }
1007              
1008             # Finally, we clean up this statement handle
1009 0 0         if (defined($sth)) {
1010 0           $sth->finish();
1011             }
1012              
1013 0           return;
1014             }
1015              
1016             sub db_hasharray {
1017             # Get the dbi handle
1018 0     0 0   my $self = shift;
1019              
1020             # Get the input structure
1021 0           my $data = shift;
1022              
1023             # Variables we use
1024 0           my $sth = undef;
1025 0           my $result = {};
1026 0           my $rows = 0;
1027              
1028             # Check if this is a non-select statement
1029             # if ( $data->{sql} !~ /^SELECT/i ) {
1030             # $self->{output} = $self->make_error( $data->{id}, "HASHARRAY is for SELECT queries only! ( $data->{sql} )" );
1031             # return;
1032             # }
1033              
1034 0           my (@cols, %col);
1035              
1036             SWITCH: {
1037              
1038 0 0         if ($data->{begin_work}) {
  0            
1039 0 0         $self->begin_work($data) or last SWITCH;
1040             }
1041              
1042             # Catch any errors
1043             try {
1044             # Make a new statement handler and prepare the query
1045 0 0   0     if ($data->{no_cache}) {
1046 0           $sth = $self->{dbh}->prepare( $data->{sql} );
1047             } else {
1048             # We use the prepare_cached method in hopes of hitting a cached one...
1049 0           $sth = $self->{dbh}->prepare_cached( $data->{sql} );
1050             }
1051              
1052             # Check for undef'ness
1053 0 0         if (!defined($sth)) {
1054 0           die 'Did not get a statement handler';
1055             } else {
1056             # Execute the query
1057             try {
1058 0           $sth->execute( @{ $data->{placeholders} } );
  0            
1059             } catch {
1060 0 0         die ( defined($sth->errstr) ? $sth->errstr : $@ );
1061 0           };
1062 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
1063             }
1064              
1065             # The result hash
1066 0           my $newdata = {};
1067              
1068             # Check the primary key
1069 0           my $foundprimary = 0;
1070              
1071 0 0         if ($data->{primary_key} =~ m/^\d+$/) {
1072             # primary_key can be a 1 based index
1073 0 0         if ($data->{primary_key} > $sth->{NUM_OF_FIELDS}) {
1074             # die "primary_key ($data->{primary_key}) is out of bounds (".$sth->{NUM_OF_FIELDS}.")";
1075 0           die "primary_key ($data->{primary_key}) is out of bounds";
1076             }
1077              
1078 0           $data->{primary_key} = $sth->{NAME}->[($data->{primary_key}-1)];
1079             }
1080              
1081             # Find the column names
1082 0           for my $i ( 0 .. $sth->{NUM_OF_FIELDS}-1 ) {
1083 0           $col{$sth->{NAME}->[$i]} = $i;
1084 0           push(@cols, $sth->{NAME}->[$i]);
1085 0 0         $foundprimary = 1 if ($sth->{NAME}->[$i] eq $data->{primary_key});
1086             }
1087              
1088 0 0         unless ($foundprimary == 1) {
1089 0           die "primary key ($data->{primary_key}) not found";
1090             }
1091              
1092             # Actually do the query!
1093             try {
1094 0           while ( my @row = $sth->fetchrow_array() ) {
1095 0 0 0       if (exists($data->{chunked}) && defined($self->{output})) {
1096             # chunk results ready to send
1097 0           $self->output();
1098 0           $result = {};
1099 0           $rows = 0;
1100             }
1101 0           $rows++;
1102 0           push(@{ $result->{$row[$col{$data->{primary_key}}]} }, @row);
  0            
1103 0 0 0       if (exists($data->{chunked}) && $data->{chunked} == $rows) {
1104             # Make output include the results
1105 0           $self->{output} = { rows => $rows, result => $result, id => $data->{id}, cols => [ @cols ], chunked => $data->{chunked}, primary_key => $data->{primary_key} };
1106             }
1107             }
1108             # in the case that our rows == chunk
1109 0           $self->{output} = undef;
1110              
1111             } catch {
1112 0           die $sth->errstr;
1113 0           };
1114              
1115 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
1116              
1117             # Check for any errors that might have terminated the loop early
1118 0 0         if ( $sth->err() ) {
1119             # Premature termination!
1120 0           die $sth->errstr;
1121             }
1122             } catch {
1123 0     0     $self->{output} = $self->make_error( $data->{id}, shift );
1124 0           };
1125              
1126             }
1127              
1128             # Check if we got any errors
1129 0 0         if (!defined($self->{output})) {
1130             # Make output include the results
1131 0           $self->{output} = { rows => $rows, result => $result, id => $data->{id}, cols => [ @cols ], primary_key => $data->{primary_key} };
1132 0 0         if (exists($data->{chunked})) {
1133 0           $self->{output}->{last_chunk} = 1;
1134 0           $self->{output}->{chunked} = $data->{chunked};
1135             }
1136             }
1137              
1138             # Finally, we clean up this statement handle
1139 0 0         if (defined($sth)) {
1140 0           $sth->finish();
1141             }
1142              
1143 0           return;
1144             }
1145              
1146             sub db_array {
1147             # Get the dbi handle
1148 0     0 0   my $self = shift;
1149              
1150             # Get the input structure
1151 0           my $data = shift;
1152              
1153             # Variables we use
1154 0           my $sth = undef;
1155 0           my $result = [];
1156 0           my $rows = 0;
1157              
1158             # Check if this is a non-select statement
1159             # if ( $data->{sql} !~ /^SELECT/i ) {
1160             # $self->{output} = $self->make_error( $data->{id}, "ARRAY is for SELECT queries only! ( $data->{sql} )" );
1161             # return;
1162             # }
1163              
1164             SWITCH: {
1165              
1166 0 0         if ($data->{begin_work}) {
  0            
1167 0 0         $self->begin_work($data) or last SWITCH;
1168             }
1169              
1170             # Catch any errors
1171             try {
1172             # Make a new statement handler and prepare the query
1173 0 0   0     if ($data->{no_cache}) {
1174 0           $sth = $self->{dbh}->prepare( $data->{sql} );
1175             } else {
1176             # We use the prepare_cached method in hopes of hitting a cached one...
1177 0           $sth = $self->{dbh}->prepare_cached( $data->{sql} );
1178             }
1179              
1180             # Check for undef'ness
1181 0 0         if (!defined($sth)) {
1182 0           die 'Did not get a statement handler';
1183             } else {
1184             # Execute the query
1185             try {
1186 0           $sth->execute( @{ $data->{placeholders} } );
  0            
1187             } catch {
1188 0 0         die ( defined($sth->errstr) ? $sth->errstr : $@ );
1189 0           };
1190 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
1191             }
1192              
1193             # The result hash
1194 0           my $newdata = {};
1195              
1196             # Actually do the query!
1197             try {
1198             # There are warnings when joining a NULL field, which is undef
1199 2     2   18 no warnings;
  2         4  
  2         4172  
1200              
1201 0           while ( my @row = $sth->fetchrow_array() ) {
1202 0 0 0       if (exists($data->{chunked}) && defined($self->{output})) {
1203             # chunk results ready to send
1204 0           $self->output();
1205 0           $result = [];
1206 0           $rows = 0;
1207             }
1208 0           $rows++;
1209 0 0         if (exists($data->{separator})) {
1210 0           push(@{$result},join($data->{separator},@row));
  0            
1211             } else {
1212 0           push(@{$result},join(',',@row));
  0            
1213             }
1214 0 0 0       if (exists($data->{chunked}) && $data->{chunked} == $rows) {
1215             # Make output include the results
1216 0           $self->{output} = { rows => $rows, result => $result, id => $data->{id}, chunked => $data->{chunked} };
1217             }
1218             }
1219             # in the case that our rows == chunk
1220 0           $self->{output} = undef;
1221              
1222             } catch {
1223 0           die $!;
1224             #die $sth->errstr;
1225 0           };
1226              
1227 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
1228              
1229             # Check for any errors that might have terminated the loop early
1230 0 0         if ( $sth->err() ) {
1231             # Premature termination!
1232 0           die $sth->errstr;
1233             }
1234             } catch {
1235 0     0     $self->{output} = $self->make_error( $data->{id}, shift );
1236 0           };
1237              
1238             }
1239              
1240             # Check if we got any errors
1241 0 0         if (!defined($self->{output})) {
1242             # Make output include the results
1243 0           $self->{output} = { rows => $rows, result => $result, id => $data->{id} };
1244 0 0         if (exists($data->{chunked})) {
1245 0           $self->{output}->{last_chunk} = 1;
1246 0           $self->{output}->{chunked} = $data->{chunked};
1247             }
1248             }
1249              
1250             # Finally, we clean up this statement handle
1251 0 0         if (defined($sth)) {
1252 0           $sth->finish();
1253             }
1254              
1255 0           return;
1256             }
1257              
1258             sub db_arrayarray {
1259             # Get the dbi handle
1260 0     0 0   my $self = shift;
1261              
1262             # Get the input structure
1263 0           my $data = shift;
1264              
1265             # Variables we use
1266 0           my $sth = undef;
1267 0           my $result = [];
1268 0           my $rows = 0;
1269              
1270             # Check if this is a non-select statement
1271             # if ( $data->{sql} !~ /^SELECT/i ) {
1272             # $self->{output} = $self->make_error( $data->{id}, "ARRAYARRAY is for SELECT queries only! ( $data->{sql} )" );
1273             # return;
1274             # }
1275              
1276             SWITCH: {
1277              
1278 0 0         if ($data->{begin_work}) {
  0            
1279 0 0         $self->begin_work($data) or last SWITCH;
1280             }
1281              
1282             # Catch any errors
1283             try {
1284             # Make a new statement handler and prepare the query
1285 0 0   0     if ($data->{no_cache}) {
1286 0           $sth = $self->{dbh}->prepare( $data->{sql} );
1287             } else {
1288             # We use the prepare_cached method in hopes of hitting a cached one...
1289 0           $sth = $self->{dbh}->prepare_cached( $data->{sql} );
1290             }
1291              
1292             # Check for undef'ness
1293 0 0         if (!defined($sth)) {
1294 0           die 'Did not get a statement handler';
1295             } else {
1296             # Execute the query
1297             try {
1298 0           $sth->execute( @{ $data->{placeholders} } );
  0            
1299             } catch {
1300 0 0         die ( defined($sth->errstr) ? $sth->errstr : $@ );
1301 0           };
1302 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
1303             }
1304              
1305             # The result hash
1306 0           my $newdata = {};
1307              
1308             # Actually do the query!
1309             try {
1310 0           while ( my @row = $sth->fetchrow_array() ) {
1311 0 0 0       if (exists($data->{chunked}) && defined($self->{output})) {
1312             # chunk results ready to send
1313 0           $self->output();
1314 0           $result = [];
1315 0           $rows = 0;
1316             }
1317 0           $rows++;
1318             # There are warnings when joining a NULL field, which is undef
1319 0           push(@{$result},\@row);
  0            
1320 0 0 0       if (exists($data->{chunked}) && $data->{chunked} == $rows) {
1321             # Make output include the results
1322 0           $self->{output} = { rows => $rows, result => $result, id => $data->{id}, chunked => $data->{chunked} };
1323             }
1324             }
1325             # in the case that our rows == chunk
1326 0           $self->{output} = undef;
1327              
1328             } catch {
1329 0           die $!;
1330             #die $sth->errstr;
1331 0           };
1332              
1333 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
1334              
1335             # Check for any errors that might have terminated the loop early
1336 0 0         if ( $sth->err() ) {
1337             # Premature termination!
1338 0           die $sth->errstr;
1339             }
1340             } catch {
1341 0     0     $self->{output} = $self->make_error( $data->{id}, shift );
1342 0           };
1343              
1344             }
1345              
1346              
1347             # Check if we got any errors
1348 0 0         if (!defined($self->{output})) {
1349             # Make output include the results
1350 0           $self->{output} = { rows => $rows, result => $result, id => $data->{id} };
1351 0 0         if (exists($data->{chunked})) {
1352 0           $self->{output}->{last_chunk} = 1;
1353 0           $self->{output}->{chunked} = $data->{chunked};
1354             }
1355             }
1356              
1357             # Finally, we clean up this statement handle
1358 0 0         if (defined($sth)) {
1359 0           $sth->finish();
1360             }
1361              
1362 0           return;
1363             }
1364              
1365             sub db_hash {
1366             # Get the dbi handle
1367 0     0 0   my $self = shift;
1368              
1369             # Get the input structure
1370 0           my $data = shift;
1371              
1372             # Variables we use
1373 0           my $sth = undef;
1374 0           my $result = {};
1375 0           my $rows = 0;
1376              
1377             # Check if this is a non-select statement
1378             # if ( $data->{sql} !~ /^SELECT/i ) {
1379             # $self->{output} = $self->make_error( $data->{id}, "HASH is for SELECT queries only! ( $data->{sql} )" );
1380             # return;
1381             # }
1382              
1383             SWITCH: {
1384              
1385 0 0         if ($data->{begin_work}) {
  0            
1386 0 0         $self->begin_work($data) or last SWITCH;
1387             }
1388              
1389             # Catch any errors
1390             try {
1391             # Make a new statement handler and prepare the query
1392 0 0   0     if ($data->{no_cache}) {
1393 0           $sth = $self->{dbh}->prepare( $data->{sql} );
1394             } else {
1395             # We use the prepare_cached method in hopes of hitting a cached one...
1396 0           $sth = $self->{dbh}->prepare_cached( $data->{sql} );
1397             }
1398              
1399             # Check for undef'ness
1400 0 0         if (!defined($sth)) {
1401 0           die 'Did not get a statement handler';
1402             } else {
1403             # Execute the query
1404             try {
1405 0           $sth->execute( @{ $data->{placeholders} } );
  0            
1406             } catch {
1407 0 0         die ( defined($sth->errstr) ? $sth->errstr : $@ );
1408 0           };
1409 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
1410             }
1411              
1412             # The result hash
1413 0           my $newdata = {};
1414              
1415             # Actually do the query!
1416             try {
1417              
1418 0           my @row = $sth->fetchrow_array();
1419              
1420 0 0         if (@row) {
1421 0           $rows = @row;
1422 0           for my $i ( 0 .. $sth->{NUM_OF_FIELDS}-1 ) {
1423 0           $result->{$sth->{NAME}->[$i]} = $row[$i];
1424             }
1425             }
1426              
1427             } catch {
1428 0           die $sth->errstr;
1429 0           };
1430              
1431 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
1432              
1433             # Check for any errors that might have terminated the loop early
1434 0 0         if ( $sth->err() ) {
1435             # Premature termination!
1436 0           die $sth->errstr;
1437             }
1438             } catch {
1439 0     0     $self->{output} = $self->make_error( $data->{id}, shift );
1440 0           };
1441              
1442             }
1443              
1444             # Check if we got any errors
1445 0 0         if (!defined($self->{output})) {
1446             # Make output include the results
1447 0           $self->{output} = { rows => $rows, result => $result, id => $data->{id} };
1448             }
1449              
1450             # Finally, we clean up this statement handle
1451 0 0         if (defined($sth)) {
1452 0           $sth->finish();
1453             }
1454              
1455 0           return;
1456             }
1457              
1458             sub db_keyvalhash {
1459             # Get the dbi handle
1460 0     0 0   my $self = shift;
1461              
1462             # Get the input structure
1463 0           my $data = shift;
1464              
1465             # Variables we use
1466 0           my $sth = undef;
1467 0           my $result = {};
1468 0           my $rows = 0;
1469              
1470             # Check if this is a non-select statement
1471             # if ( $data->{sql} !~ /^SELECT/i ) {
1472             # $self->{output} = $self->make_error( $data->{id}, "KEYVALHASH is for SELECT queries only! ( $data->{sql} )" );
1473             # return;
1474             # }
1475              
1476             SWITCH: {
1477              
1478 0 0         if ($data->{begin_work}) {
  0            
1479 0 0         $self->begin_work($data) or last SWITCH;
1480             }
1481              
1482             # Catch any errors
1483             try {
1484             # Make a new statement handler and prepare the query
1485 0 0   0     if ($data->{no_cache}) {
1486 0           $sth = $self->{dbh}->prepare( $data->{sql} );
1487             } else {
1488             # We use the prepare_cached method in hopes of hitting a cached one...
1489 0           $sth = $self->{dbh}->prepare_cached( $data->{sql} );
1490             }
1491              
1492             # Check for undef'ness
1493 0 0         if (!defined($sth)) {
1494 0           die 'Did not get a statement handler';
1495             } else {
1496             # Execute the query
1497             try {
1498 0           $sth->execute( @{ $data->{placeholders} } );
  0            
1499             } catch {
1500 0 0         die ( defined($sth->errstr) ? $sth->errstr : $@ );
1501 0           };
1502 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
1503             }
1504              
1505             # Actually do the query!
1506             try {
1507 0           while (my @row = $sth->fetchrow_array()) {
1508 0 0         if ($#row < 1) {
1509 0           die 'You need at least 2 columns selected for a keyvalhash query';
1510             }
1511 0 0 0       if (exists($data->{chunked}) && defined($self->{output})) {
1512             # chunk results ready to send
1513 0           $self->output();
1514 0           $result = {};
1515 0           $rows = 0;
1516             }
1517 0           $rows++;
1518 0           $result->{$row[0]} = $row[1];
1519 0 0 0       if (exists($data->{chunked}) && $data->{chunked} == $rows) {
1520             # Make output include the results
1521 0           $self->{output} = { rows => $rows, result => $result, id => $data->{id}, chunked => $data->{chunked} };
1522             }
1523             }
1524             # in the case that our rows == chunk
1525 0           $self->{output} = undef;
1526              
1527             } catch {
1528 0           die $sth->errstr;
1529 0           };
1530              
1531 0 0         die $self->{dbh}->errstr if ( $self->{dbh}->errstr );
1532              
1533             # Check for any errors that might have terminated the loop early
1534 0 0         if ( $sth->err() ) {
1535             # Premature termination!
1536 0           die $sth->errstr;
1537             }
1538             } catch {
1539 0     0     $self->{output} = $self->make_error( $data->{id}, shift);
1540 0           };
1541              
1542             }
1543              
1544             # Check if we got any errors
1545 0 0         if (!defined($self->{output})) {
1546             # Make output include the results
1547 0           $self->{output} = { rows => $rows, result => $result, id => $data->{id} };
1548 0 0         if (exists($data->{chunked})) {
1549 0           $self->{output}->{last_chunk} = 1;
1550 0           $self->{output}->{chunked} = $data->{chunked};
1551             }
1552             }
1553              
1554             # Finally, we clean up this statement handle
1555 0 0         if (defined($sth)) {
1556 0           $sth->finish();
1557             }
1558              
1559 0           return;
1560             }
1561              
1562             # Prints any output to STDOUT
1563             sub output {
1564 0     0 0   my $self = shift;
1565              
1566             # Get the data
1567 0   0       my $data = shift || undef;
1568              
1569 0 0         unless (defined($data)) {
1570 0           $data = $self->{output};
1571 0           $self->{output} = undef;
1572             # TODO use this at some point
1573 0           $self->{error} = undef;
1574             }
1575              
1576             # Freeze it!
1577 0           my $outdata = $self->{filter}->put( [ $data ] );
1578              
1579             # Print it!
1580 0           print STDOUT @$outdata;
1581              
1582 0           return;
1583             }
1584              
1585             1;
1586              
1587             __END__