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

Comparing AnyEvent-Fork/Fork.pm (file contents):
Revision 1.18 by root, Sat Apr 6 01:33:56 2013 UTC vs.
Revision 1.20 by root, Sat Apr 6 03:35:36 2013 UTC

    my $self = shift;
    # ideally, we would want to use "a (w/a)*" as format string, but perl
    # versions from at least 5.8.9 to 5.16.3 are all buggy and can't unpack
    # it.
-   push @{ $self->[2] }, pack "L/a*", pack "(w/a*)*", @_;
+   push @{ $self->[2] }, pack "a L/a*", $_[0], $_[1];
-   unless ($self->[3]) {
+   $self->[3] ||= AE::io $self->[1], 1, sub {
-      my $wcb = sub {
-         do {
+      do {
-            # send the next "thing" in the queue - either a reference to an fh,
+         # send the next "thing" in the queue - either a reference to an fh,
-            # or a plain string.
+         # or a plain string.
-            if (ref $self->[2][0]) {
+         if (ref $self->[2][0]) {
-               # send fh
+            # send fh
-               unless (IO::FDPass::send fileno $self->[1], fileno ${ $self->[2][0] }) {
+            unless (IO::FDPass::send fileno $self->[1], fileno ${ $self->[2][0] }) {
-                  return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
+               return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
-                  undef $self->[3];
+               undef $self->[3];
-                  die "AnyEvent::Fork: file descriptor send failure: $!";
+               die "AnyEvent::Fork: file descriptor send failure: $!";
-               }
-               shift @{ $self->[2] };
-            } else {
-               # send string
-               my $len = syswrite $self->[1], $self->[2][0];
-               unless ($len) {
-                  return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
-                  undef $self->[3];
-                  die "AnyEvent::Fork: command write failure: $!";
-               }
-               substr $self->[2][0], 0, $len, "";
-               shift @{ $self->[2] } unless length $self->[2][0];
             }
+            shift @{ $self->[2] };
+         } else {
+            # send string
+            my $len = syswrite $self->[1], $self->[2][0];
+            unless ($len) {
+               return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
+               undef $self->[3];
+               die "AnyEvent::Fork: command write failure: $!";
+            }
+            substr $self->[2][0], 0, $len, "";
+            shift @{ $self->[2] } unless length $self->[2][0];
+         }
-         } while @{ $self->[2] };
+      } while @{ $self->[2] };
-         # everything written
+      # everything written
-         undef $self->[3];
+      undef $self->[3];
-         # invoke run callback
+      # invoke run callback, if any
-         $self->[0]->($self->[1]) if $self->[0];
+      $self->[4]->($self->[1]) if $self->[4];
-      };
-      $wcb->();
-      $self->[3] ||= AE::io $self->[1], 1, $wcb
-         if @{ $self->[2] };
-   }
+   };
    () # make sure we don't leak the watcher
 }
 sub _new {
-   my ($self, $fh) = @_;
+   my ($self, $fh, $pid) = @_;
    AnyEvent::Util::fh_nonblocking $fh, 1;
    $self = bless [
-      undef, # run callback
+      $pid,
       $fh,
       [],    # write queue - strings or fd's
       undef, # AE watcher
    ], $self;
       exit 0;
    } elsif (!$pid) {
       die "AnyEvent::Fork::Early/Template: unable to fork template process: $!";
    }
-   AnyEvent::Fork->_new ($fh)
+   AnyEvent::Fork->_new ($fh, $pid)
 }
 =item my $proc = new AnyEvent::Fork
 Create a new "empty" perl interpreter process and returns its process
    # quick. also doesn't work in win32. of course. what did you expect
    #local $ENV{PERL5LIB} = join ":", grep !ref, @INC;
    my %env = %ENV;
    $env{PERL5LIB} = join +($^O eq "MSWin32" ? ";" : ":"), grep !ref, @INC;
-   Proc::FastSpawn::spawn (
+   my $pid = Proc::FastSpawn::spawn (
       $perl,
       ["perl", "-MAnyEvent::Fork::Serve", "-e", "AnyEvent::Fork::Serve::me", fileno $slave, $$],
       [map "$_=$env{$_}", keys %env],
    ) or die "unable to spawn AnyEvent::Fork server: $!";
-   $self->_new ($fh)
+   $self->_new ($fh, $pid)
+}
+=item $pid = $proc->pid
+Returns the process id of the process I<iff it is a direct child of the
+process> running AnyEvent::Fork, and C<undef> otherwise.
+Normally, only processes created via C<< AnyEvent::Fork->new_exec >> and
+L<AnyEvent::Fork::Template> are direct children, and you are responsible
+to clean up their zombies when they die.
+All other processes are not direct children, and will be cleaned up by
+AnyEvent::Fork.
+=cut
+sub pid {
+   $_[0][0]
 }
 =item $proc = $proc->eval ($perlcode, @args)
 Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to
 =cut
 sub eval {
    my ($self, $code, @args) = @_;
-   $self->_cmd (e => $code, @args);
+   $self->_cmd (e => pack "(w/a*)*", $code, @args);
    $self
 }
 =item $proc = $proc->require ($module, ...)
 =cut
 sub send_arg {
    my ($self, @arg) = @_;
-   $self->_cmd (a => @arg);
+   $self->_cmd (a => pack "(w/a*)*", @arg);
    $self
 }
 =item $proc->run ($func, $cb->($fh))
 =cut
 sub run {
    my ($self, $func, $cb) = @_;
-   $self->[0] = $cb;
+   $self->[4] = $cb;
    $self->_cmd (r => $func);
 }
 =back
 This section lists typical problems that remain. I hope by recognising
 them, most can be avoided.
 =over 4
-=item exit runs destructors
 =item "leaked" file descriptors for exec'ed processes
 POSIX systems inherit file descriptors by default when exec'ing a new
 process. While perl itself laudably sets the close-on-exec flags on new
 file handles, most C libraries don't care, and even if all cared, it's
 The solution is to either not load these modules before use'ing
 L<AnyEvent::Fork::Early> or L<AnyEvent::Fork::Template>, or to delay
 initialising them, for example, by calling C<init Gtk2> manually.
+=item exit runs destructors
+This only applies to users of Lc<AnyEvent::Fork:Early> and
+L<AnyEvent::Fork::Template>.
+When a process created by AnyEvent::Fork exits, it might do so by calling
+exit, or simply letting perl reach the end of the program. At which point
+Perl runs all destructors.
+Not all destructors are fork-safe - for example, an object that represents
+the connection to an X display might tell the X server to free resources,
+which is inconvenient when the "real" object in the parent still needs to
+use them.
+This is obviously not a problem for L<AnyEvent::Fork::Early>, as you used
+it as the very first thing, right?
+It is a problem for L<AnyEvent::Fork::Template> though - and the solution
+is to not create objects with nontrivial destructors that might have an
+effect outside of Perl.
 =back
 =head1 PORTABILITY NOTES
 Native win32 perls are somewhat supported (AnyEvent::Fork::Early is a nop,

Diff Legend

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

Comparing AnyEvent-Fork/Fork.pm (file contents): Revision 1.18 by root, Sat Apr 6 01:33:56 2013 UTC vs. Revision 1.20 by root, Sat Apr 6 03:35:36 2013 UTC

Diff Legend

Comparing AnyEvent-Fork/Fork.pm (file contents):
Revision 1.18 by root, Sat Apr 6 01:33:56 2013 UTC vs.
Revision 1.20 by root, Sat Apr 6 03:35:36 2013 UTC