File Coverage

lib/Zimbra/Expect.pm
Criterion Covered Total %
statement 12 56 21.4
branch 0 12 0.0
condition 0 9 0.0
subroutine 4 9 44.4
pod 3 3 100.0
total 19 89 21.3


line stmt bran cond sub pod time code
1             package Zimbra::Expect;
2 1     1   6 use strict;
  1         2  
  1         21  
3 1     1   4 use warnings;
  1         2  
  1         19  
4 1     1   427 use IPC::Open2;
  1         3540  
  1         41  
5 1     1   386 use IO::Select;
  1         1100  
  1         342  
6              
7             our $VERSION = '0.1.0';
8              
9             sub new {
10 0     0 1   my $proto = shift;
11 0   0       my $class = ref($proto)||$proto;
12              
13 0           my $self = { @_ };
14 0           bless $self, $class;
15 0           my ($outFh, $inFh) = (IO::Handle->new(), IO::Handle->new());
16 0           my $pid = open2($outFh,$inFh,@{$self->{cmd}});
  0            
17 0           $outFh->blocking(0);
18 0           my $select = IO::Select->new($outFh);
19              
20 0           $self->{outFh} = $outFh;
21 0           $self->{inFh} = $inFh;
22 0           $self->{select} = $select;
23              
24 0           $self->cmd; #initialize
25 0           return $self;
26             }
27              
28             sub _printRead {
29 0     0     my $self = shift;
30 0           my $cmd = shift;
31 0           my $inFh = $self->{inFh};
32 0 0         $inFh->print($cmd."\n") if $cmd;
33 0           $inFh->flush();
34 0           my $buffer = '';
35 0           my $prompt = $self->{prompt};
36 0           while (1){
37 0           $self->{select}->can_read();
38 0           my $chunk;
39 0           sysread($self->{outFh},$chunk,1024);
40 0           $buffer .= $chunk;
41 0 0         if ($buffer =~ s/${prompt}.*?> $//){
42 0           last;
43             };
44             }
45 0 0         warn "ANSWER: '$buffer'\n" if $self->{debug};
46 0           return $buffer;
47             }
48              
49             sub cmd {
50 0     0 1   my $self = shift;
51 0           my $cmd = shift;
52 0 0 0       warn " - $cmd\n" if $self->{verbose} and $cmd;
53 0           $self->_printRead($cmd);
54             }
55              
56             sub act {
57 0     0 1   my $self = shift;
58 0           my $cmd = shift;
59 0 0 0       warn " > $cmd\n" if $self->{verbose} and $cmd;
60 0 0         $self->_printRead($cmd) unless $self->{noaction};
61             }
62              
63              
64             sub DESTROY {
65 0     0     my $self = shift;
66 0           my $inFh = $self->{inFh};
67 0           print $inFh "quit\n";
68 0           close $self->{inFh};
69 0           close $self->{outFh};
70             # the zm cmmands to strange things to the terminal ... fix them
71 0           system "stty sane";
72             }
73              
74             1;
75              
76             __END__