File Coverage

lib/Test/Expect.pm

Criterion	Covered	Total	%
statement	49	53	92.4
branch	4	6	66.6
condition			n/a
subroutine	17	17	100.0
pod	7	9	77.7
total	77	85	90.5

package Test::Expect;
use strict;
use warnings;
use Class::Accessor::Chained::Fast;
use Expect::Simple;
use Exporter;
use Test::Builder;
use base qw(Class::Accessor::Chained::Fast Exporter);
__PACKAGE__->mk_accessors(qw(program));
our $VERSION = "0.32";
our @EXPORT  = qw(
    expect_run
    expect_handle
    expect_is
    expect_like
    expect_send
    expect_quit
    expect
    END
);

my $Test = Test::Builder->new;

my $expect;
my $sent;

sub import {
    my $self = shift;
    if (@_) {
        die @_;
        my $package = caller;
        $Test->exported_to($package);
        $Test->plan(@_);
    }
    $Test->no_ending(0);
    $self->export_to_level( 1, $self, $_ ) foreach @EXPORT;
}

sub expect_run {
    my (%conf) = @_;
    $expect = Expect::Simple->new(
        {   Cmd           => "PERL_RL=\" o=0\" " . $conf{command},
            Prompt        => $conf{prompt},
            DisconnectCmd => $conf{quit},
            Verbose       => 0,
            Debug         => 0,
            Timeout       => 100
        }
    );
    die $expect->error if $expect->error;
    $Test->ok( 1, "expect_run" );
}

sub expect_handle { return $expect->expect_handle(); }

sub before {
    my $before = $expect->before;
    $before =~ s/\r//g;
    $before =~ s/^\Q$sent\E// if $sent;
    $before =~ s/^\n+//;
    $before =~ s/\n+$//;
    return $before;
}

sub expect_like {
    my ( $like, $comment ) = @_;
    $Test->like( before(), $like, $comment );
}

sub expect_is {
    my ( $is, $comment ) = @_;
    $Test->is_eq( before(), $is, $comment );
}

sub expect_send {
    my ( $send, $comment ) = @_;
    $expect->send($send);
    $sent = $send;
    $Test->ok( 1, $comment );
}

sub expect {
    my ( $send, $is, $label ) = @_;
    expect_send( $send, $label );
    expect_is( $is, $label );
}

sub expect_quit {
    undef $expect;
}

sub END {
    expect_quit;
}

1;

__END__