Imported Upstream version 96.042201

MANIFEST

@@ -0,0 +1,5 @@
+MANIFEST
+Makefile.PL
+README
+lib/Proc/Forkfunc.pm
+t/fork.t

Makefile.PL

@@ -0,0 +1,9 @@
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile( 
+	'VERSION' => 96.042201,
+	'NAME'	  => 'Proc::Forkfunc',
+	'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" },
+	);
+

README

@@ -0,0 +1,11 @@
+
+This is a simple wrapper for fork.  It will wait for there
+to be a process available.  It will fork off a perl function.
+
+To build/install it, use 
+
+	perl Makefile.PL
+	make 
+	make test
+	make install
+

lib/Proc/Forkfunc.pm

@@ -0,0 +1,67 @@
+
+package Proc::Forkfunc;
+
+require Exporter;
+require POSIX;
+use Carp;
+
+@ISA = (Exporter);
+@EXPORT = qw(forkfunc);
+
+use vars qw($VERSION);
+$VERSION = 96.041701;
+
+use strict;
+
+sub forkfunc
+{
+    my ($func, @args) = @_;
+
+    my $pid;
+
+    {
+	if ($pid = fork()) {
+	    # parent
+	    return $pid;
+	} elsif (defined $pid) {
+	    # child
+	    &$func(@args);
+	    croak "call to child returned\n";
+	} elsif ($! == &POSIX::EAGAIN) {
+	    my $o0 = $0;
+	    $0 = "$o0: waiting to fork";
+	    sleep 5;
+	    $0 = $o0;
+	    redo;
+	} else {
+	    croak "Can't fork: $!";
+	}
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Proc::Forkfunk -- fork off a function
+
+=head1 SYNOPSIS
+
+    use Proc::Forkfunc;
+
+    forkfunc(\&child_func,@child_args);
+
+=head1 DESCRIPTION
+
+Fork off a process.  Call a function on the child process
+the function should be passed in as a reference.  
+The child function should not return.
+
+Logic copied from somewhere, probably Larry Wall.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com>
+

t/fork.t

@@ -0,0 +1,43 @@
+#!/usr/local/bin/perl -w 
+
+$| = 1;
+
+print "1..4\n";
+
+use Proc::Forkfunc;
+
+forkfunc(sub { exit 1} );
+
+&wok(1);
+
+forkfunc(sub { exit $_[0] }, 2);
+
+&wok(2);
+
+forkfunc(\&pok3);
+
+&wok(3);
+
+forkfunc(\&pok, 4);
+
+&wok(4);
+
+sub pok3
+{
+	exit 3;
+}
+
+sub pok
+{
+	exit $_[0];
+}
+
+sub wok
+{
+	my ($ws) = @_;
+
+	wait();
+	my $st = $? >> 8;
+
+	print($st == $ws ? "ok $ws\n" : "not ok $ws\n");
+}