[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.14 by root, Sat Oct 30 20:23:44 2010 UTC

    my $dbh = new AnyEvent::DBI "DBI:SQLite:dbname=test.db", "", "";
    $dbh->exec ("select * from test where num=?", 10, sub {
       my ($dbh, $rows, $rv) = @_;
-      $rows or die "failure: $@";
+      $#_ or die "failure: $@";
       print "@$_\n"
          for @$rows;
       $cv->broadcast;
 separate "DBI-Server" processes and sending them requests.
 It means that you can run DBI requests in parallel to other tasks.
 The overhead for very simple statements ("select 0") is somewhere
-around 120% to 200% (dual/single core CPU) compared to an explicit
+around 100% to 120% (dual/single core CPU) compared to an explicit
 prepare_cached/execute/fetchrow_arrayref/finish combination.
 =head2 ERROR HANDLING
 This module defines a number of functions that accept a callback
 =cut
 package AnyEvent::DBI;
-use strict qw(vars subs);
+use common::sense;
-no warnings;
 use Carp;
 use Socket ();
 use Scalar::Util ();
 use Storable ();
-use DBI ();
+use DBI (); # only needed in child actually - do it before fork & !exec?
 use AnyEvent ();
 use AnyEvent::Util ();
 use Errno ();
 use Fcntl ();
 use POSIX ();
-our $VERSION = '1.19';
+our $VERSION = '2.1';
 our $FD_MAX = eval { POSIX::sysconf (&POSIX::_SC_OPEN_MAX) - 1 } || 1023;
 # this is the forked server code, could/should be bundled as it's own file
 sub req_func {
    my (undef, $arg_string, $function) = @{+shift};
    my @args = eval $arg_string;
-   die "Bad func () arg string: $@"
+   die "error evaling \$dbh->func() arg_string: $@"
       if $@;
-   my $rv = $DBH->func (@args, $function);
+   my $rc = $DBH->func (@args, $function);
-   return [$rv, $DBH->err];
+   return [1, $rc, $DBI::err, $DBI::errstr];
 }
 sub serve_fh($$) {
    my ($fh, $version) = @_;
 =item exec_server => 1
 If you supply an C<exec_server> argument, then the DBI server process will
 fork and exec another perl interpreter (using C<$^X>) with just the
-AnyEvent::DBI proxy running. This will provide the cleanest possible porxy
+AnyEvent::DBI proxy running. This will provide the cleanest possible proxy
 for your database server.
 If you do not supply the C<exec_server> argument (or supply it with a
 false value) then the traditional method of starting the server by forking
 the current process is used. The forked interpreter will try to clean
 sub new {
    my ($class, $dbi, $user, $pass, %arg) = @_;
    my ($client, $server) = AnyEvent::Util::portable_socketpair
-      or croak "unable to create Anyevent::DBI communications pipe: $!";
+      or croak "unable to create AnyEvent::DBI communications pipe: $!";
    my %dbi_args = %arg;
    delete @dbi_args{qw(on_connect on_error timeout exec_server)};
    my $self = bless \%arg, $class;
    my @caller = (caller)[1,2]; # the "default" caller
    {
       Scalar::Util::weaken (my $self = $self);
-      $self->{rw} = AnyEvent->io (fh => $client, poll => "r", cb => sub {
+      $self->{rw} = AE::io $client, 0, sub {
          return unless $self;
-         $self->{last_activity} = AnyEvent->now;
+         $self->{last_activity} = AE::now;
          my $len = sysread $client, $rbuf, 65536, length $rbuf;
          if ($len > 0) {
             # we received data, so reset the timer
             $self->_error ("unexpected eof", @caller, 1);
          } elsif ($! != Errno::EAGAIN) {
             # todo, caller?
             $self->_error ("read error: $!", @caller, 1);
          }
-      });
+      };
       $self->{tw_cb} = sub {
          if ($self->{timeout} && $self->{last_activity}) {
-            if (AnyEvent->now > $self->{last_activity} + $self->{timeout}) {
+            if (AE::now > $self->{last_activity} + $self->{timeout}) {
                # we did time out
                my $req = $self->{queue}[0];
                $self->_error (timeout => $req->[1], $req->[2], 1); # timeouts are always fatal
             } else {
                # we need to re-set the timeout watcher
-               $self->{tw} = AnyEvent->timer (
+               $self->{tw} = AE::timer
-                  after => $self->{last_activity} + $self->{timeout} - AnyEvent->now,
+                  $self->{last_activity} + $self->{timeout} - AE::now,
+                  0,
-                  cb    => $self->{tw_cb},
+                  $self->{tw_cb},
-               );
+               ;
-               Scalar::Util::weaken $self;
             }
          } else {
             # no timeout check wanted, or idle
             undef $self->{tw};
          }
       };
       $self->{ww_cb} = sub {
          return unless $self;
-         $self->{last_activity} = AnyEvent->now;
+         $self->{last_activity} = AE::now;
          my $len = syswrite $client, $self->{wbuf}
             or return delete $self->{ww};
          substr $self->{wbuf}, 0, $len, "";
 sub _server_pid {
    shift->{child_pid}
 }
 sub kill_child {
-   my $self      = shift;
+   my $self = shift;
-   my $child_pid = delete $self->{child_pid};
+   if (my $pid = delete $self->{child_pid}) {
-   if ($child_pid) {
+      kill TERM => $pid;
-      # send SIGKILL in two seconds
+   }
-      my $murder_timer = AnyEvent->timer (
-         after => 2,
-         cb    => sub {
-            kill 9, $child_pid;
-         },
-      );
-      # reap process
-      my $kid_watcher; $kid_watcher = AnyEvent->child (
-         pid => $child_pid,
-         cb  => sub {
-            # just hold on to this so it won't go away
-            undef $kid_watcher;
-            # cancel SIGKILL
-            undef $murder_timer;
-         },
-      );
-      close $self->{fh};
+   close delete $self->{fh};
-   }
 }
 sub DESTROY {
    shift->kill_child;
 }
    push @{ $self->{queue} }, [$cb, $filename, $line];
    # re-start timeout if necessary
    if ($self->{timeout} && !$self->{tw}) {
-      $self->{last_activity} = AnyEvent->now;
+      $self->{last_activity} = AE::now;
       $self->{tw_cb}->();
    }
    $self->{wbuf} .= pack "L/a*", Storable::freeze \@_;
    unless ($self->{ww}) {
       my $len = syswrite $self->{fh}, $self->{wbuf};
       substr $self->{wbuf}, 0, $len, "";
       # still any left? then install a write watcher
-      $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $self->{ww_cb})
+      $self->{ww} = AE::io $self->{fh}, 1, $self->{ww_cb}
          if length $self->{wbuf};
    }
 }
 =item $dbh->exec ("statement", @args, $cb->($dbh, \@rows, $rv))
 if successful.
 If an error occurs and the C<on_error> callback returns, then only C<$dbh>
 will be passed and C<$@> contains the error message.
-=item $dbh->begin_work ($cb->($dbh[, $success]))
+=item $dbh->begin_work ($cb->($dbh[, $rc]))
-=item $dbh->commit     ($cb->($dbh[, $success]))
+=item $dbh->commit     ($cb->($dbh[, $rc]))
-=item $dbh->rollback   ($cb->($dbh[, $success]))
+=item $dbh->rollback   ($cb->($dbh[, $rc]))
 The begin_work, commit, and rollback methods expose the equivalent
-transaction control method of the DBI driver. On success, C<$success>
+transaction control method of the DBI driver. On success, C<$rc> is true.
-is true.
 If an error occurs and the C<on_error> callback returns, then only C<$dbh>
 will be passed and C<$@> contains the error message.
-=item $dbh->func ('string_which_yields_args_when_evaled', $func_name, $cb->($dbh, $result, $handle_error))
+=item $dbh->func ('string_which_yields_args_when_evaled', $func_name, $cb->($dbh, $rc, $dbi_err, $dbi_errstr))
 This gives access to database driver private methods. Because they
-are not standard you cannot always depend on the value of C<$result>
+are not standard you cannot always depend on the value of C<$rc> or
-or C<$handle_error>. Check the documentation for your specific
+C<$dbi_err>. Check the documentation for your specific driver/function
-driver/function combination to see what it returns.
+combination to see what it returns.
 Note that the first argument will be eval'ed to produce the argument list to
 the func() method. This must be done because the serialization protocol
 between the AnyEvent::DBI server process and your program does not support the
 passage of closures.
              my ($string, $search) = @_;
              return index $string, $search;
           },
        },
        create_function => sub {
-          return $cv->send($@)
+          return $cv->send ($@)
-             unless $_[0];
+             unless $#_;
-          $cv->send (undef, @_[1,2]);
+          $cv->send (undef, @_[1,2,3]);
        }
     );
-    my ($err,$result,$handle_err) = $cv->recv;
+    my ($err,$rc,$errcode,$errstr) = $cv->recv;
+    die $err if defined $err;
-    die "EVAL failed: $err"
+    die "EVAL failed: $errstr"
-       if $err;
+       if $errcode;
-    # otherwise, we can ignore $result and $handle_err for this particular func
+    # otherwise, we can ignore $rc and $errcode for this particular func
 =cut
 for my $cmd_name (qw(exec attr begin_work commit rollback func)) {
    eval 'sub ' . $cmd_name . '{

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.14 by root, Sat Oct 30 20:23:44 2010 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.14 by root, Sat Oct 30 20:23:44 2010 UTC