[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.23 by root, Sat Feb 1 21:43:28 2020 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.04';
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
…		…
214	C<on_error> callback, all of your queued request callbacks are called	106	C<on_error> callback, all of your queued request callbacks are called
215	without only the C<$dbh> argument.	107	without only the C<$dbh> argument.
216		108
217	If omitted, then C<die> will be called on any errors, fatal or not.	109	If omitted, then C<die> will be called on any errors, fatal or not.
218		110
		111	Note that AnyEvent::DBI will not catch errors in user-provided callbacks:
		112	if you die in your callback, things might malfunction.
		113
219	=item on_connect => $callback->($dbh[, $success])	114	=item on_connect => $callback->($dbh[, $success])
220		115
221	If you supply an C<on_connect> callback, then this callback will be	116	If you supply an C<on_connect> callback, then this callback will be
222	invoked after the database connect attempt. If the connection succeeds,	117	invoked after the database connect attempt. If the connection succeeds,
223	C<$success> is true, otherwise it is missing and C<$@> contains the	118	C<$success> is true, otherwise it is missing and C<$@> contains the
…		…
230		125
231	When on_connect is supplied, connect error are not fatal and AnyEvent::DBI	126	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	127	will not C<die>. You still cannot, however, use the $dbh object you
233	received from C<new> to make requests.	128	received from C<new> to make requests.
234		129
235	=item exec_server => 1	130	=item fork_template => $AnyEvent::Fork-object
236		131
237	If you supply an C<exec_server> argument, then the DBI server process will	132	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	133	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	134	C<exec_server> constructor argument) or uses a process forked early (see
240	for your database server.	135	L<AnyEvent::Fork::Early>).
241		136
242	If you do not supply the C<exec_server> argument (or supply it with a	137	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	138	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	139	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,	140	and again into your child processes:
246	STDOUT, and STDERR (and the socket it uses to communicate with the cilent,	141
247	of course).	142	my $template = AnyEvent::Fork
		143	->new # create new template
		144	->require ("AnyEvent::DBI::Slave"); # preload AnyEvent::DBI::Slave module
		145
		146	for (...) {
		147	$dbh = new AnyEvent::DBI ...
		148	fork_template => $template;
248		149
249	=item timeout => seconds	150	=item timeout => seconds
250		151
251	If you supply a timeout parameter (fractional values are supported), then	152	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	153	a timer is started any time the DBI handle expects a response from the
…		…
267		168
268	=back	169	=back
269		170
270	Any additional key-value pairs will be rolled into a hash reference	171	Any additional key-value pairs will be rolled into a hash reference
271	and passed as the final argument to the C<< DBI->connect (...) >>	172	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	173	call. For example, to suppress errors on STDERR and send them instead to an
273	AnyEvent::Handle you could do:	174	AnyEvent::Handle you could do:
274		175
275	$dbh = new AnyEvent::DBI	176	$dbh = new AnyEvent::DBI
276	"DBI:mysql:test;mysql_read_default_file=/root/.my.cnf", "", "",	177	"DBI:mysql:test;mysql_read_default_file=/root/.my.cnf", "", "",
277	PrintError => 0,	178	PrintError => 0,
…		…
279	$log_handle->push_write ("DBI Error: $@ at $_[1]:$_[2]\n");	180	$log_handle->push_write ("DBI Error: $@ at $_[1]:$_[2]\n");
280	};	181	};
281		182
282	=cut	183	=cut
283		184
284	# stupid Storable autoloading, total loss-loss situation
285	Storable::thaw Storable::freeze [];
286
287	sub new {	185	sub new {
288	my ($class, $dbi, $user, $pass, %arg) = @_;	186	my ($class, $dbi, $user, $pass, %arg) = @_;
289		187
		188	# we use our own socketpair, so we always have a socket
		189	# available, even before the forked process exsist.
		190	# this is mostly done so this module is compatible
		191	# to versions of itself older than 3.0.
290	my ($client, $server) = AnyEvent::Util::portable_socketpair	192	my ($client, $server) = AnyEvent::Util::portable_socketpair
291	or croak "unable to create Anyevent::DBI communications pipe: $!";	193	or croak "unable to create AnyEvent::DBI communications pipe: $!";
		194
		195	AnyEvent::fh_unblock $client;
		196
		197	my $fork = delete $arg{fork_template};
292		198
293	my %dbi_args = %arg;	199	my %dbi_args = %arg;
294	delete @dbi_args{qw(on_connect on_error timeout exec_server)};	200	delete @dbi_args{qw(on_connect on_error timeout fork_template exec_server)};
295		201
296	my $self = bless \%arg, $class;	202	my $self = bless \%arg, $class;
		203
297	$self->{fh} = $client;	204	$self->{fh} = $client;
298
299	AnyEvent::Util::fh_nonblocking $client, 1;
300		205
301	my $rbuf;	206	my $rbuf;
302	my @caller = (caller)[1,2]; # the "default" caller	207	my @caller = (caller)[1,2]; # the "default" caller
303		208
		209	$fork = $fork ? $fork->fork : AnyEvent::Fork->new
		210	or croak "fork: $!";
		211
		212	$fork->require ("AnyEvent::DBI::Slave");
		213	$fork->send_arg ($VERSION);
		214	$fork->send_fh ($server);
		215
		216	# we don't rely on the callback, because we use our own
		217	# socketpair, for better or worse.
		218	$fork->run ("AnyEvent::DBI::Slave::serve", sub { });
		219
304	{	220	{
305	Scalar::Util::weaken (my $self = $self);	221	Convert::Scalar::weaken (my $self = $self);
306		222
307	$self->{rw} = AnyEvent->io (fh => $client, poll => "r", cb => sub {	223	my $cbor = new CBOR::XS;
308	return unless $self;
309		224
310	$self->{last_activity} = AnyEvent->now;	225	$self->{rw} = AE::io $client, 0, sub {
311		226	my $len = Convert::Scalar::extend_read $client, $rbuf, 65536;
312	my $len = sysread $client, $rbuf, 65536, length $rbuf;
313		227
314	if ($len > 0) {	228	if ($len > 0) {
315	# we received data, so reset the timer	229	# we received data, so reset the timer
		230	$self->{last_activity} = AE::now;
316		231
317	while () {	232	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;	233	last unless $self;
		234
327	my $req = shift @{ $self->{queue} };	235	my $req = shift @{ $self->{queue} };
328		236
329	if (defined $res->[0]) {	237	if (defined $res->[0]) {
330	$res->[0] = $self;	238	$res->[0] = $self;
331	$req->[0](@$res);	239	$req->[0](@$res);
…		…
336	$self->_error ($res->[1], @$req, $res->[2]) # error, request record, is_fatal	244	$self->_error ($res->[1], @$req, $res->[2]) # error, request record, is_fatal
337	if $self; # cb() could have deleted it	245	if $self; # cb() could have deleted it
338	}	246	}
339		247
340	# no more queued requests, so become idle	248	# no more queued requests, so become idle
		249	if ($self && !@{ $self->{queue} }) {
341	undef $self->{last_activity}	250	undef $self->{last_activity};
342	if $self && !@{ $self->{queue} };	251	$self->{tw_cb}->();
		252	}
343	}	253	}
344		254
345	} elsif (defined $len) {	255	} elsif (defined $len) {
346	# todo, caller?	256	# todo, caller?
347	$self->_error ("unexpected eof", @caller, 1);	257	$self->_error ("unexpected eof", @caller, 1);
348	} elsif ($! != Errno::EAGAIN) {	258	} elsif ($! != Errno::EAGAIN) {
349	# todo, caller?	259	# todo, caller?
350	$self->_error ("read error: $!", @caller, 1);	260	$self->_error ("read error: $!", @caller, 1);
351	}	261	}
352	});	262	};
353		263
354	$self->{tw_cb} = sub {	264	$self->{tw_cb} = sub {
355	if ($self->{timeout} && $self->{last_activity}) {	265	if ($self->{timeout} && $self->{last_activity}) {
356	if (AnyEvent->now > $self->{last_activity} + $self->{timeout}) {	266	if (AE::now > $self->{last_activity} + $self->{timeout}) {
357	# we did time out	267	# we did time out
358	my $req = $self->{queue}[0];	268	my $req = $self->{queue}[0];
359	$self->_error (timeout => $req->[1], $req->[2], 1); # timeouts are always fatal	269	$self->_error (timeout => $req->[1], $req->[2], 1); # timeouts are always fatal
360	} else {	270	} else {
361	# we need to re-set the timeout watcher	271	# we need to re-set the timeout watcher
362	$self->{tw} = AnyEvent->timer (	272	$self->{tw} = AE::timer
363	after => $self->{last_activity} + $self->{timeout} - AnyEvent->now,	273	$self->{last_activity} + $self->{timeout} - AE::now,
		274	0,
364	cb => $self->{tw_cb},	275	$self->{tw_cb},
365	);	276	;
366	Scalar::Util::weaken $self;
367	}	277	}
368	} else {	278	} else {
369	# no timeout check wanted, or idle	279	# no timeout check wanted, or idle
370	undef $self->{tw};	280	undef $self->{tw};
371	}	281	}
372	};	282	};
373		283
374	$self->{ww_cb} = sub {	284	$self->{ww_cb} = sub {
375	return unless $self;
376
377	$self->{last_activity} = AnyEvent->now;	285	$self->{last_activity} = AE::now;
378		286
379	my $len = syswrite $client, $self->{wbuf}	287	my $len = syswrite $client, $self->{wbuf}
380	or return delete $self->{ww};	288	or return delete $self->{ww};
381		289
382	substr $self->{wbuf}, 0, $len, "";	290	substr $self->{wbuf}, 0, $len, "";
383	};	291	};
384	}	292	}
385		293
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 (	294	$self->_req (
		295	sub {
		296	return unless $self;
		297	$self->{child_pid} = $_[1];
		298	},
		299	(caller)[1,2],
		300	"req_pid"
		301	);
		302
		303	$self->_req (
		304	sub {
		305	return unless $self;
422	($self->{on_connect} ? $self->{on_connect} : sub { }),	306	&{ $self->{on_connect} } if $self->{on_connect};
		307	},
423	(caller)[1,2],	308	(caller)[1,2],
424	req_open => $dbi, $user, $pass, %dbi_args	309	req_open => $dbi, $user, $pass, %dbi_args
425	);	310	);
426		311
427	$self	312	$self
…		…
430	sub _server_pid {	315	sub _server_pid {
431	shift->{child_pid}	316	shift->{child_pid}
432	}	317	}
433		318
434	sub kill_child {	319	sub kill_child {
435	my $self = shift;	320	my $self = shift;
		321
436	my $child_pid = delete $self->{child_pid};	322	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	323	# kill and reap process
447	my $kid_watcher; $kid_watcher = AnyEvent->child (	324	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;	325	undef $kid_watcher;
452	# cancel SIGKILL
453	undef $murder_timer;
454	},
455	);	326	};
		327	kill TERM => $pid;
		328	}
456		329
		330	delete $self->{rw};
		331	delete $self->{ww};
		332	delete $self->{tw};
457	close $self->{fh};	333	close delete $self->{fh};
458	}
459	}	334	}
460		335
461	sub DESTROY {	336	sub DESTROY {
462	shift->kill_child;	337	shift->kill_child;
463	}	338	}
…		…
526		401
527	push @{ $self->{queue} }, [$cb, $filename, $line];	402	push @{ $self->{queue} }, [$cb, $filename, $line];
528		403
529	# re-start timeout if necessary	404	# re-start timeout if necessary
530	if ($self->{timeout} && !$self->{tw}) {	405	if ($self->{timeout} && !$self->{tw}) {
531	$self->{last_activity} = AnyEvent->now;	406	$self->{last_activity} = AE::now;
532	$self->{tw_cb}->();	407	$self->{tw_cb}->();
533	}	408	}
534		409
535	$self->{wbuf} .= pack "L/a*", Storable::freeze \@_;	410	$self->{wbuf} .= CBOR::XS::encode_cbor \@_;
536		411
537	unless ($self->{ww}) {	412	unless ($self->{ww}) {
538	my $len = syswrite $self->{fh}, $self->{wbuf};	413	my $len = syswrite $self->{fh}, $self->{wbuf};
539	substr $self->{wbuf}, 0, $len, "";	414	substr $self->{wbuf}, 0, $len, "";
540		415
541	# still any left? then install a write watcher	416	# still any left? then install a write watcher
542	$self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $self->{ww_cb})	417	$self->{ww} = AE::io $self->{fh}, 1, $self->{ww_cb}
543	if length $self->{wbuf};	418	if length $self->{wbuf};
544	}	419	}
545	}	420	}
		421
		422	=item $dbh->attr ($attr_name[, $attr_value], $cb->($dbh, $new_value))
		423
		424	An accessor for the database handle attributes, such as C<AutoCommit>,
		425	C<RaiseError>, C<PrintError> and so on. If you provide an C<$attr_value>
		426	(which might be C<undef>), then the given attribute will be set to that
		427	value.
		428
		429	The callback will be passed the database handle and the attribute's value
		430	if successful.
		431
		432	If an error occurs and the C<on_error> callback returns, then only C<$dbh>
		433	will be passed and C<$@> contains the error message.
546		434
547	=item $dbh->exec ("statement", @args, $cb->($dbh, \@rows, $rv))	435	=item $dbh->exec ("statement", @args, $cb->($dbh, \@rows, $rv))
548		436
549	Executes the given SQL statement with placeholders replaced by	437	Executes the given SQL statement with placeholders replaced by
550	C<@args>. The statement will be prepared and cached on the server side, so	438	C<@args>. The statement will be prepared and cached on the server side, so
…		…
558	call.	446	call.
559		447
560	If an error occurs and the C<on_error> callback returns, then only C<$dbh>	448	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.	449	will be passed and C<$@> contains the error message.
562		450
563	=item $dbh->attr ($attr_name[, $attr_value], $cb->($dbh, $new_value))	451	=item $dbh->stattr ($attr_name, $cb->($dbh, $value))
564		452
565	An accessor for the handle attributes, such as C<AutoCommit>,	453	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>	454	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		455
570	The callback will be passed the database handle and the attribute's value	456	The callback will be passed the database handle and the attribute's value
571	if successful.	457	if successful.
572		458
573	If an error occurs and the C<on_error> callback returns, then only C<$dbh>	459	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.	460	will be passed and C<$@> contains the error message.
575		461
576	=item $dbh->begin_work ($cb->($dbh[, $success]))	462	=item $dbh->begin_work ($cb->($dbh[, $rc]))
577		463
578	=item $dbh->commit ($cb->($dbh[, $success]))	464	=item $dbh->commit ($cb->($dbh[, $rc]))
579		465
580	=item $dbh->rollback ($cb->($dbh[, $success]))	466	=item $dbh->rollback ($cb->($dbh[, $rc]))
581		467
582	The begin_work, commit, and rollback methods expose the equivalent	468	The begin_work, commit, and rollback methods expose the equivalent
583	transaction control method of the DBI driver. On success, C<$success>	469	transaction control method of the DBI driver. On success, C<$rc> is true.
584	is true.
585		470
586	If an error occurs and the C<on_error> callback returns, then only C<$dbh>	471	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.	472	will be passed and C<$@> contains the error message.
588		473
589	=item $dbh->func ('string_which_yields_args_when_evaled', $func_name, $cb->($dbh, $result, $handle_error))	474	=item $dbh->func ('string_which_yields_args_when_evaled', $func_name, $cb->($dbh, $rc, $dbi_err, $dbi_errstr))
590		475
591	This gives access to database driver private methods. Because they	476	This gives access to database driver private methods. Because they
592	are not standard you cannot always depend on the value of C<$result>	477	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	478	C<$dbi_err>. Check the documentation for your specific driver/function
594	driver/function combination to see what it returns.	479	combination to see what it returns.
595		480
596	Note that the first argument will be eval'ed to produce the argument list to	481	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	482	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	483	between the AnyEvent::DBI server process and your program does not support the
599	passage of closures.	484	passage of closures.
…		…
608	my ($string, $search) = @_;	493	my ($string, $search) = @_;
609	return index $string, $search;	494	return index $string, $search;
610	},	495	},
611	},	496	},
612	create_function => sub {	497	create_function => sub {
613	return $cv->send($@)	498	return $cv->send ($@)
614	unless $_[0];	499	unless $#_;
615	$cv->send (undef, @_[1,2]);	500	$cv->send (undef, @_[1,2,3]);
616	}	501	}
617	);	502	);
618		503
619	my ($err,$result,$handle_err) = $cv->recv;	504	my ($err,$rc,$errcode,$errstr) = $cv->recv;
620		505
		506	die $err if defined $err;
621	die "EVAL failed: $err"	507	die "EVAL failed: $errstr"
622	if $err;	508	if $errcode;
623		509
624	# otherwise, we can ignore $result and $handle_err for this particular func	510	# otherwise, we can ignore $rc and $errcode for this particular func
625		511
626	=cut	512	=cut
627		513
628	for my $cmd_name (qw(exec attr begin_work commit rollback func)) {	514	for my $cmd_name (qw(attr exec stattr begin_work commit rollback func)) {
629	eval 'sub ' . $cmd_name . '{	515	eval 'sub ' . $cmd_name . '{
630	my $cb = pop;	516	my $cb = pop;
631	splice @_, 1, 0, $cb, (caller)[1,2], "req_' . $cmd_name . '";	517	splice @_, 1, 0, $cb, (caller)[1,2], "req_' . $cmd_name . '";
632	&_req	518	&_req
633	}';	519	}';
…		…
637		523
638	=head1 SEE ALSO	524	=head1 SEE ALSO
639		525
640	L<AnyEvent>, L<DBI>, L<Coro::Mysql>.	526	L<AnyEvent>, L<DBI>, L<Coro::Mysql>.
641		527
642	=head1 AUTHOR	528	=head1 AUTHOR AND CONTACT
643		529
644	Marc Lehmann <schmorp@schmorp.de>	530	Marc Lehmann <schmorp@schmorp.de> (current maintainer)
645	http://home.schmorp.de/	531	http://home.schmorp.de/
646		532
647	Adam Rosenstein <adam@redcondor.com>	533	Adam Rosenstein <adam@redcondor.com>
648	http://www.redcondor.com/	534	http://www.redcondor.com/
649		535
650	=cut	536	=cut
651		537
652	1;	538	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.23 by root, Sat Feb 1 21:43:28 2020 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.23 by root, Sat Feb 1 21:43:28 2020 UTC