######################################################################
# $Id$
package POE::Component::Generic::Child;
use strict;

# use Carp;

sub new
{
    my( $package, %params ) = @_;
    my $self = bless { %params }, $package;
    $self->{filter} = POE::Filter::Reference->new();
    # there's room for other callbacks
    $self->{callbacks} = {};
    return $self;
}

##################################################
sub loop
{
    my( $self ) = @_;
    
    my $raw;
	
    $self->status( 'startup' );


    READ:
    while ( sysread ( STDIN, $raw, $self->{size} ) ) {
        $self->status( 'request' );
        my $requests = $self->{filter}->get([$raw]);

        unless ($self->{obj}) {
            my $req = shift @{$requests};
            unless( ref( $req ) eq 'HASH' and $req->{req} eq 'setup' ) {
                die "First request must be a setup";
            }
            $self->OOB_req( $req );
        }
        
        foreach my $req (@{$requests}) {
            # use Data::Denter;
            # warn "req=", Denter $req;
            if( $req->{req} ) {
                $self->OOB_req( $req );
            }
            else {
                $self->request( $req );
            }
        }
        $self->status( 'read' );
    }
}

##################################################
sub status
{
    my $self = shift;
    $0 = join ' ', $self->{proc}, $self->{name}, @_;
    
    $self->{debug} and warn join ' ', @_;
}

##################################################
sub reply
{
    my( $self, $resp ) = @_;
    $self->{debug} and warn "reply";
    # use Data::Denter;
    # warn "reply=", Denter $resp;
    my $replies = $self->{filter}->put( [ $resp ] );
    print STDOUT @$replies;
}




##################################################
sub request
{
    my( $self, $req ) = @_;
    
    my $func = $req->{state};
    $self->{debug} and warn "method=$func";

    if( $req->{callbacks} ) {
        $self->callback_demarshall( $req, $req->{callbacks} );
    }
    if( $req->{postbacks} ) {
        $self->postback_demarshall( $req, $req->{postbacks} );
    }

    
    my $obj = $self->{obj};

    # keeping {args} in req messes up callbacks
    my $args = delete $req->{args};
    
    eval {
        if( $req->{wantarray} ) {
            $req->{result} = [ $obj->$func( @$args ) ];
        } 
        elsif( defined $req->{wantarray} ) {
            $req->{result} = [ scalar $obj->$func( @$args ) ];
        }
        else {
            $obj->$func( @$args );
        }
    };

    if ($@) {
        $req->{error} = $@;
        delete $req->{result};
    }

    if( defined $req->{event} ) {
        $self->reply( $req );
    }
    elsif( $req->{error} ) {
        warn $req->{error};
    }

}

##################################################
sub callback_demarshall
{
    my( $self, $req, $cdef ) = @_;
    
    foreach my $cb ( @$cdef ) {
        unless( $req->{args}[ $cb->{pos} ] eq $cb->{CBid} ) {
            die "Argument at position $cb->{pos} isn't $cb->{CBid}";
        }
    
        $req->{args}[ $cb->{pos} ] = sub {
            $self->reply( {
                  response => 'callback',
                  id	   => $req->{id},
                  pos      => $cb->{pos},
                  result   => [ @_ ]
              } );
        };
    }
}

##################################################
sub postback_demarshall
{
    my( $self, $req, $pdef ) = @_;
    
    foreach my $pb ( @$pdef ) {
        unless( $req->{args}[ $pb->{pos} ] eq $pb->{PBid} ) {
            die "Argument at position $pb->{pos} isn't $pb->{PBid}";
        }
    
        $req->{args}[ $pb->{pos} ] = sub {
            $self->reply( {
                  response => 'postback',
                  PBid	   => $pb->{PBid},
                  result   => [ @_ ]
              } );
        };
    }
}



##################################################
sub OOB_req
{
    my( $self, $req ) = @_;

    $self->status( 'OOB' );

    my $func = $req->{req};
    if( $func eq 'setup' ) {
        $self->OOB_setup( $req );
    }
    elsif( $func eq 'callbackup_setup' ) {
        $self->OOB_callback_setup( $req );
    }
    else {
        warn "Unknown OOB request $func";
    }
}

##################################################
sub OOB_setup
{
    my( $self, $req ) = @_;
    
    foreach my $f ( qw( name size debug verbose ) ) {
        next unless exists $req->{$f};
        $self->{$f} = $req->{$f};
        $self->{debug} and warn "Setting $f=$self->{$f}";
    }
    
    $self->{debug} and warn "build object $req->{package}";
    $self->{obj} = object_build( $req->{package}, $req->{args} );

    ($self->{verbose} or
        $self->{debug} ) and warn "Child PID is $$\n";

    $self->{debug} and warn "object=$self->{obj}";
    $self->reply( { PID=>$$, response=>'new' } );
}

##################################################
sub OOB_callback_setup
{
    my( $self, $req ) = @_;
    
    $self->{callback_defs}{ $req->{Cid} } = $req->{callbacks};
}


##################################################
sub object_build
{
    my( $package, $args ) = @_;
    my $ctor = package_load( $package );
    die "Can't find constructor for package $package" unless $ctor;
    return $package->can($ctor)->( $package, @$args );
}


##################################################
# Load the user package
sub package_load
{
    my( $package ) = @_;
    my $ctor = find_ctor( $package );
    return $ctor if $ctor;		# package already loaded
    eval "use $package";
    die $@ if $@;
    return find_ctor( $package );
}

##################################################
sub find_ctor
{
    my( $package ) = @_;
    foreach my $ctor ( qw( new spawn create ) ) {
        return $ctor if $package->can( $ctor );
    }
    return;
}


1;

__END__

=head1 NAME

POE::Component::Generic::Child - Child process handling

=head1 SYNOPSIS

    # Do not use POE::Component::Generic::Child directly.
    # Let POE::Component::Generic do it for you

=head1 DESCRIPTION

POE::Component::Generic::Child handles the child process for
L<POE::Component::Generic>.  You should never use it directly, but let
POE::Component::Generic do all the work.

=head1 AUTHOR

Philip Gwyn E<lt>gwyn-at-cpan.orgE<gt>

Based on work by David Davis E<lt>xantus@cpan.orgE<gt>

=head1 SEE ALSO

L<POE>, L<POE::Component::Generic>

=head1 RATING

Please rate this module. L<http://cpanratings.perl.org/rate/?distribution=POE-Component-Generic>

=head1 BUGS

Haven't implemented postbacks yet.

Probably.  Report them here: L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=POE%3A%3AComponent%3A%3AGeneric>

=head1 COPYRIGHT AND LICENSE

Copyright 2006 by Philip Gwyn;

Copyright 2005 by David Davis and Teknikill Software.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut