1 |
cvsjoko |
1.1 |
############################################################################### |
2 |
|
|
# |
3 |
|
|
# This file copyright (c) 2001 by Randy J. Ray, all rights reserved |
4 |
|
|
# |
5 |
|
|
# Copying and distribution are permitted under the terms of the Artistic |
6 |
|
|
# License as distributed with Perl versions 5.005 and later. See |
7 |
|
|
# http://language.perl.com/misc/Artistic.html |
8 |
|
|
# |
9 |
|
|
############################################################################### |
10 |
|
|
# |
11 |
|
|
# $Id: Procedure.pm,v 1.5 2002/05/22 09:45:59 rjray Exp $ |
12 |
|
|
# |
13 |
|
|
# Description: This class abstracts out all the procedure-related |
14 |
|
|
# operations from the RPC::XML::Server class |
15 |
|
|
# |
16 |
|
|
# Functions: new |
17 |
|
|
# name \ |
18 |
|
|
# code \ |
19 |
|
|
# signature \ These are the accessor functions for the |
20 |
|
|
# help / data in the object, though it's visible. |
21 |
|
|
# version / |
22 |
|
|
# hidden / |
23 |
|
|
# clone |
24 |
|
|
# is_valid |
25 |
|
|
# add_signature |
26 |
|
|
# delete_signature |
27 |
|
|
# make_sig_table |
28 |
|
|
# match_signature |
29 |
|
|
# reload |
30 |
|
|
# load_XPL_file |
31 |
|
|
# |
32 |
|
|
# Libraries: XML::Parser (used only on demand in load_XPL_file) |
33 |
|
|
# File::Spec |
34 |
|
|
# |
35 |
|
|
# Global Consts: $VERSION |
36 |
|
|
# |
37 |
|
|
# Environment: None. |
38 |
|
|
# |
39 |
|
|
############################################################################### |
40 |
|
|
|
41 |
|
|
package RPC::XML::Procedure; |
42 |
|
|
|
43 |
|
|
use 5.005; |
44 |
|
|
use strict; |
45 |
|
|
use vars qw($VERSION); |
46 |
|
|
use subs qw(new is_valid name code signature help version hidden |
47 |
|
|
add_signature delete_signature make_sig_table match_signature |
48 |
|
|
reload load_XPL_file); |
49 |
|
|
|
50 |
|
|
use AutoLoader 'AUTOLOAD'; |
51 |
|
|
require File::Spec; |
52 |
|
|
|
53 |
|
|
$VERSION = do { my @r=(q$Revision: 1.5 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; |
54 |
|
|
|
55 |
|
|
1; |
56 |
|
|
|
57 |
|
|
############################################################################### |
58 |
|
|
# |
59 |
|
|
# Sub Name: new |
60 |
|
|
# |
61 |
|
|
# Description: Create a new object of this class, storing the info on |
62 |
|
|
# regular keys (no obfuscation used here). |
63 |
|
|
# |
64 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
65 |
|
|
# $class in scalar Class to bless into |
66 |
|
|
# @argz in variable Disposition is variable; see |
67 |
|
|
# below |
68 |
|
|
# |
69 |
|
|
# Returns: Success: object ref |
70 |
|
|
# Failure: error string |
71 |
|
|
# |
72 |
|
|
############################################################################### |
73 |
|
|
sub new |
74 |
|
|
{ |
75 |
|
|
my $class = shift; |
76 |
|
|
my @argz = @_; |
77 |
|
|
|
78 |
|
|
my $data; # This will be a hashref that eventually gets blessed |
79 |
|
|
|
80 |
|
|
$class = ref($class) || $class; |
81 |
|
|
|
82 |
|
|
# |
83 |
|
|
# There are three things that @argz could be: |
84 |
|
|
# |
85 |
|
|
if (ref $argz[0]) |
86 |
|
|
{ |
87 |
|
|
# 1. A hashref containing all the relevant keys |
88 |
|
|
$data = {}; |
89 |
|
|
%$data = %{$argz[0]}; |
90 |
|
|
} |
91 |
|
|
elsif (@argz == 1) |
92 |
|
|
{ |
93 |
|
|
# 2. Exactly one non-ref element, a file to load |
94 |
|
|
|
95 |
|
|
# And here is where I cheat in a way that makes even me uncomfortable. |
96 |
|
|
# |
97 |
|
|
# Loading code from an XPL file, it can actually be of a type other |
98 |
|
|
# than how this constructor was called. So what we are going to do is |
99 |
|
|
# this: If $class is undef, that can only mean that we were called |
100 |
|
|
# with the intent of letting the XPL file dictate the resulting object. |
101 |
|
|
# If $class is set, then we'll call load_XPL_file normally, as a |
102 |
|
|
# method, to allow for subclasses to tweak things. |
103 |
|
|
if (defined $class) |
104 |
|
|
{ |
105 |
|
|
$data = $class->load_XPL_file($argz[0]); |
106 |
|
|
return $data unless ref $data; # load_XPL_path signalled an error |
107 |
|
|
} |
108 |
|
|
else |
109 |
|
|
{ |
110 |
|
|
# Spoofing the "class" argument to load_XPL_file makes me feel |
111 |
|
|
# even dirtier... |
112 |
|
|
$data = load_XPL_file(\$class, $argz[0]); |
113 |
|
|
return $data unless ref $data; # load_XPL_path signalled an error |
114 |
|
|
$class = "RPC::XML::$class"; |
115 |
|
|
} |
116 |
|
|
} |
117 |
|
|
else |
118 |
|
|
{ |
119 |
|
|
# 3. If there is more than one arg, it's a sort-of-hash. That is, the |
120 |
|
|
# key 'signature' is allowed to repeat. |
121 |
|
|
my ($key, $val); |
122 |
|
|
$data = {}; |
123 |
|
|
$data->{signature} = []; |
124 |
|
|
while (@argz) |
125 |
|
|
{ |
126 |
|
|
($key, $val) = splice(@argz, 0, 2); |
127 |
|
|
if ($key eq 'signature') |
128 |
|
|
{ |
129 |
|
|
# Since there may be more than one signature, we allow it to |
130 |
|
|
# repeat. Of course, that's also why we can't just take @argz |
131 |
|
|
# directly as a hash. *shrug* |
132 |
|
|
push(@{$data->{signature}}, |
133 |
|
|
[ ref($val) ? @$val : split(/ /, $val) ]); |
134 |
|
|
} |
135 |
|
|
elsif (exists $data->{$key}) |
136 |
|
|
{ |
137 |
|
|
return "${class}::new: Key '$key' may not be repeated"; |
138 |
|
|
} |
139 |
|
|
else |
140 |
|
|
{ |
141 |
|
|
$data->{$key} = $val; |
142 |
|
|
} |
143 |
|
|
} |
144 |
|
|
} |
145 |
|
|
|
146 |
|
|
return "${class}::new: Missing required data" |
147 |
|
|
unless (exists $data->{signature} and |
148 |
|
|
(ref($data->{signature}) eq 'ARRAY') and |
149 |
|
|
scalar(@{$data->{signature}}) and |
150 |
|
|
$data->{name} and $data->{code}); |
151 |
|
|
bless $data, $class; |
152 |
|
|
# This needs to happen post-bless in case of error (for error messages) |
153 |
|
|
$data->make_sig_table; |
154 |
|
|
} |
155 |
|
|
|
156 |
|
|
############################################################################### |
157 |
|
|
# |
158 |
|
|
# Sub Name: make_sig_table |
159 |
|
|
# |
160 |
|
|
# Description: Create a hash table of the signatures that maps to the |
161 |
|
|
# corresponding return type for that particular invocation. |
162 |
|
|
# Makes looking up call patterns much easier. |
163 |
|
|
# |
164 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
165 |
|
|
# $self in ref Object of this class |
166 |
|
|
# |
167 |
|
|
# Returns: Success: $self |
168 |
|
|
# Failure: error message |
169 |
|
|
# |
170 |
|
|
############################################################################### |
171 |
|
|
sub make_sig_table |
172 |
|
|
{ |
173 |
|
|
my $self = shift; |
174 |
|
|
|
175 |
|
|
my ($sig, $return, $rest); |
176 |
|
|
|
177 |
|
|
delete $self->{sig_table}; |
178 |
|
|
for $sig (@{$self->{signature}}) |
179 |
|
|
{ |
180 |
|
|
($return, $rest) = split(/ /, $sig, 2); $rest = '' unless $rest; |
181 |
|
|
# If the key $rest already exists, then this is a collision |
182 |
|
|
return ref($self) . '::make_sig_table: Cannot have two different ' . |
183 |
|
|
"return values for one set of params ($return vs. " . |
184 |
|
|
"$self->{sig_table}->{$rest})" |
185 |
|
|
if $self->{sig_table}->{$rest}; |
186 |
|
|
$self->{sig_table}->{$rest} = $return; |
187 |
|
|
} |
188 |
|
|
|
189 |
|
|
$self; |
190 |
|
|
} |
191 |
|
|
|
192 |
|
|
# |
193 |
|
|
# These are basic accessor/setting functions for the various attributes |
194 |
|
|
# |
195 |
|
|
sub name { $_[0]->{name}; } # "name" cannot be changed at this level |
196 |
|
|
sub help { $_[1] and $_[0]->{help} = $_[1]; $_[0]->{help}; } |
197 |
|
|
sub version { $_[1] and $_[0]->{version} = $_[1]; $_[0]->{version}; } |
198 |
|
|
sub hidden { $_[1] and $_[0]->{hidden} = $_[1]; $_[0]->{hidden}; } |
199 |
|
|
sub code |
200 |
|
|
{ |
201 |
|
|
ref $_[1] eq 'CODE' and $_[0]->{code} = $_[1]; |
202 |
|
|
$_[0]->{code}; |
203 |
|
|
} |
204 |
|
|
sub signature |
205 |
|
|
{ |
206 |
|
|
if ($_[1] and ref $_[1] eq 'ARRAY') |
207 |
|
|
{ |
208 |
|
|
my $old = $_[0]->{signature}; |
209 |
|
|
$_[0]->{signature} = $_[1]; |
210 |
|
|
unless (ref($_[0]->make_sig_table)) |
211 |
|
|
{ |
212 |
|
|
# If it failed to re-init the table, restore the old list (and old |
213 |
|
|
# table). We don't have to check this return, since it had worked |
214 |
|
|
$_[0]->{signature} = $old; |
215 |
|
|
$_[0]->make_sig_table; |
216 |
|
|
} |
217 |
|
|
} |
218 |
|
|
# Return a copy of the array, not the original |
219 |
|
|
[ @{$_[0]->{signature}} ]; |
220 |
|
|
} |
221 |
|
|
|
222 |
|
|
package RPC::XML::Method; |
223 |
|
|
|
224 |
|
|
use strict; |
225 |
|
|
|
226 |
|
|
@RPC::XML::Method::ISA = qw(RPC::XML::Procedure); |
227 |
|
|
|
228 |
|
|
package RPC::XML::Procedure; |
229 |
|
|
|
230 |
|
|
=head1 NAME |
231 |
|
|
|
232 |
|
|
RPC::XML::Procedure - Object encapsulation of server-side RPC procedures |
233 |
|
|
|
234 |
|
|
=head1 SYNOPSIS |
235 |
|
|
|
236 |
|
|
require RPC::XML::Procedure; |
237 |
|
|
|
238 |
|
|
... |
239 |
|
|
$method_1 = RPC::XML::Procedure->new({ name => 'system.identity', |
240 |
|
|
code => sub { ... }, |
241 |
|
|
signature => [ 'string' ] }); |
242 |
|
|
$method_2 = RPC::XML::Procedure->new('/path/to/status.xpl'); |
243 |
|
|
|
244 |
|
|
=head1 IMPORTANT NOTE |
245 |
|
|
|
246 |
|
|
This package is comprised of the code that was formerly B<RPC::XML::Method>. |
247 |
|
|
The package was renamed when the decision was made to support procedures and |
248 |
|
|
methods as functionally different entities. It is not necessary to include |
249 |
|
|
both this module and B<RPC::XML::Method> -- this module provides the latter as |
250 |
|
|
an empty subclass. In time, B<RPC::XML::Method> will be removed from the |
251 |
|
|
distribution entirely. |
252 |
|
|
|
253 |
|
|
=head1 DESCRIPTION |
254 |
|
|
|
255 |
|
|
The B<RPC::XML::Procedure> package is designed primarily for behind-the-scenes |
256 |
|
|
use by the B<RPC::XML::Server> class and any subclasses of it. It is |
257 |
|
|
documented here in case a project chooses to sub-class it for their purposes |
258 |
|
|
(which would require setting the C<method_class> attribute when creating |
259 |
|
|
server objects, see L<RPC::XML::Server>). |
260 |
|
|
|
261 |
|
|
This package grew out of the increasing need to abstract the operations that |
262 |
|
|
related to the methods a given server instance was providing. Previously, |
263 |
|
|
methods were passed around simply as hash references. It was a small step then |
264 |
|
|
to move them into a package and allow for operations directly on the objects |
265 |
|
|
themselves. In the spirit of the original hashes, all the key data is kept in |
266 |
|
|
clear, intuitive hash keys (rather than obfuscated as the other classes |
267 |
|
|
do). Thus it is important to be clear on the interface here before |
268 |
|
|
sub-classing this package. |
269 |
|
|
|
270 |
|
|
=head1 USAGE |
271 |
|
|
|
272 |
|
|
The following methods are provided by this class: |
273 |
|
|
|
274 |
|
|
=over 4 |
275 |
|
|
|
276 |
|
|
=item new(FILE|HASHREF|LIST) |
277 |
|
|
|
278 |
|
|
Creates a new object of the class, and returns a reference to it. The |
279 |
|
|
arguments to the constructor are variable in nature, depending on the type: |
280 |
|
|
|
281 |
|
|
=over 8 |
282 |
|
|
|
283 |
|
|
=item FILE |
284 |
|
|
|
285 |
|
|
If there is exactly on argument that is not a reference, it is assumed to be a |
286 |
|
|
filename from which the method is to be loaded. This is presumed to be in the |
287 |
|
|
B<XPL> format descibed below (see L</"XPL File Structure">). If the file |
288 |
|
|
cannot be opened, or if once opened cannot be parsed, an error is raised. |
289 |
|
|
|
290 |
|
|
=item HASHREF |
291 |
|
|
|
292 |
|
|
If there is exactly one argument that is a reference, it is assumed to be a |
293 |
|
|
hash with the relevant information on the same keys as the object itself |
294 |
|
|
uses. This is primarily to support backwards-compatibility to code written |
295 |
|
|
when methods were implemented simply as hash references. |
296 |
|
|
|
297 |
|
|
=item LIST |
298 |
|
|
|
299 |
|
|
If there is more than one argument in the list, then the list is assumed to be |
300 |
|
|
a sort of "ersatz" hash construct, in that one of the keys (C<signature>) is |
301 |
|
|
allowed to occur multiple times. Otherwise, each of the following is allowed, |
302 |
|
|
but may only occur once: |
303 |
|
|
|
304 |
|
|
=over 12 |
305 |
|
|
|
306 |
|
|
=item name |
307 |
|
|
|
308 |
|
|
The name of the method, as it will be presented to clients |
309 |
|
|
|
310 |
|
|
=item code |
311 |
|
|
|
312 |
|
|
A reference to a subroutine, or an anonymous subroutine, that will receive |
313 |
|
|
calls for the method |
314 |
|
|
|
315 |
|
|
=item signature |
316 |
|
|
|
317 |
|
|
(May appear more than once) Provides one calling-signature for the method, as |
318 |
|
|
either a space-separated string of types or a list-reference |
319 |
|
|
|
320 |
|
|
=item help |
321 |
|
|
|
322 |
|
|
The help-text for a method, which is generally used as a part of the |
323 |
|
|
introspection interface for a server |
324 |
|
|
|
325 |
|
|
=item version |
326 |
|
|
|
327 |
|
|
The version number/string for the method |
328 |
|
|
|
329 |
|
|
=item hidden |
330 |
|
|
|
331 |
|
|
A boolean (true or false) value indicating whether the method should be hidden |
332 |
|
|
from introspection and similar listings |
333 |
|
|
|
334 |
|
|
=back |
335 |
|
|
|
336 |
|
|
Note that all of these correspond to the values that can be changed via the |
337 |
|
|
accessor methods detailed later. |
338 |
|
|
|
339 |
|
|
=back |
340 |
|
|
|
341 |
|
|
If any error occurs during object creation, an error message is returned in |
342 |
|
|
lieu of the object reference. |
343 |
|
|
|
344 |
|
|
=item clone |
345 |
|
|
|
346 |
|
|
Create a copy of the calling object, and return the new reference. All |
347 |
|
|
elements are copied over cleanly, except for the code reference stored on the |
348 |
|
|
C<code> hash key. The clone will point to the same code reference as the |
349 |
|
|
original. Elements such as C<signature> are copied, so that changes to the |
350 |
|
|
clone will not impact the original. |
351 |
|
|
|
352 |
|
|
=item name |
353 |
|
|
|
354 |
|
|
Returns the name by which the server is advertising the method. Unlike the |
355 |
|
|
next few accessors, this cannot be changed on an object. In order to |
356 |
|
|
streamline the managment of methods within the server classes, this must |
357 |
|
|
persist. However, the other elements may be used in the creation of a new |
358 |
|
|
object, which may then be added to the server, if the name absolutely must |
359 |
|
|
change. |
360 |
|
|
|
361 |
|
|
=item code([NEW]) |
362 |
|
|
|
363 |
|
|
Returns or sets the code-reference that will receive calls as marshalled by |
364 |
|
|
the server. The existing value is lost, so if it must be preserved, then it |
365 |
|
|
should be retrieved prior to the new value being set. |
366 |
|
|
|
367 |
|
|
=item signature([NEW]) |
368 |
|
|
|
369 |
|
|
Return a list reference containing the signatures, or set it. Each element of |
370 |
|
|
the list is a string of space-separated types (the first of which is the |
371 |
|
|
return type the method produces in that calling context). If this is being |
372 |
|
|
used to set the signature, then an array reference must be passed that |
373 |
|
|
contains one or more strings of this nature. Nested list references are not |
374 |
|
|
allowed at this level. If the new signatures would cause a conflict (a case in |
375 |
|
|
which the same set of input types are specified for different output types), |
376 |
|
|
the old set is silently restored. |
377 |
|
|
|
378 |
|
|
=item help([NEW]) |
379 |
|
|
|
380 |
|
|
Returns or sets the help-text for the method. As with B<code>, the previous |
381 |
|
|
value is lost. |
382 |
|
|
|
383 |
|
|
=item hidden([NEW]) |
384 |
|
|
|
385 |
|
|
Returns or sets the hidden status of the method. Setting it loses the previous |
386 |
|
|
value. |
387 |
|
|
|
388 |
|
|
=item version([NEW]) |
389 |
|
|
|
390 |
|
|
Returns or sets the version string for the method (overwriting as with the |
391 |
|
|
other accessors). |
392 |
|
|
|
393 |
|
|
=item is_valid |
394 |
|
|
|
395 |
|
|
Returns a true/false value as to whether the object currently has enough |
396 |
|
|
content to be a valid method for a server to publish. This entails having at |
397 |
|
|
the very least a name, one or more signatures, and a code-reference to route |
398 |
|
|
the calls to. A server created from the classes in this software suite will |
399 |
|
|
not accept a method that is not valid. |
400 |
|
|
|
401 |
|
|
=item add_signature(LIST) |
402 |
|
|
|
403 |
|
|
Add one or more signatures (which may be a list reference or a string) to the |
404 |
|
|
internal tables for this method. Duplicate signatures are ignored. If the new |
405 |
|
|
signature would cause a conflict (a case in which the same set of input types |
406 |
|
|
are specified for different output types), the old set is restored and an |
407 |
|
|
error message is returned. |
408 |
|
|
|
409 |
|
|
=item delete_signature(LIST) |
410 |
|
|
|
411 |
|
|
Deletes the signature or signatures (list reference or string) from the |
412 |
|
|
internal tables. Quietly ignores any signature that does not exist. If the new |
413 |
|
|
signature would cause a conflict (a case in which the same set of input types |
414 |
|
|
are specified for different output types), the old set is restored and an |
415 |
|
|
error message is returned. |
416 |
|
|
|
417 |
|
|
=item match_signature(SIGNATURE) |
418 |
|
|
|
419 |
|
|
Check that the passed-in signature is known to the method, and if so returns |
420 |
|
|
the type that the method should be returning as a result of the call. Returns |
421 |
|
|
a zero (0) otherwise. This differs from other signature operations in that the |
422 |
|
|
passed-in signature (which may be a list-reference or a string) B<I<does not |
423 |
|
|
include the return type>>. This method is provided so that servers may check a |
424 |
|
|
list of arguments against type when marshalling an incoming call. For example, |
425 |
|
|
a signature of C<'int int'> would be tested for by calling |
426 |
|
|
C<$M-E<gt>match_signature('int')> and expecting the return value to be C<int>. |
427 |
|
|
|
428 |
|
|
=item call(SERVER, PARAMLIST) |
429 |
|
|
|
430 |
|
|
Execute the code that this object encapsulates, using the list of parameters |
431 |
|
|
passed in PARAMLIST. The SERVER argument should be an object derived from the |
432 |
|
|
B<RPC::XML::Server> class. For some types of procedure objects, this becomes |
433 |
|
|
the first argument of the parameter list to simulate a method call as if it |
434 |
|
|
were on the server object itself. The return value should be a data object |
435 |
|
|
(possible a B<RPC::XML::fault>), but may not always be pre-encoded. This |
436 |
|
|
method is generally used in the C<dispatch> and C<call> methods of the server |
437 |
|
|
class, where the return value is subsequently wrapped within a |
438 |
|
|
B<RPC::XML::response> object. |
439 |
|
|
|
440 |
|
|
=item reload |
441 |
|
|
|
442 |
|
|
Instruct the object to reload itself from the file it originally was loaded |
443 |
|
|
from, assuming that it was loaded from a file to begin with. Returns an error |
444 |
|
|
if the method was not originally loaded from a file, or if an error occurs |
445 |
|
|
during the reloading operation. |
446 |
|
|
|
447 |
|
|
=back |
448 |
|
|
|
449 |
|
|
=head2 Additional Hash Data |
450 |
|
|
|
451 |
|
|
In addition to the attributes managed by the accessors documented earlier, the |
452 |
|
|
following hash keys are also available for use. These are also not strongly |
453 |
|
|
protected, and the same care should be taken before altering any of them: |
454 |
|
|
|
455 |
|
|
=over 4 |
456 |
|
|
|
457 |
|
|
=item C<file> |
458 |
|
|
|
459 |
|
|
When the method was loaded from a file, this key contains the path to the file |
460 |
|
|
used. |
461 |
|
|
|
462 |
|
|
=item C<mtime> |
463 |
|
|
|
464 |
|
|
When the method was loaded from a file, this key contains the |
465 |
|
|
modification-time of the file, as a UNIX-style C<time> value. This is used to |
466 |
|
|
check for changes to the file the code was originally read from. |
467 |
|
|
|
468 |
|
|
=item C<called> |
469 |
|
|
|
470 |
|
|
When the method is being used by one of the server classes provided in this |
471 |
|
|
software suite, this key is incremented each time the server object dispatches |
472 |
|
|
a request to the method. This can later be checked to provide some indication |
473 |
|
|
of how frequently the method is being invoked. |
474 |
|
|
|
475 |
|
|
=back |
476 |
|
|
|
477 |
|
|
=head2 XPL File Structure |
478 |
|
|
|
479 |
|
|
This section focuses on the way in which methods are expressed in these files, |
480 |
|
|
referred to here as "XPL files" due to the C<*.xpl> filename extension |
481 |
|
|
(which stands for "XML Procedure Layout"). This mini-dialect, based on XML, |
482 |
|
|
is meant to provide a simple means of specifying method definitions separate |
483 |
|
|
from the code that comprises the application itself. Thus, methods may |
484 |
|
|
theoretically be added, removed, debugged or even changed entirely without |
485 |
|
|
requiring that the server application itself be rebuilt (or, possibly, without |
486 |
|
|
it even being restarted). |
487 |
|
|
|
488 |
|
|
=head3 The XPL file structure |
489 |
|
|
|
490 |
|
|
The B<XPL Procedure Layout> dialect is a very simple application of XML to the |
491 |
|
|
problem of expressing the method in such a way that it could be useful to |
492 |
|
|
other packages than this one, or useful in other contexts than this one. |
493 |
|
|
|
494 |
|
|
The lightweight DTD for the layout can be summarized as: |
495 |
|
|
|
496 |
|
|
<!ELEMENT proceduredef (name, version?, hidden?, signature+, |
497 |
|
|
help?, code)> |
498 |
|
|
<!ELEMENT methoddef (name, version?, hidden?, signature+, |
499 |
|
|
help?, code)> |
500 |
|
|
<!ELEMENT name (#PCDATA)> |
501 |
|
|
<!ELEMENT version (#PCDATA)> |
502 |
|
|
<!ELEMENT hidden EMPTY> |
503 |
|
|
<!ELEMENT signature (#PCDATA)> |
504 |
|
|
<!ELEMENT help (#PCDATA)> |
505 |
|
|
<!ELEMENT code (#PCDATA)> |
506 |
|
|
<!ATTLIST code language (#PCDATA)> |
507 |
|
|
|
508 |
|
|
The containing tag is always one of C<E<lt>methoddefE<gt>> or |
509 |
|
|
C<E<lt>proceduredefE<gt>>. The tags that specify name, signatures and the code |
510 |
|
|
itself must always be present. Some optional information may also be |
511 |
|
|
supplied. The "help" text, or what an introspection API would expect to use to |
512 |
|
|
document the method, is also marked as optional. Having some degree of |
513 |
|
|
documentation for all the methods a server provides is a good rule of thumb, |
514 |
|
|
however. |
515 |
|
|
|
516 |
|
|
The default methods that this package provides are turned into XPL files by |
517 |
|
|
the B<make_method> tool (see L<make_method>). The final forms of these may |
518 |
|
|
serve as direct examples of what the file should look like. |
519 |
|
|
|
520 |
|
|
=head3 Information used only for book-keeping |
521 |
|
|
|
522 |
|
|
Some of the information in the XPL file is only for book-keeping: the version |
523 |
|
|
stamp of a method is never involved in the invocation. The server also keeps |
524 |
|
|
track of the last-modified time of the file the method is read from, as well |
525 |
|
|
as the full directory path to that file. The C<E<lt>hidden /E<gt>> tag is used |
526 |
|
|
to identify those methods that should not be exposed to the outside world |
527 |
|
|
through any sort of introspection/documentation API. They are still available |
528 |
|
|
and callable, but the client must possess the interface information in order |
529 |
|
|
to do so. |
530 |
|
|
|
531 |
|
|
=head3 The information crucial to the method |
532 |
|
|
|
533 |
|
|
The name, signatures and code must be present for obvious reasons. The |
534 |
|
|
C<E<lt>nameE<gt>> tag tells the server what external name this procedure is |
535 |
|
|
known by. The C<E<lt>signatureE<gt>> tag, which may appear more than once, |
536 |
|
|
provides the definition of the interface to the function in terms of what |
537 |
|
|
types and quantity of arguments it will accept, and for a given set of |
538 |
|
|
arguments what the type of the returned value is. Lastly is the |
539 |
|
|
C<E<lt>codeE<gt>> tag, without which there is no procedure to remotely call. |
540 |
|
|
|
541 |
|
|
=head3 Why the <code> tag allows multiple languages |
542 |
|
|
|
543 |
|
|
Note that the C<E<lt>codeE<gt>> tag is the only one with an attribute, in this |
544 |
|
|
case "language". This is designed to allow for one XPL file to provide a given |
545 |
|
|
method in multiple languages. Why, one might ask, would there be a need for |
546 |
|
|
this? |
547 |
|
|
|
548 |
|
|
It is the hope behind this package that collections of RPC suites may one day |
549 |
|
|
be made available as separate entities from this specific software package. |
550 |
|
|
Given this hope, it is not unreasonable to suggest that such a suite of code |
551 |
|
|
might be implemented in more than one language (each of Perl, Python, Ruby and |
552 |
|
|
Tcl, for example). Languages which all support the means by which to take new |
553 |
|
|
code and add it to a running process on demand (usually through an "C<eval>" |
554 |
|
|
keyword or something similar). If the file F<A.xpl> is provided with |
555 |
|
|
implementations in all four of the above languages, the name, help text, |
556 |
|
|
signature and even hidden status would likely be identical. So, why not share |
557 |
|
|
the non-language-specific elements in the spirit of re-use? |
558 |
|
|
|
559 |
|
|
=head3 The "make_method" utility |
560 |
|
|
|
561 |
|
|
The utility script C<make_method> is provided as a part of this software |
562 |
|
|
suite. It allows for the automatic creation of XPL files from either |
563 |
|
|
command-line information or from template files. It has a wide variety of |
564 |
|
|
features and options, and is out of the scope of this particular manual |
565 |
|
|
page. The package F<Makefile.PL> features an example of engineering the |
566 |
|
|
automatic generation of XPL files and their delivery as a part of the normal |
567 |
|
|
Perl module build process. Using this tool is highly recommended over managing |
568 |
|
|
XPL files directly. For the full details, see L<make_method>. |
569 |
|
|
|
570 |
|
|
=head1 DIAGNOSTICS |
571 |
|
|
|
572 |
|
|
Unless otherwise noted in the individual documentation sections, all methods |
573 |
|
|
return the object reference on success, or a (non-reference) text string |
574 |
|
|
containing the error message upon failure. |
575 |
|
|
|
576 |
|
|
=head1 CAVEATS |
577 |
|
|
|
578 |
|
|
Moving the method management to a separate class adds a good deal of overhead |
579 |
|
|
to the general system. The trade-off in reduced complexity and added |
580 |
|
|
maintainability should offset this. |
581 |
|
|
|
582 |
|
|
=head1 LICENSE |
583 |
|
|
|
584 |
|
|
This module is licensed under the terms of the Artistic License that covers |
585 |
|
|
Perl. See <http://language.perl.com/misc/Artistic.html> for the |
586 |
|
|
license. |
587 |
|
|
|
588 |
|
|
=head1 SEE ALSO |
589 |
|
|
|
590 |
|
|
L<RPC::XML::Server>, L<make_method> |
591 |
|
|
|
592 |
|
|
=head1 AUTHOR |
593 |
|
|
|
594 |
|
|
Randy J. Ray <rjray@blackperl.com> |
595 |
|
|
|
596 |
|
|
=cut |
597 |
|
|
|
598 |
|
|
__END__ |
599 |
|
|
|
600 |
|
|
############################################################################### |
601 |
|
|
# |
602 |
|
|
# Sub Name: clone |
603 |
|
|
# |
604 |
|
|
# Description: Create a near-exact copy of the invoking object, save that |
605 |
|
|
# the listref in the "signature" key is a copy, not a ref |
606 |
|
|
# to the same list. |
607 |
|
|
# |
608 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
609 |
|
|
# $self in ref Object of this class |
610 |
|
|
# |
611 |
|
|
# Returns: Success: $new_self |
612 |
|
|
# Failure: error message |
613 |
|
|
# |
614 |
|
|
############################################################################### |
615 |
|
|
sub clone |
616 |
|
|
{ |
617 |
|
|
my $self = shift; |
618 |
|
|
|
619 |
|
|
my $new_self = {}; |
620 |
|
|
for (keys %$self) |
621 |
|
|
{ |
622 |
|
|
next if $_ eq 'signature'; |
623 |
|
|
$new_self->{$_} = $self->{$_}; |
624 |
|
|
} |
625 |
|
|
$new_self->{signature} = []; |
626 |
|
|
@{$new_self->{signature}} = @{$self->{signature}}; |
627 |
|
|
|
628 |
|
|
bless $new_self, ref($self); |
629 |
|
|
} |
630 |
|
|
|
631 |
|
|
############################################################################### |
632 |
|
|
# |
633 |
|
|
# Sub Name: is_valid |
634 |
|
|
# |
635 |
|
|
# Description: Boolean test to tell if the calling object has sufficient |
636 |
|
|
# data to be used as a server method for RPC::XML::Server or |
637 |
|
|
# Apache::RPC::Server. |
638 |
|
|
# |
639 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
640 |
|
|
# $self in ref Object to test |
641 |
|
|
# |
642 |
|
|
# Returns: Success: 1, valid/complete |
643 |
|
|
# Failure: 0, invalid/incomplete |
644 |
|
|
# |
645 |
|
|
############################################################################### |
646 |
|
|
sub is_valid |
647 |
|
|
{ |
648 |
|
|
my $self = shift; |
649 |
|
|
|
650 |
|
|
return ((ref($self->{code}) eq 'CODE') and $self->{name} and |
651 |
|
|
(ref($self->{signature}) && scalar(@{$self->{signature}}))); |
652 |
|
|
} |
653 |
|
|
|
654 |
|
|
############################################################################### |
655 |
|
|
# |
656 |
|
|
# Sub Name: add_signature |
657 |
|
|
# delete_signature |
658 |
|
|
# |
659 |
|
|
# Description: This pair of functions may be used to add and remove |
660 |
|
|
# signatures from a method-object. |
661 |
|
|
# |
662 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
663 |
|
|
# $self in ref Object of this class |
664 |
|
|
# @args in list One or more signatures |
665 |
|
|
# |
666 |
|
|
# Returns: Success: $self |
667 |
|
|
# Failure: error string |
668 |
|
|
# |
669 |
|
|
############################################################################### |
670 |
|
|
sub add_signature |
671 |
|
|
{ |
672 |
|
|
my $self = shift; |
673 |
|
|
my @args = @_; |
674 |
|
|
|
675 |
|
|
my (%sigs, $one_sig, $tmp, $old); |
676 |
|
|
|
677 |
|
|
# Preserve the original in case adding the new one causes a problem |
678 |
|
|
$old = $self->{signature}; |
679 |
|
|
%sigs = map { $_ => 1 } @{$self->{signature}}; |
680 |
|
|
for $one_sig (@args) |
681 |
|
|
{ |
682 |
|
|
$tmp = (ref $one_sig) ? join(' ', @$one_sig) : $one_sig; |
683 |
|
|
$sigs{$tmp} = 1; |
684 |
|
|
} |
685 |
|
|
$self->{signature} = [ keys %sigs ]; |
686 |
|
|
unless (ref($tmp = $self->make_sig_table)) |
687 |
|
|
{ |
688 |
|
|
# Because this failed, we have to restore the old table and return |
689 |
|
|
# an error |
690 |
|
|
$self->{signature} = $old; |
691 |
|
|
$self->make_sig_table; |
692 |
|
|
return ref($self) . '::add_signature: Error re-hashing table: ' . |
693 |
|
|
$tmp; |
694 |
|
|
} |
695 |
|
|
|
696 |
|
|
$self; |
697 |
|
|
} |
698 |
|
|
|
699 |
|
|
sub delete_signature |
700 |
|
|
{ |
701 |
|
|
my $self = shift; |
702 |
|
|
my @args = @_; |
703 |
|
|
|
704 |
|
|
my (%sigs, $one_sig, $tmp, $old); |
705 |
|
|
|
706 |
|
|
# Preserve the original in case adding the new one causes a problem |
707 |
|
|
$old = $self->{signature}; |
708 |
|
|
%sigs = map { $_ => 1 } @{$self->{signature}}; |
709 |
|
|
for $one_sig (@args) |
710 |
|
|
{ |
711 |
|
|
$tmp = (ref $one_sig) ? join(' ', @$one_sig) : $one_sig; |
712 |
|
|
delete $sigs{$tmp}; |
713 |
|
|
} |
714 |
|
|
$self->{signature} = [ keys %sigs ]; |
715 |
|
|
unless (ref($tmp = $self->make_sig_table)) |
716 |
|
|
{ |
717 |
|
|
# Because this failed, we have to restore the old table and return |
718 |
|
|
# an error |
719 |
|
|
$self->{signature} = $old; |
720 |
|
|
$self->make_sig_table; |
721 |
|
|
return ref($self) . '::delete_signature: Error re-hashing table: ' . |
722 |
|
|
$tmp; |
723 |
|
|
} |
724 |
|
|
|
725 |
|
|
$self; |
726 |
|
|
} |
727 |
|
|
|
728 |
|
|
############################################################################### |
729 |
|
|
# |
730 |
|
|
# Sub Name: match_signature |
731 |
|
|
# |
732 |
|
|
# Description: Determine if the passed-in signature string matches any |
733 |
|
|
# of this method's known signatures. |
734 |
|
|
# |
735 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
736 |
|
|
# $self in ref Object of this class |
737 |
|
|
# $sig in scalar Signature to check for |
738 |
|
|
# |
739 |
|
|
# Returns: Success: return type as a string |
740 |
|
|
# Failure: 0 |
741 |
|
|
# |
742 |
|
|
############################################################################### |
743 |
|
|
sub match_signature |
744 |
|
|
{ |
745 |
|
|
my $self = shift; |
746 |
|
|
my $sig = shift; |
747 |
|
|
|
748 |
|
|
$sig = join(' ', @$sig) if ref $sig; |
749 |
|
|
|
750 |
|
|
return $self->{sig_table}->{$sig} || 0; |
751 |
|
|
} |
752 |
|
|
|
753 |
|
|
############################################################################### |
754 |
|
|
# |
755 |
|
|
# Sub Name: reload |
756 |
|
|
# |
757 |
|
|
# Description: Reload the method's code and ancillary data from the file |
758 |
|
|
# |
759 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
760 |
|
|
# $self in ref Object of this class |
761 |
|
|
# |
762 |
|
|
# Returns: Success: $self |
763 |
|
|
# Failure: error message |
764 |
|
|
# |
765 |
|
|
############################################################################### |
766 |
|
|
sub reload |
767 |
|
|
{ |
768 |
|
|
my $self = shift; |
769 |
|
|
|
770 |
|
|
return ref($self) . '::reload: No file associated with method ' . |
771 |
|
|
$self->{name} unless $self->{file}; |
772 |
|
|
my $tmp = $self->load_XPL_file($self->{file}); |
773 |
|
|
|
774 |
|
|
# Re-calculate the signature table, in case that changed as well |
775 |
|
|
return (ref $tmp) ? $self->make_sig_table : $tmp; |
776 |
|
|
} |
777 |
|
|
|
778 |
|
|
############################################################################### |
779 |
|
|
# |
780 |
|
|
# Sub Name: load_XPL_file |
781 |
|
|
# |
782 |
|
|
# Description: Load a XML-encoded method description (generally denoted |
783 |
|
|
# by a *.xpl suffix) and return the relevant information. |
784 |
|
|
# |
785 |
|
|
# Note that this does not fill in $self if $self is a hash |
786 |
|
|
# or object reference. This routine is not a substitute for |
787 |
|
|
# calling new() (which is why it isn't part of the public |
788 |
|
|
# API). |
789 |
|
|
# |
790 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
791 |
|
|
# $self in ref Object of this class |
792 |
|
|
# $file in scalar File to load |
793 |
|
|
# |
794 |
|
|
# Returns: Success: hashref of values |
795 |
|
|
# Failure: error string |
796 |
|
|
# |
797 |
|
|
############################################################################### |
798 |
|
|
sub load_XPL_file |
799 |
|
|
{ |
800 |
|
|
my $self = shift; |
801 |
|
|
my $file = shift; |
802 |
|
|
|
803 |
|
|
require XML::Parser; |
804 |
|
|
|
805 |
|
|
my ($me, $pkg, $data, $signature, $code, $codetext, $accum, $P, %attr); |
806 |
|
|
local *F; |
807 |
|
|
|
808 |
|
|
if (ref($self) eq 'SCALAR') |
809 |
|
|
{ |
810 |
|
|
$me = __PACKAGE__ . '::load_XPL_file'; |
811 |
|
|
} |
812 |
|
|
else |
813 |
|
|
{ |
814 |
|
|
$me = (ref $self) || $self || __PACKAGE__; |
815 |
|
|
$me .= '::load_XPL_file'; |
816 |
|
|
} |
817 |
|
|
$data = {}; |
818 |
|
|
# So these don't end up undef, since they're optional elements |
819 |
|
|
$data->{hidden} = 0; $data->{version} = ''; $data->{help} = ''; |
820 |
|
|
$data->{called} = 0; |
821 |
|
|
open(F, "< $file"); |
822 |
|
|
return "$me: Error opening $file for reading: $!" if ($?); |
823 |
|
|
$P = XML::Parser |
824 |
|
|
->new(Handlers => {Char => sub { $accum .= $_[1] }, |
825 |
|
|
Start => sub { %attr = splice(@_, 2) }, |
826 |
|
|
End => |
827 |
|
|
sub { |
828 |
|
|
my $elem = $_[1]; |
829 |
|
|
|
830 |
|
|
$accum =~ s/^[\s\n]+//; |
831 |
|
|
$accum =~ s/[\s\n]+$//; |
832 |
|
|
if ($elem eq 'signature') |
833 |
|
|
{ |
834 |
|
|
$data->{signature} ||= []; |
835 |
|
|
push(@{$data->{signature}}, $accum); |
836 |
|
|
} |
837 |
|
|
elsif ($elem eq 'code') |
838 |
|
|
{ |
839 |
|
|
$data->{$elem} = $accum |
840 |
|
|
unless ($attr{language} and |
841 |
|
|
$attr{language} ne 'perl'); |
842 |
|
|
} |
843 |
|
|
elsif (substr($elem, -3) eq 'def') |
844 |
|
|
{ |
845 |
|
|
# Don't blindly store the container tag... |
846 |
|
|
# We may need it to tell the caller what |
847 |
|
|
# our type is |
848 |
|
|
$$self = ucfirst substr($elem, 0, -3) |
849 |
|
|
if (ref($self) eq 'SCALAR'); |
850 |
|
|
} |
851 |
|
|
else |
852 |
|
|
{ |
853 |
|
|
$data->{$elem} = $accum; |
854 |
|
|
} |
855 |
|
|
|
856 |
|
|
%attr = (); |
857 |
|
|
$accum = ''; |
858 |
|
|
}}); |
859 |
|
|
return "$me: Error creating XML::Parser object" unless $P; |
860 |
|
|
# Trap any errors |
861 |
|
|
eval { $P->parse(*F) }; |
862 |
|
|
return "$me: Error parsing $file: $@" if $@; |
863 |
|
|
|
864 |
|
|
# Try to normalize $codetext before passing it to eval |
865 |
|
|
my $class = __PACKAGE__; # token won't expand in the s/// below |
866 |
|
|
($codetext = $data->{code}) =~ |
867 |
|
|
s/sub[\s\n]+([\w:]+)?[\s\n]*\{/sub \{ package $class; /; |
868 |
|
|
$code = eval $codetext; |
869 |
|
|
return "$me: Error creating anonymous sub: $@" if $@; |
870 |
|
|
|
871 |
|
|
$data->{code} = $code; |
872 |
|
|
# Add the file's mtime for when we check for stat-based reloading |
873 |
|
|
$data->{mtime} = (stat $file)[9]; |
874 |
|
|
$data->{file} = $file; |
875 |
|
|
|
876 |
|
|
$data; |
877 |
|
|
} |
878 |
|
|
|
879 |
|
|
############################################################################### |
880 |
|
|
# |
881 |
|
|
# Sub Name: call |
882 |
|
|
# |
883 |
|
|
# Description: Encapsulates the invocation of the code block that the |
884 |
|
|
# object is abstracting. Manages parameters, signature |
885 |
|
|
# checking, etc. |
886 |
|
|
# |
887 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
888 |
|
|
# $self in ref Object of this class |
889 |
|
|
# $srv in ref An object derived from the |
890 |
|
|
# RPC::XML::Server class |
891 |
|
|
# @dafa in list The params for the call itself |
892 |
|
|
# |
893 |
|
|
# Globals: None. |
894 |
|
|
# |
895 |
|
|
# Environment: None. |
896 |
|
|
# |
897 |
|
|
# Returns: Success: value |
898 |
|
|
# Failure: dies with RPC::XML::Fault object as message |
899 |
|
|
# |
900 |
|
|
############################################################################### |
901 |
|
|
sub call |
902 |
|
|
{ |
903 |
|
|
my ($self, $srv, @data) = @_; |
904 |
|
|
|
905 |
|
|
my (@paramtypes, @params, $signature, $resptype, $response, $name); |
906 |
|
|
|
907 |
|
|
$name = $self->name; |
908 |
|
|
# Create the param list. |
909 |
|
|
# The type for the response will be derived from the matching signature |
910 |
|
|
@paramtypes = map { $_->type } @data; |
911 |
|
|
@params = map { $_->value } @data; |
912 |
|
|
$signature = join(' ', @paramtypes); |
913 |
|
|
$resptype = $self->match_signature($signature); |
914 |
|
|
# Since there must be at least one signature with a return value (even |
915 |
|
|
# if the param list is empty), this tells us if the signature matches: |
916 |
|
|
return RPC::XML::fault->new(301, |
917 |
|
|
"method $name nas no matching " . |
918 |
|
|
'signature for the argument list') |
919 |
|
|
unless ($resptype); |
920 |
|
|
|
921 |
|
|
# Set these in case the server object is part of the param list |
922 |
|
|
local $srv->{signature} = [ $resptype, @paramtypes ]; |
923 |
|
|
local $srv->{method_name} = $name; |
924 |
|
|
# For RPC::XML::Method (and derivatives), pass the server object |
925 |
|
|
if ($self->isa('RPC::XML::Method')) |
926 |
|
|
{ |
927 |
|
|
unshift(@params, $srv); |
928 |
|
|
} |
929 |
|
|
|
930 |
|
|
# Now take a deep breath and call the method with the arguments |
931 |
|
|
eval { $response = $self->{code}->(@params); }; |
932 |
|
|
# Report a Perl-level error/failure if it occurs |
933 |
|
|
return RPC::XML::fault->new(302, "Method $name returned error: $@") if $@; |
934 |
|
|
|
935 |
|
|
$self->{called}++; |
936 |
|
|
# Create a suitable return value |
937 |
|
|
if ((! ref($response)) && UNIVERSAL::can("RPC::XML::$resptype", 'new')) |
938 |
|
|
{ |
939 |
|
|
my $class = "RPC::XML::$resptype"; |
940 |
|
|
$response = $class->new($response); |
941 |
|
|
} |
942 |
|
|
|
943 |
|
|
$response; |
944 |
|
|
} |