sshwrap/Shell/SSH.pm

package Shell::SSH;
use strict;
use warnings;
use base qw( Shell );
our($VERSION, $AUTOLOAD);

$VERSION = '0.01';

# this is just needed for checking $VERSION of Shell.pm which we inherit from
# alternative: don't "use warnings;" else this modules throws "Subroutine AUTOLOAD redefined at Shell/SSH.pm line ..."
# we try to imitate "use base qw( Shell 0.4 );" which of course will never work since it "arrays" all values inside qw()
# but it also calls 'require' under the hood - rendering a "use base ('Shell 0.4');" useless, too, hmmm.....
# question: can this already be done in a more formal way?
BEGIN { my $requires = 0.4; die "Shell version $requires required--this is only version $Shell::VERSION" if ($Shell::VERSION lt $requires); }

use Data::Dumper;
use IPC::Run qw( start pump finish timeout );

# debugging for IPC::Run
# $ENV{IPCRUNDEBUG} = 2;

local *IN;
local *OUT;
local *ERR;

$Shell::hasHandler = 1;

sub new {
  my $class = shift;
  my $self = { @_ };
  bless $self, $class;
  $self->_init();
  $self->_start();
  return $self;
}

sub DESTROY { }

sub AUTOLOAD {
  my $self = shift if ref $_[0] && $_[0]->isa( 'Shell' );
  my $cmd = $AUTOLOAD;
  $cmd =~ s/^.*:://;
  #print Dumper(@_);
  #exit;
  if ($self) {
    # TODO: handle asynchronizity(?) here!
    return $self->_run_command($cmd, @_);
  }
}

sub _init {
  my $self = shift;
  $self->{method} ||= 'ssh';
}


sub _start {
  my $self = shift;

  my @cmd = ();
  die "please supply method" if (!$self->{method});
  die "please supply target" if (!$self->{target});
  
  push @cmd, $self->{method};
  push @cmd, @{$self->{args}} if ($self->{args});
  push @cmd, $self->{target} if ($self->{target});

  my $cmd = join(" ", @cmd);
  #print "command: ", $cmd, "\n";

  $self->{handle} = start
     \@cmd,
        '<pipe', \*IN,
        '>pipe', \*OUT,
        '2>pipe', \*ERR,
        timeout( 5 )
     or die "could not open IPC::Run - handle: $?" ;
  
}

sub _stop {
  my $self = shift;
  finish $self->{handle};
}

sub _run_command {
  my $self = shift;
  my $rcommand = shift;
  my $rargs = join(' ', @_);
  $rargs ||= '';
  my $rcommandstring = join(' ', $rcommand, $rargs);
  #open IN, '';
  print IN $rcommandstring;
  close IN;
  $self->_read_output();
  return '';
}

sub _read_output {
  my $self = shift;
  $self->{buffer} = [];
  my $buffer = '';
  #print "=read\n";
  #print Dumper($self->{handle});
  while (<OUT>) {
    #print "line: ", $_, "\n";
    chomp();
    push @{$self->{buffer}}, $_;
    $buffer .= $_ . "\n";
  }
  #print "=read okay\n";
  # TODO: async!
  #return $buffer;
  $self->{response}->($buffer);
}

sub get_output {
  my $self = shift;
  return $self->{buffer};
}

sub disconnect {
  my $self = shift;
  $self->_stop();
}

1;
1	joko	1.1	package Shell::SSH;
2			use strict;
3			use warnings;
4			use base qw( Shell );
5			our($VERSION, $AUTOLOAD);
6
7			$VERSION = '0.01';
8
9			# this is just needed for checking $VERSION of Shell.pm which we inherit from
10			# alternative: don't "use warnings;" else this modules throws "Subroutine AUTOLOAD redefined at Shell/SSH.pm line ..."
11			# we try to imitate "use base qw( Shell 0.4 );" which of course will never work since it "arrays" all values inside qw()
12			# but it also calls 'require' under the hood - rendering a "use base ('Shell 0.4');" useless, too, hmmm.....
13			# question: can this already be done in a more formal way?
14			BEGIN { my $requires = 0.4; die "Shell version $requires required--this is only version $Shell::VERSION" if ($Shell::VERSION lt $requires); }
15
16			use Data::Dumper;
17			use IPC::Run qw( start pump finish timeout );
18
19			# debugging for IPC::Run
20			# $ENV{IPCRUNDEBUG} = 2;
21
22			local *IN;
23			local *OUT;
24			local *ERR;
25
26			$Shell::hasHandler = 1;
27
28			sub new {
29			my $class = shift;
30			my $self = { @_ };
31			bless $self, $class;
32			$self->_init();
33			$self->_start();
34			return $self;
35			}
36
37			sub DESTROY { }
38
39			sub AUTOLOAD {
40			my $self = shift if ref $_[0] && $_[0]->isa( 'Shell' );
41			my $cmd = $AUTOLOAD;
42			$cmd =~ s/^.*:://;
43			#print Dumper(@_);
44			#exit;
45			if ($self) {
46			# TODO: handle asynchronizity(?) here!
47			return $self->_run_command($cmd, @_);
48			}
49			}
50
51			sub _init {
52			my $self = shift;
53			$self->{method} \|\|= 'ssh';
54			}
55
56
57			sub _start {
58			my $self = shift;
59
60			my @cmd = ();
61			die "please supply method" if (!$self->{method});
62			die "please supply target" if (!$self->{target});
63
64			push @cmd, $self->{method};
65			push @cmd, @{$self->{args}} if ($self->{args});
66			push @cmd, $self->{target} if ($self->{target});
67
68			my $cmd = join(" ", @cmd);
69			#print "command: ", $cmd, "\n";
70
71			$self->{handle} = start
72			\@cmd,
73			'<pipe', \*IN,
74			'>pipe', \*OUT,
75			'2>pipe', \*ERR,
76			timeout( 5 )
77			or die "could not open IPC::Run - handle: $?" ;
78
79			}
80
81			sub _stop {
82			my $self = shift;
83			finish $self->{handle};
84			}
85
86			sub _run_command {
87			my $self = shift;
88			my $rcommand = shift;
89			my $rargs = join(' ', @_);
90			$rargs \|\|= '';
91			my $rcommandstring = join(' ', $rcommand, $rargs);
92			#open IN, '';
93			print IN $rcommandstring;
94			close IN;
95			$self->_read_output();
96			return '';
97			}
98
99			sub _read_output {
100			my $self = shift;
101			$self->{buffer} = [];
102			my $buffer = '';
103			#print "=read\n";
104			#print Dumper($self->{handle});
105			while (<OUT>) {
106			#print "line: ", $_, "\n";
107			chomp();
108			push @{$self->{buffer}}, $_;
109			$buffer .= $_ . "\n";
110			}
111			#print "=read okay\n";
112			# TODO: async!
113			#return $buffer;
114			$self->{response}->($buffer);
115			}
116
117			sub get_output {
118			my $self = shift;
119			return $self->{buffer};
120			}
121
122			sub disconnect {
123			my $self = shift;
124			$self->_stop();
125			}
126
127			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26