http://qs1969.pair.com?node_id=59619
Category: Miscellaneous
Author/Contact Info Brent Dax
brentdax1@earthlink.net
Description: This Perl module allows you to write forks like:
use ForkBlock;

Fork {
    Parent {
        #parent code
    }
    Child {
        #child code
    }
    Error {
        #optional for handling non-recoverable errors
    }
};

[download]

You use Fork if you want each process to terminate after its block, or DumbFork if you don't.

I'm not including the pod documentation, as it adds another hundred lines or so to the bottom of the script. If you want the source, including pod, e-mail me.

If nothing else, see it as a creative use of an anonymous hash.

Currently the only problem I have with it is that it doesn't croak if you forget the Parent or Child blocks, but I think that's pretty minor.

 
package ForkBlock;

use strict;
use vars qw/$CHILD_PID @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION/;
use Carp;
use Exporter;

@ISA=("Exporter");
@EXPORT=qw/Fork Parent Child Error/;
@EXPORT_OK=("DumbFork");
%EXPORT_TAGS=('all' => [qw/Fork Parent Child Error DumbFork/]);
$VERSION=0.02;

sub Fork {
    phork(@_) or croak "unable to fork: $!";
    exit(0);
}

sub DumbFork {
    phork(@_) or croak "unable to fork: $!";
}

sub Parent(&;%) { return "parent", @_ }
sub Child(&;%)  { return "child",  @_ }
sub Error(&;%)  { return "error",  @_ }

#private--implements the actual forking
sub phork {
    my %params=%{shift()};
    
    my $parent=$params{"parent"};
    my $child =$params{"child"} ;
    my $error =$params{"error"} ;
    
    local $!;

    FORK_IT: {
        if($CHILD_PID=fork()) {
            #i'm the parent
            &$parent;
        }
        elsif(defined($CHILD_PID)) {
            #i'm the child
            &$child;
        }
        else {
            #something went wrong
            if($! =~ /No more process/) {
                #recoverable, so wait a second and try again
                sleep 1;
                redo FORK_IT;
            }
            elsif(defined($error)) {
                    #something went wrong, but an Error block was defi
+ned
                    &$error;
            }
            else {
                #something went wrong, and the user forgot an Error bl
+ock
                return 0;
            }
        }
    }
    
    return 1;
}

1;
Replies are listed 'Best First'.
Re: ForkBlock
by EvanK (Chaplain) on Feb 28, 2001 at 23:58 UTC
    You're right...that is quite ingenious. Not that I ever had trouble using forks (i hardly ever use them anyway) but this is VERY clever.

    ______________________________________________
    When I get a little money, I buy books. If I have any left over, I buy food and clothes.
    -Erasmus

[reply]
Re: ForkBlock
by belg4mit (Prior) on Dec 25, 2008 at 02:04 UTC
    Currently the only problem I have with it is that it doesn't croak if you forget the Parent or Child blocks, but I think that's pretty minor.
    Easy enough: 
    --- ForkBlock.pm~    Wed Dec 24 20:18:01 2008
+++ ForkBlock.pm    Wed Dec 24 21:02:50 2008
@@ -31,6 +31,9 @@
     my $parent=$params{"parent"};
     my $child =$params{"child"} ;
     my $error =$params{"error"} ;
+
+    croak "No Child defined" unless $child;
+    croak "No Parent defined" unless $parent;
     
     local $!;

    [download]
    Although one could make the case that it ought to fall-through without a Parent. You can achieve that with DumbFork { Parent {return} ...}

    This patch exposes the child PID in a non-collisiony way, as a parameter to the parent; you could also copy $ForkBlock::CHILD_PID immediately after fork. 

    --- ForkBlock.pm~    Wed Dec 24 21:02:50 2008
+++ ForkBlock.pm    Wed Dec 24 21:14:35 2008
@@ -40,7 +40,7 @@
     FORK_IT: {
         if($CHILD_PID=fork()) {
             #i'm the parent
-            &$parent;
+            &$parent($CHILD_PID);
       }
         elsif(defined($CHILD_PID)) {
             #i'm the child

    [download]
    Also note that the prototype permits this alternate invocation: 
    Fork {
    Parent \&manager,
    Child  \&worker
};

    [download]
    And with this patch: 
    --- ForkBlock.pm~    Wed Dec 24 21:14:35 2008
+++ ForkBlock.pm    Thu Dec 25 02:08:18 2008
@@ -27,10 +27,10 @@
 #private--implements the actual forking
 sub phork {
     my %params=%{shift()};
-    
-    my $parent=$params{"parent"};
-    my $child =$params{"child"} ;
-    my $error =$params{"error"} ;
+
+    my $parent=$params{parent}|| $params{Parent};
+    my $child =$params{child} || $params{Child};
+    my $error =$params{error} || $params{Error};
 
     croak "No Child defined" unless $child;
     croak "No Parent defined" unless $parent;

    [download]
    You can also do: 
    Fork {
    Parent=>sub{ ... }, #The comma's important here.
    Child =>sub{ ... }
};

    [download]
    The distinction between DumbFork and Fork seems backwards/unnecessary. What if the exit has a condition of if $CHILD_PID == 0 added? Another interesting change might be an optional/default Reaper that's invoked before the phork...

    --
    In Bob We Trust, All Others Bring Data.

[reply]
[d/l]
[select]

Back to Code Catacombs