1 |
cvsjoko |
1.1 |
############################################################################### |
2 |
|
|
# |
3 |
|
|
# This file copyright (c) 2002 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: Function.pm,v 1.1 2002/05/03 21:31:33 rjray Exp $ |
12 |
|
|
# |
13 |
|
|
# Description: This is a type of Procedure that does no signature tests |
14 |
|
|
# at either creation or invocation. |
15 |
|
|
# |
16 |
|
|
# Functions: new (superclass new expects signatures) |
17 |
|
|
# signature |
18 |
|
|
# make_sig_table (called by some superclass methods) |
19 |
|
|
# clone |
20 |
|
|
# is_valid |
21 |
|
|
# match_signature |
22 |
|
|
# |
23 |
|
|
# Libraries: RPC::XML::Procedure (base class) |
24 |
|
|
# |
25 |
|
|
# Global Consts: $VERSION |
26 |
|
|
# |
27 |
|
|
# Environment: None |
28 |
|
|
# |
29 |
|
|
############################################################################### |
30 |
|
|
|
31 |
|
|
package RPC::XML::Function; |
32 |
|
|
|
33 |
|
|
use 5.005; |
34 |
|
|
use strict; |
35 |
|
|
use vars qw($VERSION @ISA); |
36 |
|
|
use subs qw(new signature make_sig_table clone is_valid match_signature); |
37 |
|
|
|
38 |
|
|
use AutoLoader 'AUTOLOAD'; |
39 |
|
|
|
40 |
|
|
require RPC::XML::Procedure; |
41 |
|
|
|
42 |
|
|
@ISA = qw(RPC::XML::Procedure); |
43 |
|
|
$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; |
44 |
|
|
|
45 |
|
|
1; |
46 |
|
|
|
47 |
|
|
############################################################################### |
48 |
|
|
# |
49 |
|
|
# Sub Name: new |
50 |
|
|
# |
51 |
|
|
# Description: Create a new object of this class, storing the info on |
52 |
|
|
# regular keys (no obfuscation used here). |
53 |
|
|
# |
54 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
55 |
|
|
# $class in scalar Class to bless into |
56 |
|
|
# @argz in variable Disposition is variable; see |
57 |
|
|
# below |
58 |
|
|
# |
59 |
|
|
# Returns: Success: object ref |
60 |
|
|
# Failure: error string |
61 |
|
|
# |
62 |
|
|
############################################################################### |
63 |
|
|
sub new |
64 |
|
|
{ |
65 |
|
|
# |
66 |
|
|
# This is largely a verbatim-copy of RPC::XML::Procedure::new. I plan on |
67 |
|
|
# going back and coming up with a way for this class to be able to use |
68 |
|
|
# the super-class new, but this is sufficient for now. |
69 |
|
|
# |
70 |
|
|
|
71 |
|
|
my $class = shift; |
72 |
|
|
my @argz = @_; |
73 |
|
|
|
74 |
|
|
my $data; # This will be a hashref that eventually gets blessed |
75 |
|
|
|
76 |
|
|
$class = ref($class) || $class; |
77 |
|
|
|
78 |
|
|
# |
79 |
|
|
# There are three things that @argz could be: |
80 |
|
|
# |
81 |
|
|
if (ref $argz[0]) |
82 |
|
|
{ |
83 |
|
|
# 1. A hashref containing all the relevant keys |
84 |
|
|
$data = {}; |
85 |
|
|
%$data = %{$argz[0]}; |
86 |
|
|
} |
87 |
|
|
elsif (@argz == 1) |
88 |
|
|
{ |
89 |
|
|
# 2. Exactly one non-ref element, a file to load |
90 |
|
|
|
91 |
|
|
# And here is where I cheat in a way that makes even me uncomfortable. |
92 |
|
|
# |
93 |
|
|
# Loading code from an XPL file, it can actually be of a type other |
94 |
|
|
# than how this constructor was called. So what we are going to do is |
95 |
|
|
# this: If $class is undef, that can only mean that we were called |
96 |
|
|
# with the intent of letting the XPL file dictate the resulting object. |
97 |
|
|
# If $class is set, then we'll call load_XPL_file normally, as a |
98 |
|
|
# method, to allow for subclasses to tweak things. |
99 |
|
|
if (defined $class) |
100 |
|
|
{ |
101 |
|
|
$data = $class->load_XPL_file($argz[0]); |
102 |
|
|
return $data unless ref $data; # load_XPL_path signalled an error |
103 |
|
|
} |
104 |
|
|
else |
105 |
|
|
{ |
106 |
|
|
# Spoofing the "class" argument to load_XPL_file makes me feel |
107 |
|
|
# even dirtier... |
108 |
|
|
$data = load_XPL_file(\$class, $argz[0]); |
109 |
|
|
return $data unless ref $data; # load_XPL_path signalled an error |
110 |
|
|
$class = "RPC::XML::$class"; |
111 |
|
|
} |
112 |
|
|
} |
113 |
|
|
else |
114 |
|
|
{ |
115 |
|
|
# 3. If there is more than one arg, it's a sort-of-hash. That is, the |
116 |
|
|
# key 'signature' is allowed to repeat. (But this class ignores it) |
117 |
|
|
my ($key, $val); |
118 |
|
|
$data = {}; |
119 |
|
|
while (@argz) |
120 |
|
|
{ |
121 |
|
|
($key, $val) = splice(@argz, 0, 2); |
122 |
|
|
if ($key eq 'signature') |
123 |
|
|
{ |
124 |
|
|
# Noop |
125 |
|
|
next; |
126 |
|
|
} |
127 |
|
|
elsif (exists $data->{$key}) |
128 |
|
|
{ |
129 |
|
|
return "${class}::new: Key '$key' may not be repeated"; |
130 |
|
|
} |
131 |
|
|
else |
132 |
|
|
{ |
133 |
|
|
$data->{$key} = $val; |
134 |
|
|
} |
135 |
|
|
} |
136 |
|
|
} |
137 |
|
|
|
138 |
|
|
return "${class}::new: Missing required data" |
139 |
|
|
unless ($data->{name} and $data->{code}); |
140 |
|
|
bless $data, $class; |
141 |
|
|
} |
142 |
|
|
|
143 |
|
|
# |
144 |
|
|
# These two are only implemented here at all, because some of the logic in |
145 |
|
|
# other places call them |
146 |
|
|
# |
147 |
|
|
sub signature { undef; } |
148 |
|
|
sub make_sig_table { $_[0]; } |
149 |
|
|
|
150 |
|
|
=pod |
151 |
|
|
|
152 |
|
|
=head1 NAME |
153 |
|
|
|
154 |
|
|
RPC::XML::Function - Object class for RPC routines that do not check signatures |
155 |
|
|
|
156 |
|
|
=head1 SYNOPSIS |
157 |
|
|
|
158 |
|
|
require RPC::XML::Function; |
159 |
|
|
|
160 |
|
|
... |
161 |
|
|
$method_1 = RPC::XML::Function->new(name => 'system.identity', |
162 |
|
|
code => sub { ... }); |
163 |
|
|
$method_2 = RPC::XML::Function->new('/path/to/status.xpl'); |
164 |
|
|
|
165 |
|
|
=head1 DESCRIPTION |
166 |
|
|
|
167 |
|
|
The B<RPC::XML::Function> is a class that derives from B<RPC::XML::Procedure> |
168 |
|
|
(see L<RPC::XML::Procedure>), while bypassing all the signature-specific logic |
169 |
|
|
associated with server-side methods in the B<RPC::XML> suite. |
170 |
|
|
|
171 |
|
|
By doing this, the encapsulated code becomes responsible for how the server |
172 |
|
|
(and ultimately, the client) interprets returned values. For the classes that |
173 |
|
|
adhere to signatures, the signature includes the expected type of the returned |
174 |
|
|
value. If an object of this class anticipates that the data may be ambiguous |
175 |
|
|
(an intended string being interpreted as an integer, for example), the code |
176 |
|
|
it encapsulates should consider encoding the response with the data-classes |
177 |
|
|
documented in L<RPC::XML> prior to return. |
178 |
|
|
|
179 |
|
|
=head1 USAGE |
180 |
|
|
|
181 |
|
|
Only those routines different from B<RPC::XML::Procedure> are listed: |
182 |
|
|
|
183 |
|
|
=over 4 |
184 |
|
|
|
185 |
|
|
=item new(LIST) |
186 |
|
|
|
187 |
|
|
The constructor for this class is identical to the super-class versions, |
188 |
|
|
except that it disregards any C<signature> keys on the input list. The |
189 |
|
|
return value upon success is a newly-blessed object reference, otherwise |
190 |
|
|
an error message is returned. |
191 |
|
|
|
192 |
|
|
=item signature |
193 |
|
|
|
194 |
|
|
Returns C<undef> only. |
195 |
|
|
|
196 |
|
|
=item make_sig_table |
197 |
|
|
|
198 |
|
|
This method does nothing, though in keeping with the interface from the |
199 |
|
|
parent class, it returns the object reference to permit chaining methods |
200 |
|
|
together. |
201 |
|
|
|
202 |
|
|
=item clone |
203 |
|
|
|
204 |
|
|
Acts as the parent C<clone> method, save that in the absence of any signature |
205 |
|
|
data, the clone is in fact a perfect copy of the original. |
206 |
|
|
|
207 |
|
|
=item is_valid |
208 |
|
|
|
209 |
|
|
Uses the same validity test, minus the checking of signature data (tests only |
210 |
|
|
for valid C<name> and C<code> keys). |
211 |
|
|
|
212 |
|
|
=item match_signature |
213 |
|
|
|
214 |
|
|
Always returns the string, C<scalar>. |
215 |
|
|
|
216 |
|
|
=back |
217 |
|
|
|
218 |
|
|
=head1 DIAGNOSTICS |
219 |
|
|
|
220 |
|
|
Unless otherwises specified, routines return the object reference itself upon |
221 |
|
|
a successful operation, and an error string (which is not a blessed reference) |
222 |
|
|
upon error. |
223 |
|
|
|
224 |
|
|
=head1 SEE ALSO |
225 |
|
|
|
226 |
|
|
L<RPC::XML>, L<RPC::XML::Procedure>, L<make_method> |
227 |
|
|
|
228 |
|
|
=head1 AUTHOR |
229 |
|
|
|
230 |
|
|
Randy J. Ray <rjray@blackperl.com> |
231 |
|
|
|
232 |
|
|
=cut |
233 |
|
|
|
234 |
|
|
__END__ |
235 |
|
|
|
236 |
|
|
# |
237 |
|
|
# These are the same as RPC::XML::Procedure subs, except that they have no |
238 |
|
|
# references to signatures. |
239 |
|
|
# |
240 |
|
|
############################################################################### |
241 |
|
|
# |
242 |
|
|
# Sub Name: clone |
243 |
|
|
# |
244 |
|
|
# Description: Create a copy of the invoking object. |
245 |
|
|
# |
246 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
247 |
|
|
# $self in ref Object of this class |
248 |
|
|
# |
249 |
|
|
# Returns: Success: $new_self |
250 |
|
|
# Failure: error message |
251 |
|
|
# |
252 |
|
|
############################################################################### |
253 |
|
|
sub clone |
254 |
|
|
{ |
255 |
|
|
my $self = shift; |
256 |
|
|
|
257 |
|
|
my $new_self = {}; |
258 |
|
|
%$new_self = %$self; |
259 |
|
|
|
260 |
|
|
bless $new_self, ref($self); |
261 |
|
|
} |
262 |
|
|
|
263 |
|
|
############################################################################### |
264 |
|
|
# |
265 |
|
|
# Sub Name: is_valid |
266 |
|
|
# |
267 |
|
|
# Description: Boolean test to tell if the calling object has sufficient |
268 |
|
|
# data to be used as a server method for RPC::XML::Server or |
269 |
|
|
# Apache::RPC::Server. |
270 |
|
|
# |
271 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
272 |
|
|
# $self in ref Object to test |
273 |
|
|
# |
274 |
|
|
# Returns: Success: 1, valid/complete |
275 |
|
|
# Failure: 0, invalid/incomplete |
276 |
|
|
# |
277 |
|
|
############################################################################### |
278 |
|
|
sub is_valid |
279 |
|
|
{ |
280 |
|
|
my $self = shift; |
281 |
|
|
|
282 |
|
|
return ((ref($self->{code}) eq 'CODE') and $self->{name}); |
283 |
|
|
} |
284 |
|
|
|
285 |
|
|
############################################################################### |
286 |
|
|
# |
287 |
|
|
# Sub Name: match_signature |
288 |
|
|
# |
289 |
|
|
# Description: Noop. Needed for RPC::XML::Server. |
290 |
|
|
# |
291 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
292 |
|
|
# $self in ref Object of this class |
293 |
|
|
# $sig in scalar Signature to check for |
294 |
|
|
# |
295 |
|
|
# Returns: Success: return type as a string |
296 |
|
|
# Failure: 0 |
297 |
|
|
# |
298 |
|
|
############################################################################### |
299 |
|
|
sub match_signature |
300 |
|
|
{ |
301 |
|
|
'scalar'; |
302 |
|
|
} |