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 |
} |