1=head1 NAME 2 3AnyEvent::DBI::Slave - implement AnyEvent::DBI child/server processes 4 5=head1 SYNOPSIS 6 7 # this module is normally loaded automatically 8 9=head1 DESCRIPTION 10 11This module contains the code that implements the DBI server part of 12C<AnyEvent::DBI>. It is normally loaded automatically into each child 13process, but can be loaded explicitly to save memory or startup time 14(search for C<AnyEvent::DBI::Slave> in the L<AnyEvent::DBI> manpage). 15 16=cut 17 18package AnyEvent::DBI::Slave; 19 20use common::sense; 21 22use DBI (); 23use Convert::Scalar (); 24use CBOR::XS (); 25use AnyEvent (); 26 27our $VERSION = '3.04'; 28 29# this is the forked server code, could/should be bundled as it's own file 30 31our $DBH; 32our $STH; 33 34sub req_pid { 35 [1, $$] 36} 37 38sub req_open { 39 my (undef, $dbi, $user, $pass, %attr) = @{+shift}; 40 41 $DBH = DBI->connect ($dbi, $user, $pass, \%attr) or die $DBI::errstr; 42 43 [1, 1] 44} 45 46sub req_attr { 47 my (undef, $attr_name, @attr_val) = @{+shift}; 48 49 $DBH->{$attr_name} = $attr_val[0] 50 if @attr_val; 51 52 [1, $DBH->{$attr_name}] 53} 54 55sub req_exec { 56 my (undef, $st, @args) = @{+shift}; 57 $STH = $DBH->prepare_cached ($st, undef, 1) 58 or die [$DBI::errstr]; 59 60 my $rv = $STH->execute (@args) 61 or die [$STH->errstr]; 62 63 [1, $STH->{NUM_OF_FIELDS} ? $STH->fetchall_arrayref : undef, $rv] 64} 65 66sub req_stattr { 67 my (undef, $attr_name) = @{+shift}; 68 69 [1, $STH->{$attr_name}] 70} 71 72sub req_begin_work { 73 [1, $DBH->begin_work || die [$DBI::errstr]] 74} 75 76sub req_commit { 77 [1, $DBH->commit || die [$DBI::errstr]] 78} 79 80sub req_rollback { 81 [1, $DBH->rollback || die [$DBI::errstr]] 82} 83 84sub req_func { 85 my (undef, $arg_string, $function) = @{+shift}; 86 my @args = eval $arg_string; 87 88 die "error evaling \$dbh->func() arg_string: $@" 89 if $@; 90 91 my $rc = $DBH->func (@args, $function); 92 return [1, $rc, $DBI::err, $DBI::errstr]; 93} 94 95sub serve($$) { 96 my ($fork_fh, $version, $fh) = @_; 97 98 $0 = "dbi slave"; 99 100 close $fork_fh; 101 102 if ($VERSION != $version) { 103 Convert::Scalar::write_all $fh, CBOR::XS::encode_cbor 104 [undef, "AnyEvent::DBI version mismatch ($VERSION vs. $version)"]; 105 return; 106 } 107 108 eval { 109 my $cbor = new CBOR::XS; 110 my $rbuf; 111 112 while (Convert::Scalar::extend_read $fh, $rbuf, 16000) { 113 for my $req ($cbor->incr_parse_multiple ($rbuf)) { 114 my $wbuf = eval { CBOR::XS::encode_cbor $req->[0]($req) }; 115 $wbuf = CBOR::XS::encode_cbor [undef, ref $@ ? ("$@->[0]", $@->[1]) : ("$@", 1)] 116 if $@; 117 118 Convert::Scalar::write_all $fh, $wbuf 119 or die "unable to write results"; 120 } 121 } 122 }; 123} 124 125=head1 SEE ALSO 126 127L<AnyEvent::DBI>. 128 129=head1 AUTHOR AND CONTACT 130 131 Marc Lehmann <schmorp@schmorp.de> (current maintainer) 132 http://home.schmorp.de/ 133 134 Adam Rosenstein <adam@redcondor.com> 135 http://www.redcondor.com/ 136 137=cut 138 1391 140