#!/usr/bin/perl -w
# $Id: forking 134 2006-09-14 18:28:46Z fil $

use strict;

# use Religion::Package qw(1 1);
use POE;
use POE::Component::Daemon;
use POE::Wheel::SocketFactory;
use POE::Driver::SysRW;
use POE::Filter::Line;
use POE::Wheel::ReadWrite;
use POSIX qw(EADDRINUSE);
use Socket qw(inet_ntoa);

sub DEBUG () { 0 }

my $port=shift;
die "Usage: $0 port" unless $port;

my $logfile = "/tmp/log_forking";
warn "Logging to $logfile\n";


#########################
POE::Component::Daemon->spawn(
            verbose=>1,
            alias=>'Daemon',
            logfile=>$logfile,
            detach=>1,
            max_children=>3,
        );



#########################
POE::Session->create(
inline_states=>{

    _start=>sub {
            my($kernel, $heap)=@_[KERNEL, HEAP];
            $heap->{wheel}=POE::Wheel::SocketFactory->new(
                BindPort=>$port,
                Reuse          => 'on',                # Lets the port be reused
                BindAddress=>'127.0.0.1',
                SuccessEvent=>'accept',  
                FailureEvent=>'error',
            );
            warn "$$: Listening on port $port";
            $heap->{rid}=0;

            $kernel->sig('daemon_child' => 'request' );
            $kernel->sig('daemon_shutdown' => 'shutdown' );
            $kernel->sig('daemon_pause' => 'pause' );
            $kernel->sig('daemon_resume' => 'resume' );

            $kernel->sig( USR1 => 'USR1' );
    },

    error=>sub {
        my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0, ARG1, ARG2];

        if(0==$errnum and $operation eq 'read') { # EOF
            if($heap->{pending}) {
                $heap->{done}=1;
                return;
            } else {
                Daemon->shutdown();
            }
        }
        else {
            warn "$$: $operation:$errnum: $errstr";
        }
        if($errnum==EADDRINUSE) {       # EADDRINUSE
            Daemon->shutdown();     # THIS IS IMPORTANT
        }
        delete $heap->{wheel};
        delete $heap->{wheel_client};
        # Daemon->shutdown;  
    },   

    ###############
    # daemon_shutdown signal, caused by going from req -> done
    shutdown => sub {
        my ($heap, $kernel) = @_[HEAP, KERNEL];
        delete $heap->{wheel};
        delete $heap->{wheel_client};
    },

    ###############
    # socketfactory got a connection handle it here
    accept=>sub {       
        my ($heap, $handle, $peer, $port, $id)=@_[HEAP, ARG0..ARG3];

        $peer=inet_ntoa($peer);
        DEBUG and warn "Connection id=$id from $peer:$port";

        my $info={handle=>$handle, peer=>$peer, port=>$port, id=>$id};
        $heap->{parent} = $$;

        Daemon->update_status('req', $info);
    },

    ###############
    # PoCo::Daemon thinks there are too many proceses, and that we should
    # prevent more from happening
    pause => sub {
        my( $heap, $kernel ) = @_[ HEAP, KERNEL ];
        DEBUG and warn "PAUSE";
        if( $heap->{wheel} ) {
            $heap->{wheel}->pause_accept;
        }
    },    
    # PoCo::Daemon no longer thinks there are too many proceses.
    resume => sub {
        my( $heap, $kernel ) = @_[ HEAP, KERNEL ];
        DEBUG and warn "RESUME";
        if( $heap->{wheel} ) {
            $heap->{wheel}->resume_accept;
        }
    },    

    ###############
    # We are now the child process.  That is, we went from wait -> req
    # and so PoCo::Daemon forked a process to handle the req
    request=>sub {
        my($heap, $info)=@_[HEAP, ARG1]; 

        # $info is the hash we built in 'accept'

        delete $heap->{wheel};

        $heap->{wheel_client} = POE::Wheel::ReadWrite->new(
                Handle=>$info->{handle},
                Driver=> new POE::Driver::SysRW, # using sysread and syswrite
                Filter=> POE::Filter::Line->new(), # use a line filter for negociati
                InputEvent => 'input',
                FlushedEvent => 'flushed',
                ErrorEvent => 'error'
            );
        Daemon->update_status('long');
    },

    ###############
    # ReadWrite's InputEvent.
    input => sub {
        my($heap, $line)=@_[HEAP, ARG0];
        DEBUG and warn "Received $line";

        $line = uc $line;

        if($line eq 'PID') {
            $heap->{wheel_client}->put($$);
        }
        elsif($line eq 'PARENT') {
            $heap->{wheel_client}->put( $heap->{parent} );
        }
        elsif($line eq 'PING') {
            $heap->{wheel_client}->put('PONG');
        }
        elsif($line eq 'LOGFILE') {
            $heap->{wheel_client}->put( $logfile );
        }
        elsif($line eq 'KERNEL') {
            $heap->{wheel_client}->put( $poe_kernel->ID );
        }
        elsif($line eq 'DONE') {
            $heap->{wheel_client}->put('OK');
            $heap->{done}=1;
        }
        elsif($line eq 'STATUS') {
            $heap->{wheel_client}->put(Daemon->status);
        }
        else {
            $heap->{wheel_client}->put('???');
        }
        $heap->{pending}=1;
    },

    ###############
    # ReadWrite's FlushedEvent.
    flushed=>sub {
        my($heap)=$_[HEAP];
        # DEBUG and warn "Flushed";
        $heap->{pending}=0;
        return unless $heap->{done};

        delete $heap->{wheel_client};
        $poe_kernel->post(Daemon=>'update_status', 'done');
    },

    ###############
    USR1=>sub { Daemon->peek( 1 ) },

});      


#########################
$poe_kernel->run();

DEBUG and warn "$$: Exiting";
1;

__END__

$Log$
Revision 1.2  2006/09/14 18:28:46  fil
Added foreign_child()
Added HUP and TERM support
Moved signal sending to inform_others() and expedite_signal()
expedite_signal by-passes POE's queue, by sending signals directly to
    watchers via ->call();

Added ->peek()
Many tweaks for preforking child
Coverage and tests

Revision 1.1.1.1  2004/04/13 19:01:42  fil
Honk