File Coverage

blib/lib/IPC/PerlSSH/Library.pm
Criterion Covered Total %
statement 34 34 100.0
branch 9 12 75.0
condition n/a
subroutine 7 7 100.0
pod 2 3 66.6
total 52 56 92.8


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,2016 -- leonerd@leonerd.org.uk
5              
6             package IPC::PerlSSH::Library;
7              
8 5     5   24 use strict;
  5         7  
  5         198  
9 5     5   19 use warnings;
  5         11  
  5         214  
10              
11 5     5   18 use Exporter 'import';
  5         6  
  5         291  
12             our @EXPORT = qw( init func );
13 5     5   22 use Carp;
  5         9  
  5         2292  
14              
15             our $VERSION = '0.17';
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->use_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 a perl module, or declare shared variables
57             or functions. Be careful when Cing a module, as the remote perl executing
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
97              
98             func( $name, $code )
99              
100             Declare a function called $name, which is implemented using the source code in
101             $code. Note that $code must be a plain string, I a CODE reference.
102              
103             The function name may not begin with an underscore.
104              
105             =cut
106              
107             sub func
108             {
109 78     78 1 143 my ( $name, $code ) = @_;
110 78         66 my $caller = caller;
111              
112 78 50       136 $name =~ m/^_/ and croak "Cannot name a library function beginning with '_'";
113              
114             # $code may contain leading whitespace and linefeeds. Kill them
115 78         205 $code =~ s/\s*\n\s*//g;
116              
117 78         261 $package_funcs{$caller}->{$name} = $code;
118             }
119              
120             =head2 init( $code )
121              
122             Declare library initialisation code. This code will be executed in the remote
123             perl before any functions are compiled.
124              
125             =cut
126              
127             sub init
128             {
129 4     4 1 84 my ( $code ) = @_;
130 4         9 my $caller = caller;
131              
132 4 50       21 $package_funcs{$caller}->{_init} and croak "Already have library initialisation";
133              
134             # $code may contain leading whitespace and linefeeds. Kill them
135 4         120 $code =~ s/\s*\n\s*//g;
136              
137 4         16 $package_funcs{$caller}->{_init} = $code;
138             }
139              
140             sub funcs
141             {
142 7     7 0 13 my ( $classname, @funcs ) = @_;
143              
144 7         9 my $package_funcs = $package_funcs{$classname};
145 7 50       19 $package_funcs or croak "$classname does not define any library functions";
146              
147 7         7 my %funcs;
148             # Always report the _init function
149 7 100       19 $funcs{_init} = $package_funcs->{_init} if exists $package_funcs->{_init};
150              
151 7 100       24 if( @funcs ) {
152 3         5 foreach my $f ( @funcs ) {
153 7 100       199 $package_funcs->{$f} or croak "$classname does not define a library function called $f";
154 6         10 $funcs{$f} = $package_funcs->{$f};
155             }
156             }
157             else {
158 4         5 %funcs = %{ $package_funcs };
  4         48  
159             }
160              
161 6         66 %funcs;
162             }
163              
164             =head1 AUTHOR
165              
166             Paul Evans
167              
168             =cut
169              
170             0x55AA;