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 -- 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 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( $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;