Proc::Forking 1.38

Proc::Forking is a Perl module that provides a set of tool to fork and daemonize.

SYNOPSIS

#!/usr/bin/perl

use strict;
use Proc::Forking;
use Data::Dumper;
use Time::HiRes qw(usleep); # to allow micro sleep

my $f = Proc::Forking->new();
$SIG{ KILL } = $SIG{ TERM } = $SIG{ INT } = sub { $f->killall_childs;sleep 1; exit },
$f->daemonize(
## uid => 1000,
## gid => 1000,
## home => "/tmp",
pid_file => "/tmp/master.pid"
);

open( STDOUT, ">>/tmp/master.log" );
my $nbr = 0;
my $timemout;

while ( 1 )
{
if ( $nbr < 20 )
{
my $extra = "other parameter";
my ( $status, $pid, $error ) = $f->fork_child(
function => &func,
name => "new_name.##",
args => [ "hello SOMEONE", 3, $extra ],
pid_file => "/tmp/fork.##.pid",
uid => 1000,
gid => 1000,
home => "/tmp",
max_load => 5,
max_mem => 185000000,
expiration => 10,
# expiration_auto => 1,
);
if ( $status == 4 ) # if the load become to high
{
print "Max load reached, do a little napn";
usleep( 100000 );
next;
}
elsif ( $status ) # if another kind of error

{
print "PID=$pidt error=$errorn";
print Dumper( $f->list_names() );
print Dumper( $f->list_pids() );
}
}
$nbr = $f->pid_nbr;
my ( $n, @dp, @dn ) = $f->expirate;
if ( $n )
{
print Dumper( @dp );
}
print "free=<" . scalar( $f->getmemfree ) . ">n";
usleep( 100000 ); # always a good idea to put a small sleep to allow task swapper to gain some free resources
}

sub func
{
my $ref = shift;
my @args = @$ref;
my ( $data, $time_out, $sockC ) = @args;
$SIG{ USR1 } = sub { open my $log, ">>/tmp/log.s"; print $log "signal USR1 receivedn"; close $log; };
if ( !$time_out )
{
$time_out = 3;
}
open my $FF, ">>/tmp/loglist";
print $FF $$, " start time =", $^T;
close $FF;

for ( 1 .. 4 )
{
open my $fh, ">>/tmp/log";
if ( defined $fh )
{
print $fh "TMOUT = $time_out " . time . " PID=$$ cwd=" . Cwd::cwd() . " name =$0n";
$fh->close;
}
sleep $time_out + rand( 5 );
}
}