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