view release on metacpan or  search on metacpan

lib/Alien/Taco.pm  view on Meta::CPAN

# Taco Perl client module.
# Copyright (C) 2013-2014 Graham Bell
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

=head1 NAME

Alien::Taco - Taco Perl client module

=head1 SYNOPSIS

    use Alien::Taco;

    my $taco = new Alien::Taco(lang => 'perl');
    $taco->call_function('CORE::sleep', args => [10]);

=head1 DESCRIPTION

This is the Taco client module for Perl.

=cut

package Alien::Taco;

use IPC::Open2;
use Scalar::Util qw/blessed/;

use Alien::Taco::Object;
use Alien::Taco::Transport;

use strict;

our $VERSION = '0.003';

=head1 METHODS

=head2 Constructor

=over 4

=item new(lang => 'language' | script => 'server_script')

Connect to a Taco server instance.  The server script can either
be specified explicitly, or the language can be given.  In that 
case the server script will be assumed to be named taco-I<language>
and installed in your executable search path (C<$PATH>).

The server script will be launched in a subprocess, and a
L<Alien::Taco::Transport> object will be attached to it.

=cut

sub new {
    my $class = shift;
    my %opts = @_;

    my $serv = undef;
    if (exists $opts{'script'}) {
        $serv = $opts{'script'};
    }
    elsif (exists $opts{'lang'}) {
        $serv = 'taco-' . $opts{'lang'};
    }
    else {
        die 'languange or script not specified';
    }

    my ($serv_in, $serv_out);
    my $pid = open2($serv_out, $serv_in, $serv);

    my $self = bless {}, $class;

    $self->{'xp'} = $self->_construct_transport($serv_out, $serv_in);

    return $self;
}

# _construct_transport()

sub _construct_transport {
    my $self = shift;
    my $in = shift;
    my $out = shift;

    return new Alien::Taco::Transport(
            in => $in,
            out => $out,
            filter_single => ['_Taco_Object_' =>  sub {
                return new Alien::Taco::Object($self, shift);
            }],
    );
}

# _interact(\%message)
#
# General interaction method.  This is the internal method used to
# implement the main Taco methods.
#
# The given message is filtered for objects and then sent using the
# Alien::Taco::Transport.  If the response is a result then it is
# returned.  If the response is an exception, then an exception is
# raised.

sub _interact {
    my $self = shift;
    my $message = shift;
    my $xp = $self->{'xp'};

    $xp->write($message);