| 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__ |