File Coverage

blib/lib/POE/Component/AI/MegaHAL.pm
Criterion Covered Total %
statement 69 100 69.0
branch 13 32 40.6
condition 4 12 33.3
subroutine 15 18 83.3
pod 3 4 75.0
total 104 166 62.6


line stmt bran cond sub pod time code
1             package POE::Component::AI::MegaHAL;
2              
3 2     2   72581 use strict;
  2         6  
  2         84  
4 2     2   12 use warnings;
  2         5  
  2         101  
5 2     2   2182 use AI::MegaHAL;
  2         23666  
  2         264  
6 2     2   3086 use POE qw(Wheel::Run Filter::Line Filter::Reference);
  2         163257  
  2         16  
7 2     2   291693 use Carp;
  2         6  
  2         125  
8 2     2   8 use vars qw($VERSION);
  2         5  
  2         2347  
9              
10             $VERSION = '1.18';
11              
12             sub spawn {
13 1     1 1 1067 my $package = shift;
14 1         6 my %params = @_;
15              
16 1         11 $params{ lc $_ } = delete $params{$_} for keys %params;
17 1 50 33     12 $params{'autosave'} = 1 unless defined ( $params{'autosave'} ) and $params{'autosave'} eq '0';
18 1         3 my $options = delete $params{'options'};
19 1         3 my $self = bless \%params, $package;
20              
21 1 50       26 POE::Session->create(
22             object_states => [
23             $self => {
24             do_reply => '_megahal_function',
25             initial_greeting => '_megahal_function',
26             learn => '_megahal_function',
27             _cleanup => '_megahal_function',
28             },
29             $self => [ qw(_child_closed _child_error _child_stderr _child_stdout _start shutdown _sig_chld) ],
30             ],
31             ( ref ( $options ) eq 'HASH' ? ( options => $options ) : () ),
32             );
33              
34 1         317 return $self;
35             }
36              
37             sub session_id {
38 5     5 1 6109 return $_[0]->{session_id};
39             }
40              
41             sub _megahal_function {
42 4     4   592 my ($kernel,$self,$state) = @_[KERNEL,OBJECT,STATE];
43 4         23 my $sender = $_[SENDER]->ID();
44 4 50       72 return if $self->{shutdown};
45              
46 4         6 my $args;
47              
48 4 50       32 if ( ref( $_[ARG0] ) eq 'HASH' ) {
49 4         6 $args = { %{ $_[ARG0] } };
  4         24  
50             }
51             else {
52 0         0 warn "first parameter must be a hashref, trying to adjust. "
53             ."(fix this to get rid of this message)";
54 0         0 $args = { @_[ARG0..$#_] };
55             }
56              
57 4 50       18 unless ( $args->{event} ) {
58 0         0 warn "where am i supposed to send the output?";
59 0         0 return;
60             }
61              
62              
63 4 50 33     75 return if $state =~ /^(do_reply|learn)$/ and !defined $args->{text};
64              
65 4 50 33     17 delete $args->{text} if $state eq 'initial_greeting' and defined $args->{text};
66            
67 4 50 33     16 delete $args->{text} if $state eq '_cleanup' and defined $args->{text};
68            
69 4         11 $args->{sender} = $sender;
70 4         16 $args->{func} = $state;
71 4         18 $kernel->refcount_increment( $sender => __PACKAGE__ );
72 4         133 $args->{sender} = $sender;
73              
74 4 50       140 $self->{wheel}->put( $args ) if defined $self->{wheel};
75 4         715 return;
76             }
77              
78             sub _start {
79 1     1   307 my ($kernel,$self) = @_[KERNEL,OBJECT];
80 1         5 $self->{session_id} = $_[SESSION]->ID();
81              
82 1 50       6 if ( $self->{alias} ) {
83 0         0 $kernel->alias_set( $self->{alias} );
84             } else {
85 1         11 $kernel->refcount_increment( $self->{session_id} => __PACKAGE__ );
86             }
87              
88 1 50       49 $self->{wheel} = POE::Wheel::Run->new(
89             Program => \&main,
90             ProgramArgs => [ AutoSave => $self->{autosave}, Path => $self->{path} ],
91             ErrorEvent => '_child_error',
92             CloseEvent => '_child_closed',
93             StdoutEvent => '_child_stdout',
94             StderrEvent => '_child_stderr',
95             StdioFilter => POE::Filter::Reference->new(),
96             StderrFilter => POE::Filter::Line->new(),
97             ( $^O eq 'MSWin32' ? ( CloseOnCall => 0 ) : ( CloseOnCall => 1 ) ),
98             );
99              
100 1         5194 $kernel->sig_child( $self->{wheel}->PID, '_sig_chld' );
101 1         683 return;
102             }
103              
104             sub _sig_chld {
105 1     1   3219 $_[KERNEL]->sig_handled();
106             }
107              
108             sub _child_closed {
109 0     0   0 delete $_[OBJECT]->{wheel};
110 0         0 return;
111             }
112              
113             sub _child_error {
114 1     1   371 delete $_[OBJECT]->{wheel};
115 1         312 return;
116             }
117              
118             sub _child_stderr {
119 1     1   2530430 my ($kernel,$self,$input) = @_[KERNEL,OBJECT,ARG0];
120 1 50       13 warn $input . "\n" if $self->{debug};
121 1         6 return;
122             }
123              
124             sub _child_stdout {
125 4     4   3776407 my ($kernel,$self,$input) = @_[KERNEL,OBJECT,ARG0];
126 4         89 my $sender = delete $input->{sender};
127 4         10 my $event = delete $input->{event};
128 4         21 $kernel->post( $sender => $event => $input );
129 4         510 $kernel->refcount_decrement( $sender => __PACKAGE__ );
130 4         185 return;
131             }
132              
133             sub shutdown {
134 1     1 1 52 my ($kernel,$self) = @_[KERNEL,OBJECT];
135 1         14 $kernel->alias_remove( $_ ) for $kernel->alias_list();
136 1 50       51 $kernel->refcount_decrement( $self->{session_id} => __PACKAGE__ ) unless $self->{alias};
137 1         37 $self->{shutdown} = 1;
138 1         7 $self->{wheel}->shutdown_stdin;
139 1         586 return;
140             }
141              
142             sub main {
143 0     0 0   my %params = @_;
144 0 0         if ( $^O eq 'MSWin32' ) {
145 0           binmode(STDIN); binmode(STDOUT);
  0            
146             }
147 0           my $raw;
148 0           my $size = 4096;
149 0           my $filter = POE::Filter::Reference->new();
150 0           my $megahal;
151 0           eval {
152 0           $megahal = AI::MegaHAL->new( %params );
153             };
154              
155 0 0         if ( $@ ) {
156 0           print STDERR $@ . "\n";
157 0           return;
158             }
159              
160 0           while ( sysread ( STDIN, $raw, $size ) ) {
161 0           my $requests = $filter->get( [ $raw ] );
162 0           _process_requests( $megahal, $_, $filter ) for @{ $requests };
  0            
163             }
164 0 0         $megahal->_cleanup() if $params{'AutoSave'};
165 0           $megahal->DESTROY;
166             }
167              
168             sub _process_requests {
169 0     0     my ($megahal,$req,$filter) = @_;
170              
171 0           my $func = $req->{func};
172 0           $req->{reply} = $megahal->$func( $req->{text} );
173 0           my $response = $filter->put( [ $req ] );
174 0           print STDOUT @$response;
175             }
176              
177             1;
178              
179             __END__