File Coverage

blib/lib/POE/Component/Hailo.pm

Criterion	Covered	Total	%
statement	73	120	60.8
branch	8	22	36.3
condition	2	4	50.0
subroutine	16	26	61.5
pod	3	3	100.0
total	102	175	58.2

package POE::Component::Hailo;
our $AUTHORITY = 'cpan:HINRIK';
$POE::Component::Hailo::VERSION = '0.11';
use 5.010;
use strict;
use warnings;
use Carp 'croak';
use Hailo;
use JSON;
use LWP::UserAgent;
use POE qw(Wheel::Run Filter::JSON);
use Try::Tiny;

sub spawn {
    my ($package, %args) = @_;

    croak "Hailo_args parameter missing" if ref $args{Hailo_args} ne 'HASH';
    my $options = delete $args{options};
    my $self = bless \%args, $package;

    $self->{response} = {
        learn       => 'hailo_learned',
        train       => 'hailo_trained',
        reply       => 'hailo_replied',
        learn_reply => 'hailo_learn_replied',
        stats       => 'hailo_stats',
        save        => 'hailo_saved',
    };

    POE::Session->create(
        object_states => [
            $self => [qw(
                _start
                shutdown
                _sig_DIE
                _sig_chld
                _go_away
                _child_stderr
                _child_stdout
            )],
            $self => {
                map { +$_ => '_hailo_method' } keys %{ $self->{response } },
            }
        ],
        (ref $options eq 'HASH' ? (options => $options) : ()),
    );

    return $self;
}

sub _start {
    my ($kernel, $session, $self) = @_[KERNEL, SESSION, OBJECT];
    $self->{session_id} = $session->ID();
    $kernel->sig(DIE => '_sig_DIE');

    if (defined $self->{alias}) {
        $kernel->alias_set($self->{alias});
    }
    else {
        $kernel->refcount_increment($self->{session_id}, __PACKAGE__);
    }

    $self->{wheel} = POE::Wheel::Run->new(
        Program     => \&_main,
        ProgramArgs => [ %{ $self->{Hailo_args} } ],
        StdoutEvent => '_child_stdout',
        StderrEvent => '_child_stderr',
        StdioFilter => POE::Filter::JSON->new,
        ( $^O eq 'MSWin32' ? ( CloseOnCall => 0 ) : ( CloseOnCall => 1 ) ),
    );

    $kernel->sig_child( $self->{wheel}->PID, '_sig_chld' );
    return;
}

sub _sig_DIE {
    my ($kernel, $self, $ex) = @_[KERNEL, OBJECT, ARG1];
    chomp $ex->{error_str};
    warn "Error: Event $ex->{event} in $ex->{dest_session} raised exception:\n";
    warn "  $ex->{error_str}\n";
    $kernel->sig_handled();
    return;
}

sub session_id {
    return $_[0]->{session_id};
}

sub _hailo_method {
    my ($kernel, $self, $state, $args, $context)
        = @_[KERNEL, OBJECT, STATE, ARG0, ARG1];
    my $sender = $_[SENDER]->ID();

    return if $self->{shutdown};

    $args //= [ ];
    $context = { %{ $context // { } } };
    my $request = {
        args    => $args,
        context => $context,
        method  => $state,
        sender  => $sender,
        event   => $self->{response}{$state},
    };

    $kernel->refcount_increment($sender, __PACKAGE__);
    $self->{wheel}->put($request);

    return;
}

sub _sig_chld {
    my ($kernel, $self) = @_[KERNEL, OBJECT];
    $kernel->yield('shutdown') if !$self->{shutdown};
    $kernel->yield('_go_away');
    $kernel->sig_handled();
    return;
}

sub _child_stderr {
    my ($kernel, $self, $input) = @_[KERNEL, OBJECT, ARG0];
    warn "$input\n";
    return;
}

sub _child_stdout {
    my ($kernel, $self, $input) = @_[KERNEL, OBJECT, ARG0];

    warn $input->{error} if $input->{error};
    $kernel->post(@$input{qw(sender event result context error)});
    $kernel->refcount_decrement($input->{sender}, __PACKAGE__);
    return;
}

sub shutdown {
    my ($self) = $_[OBJECT];
    $self->{shutdown} = 1;
    $self->{wheel}->shutdown_stdin;
    return;
}

sub _go_away {
    my ($kernel, $self) = @_[KERNEL, OBJECT];

    delete $self->{wheel};
    $kernel->alias_remove($_) for $kernel->alias_list();
    if (!defined $self->{alias}) {
        $kernel->refcount_decrement($self->{session_id}, __PACKAGE__);
    }
    return;
}

sub _main {
    my (%args) = @_;

    if ($^O eq 'MSWin32') {
        binmode STDIN;
        binmode STDOUT;
    }

    my $raw;
    my $size = 4096;
    my $filter = POE::Filter::JSON->new;

    while (sysread STDIN, $raw, $size) {
        my $requests = $filter->get([$raw]);
        for my $req (@$requests) {
            if ($args{server_host}) {
                _call_hailo_server(@args{qw(server_host server_port)}, $req);
            }
            else {
                _call_hailo_native(\%args, $req);
            }
            my $response = $filter->put([$req]);
            print @$response;
        }
    }

    return;
}

sub _call_hailo_native {
    my ($hailo_args, $request) = @_;

    try {
        my $hailo = Hailo->new(%$hailo_args);
        my $method = $request->{method};
        $request->{result} = [$hailo->$method(@{ $request->{args} })];
    }
    catch {
        $request->{error} = $_;
    };

    return;
}

sub _call_hailo_server {
    my ($host, $port, $request) = @_;

    my %method_map = (
        learn       => 'learn',
        learn_reply => 'learn_and_reply',
        reply       => 'reply',
    );
    my $rest_method = $method_map{$request->{method}};
    return if !$rest_method;

    try {
        my $ua = LWP::UserAgent->new(
            default_headers => HTTP::Headers->new(
                Content_Type => 'application/json'
            ),
        );
        my $raw_response = $ua->post(
            "http://$host:$port/$rest_method",
            Content => encode_json({input => $request->{args}[0]}),
        );

        my $response = decode_json($raw_response->content);
        $request->{result} = [$response->{reply}];
    }
    catch {
        $request->{error} = $_;
    };

    return;
}

1;

=encoding utf8

=head1 NAME

POE::Component::Hailo - A non-blocking wrapper around L<Hailo|Hailo>

=head1 SYNOPSIS

 use strict;
 use warnings;
 use POE qw(Component::Hailo);

 POE::Session->create(
     package_states => [
         (__PACKAGE__) => [ qw(_start hailo_learned hailo_replied) ],
     ],
 );

 POE::Kernel->run;

 sub _start {
     POE::Component::Hailo->spawn(
         alias      => 'hailo',
         Hailo_args => {
             storage_class  => 'SQLite',
             brain_resource => 'hailo.sqlite',
         },
     );

     POE::Kernel->post(hailo => learn =>
         ['This is a sentence'],
     );
 }

 sub hailo_learned {
     POE::Kernel->post(hailo => reply => ['This']);
 }

 sub hailo_replied {
     my $reply = $_[ARG0]->[0];
     die "Didn't get a reply" if !defined $reply;
     print "Got reply: $reply\n";
     POE::Kernel->post(hailo => 'shutdown');
 }

=head1 DESCRIPTION

POE::Component::Hailo is a L<POE|POE> component that provides a
non-blocking wrapper around L<Hailo|Hailo>. It accepts the events listed
under L</INPUT> and emits the events listed under L</OUTPUT>.

=head1 METHODS

=head2 C<spawn>

This is the constructor. It takes the following arguments:

B<'alias'>, an optional alias for the component's session.

B<'Hailo_args'>, a hash reference of arguments to pass to L<Hailo|Hailo>'s
constructor.

B<'options'>, a hash reference of options to pass to
L<POE::Session|POE::Session>'s constructor.

=head2 C<session_id>

Takes no arguments. Returns the POE Session ID of the component.

=head1 INPUT

This component reacts to the following POE events:

=head2 C<learn>

=head2 C<train>

=head2 C<reply>

=head2 C<learn_reply>

=head2 C<stats>

=head2 C<save>

All these events take two arguments. The first is an array reference of
arguments which will be passed to the L<Hailo|Hailo> method of the same
name. The second (optional) is a hash reference. You'll get this hash
reference back with the corresponding event listed under L</OUTPUT>.

=head2 C<shutdown>

Takes no arguments. Terminates the component.

=head1 OUTPUT

The component will post the following event to your session:

=head2 C<hailo_learned>

=head2 C<hailo_trained>

=head2 C<hailo_replied>

=head2 C<hailo_learn_replied>

=head2 C<hailo_stats>

=head2 C<hailo_saved>

C<ARG0> is an array reference of arguments returned by the underlying
L<Hailo|Hailo> method. C<ARG1> is the context hashref you provided (if any).

=head1 AUTHOR

Hinrik E<Ouml>rn SigurE<eth>sson, [e-mail]

=head1 LICENSE AND COPYRIGHT

Copyright 2010 Hinrik E<Ouml>rn SigurE<eth>sson

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

=cut