File Coverage

blib/lib/MozRepl/Client.pm

Criterion	Covered	Total	%
statement	45	71	63.3
branch	5	20	25.0
condition	8	20	40.0
subroutine	9	12	75.0
pod	5	5	100.0
total	72	128	56.2

package MozRepl::Client;

use strict;
use warnings;

use base qw(Class::Accessor::Fast);

__PACKAGE__->mk_accessors(qw/telnet connect_args extra_telnet_args/);

use Carp::Clan qw(croak);
use Data::Dump qw(dump);
use Net::Telnet;
use Text::SimpleTable;

=head1 NAME

MozRepl::Client - MozRepl client class using telnet.

=head1 VERSION

version 0.03

=cut

our $VERSION = '0.03';

=head1 METHODS

=head2 new($ctx, $args)

Create instance. two arguments.

=over 4

=item $ctx

Context object. see L.

=item $args

Hash reference.

=over 4

=item host

Default value is "localhost".

=item port

Default value is 4242.

=item timeout

Default value is 10(sec).

=item extra_client_args

See L's new method arguments.

=back

=back

=cut

sub new {
    my ($class, $ctx, $args) = @_;

    $args->{host} ||= $ENV{MOZREPL_HOST} || 'localhost';
    $args->{port} ||= $ENV{MOZREPL_PORT} || 4242;
    $args->{timeout} ||= $ENV{MOZREPL_TIMEOUT} || 10;
    $args->{extra_client_args} ||= {};

    $args->{extra_client_args}->{binmode} = 1 if ($^O eq "cygwin");

    if ($ctx->log->is_debug) {
        my $table = Text::SimpleTable->new([20, 'client_arg_name'], [40, 'client_arg_value']);

        $table->row('host', $args->{host});
        $table->row('port', $args->{port});
        $table->row('timeout', $args->{timeout});
        $table->row('extra_client_args', dump($args->{extra_client_args}));

        $ctx->log->debug("---- Client arguments ----\n" . $table->draw);
    }

    my $self = $class->SUPER::new({
        telnet => Net::Telnet->new(%{$args->{extra_client_args}}),
        connect_args => {
            Host => $args->{host},
            Port => int($args->{port}),
            Timeout => int($args->{timeout})
        }
    });

    return $self;
}

=head2 setup($ctx, $args)

Two arguments.

=over 4

=item $ctx

Context object. see L.

=item $args

Hash reference.

=over 4

=item host

Default value is "localhost".

=item port

Default value is 4242.

=item timeout

Default value is 10(sec).

=back

=back

=cut

sub setup {
    my ($self, $ctx, $args) = @_;

    my $telnet = $self->telnet;
    my %connect_args = %{$self->connect_args};

    $connect_args{Host} = $args->{host} if ($args->{host});
    $connect_args{Port} = int($args->{port}) if (defined $args->{port});
    $connect_args{Timeoout} = int($args->{timeout}) if (defined $args->{timeout} && $args->{timeout} > 0);

    unless ($telnet->open(%connect_args)) {
        my $message = q|Can't connect to | . sprintf("%s:%d", $connect_args{Host}, $connect_args{Port});
        # $ctx->log->fatal($message);
        croak($message);
    }

    # initialize repl object name and prompt pattern
    my @msg = $telnet->waitfor('/repl\d*> /');
    my $prompt =  pop @msg;
    $prompt = '/' . $prompt . '/';
    my ($repl) = ($prompt =~ m|(repl\d*)|);

    $ctx->log->debug('repl name: ' . $repl);

    $telnet->prompt($prompt);
    $ctx->repl($repl);
}

=head2 execute($ctx, $command)

Execute command and return result string or lines as array.

=over 4

=item $ctx

Context object. see L.

=item $command

Command string.

=back

=cut

sub execute {
    my ($self, $ctx, $command) = @_;

    ### adhoc
    $command = join(" ", split(/\n/, $command)) if ($^O eq "cygwin");

    my $message = [map { chomp; $_ } $self->telnet->cmd(String => $command)];

    if ($ctx->log->is_debug) {
        my $table = Text::SimpleTable->new([10, 'type'], [40, 'content']);
        $table->row('command', $command);
        $table->row('result', join("\n", @$message));
        $ctx->log->debug($table->draw);
    }

    return wantarray ? @$message : join("\n", @$message);
}

=head2 prompt($prompt)

Telnet prompt string.

=cut

sub prompt {
    my ($self, $prompt) = @_;

    if ($prompt) {
        $self->telnet->prompt($prompt);
    }
    else {
        $self->telnet->prompt;
    }
}

=head2 quit()

Quit connection.

=cut

sub quit {
    my ($self, $ctx, $args) = @_;
    ### logging
    $self->telnet->quit;
}

=head1 SEE ALSO

=over 4

=item L

=back

=head1 AUTHOR

Toru Yamaguchi, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.  I will be notified, and then you'll automatically be
notified of progress on your bug as I make changes.

=head1 COPYRIGHT & LICENSE

Copyright 2007 Toru Yamaguchi, All Rights Reserved.

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

=cut

1; # End of MozRepl::Client