[ViewVC] Diff of: cvs/AnyEvent-DBI/DBI.pm

Comparing AnyEvent-DBI/DBI.pm (file contents):
Revision 1.11 by root, Sun Jun 28 14:59:51 2009 UTC vs.
Revision 1.20 by root, Sat Mar 24 23:22:25 2018 UTC

…		…
11	my $dbh = new AnyEvent::DBI "DBI:SQLite:dbname=test.db", "", "";	11	my $dbh = new AnyEvent::DBI "DBI:SQLite:dbname=test.db", "", "";
12		12
13	$dbh->exec ("select * from test where num=?", 10, sub {	13	$dbh->exec ("select * from test where num=?", 10, sub {
14	my ($dbh, $rows, $rv) = @_;	14	my ($dbh, $rows, $rv) = @_;
15		15
16	$rows or die "failure: $@";	16	$#_ or die "failure: $@";
17		17
18	print "@$_\n"	18	print "@$_\n"
19	for @$rows;	19	for @$rows;
20		20
21	$cv->broadcast;	21	$cv->broadcast;
…		…
33	This module implements asynchronous DBI access by forking or executing	33	This module implements asynchronous DBI access by forking or executing
34	separate "DBI-Server" processes and sending them requests.	34	separate "DBI-Server" processes and sending them requests.
35		35
36	It means that you can run DBI requests in parallel to other tasks.	36	It means that you can run DBI requests in parallel to other tasks.
37		37
38	The overhead for very simple statements ("select 0") is somewhere	38	With DBD::mysql, the overhead for very simple statements
39	around 120% to 200% (dual/single core CPU) compared to an explicit	39	("select 0") is somewhere around 50% compared to an explicit
40	prepare_cached/execute/fetchrow_arrayref/finish combination.	40	prepare_cached/execute/fetchrow_arrayref/finish combination. With
		41	DBD::SQlite3, it's more like a factor of 8 for this trivial statement.
41		42
42	=head2 ERROR HANDLING	43	=head2 ERROR HANDLING
43		44
44	This module defines a number of functions that accept a callback	45	This module defines a number of functions that accept a callback
45	argument. All callbacks used by this module get their AnyEvent::DBI handle	46	argument. All callbacks used by this module get their AnyEvent::DBI handle
…		…
47		48
48	If the request was successful, then there will be more arguments,	49	If the request was successful, then there will be more arguments,
49	otherwise there will only be the C<$dbh> argument and C<$@> contains an	50	otherwise there will only be the C<$dbh> argument and C<$@> contains an
50	error message.	51	error message.
51		52
52	A convinient way to check whether an error occured is to check C<$#_> -	53	A convenient way to check whether an error occurred is to check C<$#_> -
53	if that is true, then the function was successful, otherwise there was an	54	if that is true, then the function was successful, otherwise there was an
54	error.	55	error.
55		56
56	=cut	57	=cut
57		58
58	package AnyEvent::DBI;	59	package AnyEvent::DBI;
59		60
60	use strict qw(vars subs);	61	use common::sense;
61	no warnings;
62		62
63	use Carp;	63	use Carp;
64	use Socket ();	64	use Convert::Scalar ();
65	use Scalar::Util ();	65	use AnyEvent::Fork ();
66	use Storable ();	66	use CBOR::XS ();
67
68	use DBI ();
69		67
70	use AnyEvent ();	68	use AnyEvent ();
71	use AnyEvent::Util ();	69	use AnyEvent::Util ();
72		70
73	use Errno ();	71	use Errno ();
74	use Fcntl ();
75	use POSIX ();
76		72
77	our $VERSION = '1.19';	73	our $VERSION = '3.02';
78
79	our $FD_MAX = eval { POSIX::sysconf (&POSIX::_SC_OPEN_MAX) - 1 } \|\| 1023;
80
81	# this is the forked server code, could/should be bundled as it's own file
82
83	our $DBH;
84
85	sub req_open {
86	my (undef, $dbi, $user, $pass, %attr) = @{+shift};
87
88	$DBH = DBI->connect ($dbi, $user, $pass, \%attr) or die $DBI::errstr;
89
90	[1, 1]
91	}
92
93	sub req_exec {
94	my (undef, $st, @args) = @{+shift};
95	my $sth = $DBH->prepare_cached ($st, undef, 1)
96	or die [$DBI::errstr];
97
98	my $rv = $sth->execute (@args)
99	or die [$sth->errstr];
100
101	[1, $sth->{NUM_OF_FIELDS} ? $sth->fetchall_arrayref : undef, $rv]
102	}
103
104	sub req_attr {
105	my (undef, $attr_name, @attr_val) = @{+shift};
106
107	$DBH->{$attr_name} = $attr_val[0]
108	if @attr_val;
109
110	[1, $DBH->{$attr_name}]
111	}
112
113	sub req_begin_work {
114	[1, $DBH->begin_work or die [$DBI::errstr]]
115	}
116
117	sub req_commit {
118	[1, $DBH->commit or die [$DBI::errstr]]
119	}
120
121	sub req_rollback {
122	[1, $DBH->rollback or die [$DBI::errstr]]
123	}
124
125	sub req_func {
126	my (undef, $arg_string, $function) = @{+shift};
127	my @args = eval $arg_string;
128
129	die "Bad func () arg string: $@"
130	if $@;
131
132	my $rv = $DBH->func (@args, $function);
133	return [$rv, $DBH->err];
134	}
135
136	sub serve_fh($$) {
137	my ($fh, $version) = @_;
138
139	if ($VERSION != $version) {
140	syswrite $fh,
141	pack "L/a*",
142	Storable::freeze
143	[undef, "AnyEvent::DBI version mismatch ($VERSION vs. $version)"];
144	return;
145	}
146
147	eval {
148	my $rbuf;
149
150	while () {
151	sysread $fh, $rbuf, 16384, length $rbuf
152	or last;
153
154	while () {
155	my $len = unpack "L", $rbuf;
156
157	# full request available?
158	last unless $len && $len + 4 <= length $rbuf;
159
160	my $req = Storable::thaw substr $rbuf, 4;
161	substr $rbuf, 0, $len + 4, ""; # remove length + request
162
163	my $wbuf = eval { pack "L/a*", Storable::freeze $req->[0]($req) };
164	$wbuf = pack "L/a*", Storable::freeze [undef, ref $@ ? ("$@->[0]", $@->[1]) : ("$@", 1)]
165	if $@;
166
167	for (my $ofs = 0; $ofs < length $wbuf; ) {
168	$ofs += (syswrite $fh, substr $wbuf, $ofs
169	or die "unable to write results");
170	}
171	}
172	}
173	};
174	}
175
176	sub serve_fd($$) {
177	open my $fh, ">>&=$_[0]"
178	or die "Couldn't open server file descriptor: $!";
179
180	serve_fh $fh, $_[1];
181	}
182		74
183	=head2 METHODS	75	=head2 METHODS
184		76
185	=over 4	77	=over 4
186		78
…		…
230		122
231	When on_connect is supplied, connect error are not fatal and AnyEvent::DBI	123	When on_connect is supplied, connect error are not fatal and AnyEvent::DBI
232	will not C<die>. You still cannot, however, use the $dbh object you	124	will not C<die>. You still cannot, however, use the $dbh object you
233	received from C<new> to make requests.	125	received from C<new> to make requests.
234		126
235	=item exec_server => 1	127	=item fork_template => $AnyEvent::Fork-object
236		128
237	If you supply an C<exec_server> argument, then the DBI server process will	129	C<AnyEvent::DBI> uses C<< AnyEvent::Fork->new >> to create the database
238	fork and exec another perl interpreter (using C<$^X>) with just the	130	slave, which in turn either C<exec>'s a new process (similar to the old
239	AnyEvent::DBI proxy running. This will provide the cleanest possible porxy	131	C<exec_server> constructor argument) or uses a process forked early (see
240	for your database server.	132	L<AnyEvent::Fork::Early>).
241		133
242	If you do not supply the C<exec_server> argument (or supply it with a	134	With this argument you can provide your own fork template. This can be
243	false value) then the traditional method of starting the server by forking	135	useful if you create a lot of C<AnyEvent::DBI> handles and want to save
244	the current process is used. The forked interpreter will try to clean	136	memory (And speed up startup) by not having to load C<AnyEvent::DBI> again
245	itself up by calling POSIX::close on all file descriptors except STDIN,	137	and again into your child processes:
246	STDOUT, and STDERR (and the socket it uses to communicate with the cilent,	138
247	of course).	139	my $template = AnyEvent::Fork
		140	->new # create new template
		141	->require ("AnyEvent::DBI::Slave"); # preload AnyEvent::DBI::Slave module
		142
		143	for (...) {
		144	$dbh = new AnyEvent::DBI ...
		145	fork_template => $template;
248		146
249	=item timeout => seconds	147	=item timeout => seconds
250		148
251	If you supply a timeout parameter (fractional values are supported), then	149	If you supply a timeout parameter (fractional values are supported), then
252	a timer is started any time the DBI handle expects a response from the	150	a timer is started any time the DBI handle expects a response from the
…		…
267		165
268	=back	166	=back
269		167
270	Any additional key-value pairs will be rolled into a hash reference	168	Any additional key-value pairs will be rolled into a hash reference
271	and passed as the final argument to the C<< DBI->connect (...) >>	169	and passed as the final argument to the C<< DBI->connect (...) >>
272	call. For example, to supress errors on STDERR and send them instead to an	170	call. For example, to suppress errors on STDERR and send them instead to an
273	AnyEvent::Handle you could do:	171	AnyEvent::Handle you could do:
274		172
275	$dbh = new AnyEvent::DBI	173	$dbh = new AnyEvent::DBI
276	"DBI:mysql:test;mysql_read_default_file=/root/.my.cnf", "", "",	174	"DBI:mysql:test;mysql_read_default_file=/root/.my.cnf", "", "",
277	PrintError => 0,	175	PrintError => 0,
…		…
279	$log_handle->push_write ("DBI Error: $@ at $_[1]:$_[2]\n");	177	$log_handle->push_write ("DBI Error: $@ at $_[1]:$_[2]\n");
280	};	178	};
281		179
282	=cut	180	=cut
283		181
284	# stupid Storable autoloading, total loss-loss situation
285	Storable::thaw Storable::freeze [];
286
287	sub new {	182	sub new {
288	my ($class, $dbi, $user, $pass, %arg) = @_;	183	my ($class, $dbi, $user, $pass, %arg) = @_;
289		184
		185	# we use our own socketpair, so we always have a socket
		186	# available, even before the forked process exsist.
		187	# this is mostly done so this module is compatible
		188	# to versions of itself older than 3.0.
290	my ($client, $server) = AnyEvent::Util::portable_socketpair	189	my ($client, $server) = AnyEvent::Util::portable_socketpair
291	or croak "unable to create Anyevent::DBI communications pipe: $!";	190	or croak "unable to create AnyEvent::DBI communications pipe: $!";
		191
		192	AnyEvent::fh_unblock $client;
		193
		194	my $fork = delete $arg{fork_template};
292		195
293	my %dbi_args = %arg;	196	my %dbi_args = %arg;
294	delete @dbi_args{qw(on_connect on_error timeout exec_server)};	197	delete @dbi_args{qw(on_connect on_error timeout fork_template exec_server)};
295		198
296	my $self = bless \%arg, $class;	199	my $self = bless \%arg, $class;
		200
297	$self->{fh} = $client;	201	$self->{fh} = $client;
298
299	AnyEvent::Util::fh_nonblocking $client, 1;
300		202
301	my $rbuf;	203	my $rbuf;
302	my @caller = (caller)[1,2]; # the "default" caller	204	my @caller = (caller)[1,2]; # the "default" caller
303		205
		206	$fork = $fork ? $fork->fork : AnyEvent::Fork->new
		207	or croak "fork: $!";
		208
		209	$fork->require ("AnyEvent::DBI::Slave");
		210	$fork->send_arg ($VERSION);
		211	$fork->send_fh ($server);
		212
		213	# we don't rely on the callback, because we use our own
		214	# socketpair, for better or worse.
		215	$fork->run ("AnyEvent::DBI::Slave::serve", sub { });
		216
304	{	217	{
305	Scalar::Util::weaken (my $self = $self);	218	Convert::Scalar::weaken (my $self = $self);
306		219
307	$self->{rw} = AnyEvent->io (fh => $client, poll => "r", cb => sub {	220	my $cbor = new CBOR::XS;
308	return unless $self;
309		221
310	$self->{last_activity} = AnyEvent->now;	222	$self->{rw} = AE::io $client, 0, sub {
311		223	my $len = Convert::Scalar::extend_read $client, $rbuf, 65536;
312	my $len = sysread $client, $rbuf, 65536, length $rbuf;
313		224
314	if ($len > 0) {	225	if ($len > 0) {
315	# we received data, so reset the timer	226	# we received data, so reset the timer
		227	$self->{last_activity} = AE::now;
316		228
317	while () {	229	for my $res ($cbor->incr_parse_multiple ($rbuf)) {
318	my $len = unpack "L", $rbuf;
319
320	# full response available?
321	last unless $len && $len + 4 <= length $rbuf;
322
323	my $res = Storable::thaw substr $rbuf, 4;
324	substr $rbuf, 0, $len + 4, ""; # remove length + request
325
326	last unless $self;	230	last unless $self;
		231
327	my $req = shift @{ $self->{queue} };	232	my $req = shift @{ $self->{queue} };
328		233
329	if (defined $res->[0]) {	234	if (defined $res->[0]) {
330	$res->[0] = $self;	235	$res->[0] = $self;
331	$req->[0](@$res);	236	$req->[0](@$res);
…		…
336	$self->_error ($res->[1], @$req, $res->[2]) # error, request record, is_fatal	241	$self->_error ($res->[1], @$req, $res->[2]) # error, request record, is_fatal
337	if $self; # cb() could have deleted it	242	if $self; # cb() could have deleted it
338	}	243	}
339		244
340	# no more queued requests, so become idle	245	# no more queued requests, so become idle
		246	if ($self && !@{ $self->{queue} }) {
341	undef $self->{last_activity}	247	undef $self->{last_activity};
342	if $self && !@{ $self->{queue} };	248	$self->{tw_cb}->();
		249	}
343	}	250	}
344		251
345	} elsif (defined $len) {	252	} elsif (defined $len) {
346	# todo, caller?	253	# todo, caller?
347	$self->_error ("unexpected eof", @caller, 1);	254	$self->_error ("unexpected eof", @caller, 1);
348	} elsif ($! != Errno::EAGAIN) {	255	} elsif ($! != Errno::EAGAIN) {
349	# todo, caller?	256	# todo, caller?
350	$self->_error ("read error: $!", @caller, 1);	257	$self->_error ("read error: $!", @caller, 1);
351	}	258	}
352	});	259	};
353		260
354	$self->{tw_cb} = sub {	261	$self->{tw_cb} = sub {
355	if ($self->{timeout} && $self->{last_activity}) {	262	if ($self->{timeout} && $self->{last_activity}) {
356	if (AnyEvent->now > $self->{last_activity} + $self->{timeout}) {	263	if (AE::now > $self->{last_activity} + $self->{timeout}) {
357	# we did time out	264	# we did time out
358	my $req = $self->{queue}[0];	265	my $req = $self->{queue}[0];
359	$self->_error (timeout => $req->[1], $req->[2], 1); # timeouts are always fatal	266	$self->_error (timeout => $req->[1], $req->[2], 1); # timeouts are always fatal
360	} else {	267	} else {
361	# we need to re-set the timeout watcher	268	# we need to re-set the timeout watcher
362	$self->{tw} = AnyEvent->timer (	269	$self->{tw} = AE::timer
363	after => $self->{last_activity} + $self->{timeout} - AnyEvent->now,	270	$self->{last_activity} + $self->{timeout} - AE::now,
		271	0,
364	cb => $self->{tw_cb},	272	$self->{tw_cb},
365	);	273	;
366	Scalar::Util::weaken $self;
367	}	274	}
368	} else {	275	} else {
369	# no timeout check wanted, or idle	276	# no timeout check wanted, or idle
370	undef $self->{tw};	277	undef $self->{tw};
371	}	278	}
372	};	279	};
373		280
374	$self->{ww_cb} = sub {	281	$self->{ww_cb} = sub {
375	return unless $self;
376
377	$self->{last_activity} = AnyEvent->now;	282	$self->{last_activity} = AE::now;
378		283
379	my $len = syswrite $client, $self->{wbuf}	284	my $len = syswrite $client, $self->{wbuf}
380	or return delete $self->{ww};	285	or return delete $self->{ww};
381		286
382	substr $self->{wbuf}, 0, $len, "";	287	substr $self->{wbuf}, 0, $len, "";
383	};	288	};
384	}	289	}
385		290
386	my $pid = fork;
387
388	if ($pid) {
389	# parent
390	close $server;
391	} elsif (defined $pid) {
392	# child
393	my $serv_fno = fileno $server;
394
395	if ($self->{exec_server}) {
396	fcntl $server, &Fcntl::F_SETFD, 0; # don't close the server side
397	exec {$^X}
398	"$0 dbi slave",
399	-e => "require shift; AnyEvent::DBI::serve_fd ($serv_fno, $VERSION)",
400	$INC{"AnyEvent/DBI.pm"};
401	POSIX::_exit 124;
402	} else {
403	($_ != $serv_fno) && POSIX::close $_
404	for $^F+1..$FD_MAX;
405	serve_fh $server, $VERSION;
406
407	# no other way on the broken windows platform, even this leaks
408	# memory and might fail.
409	kill 9, $$
410	if AnyEvent::WIN32;
411
412	# and this kills the parent process on windows
413	POSIX::_exit 0;
414	}
415	} else {
416	croak "fork: $!";
417	}
418
419	$self->{child_pid} = $pid;
420
421	$self->_req (	291	$self->_req (
		292	sub {
		293	return unless $self;
		294	$self->{child_pid} = $_[1];
		295	},
		296	(caller)[1,2],
		297	"req_pid"
		298	);
		299
		300	$self->_req (
		301	sub {
		302	return unless $self;
422	($self->{on_connect} ? $self->{on_connect} : sub { }),	303	&{ $self->{on_connect} } if $self->{on_connect};
		304	},
423	(caller)[1,2],	305	(caller)[1,2],
424	req_open => $dbi, $user, $pass, %dbi_args	306	req_open => $dbi, $user, $pass, %dbi_args
425	);	307	);
426		308
427	$self	309	$self
…		…
430	sub _server_pid {	312	sub _server_pid {
431	shift->{child_pid}	313	shift->{child_pid}
432	}	314	}
433		315
434	sub kill_child {	316	sub kill_child {
435	my $self = shift;	317	my $self = shift;
		318
436	my $child_pid = delete $self->{child_pid};	319	if (my $pid = delete $self->{child_pid}) {
437	if ($child_pid) {
438	# send SIGKILL in two seconds
439	my $murder_timer = AnyEvent->timer (
440	after => 2,
441	cb => sub {
442	kill 9, $child_pid;
443	},
444	);
445
446	# reap process	320	# kill and reap process
447	my $kid_watcher; $kid_watcher = AnyEvent->child (	321	my $kid_watcher; $kid_watcher = AE::child $pid, sub {
448	pid => $child_pid,
449	cb => sub {
450	# just hold on to this so it won't go away
451	undef $kid_watcher;	322	undef $kid_watcher;
452	# cancel SIGKILL
453	undef $murder_timer;
454	},
455	);	323	};
		324	kill TERM => $pid;
		325	}
456		326
		327	delete $self->{rw};
		328	delete $self->{ww};
		329	delete $self->{tw};
457	close $self->{fh};	330	close delete $self->{fh};
458	}
459	}	331	}
460		332
461	sub DESTROY {	333	sub DESTROY {
462	shift->kill_child;	334	shift->kill_child;
463	}	335	}
…		…
526		398
527	push @{ $self->{queue} }, [$cb, $filename, $line];	399	push @{ $self->{queue} }, [$cb, $filename, $line];
528		400
529	# re-start timeout if necessary	401	# re-start timeout if necessary
530	if ($self->{timeout} && !$self->{tw}) {	402	if ($self->{timeout} && !$self->{tw}) {
531	$self->{last_activity} = AnyEvent->now;	403	$self->{last_activity} = AE::now;
532	$self->{tw_cb}->();	404	$self->{tw_cb}->();
533	}	405	}
534		406
535	$self->{wbuf} .= pack "L/a*", Storable::freeze \@_;	407	$self->{wbuf} .= CBOR::XS::encode_cbor \@_;
536		408
537	unless ($self->{ww}) {	409	unless ($self->{ww}) {
538	my $len = syswrite $self->{fh}, $self->{wbuf};	410	my $len = syswrite $self->{fh}, $self->{wbuf};
539	substr $self->{wbuf}, 0, $len, "";	411	substr $self->{wbuf}, 0, $len, "";
540		412
541	# still any left? then install a write watcher	413	# still any left? then install a write watcher
542	$self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $self->{ww_cb})	414	$self->{ww} = AE::io $self->{fh}, 1, $self->{ww_cb}
543	if length $self->{wbuf};	415	if length $self->{wbuf};
544	}	416	}
545	}	417	}
		418
		419	=item $dbh->attr ($attr_name[, $attr_value], $cb->($dbh, $new_value))
		420
		421	An accessor for the database handle attributes, such as C<AutoCommit>,
		422	C<RaiseError>, C<PrintError> and so on. If you provide an C<$attr_value>
		423	(which might be C<undef>), then the given attribute will be set to that
		424	value.
		425
		426	The callback will be passed the database handle and the attribute's value
		427	if successful.
		428
		429	If an error occurs and the C<on_error> callback returns, then only C<$dbh>
		430	will be passed and C<$@> contains the error message.
546		431
547	=item $dbh->exec ("statement", @args, $cb->($dbh, \@rows, $rv))	432	=item $dbh->exec ("statement", @args, $cb->($dbh, \@rows, $rv))
548		433
549	Executes the given SQL statement with placeholders replaced by	434	Executes the given SQL statement with placeholders replaced by
550	C<@args>. The statement will be prepared and cached on the server side, so	435	C<@args>. The statement will be prepared and cached on the server side, so
…		…
558	call.	443	call.
559		444
560	If an error occurs and the C<on_error> callback returns, then only C<$dbh>	445	If an error occurs and the C<on_error> callback returns, then only C<$dbh>
561	will be passed and C<$@> contains the error message.	446	will be passed and C<$@> contains the error message.
562		447
563	=item $dbh->attr ($attr_name[, $attr_value], $cb->($dbh, $new_value))	448	=item $dbh->stattr ($attr_name, $cb->($dbh, $value))
564		449
565	An accessor for the handle attributes, such as C<AutoCommit>,	450	An accessor for the statement attributes of the most recently executed
566	C<RaiseError>, C<PrintError> and so on. If you provide an C<$attr_value>	451	statement, such as C<NAME> or C<TYPE>.
567	(which might be C<undef>), then the given attribute will be set to that
568	value.
569		452
570	The callback will be passed the database handle and the attribute's value	453	The callback will be passed the database handle and the attribute's value
571	if successful.	454	if successful.
572		455
573	If an error occurs and the C<on_error> callback returns, then only C<$dbh>	456	If an error occurs and the C<on_error> callback returns, then only C<$dbh>
574	will be passed and C<$@> contains the error message.	457	will be passed and C<$@> contains the error message.
575		458
576	=item $dbh->begin_work ($cb->($dbh[, $success]))	459	=item $dbh->begin_work ($cb->($dbh[, $rc]))
577		460
578	=item $dbh->commit ($cb->($dbh[, $success]))	461	=item $dbh->commit ($cb->($dbh[, $rc]))
579		462
580	=item $dbh->rollback ($cb->($dbh[, $success]))	463	=item $dbh->rollback ($cb->($dbh[, $rc]))
581		464
582	The begin_work, commit, and rollback methods expose the equivalent	465	The begin_work, commit, and rollback methods expose the equivalent
583	transaction control method of the DBI driver. On success, C<$success>	466	transaction control method of the DBI driver. On success, C<$rc> is true.
584	is true.
585		467
586	If an error occurs and the C<on_error> callback returns, then only C<$dbh>	468	If an error occurs and the C<on_error> callback returns, then only C<$dbh>
587	will be passed and C<$@> contains the error message.	469	will be passed and C<$@> contains the error message.
588		470
589	=item $dbh->func ('string_which_yields_args_when_evaled', $func_name, $cb->($dbh, $result, $handle_error))	471	=item $dbh->func ('string_which_yields_args_when_evaled', $func_name, $cb->($dbh, $rc, $dbi_err, $dbi_errstr))
590		472
591	This gives access to database driver private methods. Because they	473	This gives access to database driver private methods. Because they
592	are not standard you cannot always depend on the value of C<$result>	474	are not standard you cannot always depend on the value of C<$rc> or
593	or C<$handle_error>. Check the documentation for your specific	475	C<$dbi_err>. Check the documentation for your specific driver/function
594	driver/function combination to see what it returns.	476	combination to see what it returns.
595		477
596	Note that the first argument will be eval'ed to produce the argument list to	478	Note that the first argument will be eval'ed to produce the argument list to
597	the func() method. This must be done because the serialization protocol	479	the func() method. This must be done because the serialization protocol
598	between the AnyEvent::DBI server process and your program does not support the	480	between the AnyEvent::DBI server process and your program does not support the
599	passage of closures.	481	passage of closures.
…		…
608	my ($string, $search) = @_;	490	my ($string, $search) = @_;
609	return index $string, $search;	491	return index $string, $search;
610	},	492	},
611	},	493	},
612	create_function => sub {	494	create_function => sub {
613	return $cv->send($@)	495	return $cv->send ($@)
614	unless $_[0];	496	unless $#_;
615	$cv->send (undef, @_[1,2]);	497	$cv->send (undef, @_[1,2,3]);
616	}	498	}
617	);	499	);
618		500
619	my ($err,$result,$handle_err) = $cv->recv;	501	my ($err,$rc,$errcode,$errstr) = $cv->recv;
620		502
		503	die $err if defined $err;
621	die "EVAL failed: $err"	504	die "EVAL failed: $errstr"
622	if $err;	505	if $errcode;
623		506
624	# otherwise, we can ignore $result and $handle_err for this particular func	507	# otherwise, we can ignore $rc and $errcode for this particular func
625		508
626	=cut	509	=cut
627		510
628	for my $cmd_name (qw(exec attr begin_work commit rollback func)) {	511	for my $cmd_name (qw(attr exec stattr begin_work commit rollback func)) {
629	eval 'sub ' . $cmd_name . '{	512	eval 'sub ' . $cmd_name . '{
630	my $cb = pop;	513	my $cb = pop;
631	splice @_, 1, 0, $cb, (caller)[1,2], "req_' . $cmd_name . '";	514	splice @_, 1, 0, $cb, (caller)[1,2], "req_' . $cmd_name . '";
632	&_req	515	&_req
633	}';	516	}';
…		…
637		520
638	=head1 SEE ALSO	521	=head1 SEE ALSO
639		522
640	L<AnyEvent>, L<DBI>, L<Coro::Mysql>.	523	L<AnyEvent>, L<DBI>, L<Coro::Mysql>.
641		524
642	=head1 AUTHOR	525	=head1 AUTHOR AND CONTACT
643		526
644	Marc Lehmann <schmorp@schmorp.de>	527	Marc Lehmann <schmorp@schmorp.de> (current maintainer)
645	http://home.schmorp.de/	528	http://home.schmorp.de/
646		529
647	Adam Rosenstein <adam@redcondor.com>	530	Adam Rosenstein <adam@redcondor.com>
648	http://www.redcondor.com/	531	http://www.redcondor.com/
649		532
650	=cut	533	=cut
651		534
652	1;	535	1
653

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing AnyEvent-DBI/DBI.pm (file contents): Revision 1.11 by root, Sun Jun 28 14:59:51 2009 UTC vs. Revision 1.20 by root, Sat Mar 24 23:22:25 2018 UTC

Diff Legend

Comparing AnyEvent-DBI/DBI.pm (file contents):
Revision 1.11 by root, Sun Jun 28 14:59:51 2009 UTC vs.
Revision 1.20 by root, Sat Mar 24 23:22:25 2018 UTC