1 |
############################################################################### |
2 |
# |
3 |
# This file copyright (c) 2001 by Randy J. Ray <rjray@blackperl.com>, |
4 |
# all rights reserved |
5 |
# |
6 |
# Copying and distribution are permitted under the terms of the Artistic |
7 |
# License as distributed with Perl versions 5.005 and later. See |
8 |
# http://language.perl.com/misc/Artistic.html |
9 |
# |
10 |
############################################################################### |
11 |
# |
12 |
# $Id: XML.pm,v 1.13 2002/05/22 09:43:49 rjray Exp $ |
13 |
# |
14 |
# Description: This module provides the core XML <-> RPC conversion and |
15 |
# structural management. |
16 |
# |
17 |
# Functions: This module contains many, many subclasses. Better to |
18 |
# examine them individually. |
19 |
# |
20 |
# Libraries: RPC::XML::base64 uses MIME::Base64 |
21 |
# |
22 |
# Global Consts: $VERSION |
23 |
# |
24 |
############################################################################### |
25 |
|
26 |
package RPC::XML; |
27 |
|
28 |
use 5.005; |
29 |
use strict; |
30 |
use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS @ISA $VERSION $ERROR); |
31 |
use subs qw(time2iso8601 smart_encode); |
32 |
|
33 |
require Exporter; |
34 |
|
35 |
@ISA = qw(Exporter); |
36 |
@EXPORT_OK = qw(time2iso8601 smart_encode |
37 |
RPC_BOOLEAN RPC_INT RPC_DOUBLE RPC_NIL RPC_DATETIME_ISO8601 |
38 |
RPC_DATETIME_INT RPC_BASE64 RPC_REFERENCE RPC_STRING); |
39 |
%EXPORT_TAGS = (types => [ qw(RPC_BOOLEAN RPC_INT RPC_DOUBLE RPC_STRING |
40 |
RPC_DATETIME_ISO8601 RPC_BASE64) ], |
41 |
all => [ @EXPORT_OK ]); |
42 |
|
43 |
$VERSION = do { my @r=(q$Revision: 1.13 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; |
44 |
|
45 |
# Global error string |
46 |
$ERROR = ''; |
47 |
|
48 |
1; |
49 |
|
50 |
# All of the RPC_* functions are convenience-encoders |
51 |
sub RPC_STRING ( $ ) { RPC::XML::string->new($_[0]) } |
52 |
sub RPC_BOOLEAN ( $ ) { RPC::XML::boolean->new($_[0]) } |
53 |
sub RPC_INT ( $ ) { RPC::XML::int->new($_[0]) } |
54 |
sub RPC_DOUBLE ( $ ) { RPC::XML::double->new($_[0]) } |
55 |
sub RPC_DATETIME_ISO8601 ( $ ) { RPC::XML::datetime_iso8601->new($_[0]) } |
56 |
sub RPC_BASE64 ( $ ) { RPC::XML::base64->new($_[0]) } |
57 |
|
58 |
# This is a dead-simple ISO8601-from-UNIX-time stringifier. Always expresses |
59 |
# time in UTC. |
60 |
sub time2iso8601 |
61 |
{ |
62 |
my $time = shift; |
63 |
my $zone = shift || ''; |
64 |
|
65 |
my @time = gmtime($time); |
66 |
$time = sprintf("%4d%02d%02dT%02d:%02d:%02dZ", |
67 |
$time[5] + 1900, $time[4] + 1, @time[3, 2, 1, 0]); |
68 |
if ($zone) |
69 |
{ |
70 |
my $char = $zone > 0 ? '+' : '-'; |
71 |
chop $time; # Lose the Z if we're specifying a zone |
72 |
$time .= $char . sprintf('%02d:00', abs($zone)); |
73 |
} |
74 |
|
75 |
$time; |
76 |
} |
77 |
|
78 |
# This is a (futile?) attempt to provide a "smart" encoding method that will |
79 |
# take a Perl scalar and promote it to the appropriate RPC::XML::_type_. |
80 |
sub smart_encode |
81 |
{ |
82 |
my @values = @_; |
83 |
|
84 |
my $type; |
85 |
|
86 |
@values = map |
87 |
{ |
88 |
if ($type = ref($_)) |
89 |
{ |
90 |
# Skip any that have already been encoded |
91 |
if (UNIVERSAL::isa($_, 'RPC::XML::datatype')) |
92 |
{ |
93 |
$type = $_; |
94 |
} |
95 |
elsif ($type eq 'HASH') |
96 |
{ |
97 |
$type = RPC::XML::struct->new($_); |
98 |
} |
99 |
elsif ($type eq 'ARRAY') |
100 |
{ |
101 |
$type = RPC::XML::array->new($_); |
102 |
} |
103 |
else |
104 |
{ |
105 |
# ??? Don't know what else to do |
106 |
next; |
107 |
} |
108 |
} |
109 |
# You have to check ints first, because they match the next pattern too |
110 |
elsif (/^[-+]?\d+$/) |
111 |
{ |
112 |
$type = RPC::XML::int->new($_); |
113 |
} |
114 |
# Pattern taken from perldata(1) |
115 |
elsif (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) |
116 |
{ |
117 |
$type = RPC::XML::double->new($_); |
118 |
} |
119 |
else |
120 |
{ |
121 |
$type = RPC::XML::string->new($_); |
122 |
} |
123 |
|
124 |
$type; |
125 |
} @values; |
126 |
|
127 |
return (wantarray ? @values : $values[0]); |
128 |
} |
129 |
|
130 |
# This is a (mostly) empty class used as a common superclass for simple and |
131 |
# complex types, so that their derivatives may be universally type-checked. |
132 |
package RPC::XML::datatype; |
133 |
use vars qw(@ISA); |
134 |
@ISA = (); |
135 |
|
136 |
sub type { my $class = ref($_[0]) || $_[0]; $class =~ s/.*://; $class } |
137 |
sub is_fault { 0 } |
138 |
|
139 |
############################################################################### |
140 |
# |
141 |
# Package: RPC::XML::simple_type |
142 |
# |
143 |
# Description: A base class for the simpler type-classes to inherit from, |
144 |
# for default constructor, stringification, etc. |
145 |
# |
146 |
############################################################################### |
147 |
package RPC::XML::simple_type; |
148 |
|
149 |
use strict; |
150 |
use vars qw(@ISA); |
151 |
|
152 |
@ISA = qw(RPC::XML::datatype); |
153 |
|
154 |
# new - a generic constructor that presumes the value being stored is scalar |
155 |
sub new |
156 |
{ |
157 |
my $class = shift; |
158 |
my $value = shift; |
159 |
|
160 |
$RPC::XML::ERROR = ''; |
161 |
$class = ref($class) || $class; |
162 |
bless \$value, $class; |
163 |
} |
164 |
|
165 |
# value - a generic accessor |
166 |
sub value |
167 |
{ |
168 |
my $self = shift; |
169 |
|
170 |
$$self; |
171 |
} |
172 |
|
173 |
# as_string - return the value as an XML snippet |
174 |
sub as_string |
175 |
{ |
176 |
my $self = shift; |
177 |
|
178 |
my $class; |
179 |
return unless ($class = ref($self)); |
180 |
$class =~ s/^.*\://; |
181 |
$class =~ s/_/./g; |
182 |
substr($class, 0, 8) = 'dateTime' if (substr($class, 0, 8) eq 'datetime'); |
183 |
|
184 |
"<$class>$$self</$class>"; |
185 |
} |
186 |
|
187 |
############################################################################### |
188 |
# |
189 |
# Package: RPC::XML::int |
190 |
# |
191 |
# Description: Data-type class for integers |
192 |
# |
193 |
############################################################################### |
194 |
package RPC::XML::int; |
195 |
|
196 |
use strict; |
197 |
use vars qw(@ISA); |
198 |
|
199 |
@ISA = qw(RPC::XML::simple_type); |
200 |
|
201 |
############################################################################### |
202 |
# |
203 |
# Package: RPC::XML::i4 |
204 |
# |
205 |
# Description: Data-type class for i4. Forces data into an int object. |
206 |
# |
207 |
############################################################################### |
208 |
package RPC::XML::i4; |
209 |
|
210 |
use strict; |
211 |
use vars qw(@ISA); |
212 |
|
213 |
@ISA = qw(RPC::XML::simple_type); |
214 |
|
215 |
############################################################################### |
216 |
# |
217 |
# Package: RPC::XML::double |
218 |
# |
219 |
# Description: The "double" type-class |
220 |
# |
221 |
############################################################################### |
222 |
package RPC::XML::double; |
223 |
|
224 |
use strict; |
225 |
use vars qw(@ISA); |
226 |
|
227 |
@ISA = qw(RPC::XML::simple_type); |
228 |
|
229 |
############################################################################### |
230 |
# |
231 |
# Package: RPC::XML::string |
232 |
# |
233 |
# Description: The "string" type-class |
234 |
# |
235 |
############################################################################### |
236 |
package RPC::XML::string; |
237 |
|
238 |
use strict; |
239 |
use vars qw(@ISA); |
240 |
|
241 |
@ISA = qw(RPC::XML::simple_type); |
242 |
|
243 |
# as_string - return the value as an XML snippet |
244 |
sub as_string |
245 |
{ |
246 |
my $self = shift; |
247 |
|
248 |
my ($class, $value); |
249 |
|
250 |
return unless ($class = $self->type); |
251 |
|
252 |
($value = $$self) =~ s/&/&/g; |
253 |
$value =~ s/</</g; |
254 |
$value =~ s/>/>/g; |
255 |
|
256 |
"<$class>$value</$class>"; |
257 |
} |
258 |
|
259 |
############################################################################### |
260 |
# |
261 |
# Package: RPC::XML::boolean |
262 |
# |
263 |
# Description: The type-class for boolean data. Handles some "extra" cases |
264 |
# |
265 |
############################################################################### |
266 |
package RPC::XML::boolean; |
267 |
|
268 |
use strict; |
269 |
use vars qw(@ISA); |
270 |
|
271 |
@ISA = qw(RPC::XML::simple_type); |
272 |
|
273 |
# This constructor allows any of true, false, yes or no to be specified |
274 |
sub new |
275 |
{ |
276 |
my $class = shift; |
277 |
my $value = shift || 0; |
278 |
|
279 |
$RPC::XML::ERROR = ''; |
280 |
if ($value =~ /true|yes|1/i) |
281 |
{ |
282 |
$value = 1; |
283 |
} |
284 |
elsif ($value =~ /false|no|0/i) |
285 |
{ |
286 |
$value = 0; |
287 |
} |
288 |
else |
289 |
{ |
290 |
$class = ref($class) || $class; |
291 |
$RPC::XML::ERROR = "${class}::new: Value must be one of yes, no, " . |
292 |
'true, false, 1, 0 (case-insensitive)'; |
293 |
return undef; |
294 |
} |
295 |
|
296 |
bless \$value, $class; |
297 |
} |
298 |
|
299 |
############################################################################### |
300 |
# |
301 |
# Package: RPC::XML::datetime_iso8601 |
302 |
# |
303 |
# Description: This is the class to manage ISO8601-style date/time values |
304 |
# |
305 |
############################################################################### |
306 |
package RPC::XML::datetime_iso8601; |
307 |
|
308 |
use strict; |
309 |
use vars qw(@ISA); |
310 |
|
311 |
@ISA = qw(RPC::XML::simple_type); |
312 |
|
313 |
sub type { 'dateTime.iso8601' }; |
314 |
|
315 |
############################################################################### |
316 |
# |
317 |
# Package: RPC::XML::array |
318 |
# |
319 |
# Description: This class encapsulates the array data type. Each element |
320 |
# within the array should be one of the datatype classes. |
321 |
# |
322 |
############################################################################### |
323 |
package RPC::XML::array; |
324 |
|
325 |
use strict; |
326 |
use vars qw(@ISA); |
327 |
|
328 |
@ISA = qw(RPC::XML::datatype); |
329 |
|
330 |
# The constructor for this class mainly needs to sanity-check the value data |
331 |
sub new |
332 |
{ |
333 |
my $class = shift; |
334 |
my @args = (ref($_[0]) eq 'ARRAY') ? @{$_[0]} : @_; |
335 |
|
336 |
# First ensure that each argument passed in is itself one of the data-type |
337 |
# class instances. |
338 |
for (@args) |
339 |
{ |
340 |
$_ = RPC::XML::smart_encode($_) |
341 |
unless (UNIVERSAL::isa($_, 'RPC::XML::datatype')); |
342 |
} |
343 |
|
344 |
bless \@args, $class; |
345 |
} |
346 |
|
347 |
# This became more complex once it was shown that there may be a need to fetch |
348 |
# the value while preserving the underlying objects. |
349 |
sub value |
350 |
{ |
351 |
my $self = shift; |
352 |
my $no_recurse = shift || 0; |
353 |
my $ret; |
354 |
|
355 |
if ($no_recurse) |
356 |
{ |
357 |
$ret = [ @$self ]; |
358 |
} |
359 |
else |
360 |
{ |
361 |
$ret = [ map { $_->value } @$self ]; |
362 |
} |
363 |
|
364 |
$ret; |
365 |
} |
366 |
|
367 |
sub as_string |
368 |
{ |
369 |
my $self = shift; |
370 |
|
371 |
join('', |
372 |
'<array><data>', |
373 |
(map { ('<value>', $_->as_string(), '</value>') } (@$self)), |
374 |
'</data></array>'); |
375 |
} |
376 |
|
377 |
############################################################################### |
378 |
# |
379 |
# Package: RPC::XML::struct |
380 |
# |
381 |
# Description: This is the "struct" data class. The struct is like Perl's |
382 |
# hash, with the constraint that all values are instances |
383 |
# of the datatype classes. |
384 |
# |
385 |
############################################################################### |
386 |
package RPC::XML::struct; |
387 |
|
388 |
use strict; |
389 |
use vars qw(@ISA); |
390 |
|
391 |
@ISA = qw(RPC::XML::datatype); |
392 |
|
393 |
# The constructor for this class mainly needs to sanity-check the value data |
394 |
sub new |
395 |
{ |
396 |
my $class = shift; |
397 |
my %args = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_; |
398 |
|
399 |
# First ensure that each argument passed in is itself one of the data-type |
400 |
# class instances. |
401 |
for (keys %args) |
402 |
{ |
403 |
$args{$_} = RPC::XML::smart_encode($args{$_}) |
404 |
unless (UNIVERSAL::isa($args{$_}, 'RPC::XML::datatype')); |
405 |
} |
406 |
|
407 |
bless \%args, $class; |
408 |
} |
409 |
|
410 |
# This became more complex once it was shown that there may be a need to fetch |
411 |
# the value while preserving the underlying objects. |
412 |
sub value |
413 |
{ |
414 |
my $self = shift; |
415 |
my $no_recurse = shift || 0; |
416 |
my %value; |
417 |
|
418 |
if ($no_recurse) |
419 |
{ |
420 |
%value = map { $_, $self->{$_} } (keys %$self); |
421 |
} |
422 |
else |
423 |
{ |
424 |
%value = map { $_, $self->{$_}->value } (keys %$self); |
425 |
} |
426 |
|
427 |
\%value; |
428 |
} |
429 |
|
430 |
sub as_string |
431 |
{ |
432 |
my $self = shift; |
433 |
|
434 |
join('', |
435 |
'<struct>', |
436 |
(map { |
437 |
("<member><name>$_</name><value>", |
438 |
$self->{$_}->as_string, |
439 |
'</value></member>') |
440 |
} (keys %$self)), |
441 |
'</struct>'); |
442 |
} |
443 |
|
444 |
############################################################################### |
445 |
# |
446 |
# Package: RPC::XML::base64 |
447 |
# |
448 |
# Description: This is the base64-encoding type. Plain data is passed in, |
449 |
# plain data is returned. Plain is always returned. All the |
450 |
# encoding/decoding is done behind the scenes. |
451 |
# |
452 |
############################################################################### |
453 |
package RPC::XML::base64; |
454 |
|
455 |
use strict; |
456 |
use vars qw(@ISA); |
457 |
|
458 |
@ISA = qw(RPC::XML::simple_type); |
459 |
|
460 |
use MIME::Base64; |
461 |
|
462 |
sub new |
463 |
{ |
464 |
my ($class, $value, $encoded) = @_; |
465 |
|
466 |
$RPC::XML::ERROR = ''; |
467 |
$value = $$value if (ref $value); |
468 |
unless (defined $value and length $value) |
469 |
{ |
470 |
$class = ref($class) || $class; |
471 |
$RPC::XML::ERROR = "${class}::new: Must be called with non-null data"; |
472 |
return undef; |
473 |
} |
474 |
if ($encoded) |
475 |
{ |
476 |
$value = MIME::Base64::decode_base64 $value; |
477 |
} |
478 |
|
479 |
bless \$value, $class; |
480 |
} |
481 |
|
482 |
# The value needs to be encoded before being output |
483 |
sub as_string |
484 |
{ |
485 |
my $self = shift; |
486 |
|
487 |
'<base64>' . MIME::Base64::encode_base64($$self) . '</base64>'; |
488 |
} |
489 |
|
490 |
############################################################################### |
491 |
# |
492 |
# Package: RPC::XML::fault |
493 |
# |
494 |
# Description: This is the class that encapsulates the data for a RPC |
495 |
# fault-response. Like the others, it takes the relevant |
496 |
# information and maintains it internally. This is put |
497 |
# at the end of the datum types, though it isn't really a |
498 |
# data type in the sense that it cannot be passed in to a |
499 |
# request. But it is separated so as to better generalize |
500 |
# responses. |
501 |
# |
502 |
############################################################################### |
503 |
package RPC::XML::fault; |
504 |
|
505 |
use strict; |
506 |
use vars qw(@ISA); |
507 |
|
508 |
@ISA = qw(RPC::XML::struct); |
509 |
|
510 |
# For our new(), we only need to ensure that we have the two required members |
511 |
sub new |
512 |
{ |
513 |
my $class = shift; |
514 |
my @args = @_; |
515 |
|
516 |
my ($self, %args); |
517 |
|
518 |
$RPC::XML::ERROR = ''; |
519 |
if (ref($args[0]) and UNIVERSAL::isa($args[0], 'RPC::XML::struct')) |
520 |
{ |
521 |
# Take the keys and values from the struct object as our own |
522 |
%args = %{$args[0]->value('shallow')}; |
523 |
} |
524 |
elsif (@args == 2) |
525 |
{ |
526 |
# This is a special convenience-case to make simple new() calls clearer |
527 |
%args = (faultCode => RPC::XML::int->new($args[0]), |
528 |
faultString => RPC::XML::string->new($args[1])); |
529 |
} |
530 |
else |
531 |
{ |
532 |
%args = @args; |
533 |
} |
534 |
|
535 |
unless ($args{faultCode} and $args{faultString}) |
536 |
{ |
537 |
$class = ref($class) || $class; |
538 |
$RPC::XML::ERROR = "${class}::new: Missing required struct fields"; |
539 |
return undef; |
540 |
} |
541 |
if (scalar(keys %args) > 2) |
542 |
{ |
543 |
$class = ref($class) || $class; |
544 |
$RPC::XML::ERROR = "${class}::new: Extra struct fields not allowed"; |
545 |
return undef; |
546 |
} |
547 |
|
548 |
$self = $class->SUPER::new(%args); |
549 |
} |
550 |
|
551 |
# This only differs from the display of a struct in that it has some extra |
552 |
# wrapped around it. Let the superclass as_string method do most of the work. |
553 |
sub as_string |
554 |
{ |
555 |
my $self = shift; |
556 |
|
557 |
'<fault><value>' . $self->SUPER::as_string . '</value></fault>'; |
558 |
} |
559 |
|
560 |
# Convenience methods: |
561 |
sub code { $_[0]->{faultCode}->value } |
562 |
sub string { $_[0]->{faultString}->value } |
563 |
|
564 |
# This is the only one to override this method, for obvious reasons |
565 |
sub is_fault { 1 } |
566 |
|
567 |
############################################################################### |
568 |
# |
569 |
# Package: RPC::XML::request |
570 |
# |
571 |
# Description: This is the class that encapsulates the data for a RPC |
572 |
# request. It takes the relevant information and maintains |
573 |
# it internally until asked to stringify. Only then is the |
574 |
# XML generated, encoding checked, etc. This allows for |
575 |
# late-selection of <methodCall> or <methodCallSet> as a |
576 |
# containing tag. |
577 |
# |
578 |
# This class really only needs a constructor and a method |
579 |
# to stringify. |
580 |
# |
581 |
############################################################################### |
582 |
package RPC::XML::request; |
583 |
|
584 |
use strict; |
585 |
use vars qw(@ISA); |
586 |
|
587 |
############################################################################### |
588 |
# |
589 |
# Sub Name: new |
590 |
# |
591 |
# Description: Creating a new request object, in this (reference) case, |
592 |
# means checking the list of arguments for sanity and |
593 |
# packaging it up for later use. |
594 |
# |
595 |
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
596 |
# $class in scalar Class/ref to bless into |
597 |
# @argz in list The exact disposition of the |
598 |
# arguments is based on the |
599 |
# type of the various elements |
600 |
# |
601 |
# Returns: Success: object ref |
602 |
# Failure: undef, error in $RPC::XML::ERROR |
603 |
# |
604 |
############################################################################### |
605 |
sub new |
606 |
{ |
607 |
my $class = shift; |
608 |
my @argz = @_; |
609 |
|
610 |
my ($self, $name); |
611 |
|
612 |
$class = ref($class) || $class; |
613 |
$RPC::XML::ERROR = ''; |
614 |
|
615 |
unless (@argz) |
616 |
{ |
617 |
$RPC::XML::ERROR = 'RPC::XML::request::new: At least a method name ' . |
618 |
'must be specified'; |
619 |
return undef; |
620 |
} |
621 |
|
622 |
if (UNIVERSAL::isa($argz[0], 'RPC::XML::request')) |
623 |
{ |
624 |
# Maybe this will be a clone operation |
625 |
} |
626 |
else |
627 |
{ |
628 |
# This is the method name to be called |
629 |
$name = shift(@argz); |
630 |
# All the remaining args must be data. |
631 |
@argz = RPC::XML::smart_encode(@argz); |
632 |
$self = { args => [ @argz ], name => $name }; |
633 |
bless $self, $class; |
634 |
} |
635 |
|
636 |
$self; |
637 |
} |
638 |
|
639 |
# Accessor methods |
640 |
sub name { shift->{name} } |
641 |
sub args { shift->{args} || [] } |
642 |
|
643 |
############################################################################### |
644 |
# |
645 |
# Sub Name: as_string |
646 |
# |
647 |
# Description: This is a fair bit more complex than the simple as_string |
648 |
# methods for the datatypes. Express the invoking object as |
649 |
# a well-formed XML document. |
650 |
# |
651 |
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
652 |
# $self in ref Invoking object |
653 |
# $indent in scalar Indention level for output |
654 |
# |
655 |
# Returns: Success: text |
656 |
# Failure: undef |
657 |
# |
658 |
############################################################################### |
659 |
sub as_string |
660 |
{ |
661 |
my $self = shift; |
662 |
|
663 |
my $text; |
664 |
|
665 |
$RPC::XML::ERROR = ''; |
666 |
|
667 |
$text = qq(<?xml version="1.0"?>\n); |
668 |
|
669 |
$text .= "<methodCall><methodName>$self->{name}</methodName><params>"; |
670 |
for (@{$self->{args}}) |
671 |
{ |
672 |
$text .= '<param><value>' . $_->as_string . '</value></param>'; |
673 |
} |
674 |
$text .= '</params></methodCall>'; |
675 |
|
676 |
$text; |
677 |
} |
678 |
|
679 |
############################################################################### |
680 |
# |
681 |
# Package: RPC::XML::response |
682 |
# |
683 |
# Description: This is the class that encapsulates the data for a RPC |
684 |
# response. As above, it takes the information and maintains |
685 |
# it internally until asked to stringify. Only then is the |
686 |
# XML generated, encoding checked, etc. This allows for |
687 |
# late-selection of <methodResponse> or <methodResponseSet> |
688 |
# as above. |
689 |
# |
690 |
############################################################################### |
691 |
package RPC::XML::response; |
692 |
|
693 |
use strict; |
694 |
use vars qw(@ISA); |
695 |
|
696 |
############################################################################### |
697 |
# |
698 |
# Sub Name: new |
699 |
# |
700 |
# Description: Creating a new response object, in this (reference) case, |
701 |
# means checking the outgoing parameter(s) for sanity. |
702 |
# |
703 |
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
704 |
# $class in scalar Class/ref to bless into |
705 |
# @argz in list The exact disposition of the |
706 |
# arguments is based on the |
707 |
# type of the various elements |
708 |
# |
709 |
# Returns: Success: object ref |
710 |
# Failure: undef, error in $RPC::XML::ERROR |
711 |
# |
712 |
############################################################################### |
713 |
sub new |
714 |
{ |
715 |
my $class = shift; |
716 |
my @argz = @_; |
717 |
|
718 |
my ($self, %extra, %attr); |
719 |
|
720 |
$class = ref($class) || $class; |
721 |
|
722 |
$RPC::XML::ERROR = ''; |
723 |
if (! @argz) |
724 |
{ |
725 |
$RPC::XML::ERROR = 'RPC::XML::response::new: One of a datatype, ' . |
726 |
'value or a fault object must be specified'; |
727 |
} |
728 |
elsif (UNIVERSAL::isa($argz[0], 'RPC::XML::response')) |
729 |
{ |
730 |
# This will eventually be a clone-operation. For now, just return in |
731 |
$self = $argz[0]; |
732 |
} |
733 |
elsif (@argz > 1) |
734 |
{ |
735 |
$RPC::XML::ERROR = 'RPC::XML::response::new: Responses may take ' . |
736 |
'only one argument'; |
737 |
} |
738 |
else |
739 |
{ |
740 |
$argz[0] = RPC::XML::smart_encode($argz[0]); |
741 |
|
742 |
$self = { value => $argz[0] }; |
743 |
bless $self, $class; |
744 |
} |
745 |
|
746 |
$self; |
747 |
} |
748 |
|
749 |
# Accessor/status methods |
750 |
sub value { $_[0]->{value} } |
751 |
sub is_fault { $_[0]->{value}->is_fault } |
752 |
|
753 |
############################################################################### |
754 |
# |
755 |
# Sub Name: as_string |
756 |
# |
757 |
# Description: This is a fair bit more complex than the simple as_string |
758 |
# methods for the datatypes. Express the invoking object as |
759 |
# a well-formed XML document. |
760 |
# |
761 |
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
762 |
# $self in ref Invoking object |
763 |
# $indent in scalar Indention level for output |
764 |
# |
765 |
# Returns: Success: text |
766 |
# Failure: undef |
767 |
# |
768 |
############################################################################### |
769 |
sub as_string |
770 |
{ |
771 |
my $self = shift; |
772 |
|
773 |
my $text; |
774 |
|
775 |
$RPC::XML::ERROR = ''; |
776 |
|
777 |
$text = qq(<?xml version="1.0"?>\n); |
778 |
|
779 |
$text .= '<methodResponse>'; |
780 |
if ($self->{value}->isa('RPC::XML::fault')) |
781 |
{ |
782 |
$text .= $self->{value}->as_string; |
783 |
} |
784 |
else |
785 |
{ |
786 |
$text .= '<params><param><value>' . $self->{value}->as_string . |
787 |
'</value></param></params>'; |
788 |
} |
789 |
$text .= '</methodResponse>'; |
790 |
|
791 |
$text; |
792 |
} |
793 |
|
794 |
|
795 |
__END__ |
796 |
|
797 |
=head1 NAME |
798 |
|
799 |
RPC::XML - A set of classes for core data, message and XML handling |
800 |
|
801 |
=head1 SYNOPSIS |
802 |
|
803 |
use RPC::XML; |
804 |
|
805 |
$req = RPC::XML::request->new('fetch_prime_factors', |
806 |
RPC::XML::int->new(985120528)); |
807 |
... |
808 |
$resp = RPC::XML::Parser->new()->parse(STREAM); |
809 |
if (ref($resp)) |
810 |
{ |
811 |
return $resp->value->value; |
812 |
} |
813 |
else |
814 |
{ |
815 |
die $resp; |
816 |
} |
817 |
|
818 |
=head1 DESCRIPTION |
819 |
|
820 |
The B<RPC::XML> package is a reference implementation of the XML-RPC |
821 |
standard. As a reference implementation, it is geared more towards clarity and |
822 |
readability than efficiency. |
823 |
|
824 |
The package provides a set of classes for creating values to pass to the |
825 |
constructors for requests and responses. These are lightweight objects, most |
826 |
of which are implemented as tied scalars so as to associate specific type |
827 |
information with the value. Classes are also provided for requests, responses, |
828 |
faults (errors) and a parser based on the L<XML::Parser> package from CPAN. |
829 |
|
830 |
This module does not actually provide any transport implementation or |
831 |
server basis. For these, see L<RPC::XML::Client> and L<RPC::XML::Server>, |
832 |
respectively. |
833 |
|
834 |
=head1 EXPORTABLE FUNCTIONS |
835 |
|
836 |
At present, only two functions are available for import. They must be |
837 |
explicitly imported as part of the C<use> statement, or with a direct call to |
838 |
C<import>: |
839 |
|
840 |
=over 4 |
841 |
|
842 |
=item time2iso8601($time) |
843 |
|
844 |
Convert the integer time value in C<$time> to a ISO 8601 string in the UTC |
845 |
time zone. This is a convenience function for occassions when the return value |
846 |
needs to be of the B<dateTime.iso8601> type, but the value on hand is the |
847 |
return from the C<time> built-in. |
848 |
|
849 |
=item smart_encode(@args) |
850 |
|
851 |
Converts the passed-in arguments to datatype objects. Any that are already |
852 |
encoded as such are passed through unchanged. The routine is called recursively |
853 |
on hash and array references. Note that this routine can only deduce a certain |
854 |
degree of detail about the values passed. Boolean values will be wrongly |
855 |
encoded as integers. Pretty much anything not specifically recognizable will |
856 |
get encoded as a string object. Thus, for types such as C<fault>, the ISO |
857 |
time value, base-64 data, etc., the program must still explicitly encode it. |
858 |
However, this routine will hopefully simplify things a little bit for a |
859 |
majority of the usage cases. |
860 |
|
861 |
=back |
862 |
|
863 |
=head1 CLASSES |
864 |
|
865 |
The classes provided by this module are broken into two groups: I<datatype> |
866 |
classes and I<message> classes. |
867 |
|
868 |
=head2 Data Classes |
869 |
|
870 |
The following data classes are provided by this library. Each of these provide |
871 |
at least C<new>, C<value>, C<as_string> and C<is_fault> methods. Note that |
872 |
these classes are designed to create throw-away objects. There is currently no |
873 |
mechanism for changing the value stored within one of these object after the |
874 |
constructor returns. It is assumed that a new object would be created, |
875 |
instead. |
876 |
|
877 |
The C<new> methods are constructors, C<value> returns the value stored within |
878 |
the object (processed recursively for arrays and structs), and C<as_string> |
879 |
stringifies the object as a chunk of XML. The C<is_fault> method always |
880 |
returns a false value (0), except when the object itself is of type |
881 |
B<RPC::XML::fault>. In that case, the return value is true (1). indention |
882 |
level which is applied as a base indention for output. Other arguments are |
883 |
specified with the classes. |
884 |
|
885 |
=over 4 |
886 |
|
887 |
=item RPC::XML::int |
888 |
|
889 |
Creates an integer value. Constructor expects the integer value as an |
890 |
argument. |
891 |
|
892 |
=item RPC::XML::i4 |
893 |
|
894 |
This is like the C<int> class. |
895 |
|
896 |
=item RPC::XML::double |
897 |
|
898 |
Creates a floating-point value. |
899 |
|
900 |
=item RPC::XML::string |
901 |
|
902 |
Creates an arbitrary string. No special encoding is done to the string (aside |
903 |
from XML document encoding, covered later) with the exception of the C<E<lt>>, |
904 |
C<E<gt>> and C<&> characters, which are XML-escaped during object creation, |
905 |
and then reverted when the C<value> method is called. |
906 |
|
907 |
=item RPC::XML::boolean |
908 |
|
909 |
Creates a boolean value. The value returned will always be either of B<1> |
910 |
or B<0>, for true or false, respectively. When calling the constructor, the |
911 |
program may specify any of: C<0>, C<no>, C<false>, C<1>, C<yes>, C<true>. |
912 |
|
913 |
=item RPC::XML::datetime_iso8601 |
914 |
|
915 |
Creates an instance of the XML-RPC C<dateTime.iso8601> type. The specification |
916 |
for ISO 8601 may be found elsewhere. No processing is done to the data. |
917 |
|
918 |
=item RPC::XML::base64 |
919 |
|
920 |
Creates an object that encapsulates a chunk of data that will be treated as |
921 |
base-64 for transport purposes. The value may be passed in as either a string |
922 |
or as a scalar reference. Additionally, a second (optional) parameter may be |
923 |
passed, that if true identifies the data as already base-64 encoded. If so, |
924 |
the data is decoded before storage. The C<value> method returns decoded data, |
925 |
and the C<as_string> method encodes it before stringification. |
926 |
|
927 |
=item RPC::XML::array |
928 |
|
929 |
Creates an array object. The constructor takes zero or more data-type |
930 |
instances as arguments, which are inserted into the array in the order |
931 |
specified. C<value> returns an array reference of native Perl types. If a |
932 |
non-null value is passed as an argument to C<value()>, then the array |
933 |
reference will contain the datatype objects (a shallow copy rather than a deep |
934 |
one). |
935 |
|
936 |
=item RPC::XML::struct |
937 |
|
938 |
Creates a struct object, the analogy of a hash table in Perl. The keys are |
939 |
ordinary strings, and the values must all be data-type objects. The C<value> |
940 |
method returns a hash table reference, with native Perl types in the values. |
941 |
Key order is not preserved. Key strings are not encoded for special XML |
942 |
characters, so the use of such (C<E<lt>>, C<E<gt>>, etc.) is discouraged. If a |
943 |
non-null value is passed as an argument to C<value()>, then the hash |
944 |
reference will contain the datatype objects (a shallow copy rather than a deep |
945 |
one). |
946 |
|
947 |
=item RPC::XML::fault |
948 |
|
949 |
A fault object is a special case of the struct object that checks to ensure |
950 |
that there are two keys, C<faultCode> and C<faultString>. |
951 |
|
952 |
As a matter of convenience, since the contents of a B<RPC::XML::fault> |
953 |
structure are specifically defined, the constructor may be called with exactly |
954 |
two arguments, the first of which will be taken as the code, and the second |
955 |
as the string. They will be converted to RPC::XML types automatically and |
956 |
stored by the pre-defined key names. |
957 |
|
958 |
Also as a matter of convenience, the fault class provides the following |
959 |
accessor methods for directly retrieving the integer code and error string |
960 |
from a fault object: |
961 |
|
962 |
=over 4 |
963 |
|
964 |
=item code |
965 |
|
966 |
=item string |
967 |
|
968 |
=back |
969 |
|
970 |
Both names should be self-explanatory. The values returned are Perl values, |
971 |
not B<RPC::XML> class instances. |
972 |
|
973 |
=back |
974 |
|
975 |
=head2 Message Classes |
976 |
|
977 |
The message classes are used both for constructing messages for outgoing |
978 |
communication as well as representing the parsed contents of a received |
979 |
message. Both implement the following methods: |
980 |
|
981 |
=over 4 |
982 |
|
983 |
=item new |
984 |
|
985 |
This is the constructor method for the two message classes. The response class |
986 |
may have only a single value (as a response is currently limited to a single |
987 |
return value), and requests may have as many arguments as appropriate. In both |
988 |
cases, the arguments are passed to the exported C<smart_encode> routine |
989 |
described earlier. |
990 |
|
991 |
=item as_string |
992 |
|
993 |
Returns the message object expressed as an XML document. The document will be |
994 |
lacking in linebreaks and indention, as it is not targeted for human reading. |
995 |
|
996 |
=back |
997 |
|
998 |
The two message-object classes are: |
999 |
|
1000 |
=over 4 |
1001 |
|
1002 |
=item RPC::XML::request |
1003 |
|
1004 |
This creates a request object. A request object expects the first argument to |
1005 |
be the name of the remote routine being called, and all remaining arguments |
1006 |
are the arguments to that routine. Request objects have the following methods |
1007 |
(besides C<new> and C<as_string>): |
1008 |
|
1009 |
=over 4 |
1010 |
|
1011 |
=item name |
1012 |
|
1013 |
The name of the remote routine that the request will call. |
1014 |
|
1015 |
=item args |
1016 |
|
1017 |
Returns a list reference with the arguments that will be passed. No arguments |
1018 |
will result in a reference to an empty list. |
1019 |
|
1020 |
=back |
1021 |
|
1022 |
=item RPC::XML::response |
1023 |
|
1024 |
The response object is much like the request object in most ways. They may |
1025 |
take only one argument, as that is all the specification allows for in a |
1026 |
response. Responses have the following methods (in addition to C<new> and |
1027 |
C<as_string>): |
1028 |
|
1029 |
=over 4 |
1030 |
|
1031 |
=item value |
1032 |
|
1033 |
The value the response is returning. It will be a RPC::XML data-type. |
1034 |
|
1035 |
=item is_fault |
1036 |
|
1037 |
A boolean test whether or not the response is signalling a fault. This is |
1038 |
the same as taking the C<value> method return value and testing it, but is |
1039 |
provided for clarity and simplicity. |
1040 |
|
1041 |
=back |
1042 |
|
1043 |
=back |
1044 |
|
1045 |
=head1 DIAGNOSTICS |
1046 |
|
1047 |
All constructors return C<undef> upon failure, with the error message available |
1048 |
in the package-global variable B<C<$RPC::XML::ERROR>>. |
1049 |
|
1050 |
=head1 CAVEATS |
1051 |
|
1052 |
This began as a reference implementation in which clarity of process and |
1053 |
readability of the code took precedence over general efficiency. It is now |
1054 |
being maintained as production code, but may still have parts that could be |
1055 |
written more efficiently. |
1056 |
|
1057 |
=head1 CREDITS |
1058 |
|
1059 |
The B<XML-RPC> standard is Copyright (c) 1998-2001, UserLand Software, Inc. |
1060 |
See <http://www.xmlrpc.com> for more information about the B<XML-RPC> |
1061 |
specification. |
1062 |
|
1063 |
=head1 LICENSE |
1064 |
|
1065 |
This module is licensed under the terms of the Artistic License that covers |
1066 |
Perl. See <http://language.perl.com/misc/Artistic.html> for the |
1067 |
license itself. |
1068 |
|
1069 |
=head1 SEE ALSO |
1070 |
|
1071 |
L<RPC::XML::Client>, L<RPC::XML::Server>, L<RPC::XML::Parser>, L<XML::Parser> |
1072 |
|
1073 |
=head1 AUTHOR |
1074 |
|
1075 |
Randy J. Ray <rjray@blackperl.com> |
1076 |
|
1077 |
=cut |