t/scratch.t

   1 #!/usr/bin/perl
   2 use strictures 1;
   3
   4 use Test::More;
   5
   6 {
   7   package Net::SSH::Perl::ProxiedIPC;
   8   use strict; use warnings;
   9   use Net::SSH::Perl::WithSocks;
  10   use IPC::PerlSSH;
  11
  12   sub new {
  13     my $proto = shift;
  14     my $class = ref $proto || $proto;
  15     bless( { @_ }, $class );
  16   }
  17
  18   sub _ssh {
  19     $_[0]->{ssh} ||= $_[0]->_build_ssh
  20   }
  21
  22   sub _build_ssh {
  23     Net::SSH::Perl::WithSocks->new();
  24   }
  25
  26   sub _open_perlssh {
  27     my( $self, @hosts ) = @_;
  28     my $ssh = $self->_ssh;
  29     my $command = join ' ', (map "ssh -A $_", @hosts), "perl";
  30     my( $read, $write ) = $ssh->open2($command);
  31
  32     my $readfunc = sub { sysread( $read, $_[0], $_[1] ) };
  33     my $writefunc = sub { syswrite( $write, $_[0] ) };
  34
  35     ($command, IPC::PerlSSH->new( Readfunc => $readfunc, Writefunc => $writefunc ));
  36   }
  37
  38
  39 }
  40
  41 my $ssh = Net::SSH::Perl->new('localhost');
  42 $ssh->login('test', 'test');
  43
  44 my $pipc = Net::SSH::Perl::ProxiedIPC->new(ssh => $ssh);
  45
  46 my ($cmd, $perlssh) = $pipc->_open_perlssh;
  47
  48 is( ref $perlssh, "IPC::PerlSSH", "\$perlssh isa IPC::PerlSSH (via $cmd)" );
  49
  50 $perlssh->eval( "use POSIX qw(uname)" );
  51 my @remote_uname = $perlssh->eval( "uname()" );
  52
  53 ## This is a really shitty idea for a test but fuck you.
  54 is( $remote_uname[1], "minerva", 'localhost uname() returns minerva' );
  55
  56 my $homedir = $perlssh->eval( '$ENV{HOME}' );
  57 fail( "we require a little sensibility in our \$ENV thank you." )
  58   unless defined $homedir;
  59
  60 $perlssh->eval( "use File::HomeDir" );
  61 my $homedir2 = $perlssh->eval( 'File::HomeDir->my_home' );
  62 is( $homedir2, "/home/test", 'got $ENV{HOME} the smart way' );
  63
  64 my @test_hosts = [ 'stagetwo@localhost', 'stagethree@localhost' ];
  65 my ($cmd2, $pssh2) = $pipc->_open_perlssh(@test_hosts);
  66 is( ref $pssh2, "IPC::PerlSSH", "\$pssh2 isa IPC::PerlSSH (via $cmd2)" );
  67
  68 $pssh2->eval( "use POSIX qw(uname)" );
  69 @remote_uname = $pssh2->eval( "uname()" );
  70 is( $remote_uname[1], "minerva", 'uname() returns minerva three jumps into localhost!' );
  71
  72 done_testing;