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