something's wrong, something's wronggit add t/scratch.t
[p5sagit/IPC-PerlSSH-MultiHop.git] / t / scratch.t
CommitLineData
43ee6732 1#!/usr/bin/perl
2use strictures 1;
3
4use 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
6ac47b9c 35 ($command, IPC::PerlSSH->new( Readfunc => $readfunc, Writefunc => $writefunc ));
43ee6732 36 }
37
38
39}
40
41my $ssh = Net::SSH::Perl->new('localhost');
42$ssh->login('test', 'test');
43
44my $pipc = Net::SSH::Perl::ProxiedIPC->new(ssh => $ssh);
45
6ac47b9c 46my ($cmd, $perlssh) = $pipc->_open_perlssh;
43ee6732 47
6ac47b9c 48is( ref $perlssh, "IPC::PerlSSH", "\$perlssh isa IPC::PerlSSH (via $cmd)" );
43ee6732 49
50$perlssh->eval( "use POSIX qw(uname)" );
51my @remote_uname = $perlssh->eval( "uname()" );
52
53## This is a really shitty idea for a test but fuck you.
54is( $remote_uname[1], "minerva", 'localhost uname() returns minerva' );
28a69662 55
56my $homedir = $perlssh->eval( '$ENV{HOME}' );
57fail( "we require a little sensibility in our \$ENV thank you." )
58 unless defined $homedir;
59
60$perlssh->eval( "use File::HomeDir" );
61my $homedir2 = $perlssh->eval( 'File::HomeDir->my_home' );
62is( $homedir2, "/home/test", 'got $ENV{HOME} the smart way' );
63
6ac47b9c 64my @test_hosts = [ 'stagetwo@localhost', 'stagethree@localhost' ];
65my ($cmd2, $pssh2) = $pipc->_open_perlssh(@test_hosts);
66is( ref $pssh2, "IPC::PerlSSH", "\$pssh2 isa IPC::PerlSSH (via $cmd2)" );
67
68$pssh2->eval( "use POSIX qw(uname)" );
69@remote_uname = $pssh2->eval( "uname()" );
70is( $remote_uname[1], "minerva", 'uname() returns minerva three jumps into localhost!' );
71
43ee6732 72done_testing;