#!/usr/bin/perl -w
# $Id: preforking 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_preforking";
warn "Logging to $logfile\n";

#########################
POE::Component::Daemon->spawn(
            alias=>'Daemon',
            logfile=>$logfile,
            detach=>1,
            start_children=>1,
            requests=>1,
            min_spare=>2,
            max_children=>10,
        );




#########################
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->{wheel}->pause_accept(); # is resumed in started

            $kernel->sig('daemon_child'=>'started');
            $kernel->sig('daemon_parent'=>'we_are_parent');
            $kernel->sig('daemon_accept'=>'accepting');

            $kernel->sig('daemon_shutdown'=>'game_over');

            $heap->{parent} = 0;
            $heap->{rid}=0;
    },

    error=>sub {
        my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0, ARG1, ARG2];
        if( 0==$errnum and $operation eq 'read' ) {
                                       # EOF
            $heap->{done}=1;
            return;
        }
        warn "$$: $operation:$errnum: $errstr";
        if($errnum==EADDRINUSE) {       # EADDRINUSE
            Daemon->shutdown();     # THIS IS IMPORTANT
        }
        delete $heap->{wheel};
        delete $heap->{wheel_client};
        Daemon->shutdown();
    },   

    ###############
    ## Called when we switch to a child process
    started=>sub {
        my($kernel, $heap)=@_[KERNEL, HEAP];
        DEBUG and 
            warn "Started (parent=$heap->{parent})";
        $kernel->post(Daemon=>'update_status', 'wait');
        return;
    },

    ###############
    ## Called when a child process set status to 'wait'
    accepting=>sub {
        my($kernel, $heap)=@_[KERNEL, HEAP];
        DEBUG and 
            warn "Accepting (parent=$heap->{parent})";
        $heap->{wheel}->resume_accept();    # was paused in _start and accept
        return;
    },

    ###############
    ## PoCo::Daemon's daemon_parent.  We are a parent process, after the
    ## initial children are forked off.
    we_are_parent=>sub {
        my($kernel, $heap)=@_[KERNEL, HEAP];
        DEBUG and warn "PARENT";
        $heap->{parent} = $$;
    },


    ###############
    # 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";
    
        $heap->{wheel}->pause_accept(); # is resumed in started
        my $info={handle=>$handle, peer=>$peer, port=>$port, id=>$id};
        Daemon->update_status('req');

        $heap->{done} = 0;

        $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'
            );
    },

    ###############
    ## 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 'PING') {
            $heap->{wheel_client}->put('PONG');
        }
        elsif($line eq 'PARENT') {
            $heap->{wheel_client}->put( $heap->{parent} );
        }
        elsif($line eq 'PEEK') {
            $heap->{wheel_client}->put( split "\n", Daemon->peek( 1 ) );
            $heap->{wheel_client}->put( "DONE" );
        }
        elsif($line eq 'STATUS') {
            $heap->{wheel_client}->put( split "\n", Daemon->status );
            $heap->{wheel_client}->put( "DONE" );
        }
        elsif($line eq 'DONE') {
            $heap->{wheel_client}->put('OK');
            $heap->{done} = 1;
        }
        elsif($line eq 'LOGFILE') {
            $heap->{wheel_client}->put( $logfile );
        }
        else {
            $heap->{wheel_client}->put('???');
        }
        $heap->{pending}=1;
    },

    ###############
    ## ReadWrite's FlushedEvent
    flushed=>sub {
        my($heap)=$_[HEAP];
        $heap->{pending}=0;

        return unless $heap->{done};

        DEBUG and warn "DONE";
        delete $heap->{wheel_client};
        $poe_kernel->post(Daemon=>'update_status', 'done');
    },

    ################
    ## daemon_shutdown signal.  Sent when we get at TERM or INT, or when
    ## we handle enough requests to be recycled.
    game_over => sub {
        my($heap)=$_[HEAP];

        DEBUG and warn "$$: game_over\n";

        delete $heap->{wheel};
        delete $heap->{wheel_client};
        return;
    }

});      



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

warn "$$: Exiting";
1;

__END__

$Log$
Revision 1.3  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.2  2004/10/21 03:06:19  fil
Fixed KR_RUN_CALLED call for 5.004_05
Improved debug output
added daemon_accept signal

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