#
# (c) 2011 Jan Gehring <jan.gehring@gmail.com>
# vim: set ts=3 sw=3 tw=0:
# vim: set expandtab:
#

=head1 NAME

Net::SSH2::Expect - An Expect like module for Net::SSH2

=head1 DESCRIPTION

This is a module to have expect like features for Net::SSH2. This is the first version of this module. Please report bugs at GitHub L<https://github.com/krimdomu/net-ssh2-expect>

=head1 DEPENDENCIES

=over 4

=item *

L<Net::SSH2>

=back

=head1 SYNOPSIS

 use Net::SSH2::Expect;
       
 my $exp = Net::SSH2::Expect->new($ssh2);
 $exp->spawn("passwd");
 $exp->expect($timeout, [
                           qr/Enter new UNIX password:/ => sub {
                                                              my ($exp, $line) = @_;
                                                              $exp->send($new_password);
                                                           },
                           qr/Retype new UNIX password:/ => sub {
                                                              my ($exp, $line) = @_;
                                                              $exp->send($new_password);
                                                           },
                           qr/passwd: password updated successfully/ => sub {
                                                                           my ($exp, $line) = @_;
                                                                           $exp->hard_close;
                                                                        },
                        ]);

=head1 CLASS METHODS

=cut

package Net::SSH2::Expect;

use strict;
use warnings;

our $VERSION = "0.1";

=over 4

=item new($ssh2)

Constructor: You need to parse an connected Net::SSH2 Object. 

=cut

sub new {
   my $that = shift;
   my $proto = ref($that) || $that;
   my $self = {};

   bless($self, $proto);

   $self->{"__shell"} = $_[0]->channel();
   $self->{"__shell"}->pty("vt100");
   $self->{"__shell"}->shell;

   return $self;
}

sub shell {
   my ($self) = @_;
   return $self->{"__shell"};
}

=item spawn($command, @parameters)

Spawn $command with @parameters as parameters.

=cut
sub spawn {
   my ($self, $command, @parameters) = @_;

   my $cmd = "$command " . join(" ", @parameters);
   $self->shell->write($cmd . "\n");
}

=item soft_close()

Currently only an alias to hard_close();

=cut

sub soft_close {
   my ($self) = @_;
   $self->hard_close;
}

=item hard_close();

Stops the execution of the process.

=cut

sub hard_close {
   my ($self) = @_;
   die;
}

=item expect($timeout, @match_patters)

This method controls the execution of your process.

=cut

sub expect {
   my ($self, $timeout, @match_patterns) = @_;

   eval {
      local $SIG{'ALRM'} = sub { die; };
      alarm $timeout;

      my $line = "";
      while(1) {
         my $buf;
         $self->shell->read($buf, 1);
         if($self->_check_patterns($line, @match_patterns)) {
            $line = "";
            alarm $timeout;
            next;
         }
         $line .= $buf;
      }
   };
}

=item send($string)

Send a string to the running command.

=cut

sub send {
   my ($self, $str) = @_;
   $self->shell->write($str);
}

sub _check_patterns {
   my ($self, $line, @match_patterns) = @_;

   for my $pattern (@match_patterns) {
      if($line =~ $pattern->[0]) {
         my $code = $pattern->[1];
         &$code($self, $line);
         return 1;
      }
   }
}

=back

=cut

1;