| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | #  You may distribute under the terms of either the GNU General Public License | 
| 2 |  |  |  |  |  |  | #  or the Artistic License (the same terms as Perl itself) | 
| 3 |  |  |  |  |  |  | # | 
| 4 |  |  |  |  |  |  | #  (C) Paul Evans, 2008-2010 -- leonerd@leonerd.org.uk | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | package IPC::PerlSSH::Library; | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 5 |  |  | 5 |  | 199 | use strict; | 
|  | 5 |  |  |  |  | 9 |  | 
|  | 5 |  |  |  |  | 302 |  | 
| 9 | 5 |  |  | 5 |  | 30 | use warnings; | 
|  | 5 |  |  |  |  | 15 |  | 
|  | 5 |  |  |  |  | 337 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 | 5 |  |  | 5 |  | 26 | use Exporter 'import'; | 
|  | 5 |  |  |  |  | 8 |  | 
|  | 5 |  |  |  |  | 652 |  | 
| 12 |  |  |  |  |  |  | our @EXPORT = qw( init func ); | 
| 13 | 5 |  |  | 5 |  | 28 | use Carp; | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 9761 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | our $VERSION = '0.16'; | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | =head1 NAME | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | C - support package for declaring libraries of remote | 
| 20 |  |  |  |  |  |  | functions | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | package IPC::PerlSSH::Library::Info; | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | use strict; | 
| 27 |  |  |  |  |  |  | use IPC::PerlSSH::Library; | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | func uname   => 'uname()'; | 
| 30 |  |  |  |  |  |  | func ostype  => '$^O'; | 
| 31 |  |  |  |  |  |  | func perlbin => '$^X'; | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | 1; | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | This can be loaded by | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | use IPC::PerlSSH; | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | my $ips = IPC::PerlSSH->new( Host => "over.there" ); | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | $ips->load_library( "Info" ); | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | print "Remote perl is running from " . $ips->call("perlbin") . "\n"; | 
| 44 |  |  |  |  |  |  | print " Running on a machine of type " . $ips->call("ostype") . | 
| 45 |  |  |  |  |  |  | $ips->call("uname") . "\n"; | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | This module allows the creation of pre-prepared libraries of functions which | 
| 50 |  |  |  |  |  |  | may be loaded into a remote perl running via C. | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | All the code is kept in its own package in the remote perl. The package | 
| 53 |  |  |  |  |  |  | declaration is performed in the remote perl, by including an optional block of | 
| 54 |  |  |  |  |  |  | initialisation code, passed to the C function. | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | Typically this code could C | 
| 57 |  |  |  |  |  |  | or functions. Be careful when C | 
| 58 |  |  |  |  |  |  | it may not have the same modules installed as the local machine, or even be of | 
| 59 |  |  |  |  |  |  | the same version. | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | Note that C variables will be available for use in stored code, but | 
| 62 |  |  |  |  |  |  | limitations of the way perl's lexical scopes work mean that C variables | 
| 63 |  |  |  |  |  |  | will not. On versions of perl before 5.10, the variable will have to be | 
| 64 |  |  |  |  |  |  | Ced again in each block of code that requires it. On 5.10 and above, this | 
| 65 |  |  |  |  |  |  | is not necessary; but beware that the code will not work on remote perls before | 
| 66 |  |  |  |  |  |  | this version, even if the local perl is 5.10. | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | For example, consider the following small example: | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | package IPC::PerlSSH::Library::Storage; | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | use IPC::PerlSSH::Library; | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | init q{ | 
| 75 |  |  |  |  |  |  | our %storage; | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | sub list  { keys %storage } | 
| 78 |  |  |  |  |  |  | sub clear { undef %storage } | 
| 79 |  |  |  |  |  |  | }; | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | func get   => q{ our %storage; return $storage{$_[0]} }; | 
| 82 |  |  |  |  |  |  | func set   => q{ our %storage; $storage{$_[0]} = $_[1] }; | 
| 83 |  |  |  |  |  |  | func clear => q{ clear() } | 
| 84 |  |  |  |  |  |  | func list  => q{ return list() } | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | 1; | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | =cut | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | my %package_funcs; | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | =head1 FUNCTIONS | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | =cut | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | =head2 func( $name, $code ) | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | Declare a function called $name, which is implemented using the source code in | 
| 99 |  |  |  |  |  |  | $code. Note that $code must be a plain string, I a CODE reference. | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  | The function name may not begin with an underscore. | 
| 102 |  |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | =cut | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | sub func | 
| 106 |  |  |  |  |  |  | { | 
| 107 | 78 |  |  | 78 | 1 | 295 | my ( $name, $code ) = @_; | 
| 108 | 78 |  |  |  |  | 118 | my $caller = caller; | 
| 109 |  |  |  |  |  |  |  | 
| 110 | 78 | 50 |  |  |  | 174 | $name =~ m/^_/ and croak "Cannot name a library function beginning with '_'"; | 
| 111 |  |  |  |  |  |  |  | 
| 112 |  |  |  |  |  |  | # $code may contain leading whitespace and linefeeds. Kill them | 
| 113 | 78 |  |  |  |  | 263 | $code =~ s/\s*\n\s*//g; | 
| 114 |  |  |  |  |  |  |  | 
| 115 | 78 |  |  |  |  | 484 | $package_funcs{$caller}->{$name} = $code; | 
| 116 |  |  |  |  |  |  | } | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | =head2 init( $code ) | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | Declare library initialisation code. This code will be executed in the remote | 
| 121 |  |  |  |  |  |  | perl before any functions are compiled. | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | =cut | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | sub init | 
| 126 |  |  |  |  |  |  | { | 
| 127 | 4 |  |  | 4 | 1 | 173 | my ( $code ) = @_; | 
| 128 | 4 |  |  |  |  | 11 | my $caller = caller; | 
| 129 |  |  |  |  |  |  |  | 
| 130 | 4 | 50 |  |  |  | 24 | $package_funcs{$caller}->{_init} and croak "Already have library initialisation"; | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | # $code may contain leading whitespace and linefeeds. Kill them | 
| 133 | 4 |  |  |  |  | 154 | $code =~ s/\s*\n\s*//g; | 
| 134 |  |  |  |  |  |  |  | 
| 135 | 4 |  |  |  |  | 25 | $package_funcs{$caller}->{_init} = $code; | 
| 136 |  |  |  |  |  |  | } | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | sub funcs | 
| 139 |  |  |  |  |  |  | { | 
| 140 | 7 |  |  | 7 | 0 | 33 | my ( $classname, @funcs ) = @_; | 
| 141 |  |  |  |  |  |  |  | 
| 142 | 7 |  |  |  |  | 21 | my $package_funcs = $package_funcs{$classname}; | 
| 143 | 7 | 50 |  |  |  | 24 | $package_funcs or croak "$classname does not define any library functions"; | 
| 144 |  |  |  |  |  |  |  | 
| 145 | 7 |  |  |  |  | 16 | my %funcs; | 
| 146 |  |  |  |  |  |  | # Always report the _init function | 
| 147 | 7 | 100 |  |  |  | 33 | $funcs{_init} = $package_funcs->{_init} if exists $package_funcs->{_init}; | 
| 148 |  |  |  |  |  |  |  | 
| 149 | 7 | 100 |  |  |  | 52 | if( @funcs ) { | 
| 150 | 3 |  |  |  |  | 9 | foreach my $f ( @funcs ) { | 
| 151 | 7 | 100 |  |  |  | 322 | $package_funcs->{$f} or croak "$classname does not define a library function called $f"; | 
| 152 | 6 |  |  |  |  | 11 | $funcs{$f} = $package_funcs->{$f}; | 
| 153 |  |  |  |  |  |  | } | 
| 154 |  |  |  |  |  |  | } | 
| 155 |  |  |  |  |  |  | else { | 
| 156 | 4 |  |  |  |  | 10 | %funcs = %{ $package_funcs }; | 
|  | 4 |  |  |  |  | 154 |  | 
| 157 |  |  |  |  |  |  | } | 
| 158 |  |  |  |  |  |  |  | 
| 159 | 6 |  |  |  |  | 90 | %funcs; | 
| 160 |  |  |  |  |  |  | } | 
| 161 |  |  |  |  |  |  |  | 
| 162 |  |  |  |  |  |  | =head1 AUTHOR | 
| 163 |  |  |  |  |  |  |  | 
| 164 |  |  |  |  |  |  | Paul Evans | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | =cut | 
| 167 |  |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | 0x55AA; |