| … | |
… | |
| 43 | my (undef, $dbi, $user, $pass, %attr) = @{+shift}; |
43 | my (undef, $dbi, $user, $pass, %attr) = @{+shift}; |
| 44 | |
44 | |
| 45 | $DBH = DBI->connect ($dbi, $user, $pass, \%attr); |
45 | $DBH = DBI->connect ($dbi, $user, $pass, \%attr); |
| 46 | |
46 | |
| 47 | [1] |
47 | [1] |
|
|
48 | } |
|
|
49 | |
|
|
50 | sub req_exec { |
|
|
51 | my (undef, $st, @args) = @{+shift}; |
|
|
52 | |
|
|
53 | my $sth = $DBH->prepare_cached ($st, undef, 1); |
|
|
54 | |
|
|
55 | $sth->execute (@args) |
|
|
56 | or die $sth->errstr; |
|
|
57 | |
|
|
58 | [$sth->fetchall_arrayref] |
| 48 | } |
59 | } |
| 49 | |
60 | |
| 50 | sub serve { |
61 | sub serve { |
| 51 | my ($fh) = @_; |
62 | my ($fh) = @_; |
| 52 | |
63 | |
| … | |
… | |
| 79 | } |
90 | } |
| 80 | } |
91 | } |
| 81 | } |
92 | } |
| 82 | }; |
93 | }; |
| 83 | |
94 | |
| 84 | warn $@;#d# |
|
|
| 85 | |
|
|
| 86 | kill 9, $$; # no other way on the broken windows platform |
95 | kill 9, $$; # no other way on the broken windows platform |
| 87 | } |
96 | } |
| 88 | |
97 | |
| 89 | =head2 METHODS |
98 | =head2 METHODS |
| 90 | |
99 | |
| … | |
… | |
| 117 | |
126 | |
| 118 | If this callback returns and this was a fatal error (C<$fatal> is true) |
127 | If this callback returns and this was a fatal error (C<$fatal> is true) |
| 119 | then AnyEvent::DBI die's, otherwise it calls the original request callback |
128 | then AnyEvent::DBI die's, otherwise it calls the original request callback |
| 120 | without any arguments. |
129 | without any arguments. |
| 121 | |
130 | |
| 122 | If omitted, then C<die> will be called on any fatal errors, others will be ignored. |
131 | If omitted, then C<die> will be called on any errors, fatal or not. |
| 123 | |
132 | |
| 124 | =back |
133 | =back |
| 125 | |
134 | |
| 126 | =cut |
135 | =cut |
| 127 | |
136 | |
| … | |
… | |
| 164 | if (defined $res->[0]) { |
173 | if (defined $res->[0]) { |
| 165 | $req->[0](@$res); |
174 | $req->[0](@$res); |
| 166 | } else { |
175 | } else { |
| 167 | my $cb = shift @$req; |
176 | my $cb = shift @$req; |
| 168 | $wself->_error ($res->[1], @$req); |
177 | $wself->_error ($res->[1], @$req); |
| 169 | $cb->[0](); |
178 | $cb->(); |
| 170 | } |
179 | } |
| 171 | } |
180 | } |
| 172 | |
181 | |
| 173 | } elsif (defined $len) { |
182 | } elsif (defined $len) { |
| 174 | $wself->_error ("unexpected eof", @caller, 1); |
183 | $wself->_error ("unexpected eof", @caller, 1); |
| … | |
… | |
| 208 | $@ = $error; |
217 | $@ = $error; |
| 209 | |
218 | |
| 210 | $self->{on_error}($self, $filename, $line, $fatal) |
219 | $self->{on_error}($self, $filename, $line, $fatal) |
| 211 | if $self->{on_error}; |
220 | if $self->{on_error}; |
| 212 | |
221 | |
| 213 | die "$error at $filename, line $line\n" |
222 | die "$error at $filename, line $line\n"; |
| 214 | if $fatal; |
|
|
| 215 | } |
223 | } |
| 216 | |
224 | |
| 217 | sub _req { |
225 | sub _req { |
| 218 | warn "<req(@_>\n";#d# |
|
|
| 219 | my ($self, $cb, $filename, $line, $fatal) = splice @_, 0, 5, (); |
226 | my ($self, $cb, $filename, $line, $fatal) = splice @_, 0, 5, (); |
| 220 | |
227 | |
| 221 | push @{ $self->{queue} }, [$cb, $filename, $line, $fatal]; |
228 | push @{ $self->{queue} }, [$cb, $filename, $line, $fatal]; |
| 222 | |
229 | |
| 223 | $self->{wbuf} .= pack "L/a*", Storable::freeze \@_; |
230 | $self->{wbuf} .= pack "L/a*", Storable::freeze \@_; |
| … | |
… | |
| 234 | } |
241 | } |
| 235 | |
242 | |
| 236 | =item $dbh->exec ("statement", @args, $cb->($rows, %extra)) |
243 | =item $dbh->exec ("statement", @args, $cb->($rows, %extra)) |
| 237 | |
244 | |
| 238 | Executes the given SQL statement with placeholders replaced by |
245 | Executes the given SQL statement with placeholders replaced by |
| 239 | C<@args>. The statement will be prepared and cached on the |
246 | C<@args>. The statement will be prepared and cached on the server side, so |
| 240 | server side, so using placeholders is compulsory. |
247 | using placeholders is compulsory. |
| 241 | |
248 | |
| 242 | The callback will be called with the result of C<fetchall_arrayref> as |
249 | The callback will be called with the result of C<fetchall_arrayref> as |
| 243 | first argument and possibly a hash reference with additional information. |
250 | first argument and possibly a hash reference with additional information. |
| 244 | |
251 | |
|
|
252 | If an error occurs and the C<on_error> callback returns, then no arguments |
|
|
253 | will be passed and C<$@> contains the error message. |
|
|
254 | |
| 245 | =cut |
255 | =cut |
| 246 | |
256 | |
| 247 | sub exec { |
257 | sub exec { |
| 248 | my $cb = pop; |
258 | my $cb = pop; |
| 249 | splice @_, 1, 0, $cb, (caller)[1,2], 0, "exec"; |
259 | splice @_, 1, 0, $cb, (caller)[1,2], 0, "req_exec"; |
| 250 | |
260 | |
| 251 | goto &_req; |
261 | goto &_req; |
| 252 | } |
262 | } |
| 253 | |
263 | |
| 254 | =back |
264 | =back |
