[system] / trunk / xmlrpc / daemon / Frontier / RPC2.pm Repository:
ViewVC logotype

Annotation of /trunk/xmlrpc/daemon/Frontier/RPC2.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 279 - (view) (download) (as text)

1 : gage 279 #
2 :     # Copyright (C) 1998, 1999 Ken MacLeod
3 :     # Frontier::RPC is free software; you can redistribute it
4 :     # and/or modify it under the same terms as Perl itself.
5 :     #
6 :     # $Id$
7 :     #
8 :    
9 :     # NOTE: see Storable for marshalling.
10 :    
11 :     use strict;
12 :     print "Using local, doctored version of Frontier::RPC2\n";
13 :     #modified by Michael E. Gage for use with WeBWorK
14 :    
15 :    
16 :     package Frontier::RPC2;
17 :     use XML::Parser;
18 :    
19 :     use vars qw{%scalars %char_entities};
20 :    
21 :     %char_entities = (
22 :     '&' => '&',
23 :     '<' => '&lt;',
24 :     '>' => '&gt;',
25 :     '"' => '&quot;',
26 :     );
27 :    
28 :     # FIXME I need a list of these
29 :     %scalars = (
30 :     'base64' => 1,
31 :     'boolean' => 1,
32 :     'dateTime.iso8601' => 1,
33 :     'double' => 1,
34 :     'int' => 1,
35 :     'i4' => 1,
36 :     'string' => 1,
37 :     );
38 :    
39 :     sub new {
40 :     my $class = shift;
41 :     my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
42 :    
43 :     bless $self, $class;
44 :    
45 :     if (defined $self->{'encoding'}) {
46 :     $self->{'encoding_'} = " encoding=\"$self->{'encoding'}\"";
47 :     } else {
48 :     $self->{'encoding_'} = "";
49 :     }
50 :    
51 :     return $self;
52 :     }
53 :    
54 :     sub encode_call {
55 :     my $self = shift; my $proc = shift;
56 :    
57 :     my @text;
58 :     push @text, <<EOF;
59 :     <?xml version="1.0"$self->{'encoding_'}?>
60 :     <methodCall>
61 :     <methodName>$proc</methodName>
62 :     <params>
63 :     EOF
64 :    
65 :     push @text, $self->_params([@_]);
66 :    
67 :     push @text, <<EOF;
68 :     </params>
69 :     </methodCall>
70 :     EOF
71 :    
72 :     return join('', @text);
73 :     }
74 :    
75 :     sub encode_response {
76 :     my $self = shift;
77 :    
78 :     my @text;
79 :     push @text, <<EOF;
80 :     <?xml version="1.0"$self->{'encoding_'}?>
81 :     <methodResponse>
82 :     <params>
83 :     EOF
84 :    
85 :     push @text, $self->_params([@_]);
86 :    
87 :     push @text, <<EOF;
88 :     </params>
89 :     </methodResponse>
90 :     EOF
91 :    
92 :     return join('', @text);
93 :     }
94 :    
95 :     sub encode_fault {
96 :     my $self = shift; my $code = shift; my $message = shift;
97 :    
98 :     my @text;
99 :     push @text, <<EOF;
100 :     <?xml version="1.0"$self->{'encoding_'}?>
101 :     <methodResponse>
102 :     <fault>
103 :     EOF
104 :    
105 :     push @text, $self->_item({faultCode => $code, faultString => $message});
106 :    
107 :     push @text, <<EOF;
108 :     </fault>
109 :     </methodResponse>
110 :     EOF
111 :    
112 :     return join('', @text);
113 :     }
114 :    
115 :     sub serve {
116 :     my $self = shift; my $xml = shift; my $methods = shift;
117 :    
118 :     my $call;
119 :     # FIXME bug in Frontier's XML
120 :     $xml =~ s/(<\?XML\s+VERSION)/\L$1\E/;
121 :     eval { $call = $self->decode($xml) };
122 :    
123 :     if ($@) {
124 :     return $self->encode_fault(1, "error decoding RPC.\n" . $@);
125 :     }
126 :    
127 :     if ($call->{'type'} ne 'call') {
128 :     return $self->encode_fault(2,"expected RPC \`methodCall', got \`$call->{'type'}'\n");
129 :     }
130 :    
131 :     my $method = $call->{'method_name'};
132 :     if (!defined $methods->{$method}) {
133 :     return $self->encode_fault(3, "no such method \`$method'\n");
134 :     }
135 :    
136 :     my $result;
137 :     my $eval = eval { $result = &{ $methods->{$method} }(@{ $call->{'value'} }) };
138 :     if ($@) {
139 :     return $self->encode_fault(4, "error executing RPC \`$method'.\n" . $@);
140 :     }
141 :    
142 :     my $response_xml = $self->encode_response($result);
143 :     return $response_xml;
144 :     }
145 :    
146 :     sub _params {
147 :     my $self = shift; my $array = shift;
148 :    
149 :     my @text;
150 :    
151 :     my $item;
152 :     foreach $item (@$array) {
153 :     push (@text, "<param>",
154 :     $self->_item($item),
155 :     "</param>\n");
156 :     }
157 :    
158 :     return @text;
159 :     }
160 :    
161 :     sub _item {
162 :     my $self = shift; my $item = shift;
163 :    
164 :     my @text;
165 :     my $ref = ref($item);
166 :     if (!$ref) {
167 :     push (@text, $self->_scalar ($item));
168 :     } elsif ($ref eq 'ARRAY') {
169 :     push (@text, $self->_array($item));
170 :     } elsif ($ref eq 'HASH') { # "$item" is more general than using ref($item) it will for example convert answer hashes.
171 :     push (@text, $self->_hash($item));
172 :     } elsif ($ref eq 'AnswerHash') {
173 :     push (@text, $self->_hash($item));
174 :     } elsif ("$item" =~/CODE|HASH/) {
175 :     push @text, "<value><string>$item</string></value>\n";
176 :     } elsif ($ref eq 'Frontier::RPC2::Boolean') {
177 :     push @text, "<value><boolean>", $item->repr, "</boolean></value>\n";
178 :     } elsif ($ref eq 'Frontier::RPC2::String') {
179 :     push @text, "<value><string>", $item->repr, "</string></value>\n";
180 :     } elsif ($ref eq 'Frontier::RPC2::Integer') {
181 :     push @text, "<value><int>", $item->repr, "</int></value>\n";
182 :     } elsif ($ref eq 'Frontier::RPC2::Double') {
183 :     push @text, "<value><double>", item->repr, "</double></value>\n";
184 :     } elsif ($ref eq 'Frontier::RPC2::DateTime::ISO8601') {
185 :     push @text, "<value><dateTime.iso8601>", $item->repr, "</dateTime.iso8601></value>\n";
186 :     } elsif ($ref eq 'Frontier::RPC2::Base64') {
187 :     push @text, "<value><base64>", $item->repr, "</base64></value>\n";
188 :     } elsif ($ref eq 'Complex1') {
189 :     push @text, "<value><string>$item</string></value>\n";
190 :     } else {
191 :     push @text, "<value><string>", "Don't recognize $item ", "</string></value>\n";
192 :     #die "can't convert \`$item' to XML\n";
193 :     }
194 :    
195 :     return @text;
196 :     }
197 :    
198 :     sub _hash {
199 :     my $self = shift; my $hash = shift;
200 :    
201 :     my @text = "<value><struct>\n";
202 :    
203 :     my ($key, $value);
204 :     while (($key, $value) = each %$hash) {
205 :     push (@text,
206 :     "<member><name>$key</name>",
207 :     $self->_item($value),
208 :     "</member>\n");
209 :     }
210 :    
211 :     push @text, "</struct></value>\n";
212 :    
213 :     return @text;
214 :     }
215 :    
216 :    
217 :     sub _array {
218 :     my $self = shift; my $array = shift;
219 :    
220 :     my @text = "<value><array><data>\n";
221 :    
222 :     my $item;
223 :     foreach $item (@$array) {
224 :     push @text, $self->_item($item);
225 :     }
226 :    
227 :     push @text, "</data></array></value>\n";
228 :    
229 :     return @text;
230 :     }
231 :    
232 :     sub _scalar {
233 :     my $self = shift; my $value = shift;
234 :    
235 :     # these are from `perldata(1)'
236 :     if ($value =~ /^[+-]?\d+$/) {
237 :     return ("<value><i4>$value</i4></value>");
238 :     } elsif ($value =~ /^(-?(?:\d+(?:\.\d*)?|\.\d+)|([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)$/) {
239 :     return ("<value><double>".sprintf('%0.13f',$value)."</double></value>"); # Frontier can't handle exponential notation
240 :     #return ("<value><double>$value</double></value>");
241 :     } else {
242 :     $value =~ s/([&<>\"])/$char_entities{$1}/ge;
243 :     return ("<value><string>$value</string></value>");
244 :     }
245 :     }
246 :    
247 :     sub decode {
248 :     my $self = shift; my $string = shift;
249 :    
250 :     $self->{'parser'} = new XML::Parser Style => ref($self);
251 :     return $self->{'parser'}->parsestring($string);
252 :     }
253 :    
254 :     # shortcuts
255 :     sub base64 {
256 :     my $self = shift;
257 :    
258 :     return Frontier::RPC2::Base64->new(@_);
259 :     }
260 :    
261 :     sub boolean {
262 :     my $self = shift;
263 :     my $elem = shift;
264 :     if($elem == 0 or $elem == 1) {
265 :     return Frontier::RPC2::Boolean->new($elem);
266 :     } else {
267 :     die "error in rendering RPC type \`$elem\' not a boolean\n";
268 :     }
269 :     }
270 :    
271 :     sub double {
272 :     my $self = shift;
273 :     my $elem = shift;
274 :     # this is from `perldata(1)'
275 :     if($elem =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
276 :     return Frontier::RPC2::Double->new($elem);
277 :     } else {
278 :     die "error in rendering RPC type \`$elem\' not a double\n";
279 :     }
280 :     }
281 :    
282 :     sub int {
283 :     my $self = shift;
284 :     my $elem = shift;
285 :     # this is from `perldata(1)'
286 :     if($elem =~ /^[+-]?\d+$/) {
287 :     return Frontier::RPC2::Integer->new($elem);
288 :     } else {
289 :     die "error in rendering RPC type \`$elem\' not an int\n";
290 :     }
291 :     }
292 :    
293 :     sub string {
294 :     my $self = shift;
295 :    
296 :     return Frontier::RPC2::String->new(@_);
297 :     }
298 :    
299 :     sub date_time {
300 :     my $self = shift;
301 :    
302 :     return Frontier::RPC2::DateTime::ISO8601->new(@_);
303 :     }
304 :    
305 :     ######################################################################
306 :     ###
307 :     ### XML::Parser callbacks
308 :     ###
309 :    
310 :     sub die {
311 :     my $parser = shift; my $message = shift;
312 :    
313 :     die $message
314 :     . "at line " . $parser->current_line
315 :     . " column " . $parser->current_column . "\n";
316 :     }
317 :    
318 :     sub init {
319 :     my $self = shift;
320 :    
321 :     $self->{'rpc_state'} = [];
322 :     $self->{'rpc_container'} = [ [] ];
323 :     $self->{'rpc_member_name'} = [];
324 :     $self->{'rpc_type'} = undef;
325 :     $self->{'rpc_args'} = undef;
326 :     }
327 :    
328 :     # FIXME this state machine wouldn't be necessary if we had a DTD.
329 :     sub start {
330 :     my $self = shift; my $tag = shift;
331 :    
332 :     my $state = $self->{'rpc_state'}[-1];
333 :    
334 :     if (!defined $state) {
335 :     if ($tag eq 'methodCall') {
336 :     $self->{'rpc_type'} = 'call';
337 :     push @{ $self->{'rpc_state'} }, 'want_method_name';
338 :     } elsif ($tag eq 'methodResponse') {
339 :     push @{ $self->{'rpc_state'} }, 'method_response';
340 :     } else {
341 :     Frontier::RPC2::die($self, "unknown RPC type \`$tag'\n");
342 :     }
343 :     } elsif ($state eq 'want_method_name') {
344 :     Frontier::RPC2::die($self, "wanted \`methodName' tag, got \`$tag'\n")
345 :     if ($tag ne 'methodName');
346 :     push @{ $self->{'rpc_state'} }, 'method_name';
347 :     $self->{'rpc_text'} = "";
348 :     } elsif ($state eq 'method_response') {
349 :     if ($tag eq 'params') {
350 :     $self->{'rpc_type'} = 'response';
351 :     push @{ $self->{'rpc_state'} }, 'params';
352 :     } elsif ($tag eq 'fault') {
353 :     $self->{'rpc_type'} = 'fault';
354 :     push @{ $self->{'rpc_state'} }, 'want_value';
355 :     }
356 :     } elsif ($state eq 'want_params') {
357 :     Frontier::RPC2::die($self, "wanted \`params' tag, got \`$tag'\n")
358 :     if ($tag ne 'params');
359 :     push @{ $self->{'rpc_state'} }, 'params';
360 :     } elsif ($state eq 'params') {
361 :     Frontier::RPC2::die($self, "wanted \`param' tag, got \`$tag'\n")
362 :     if ($tag ne 'param');
363 :     push @{ $self->{'rpc_state'} }, 'want_param_name_or_value';
364 :     } elsif ($state eq 'want_param_name_or_value') {
365 :     if ($tag eq 'value') {
366 :     $self->{'may_get_cdata'} = 1;
367 :     $self->{'rpc_text'} = "";
368 :     push @{ $self->{'rpc_state'} }, 'value';
369 :     } elsif ($tag eq 'name') {
370 :     push @{ $self->{'rpc_state'} }, 'param_name';
371 :     } else {
372 :     Frontier::RPC2::die($self, "wanted \`value' or \`name' tag, got \`$tag'\n");
373 :     }
374 :     } elsif ($state eq 'param_name') {
375 :     Frontier::RPC2::die($self, "wanted parameter name data, got tag \`$tag'\n");
376 :     } elsif ($state eq 'want_value') {
377 :     Frontier::RPC2::die($self, "wanted \`value' tag, got \`$tag'\n")
378 :     if ($tag ne 'value');
379 :     $self->{'rpc_text'} = "";
380 :     $self->{'may_get_cdata'} = 1;
381 :     push @{ $self->{'rpc_state'} }, 'value';
382 :     } elsif ($state eq 'value') {
383 :     $self->{'may_get_cdata'} = 0;
384 :     if ($tag eq 'array') {
385 :     push @{ $self->{'rpc_container'} }, [];
386 :     push @{ $self->{'rpc_state'} }, 'want_data';
387 :     } elsif ($tag eq 'struct') {
388 :     push @{ $self->{'rpc_container'} }, {};
389 :     push @{ $self->{'rpc_member_name'} }, undef;
390 :     push @{ $self->{'rpc_state'} }, 'struct';
391 :     } elsif ($scalars{$tag}) {
392 :     $self->{'rpc_text'} = "";
393 :     push @{ $self->{'rpc_state'} }, 'cdata';
394 :     } else {
395 :     Frontier::RPC2::die($self, "wanted a data type, got \`$tag'\n");
396 :     }
397 :     } elsif ($state eq 'want_data') {
398 :     Frontier::RPC2::die($self, "wanted \`data', got \`$tag'\n")
399 :     if ($tag ne 'data');
400 :     push @{ $self->{'rpc_state'} }, 'array';
401 :     } elsif ($state eq 'array') {
402 :     Frontier::RPC2::die($self, "wanted \`value' tag, got \`$tag'\n")
403 :     if ($tag ne 'value');
404 :     $self->{'rpc_text'} = "";
405 :     $self->{'may_get_cdata'} = 1;
406 :     push @{ $self->{'rpc_state'} }, 'value';
407 :     } elsif ($state eq 'struct') {
408 :     Frontier::RPC2::die($self, "wanted \`member' tag, got \`$tag'\n")
409 :     if ($tag ne 'member');
410 :     push @{ $self->{'rpc_state'} }, 'want_member_name';
411 :     } elsif ($state eq 'want_member_name') {
412 :     Frontier::RPC2::die($self, "wanted \`name' tag, got \`$tag'\n")
413 :     if ($tag ne 'name');
414 :     push @{ $self->{'rpc_state'} }, 'member_name';
415 :     $self->{'rpc_text'} = "";
416 :     } elsif ($state eq 'member_name') {
417 :     Frontier::RPC2::die($self, "wanted data, got tag \`$tag'\n");
418 :     } elsif ($state eq 'cdata') {
419 :     Frontier::RPC2::die($self, "wanted data, got tag \`$tag'\n");
420 :     } else {
421 :     Frontier::RPC2::die($self, "internal error, unknown state \`$state'\n");
422 :     }
423 :     }
424 :    
425 :     sub end {
426 :     my $self = shift; my $tag = shift;
427 :    
428 :     my $state = pop @{ $self->{'rpc_state'} };
429 :    
430 :     if ($state eq 'cdata') {
431 :     my $value = $self->{'rpc_text'};
432 :     if ($tag eq 'base64') {
433 :     $value = Frontier::RPC2::Base64->new($value);
434 :     } elsif ($tag eq 'boolean') {
435 :     $value = Frontier::RPC2::Boolean->new($value);
436 :     } elsif ($tag eq 'dateTime.iso8601') {
437 :     $value = Frontier::RPC2::DateTime::ISO8601->new($value);
438 :     } elsif ($self->{'use_objects'}) {
439 :     if ($tag eq 'i4') {
440 :     $value = Frontier::RPC2::Integer->new($value);
441 :     } elsif ($tag eq 'float') {
442 :     $value = Frontier::RPC2::Float->new($value);
443 :     } elsif ($tag eq 'string') {
444 :     $value = Frontier::RPC2::String->new($value);
445 :     }
446 :     }
447 :     $self->{'rpc_value'} = $value;
448 :     } elsif ($state eq 'member_name') {
449 :     $self->{'rpc_member_name'}[-1] = $self->{'rpc_text'};
450 :     $self->{'rpc_state'}[-1] = 'want_value';
451 :     } elsif ($state eq 'method_name') {
452 :     $self->{'rpc_method_name'} = $self->{'rpc_text'};
453 :     $self->{'rpc_state'}[-1] = 'want_params';
454 :     } elsif ($state eq 'struct') {
455 :     $self->{'rpc_value'} = pop @{ $self->{'rpc_container'} };
456 :     pop @{ $self->{'rpc_member_name'} };
457 :     } elsif ($state eq 'array') {
458 :     $self->{'rpc_value'} = pop @{ $self->{'rpc_container'} };
459 :     } elsif ($state eq 'value') {
460 :     # the rpc_text is a string if no type tags were given
461 :     if ($self->{'may_get_cdata'}) {
462 :     $self->{'may_get_cdata'} = 0;
463 :     if ($self->{'use_objects'}) {
464 :     $self->{'rpc_value'}
465 :     = Frontier::RPC2::String->new($self->{'rpc_text'});
466 :     } else {
467 :     $self->{'rpc_value'} = $self->{'rpc_text'};
468 :     }
469 :     }
470 :     my $container = $self->{'rpc_container'}[-1];
471 :     if (ref($container) eq 'ARRAY') {
472 :     push @$container, $self->{'rpc_value'};
473 :     } elsif (ref($container) eq 'HASH') {
474 :     $container->{ $self->{'rpc_member_name'}[-1] } = $self->{'rpc_value'};
475 :     }
476 :     }
477 :     }
478 :    
479 :     sub char {
480 :     my $self = shift; my $text = shift;
481 :    
482 :     $self->{'rpc_text'} .= $text;
483 :     }
484 :    
485 :     sub proc {
486 :     }
487 :    
488 :     sub final {
489 :     my $self = shift;
490 :    
491 :     $self->{'rpc_value'} = pop @{ $self->{'rpc_container'} };
492 :    
493 :     return {
494 :     value => $self->{'rpc_value'},
495 :     type => $self->{'rpc_type'},
496 :     method_name => $self->{'rpc_method_name'},
497 :     };
498 :     }
499 :    
500 :     package Frontier::RPC2::DataType;
501 :    
502 :     sub new {
503 :     my $type = shift; my $value = shift;
504 :    
505 :     return bless \$value, $type;
506 :     }
507 :    
508 :     # `repr' returns the XML representation of this data, which may be
509 :     # different [in the future] from what is returned from `value'
510 :     sub repr {
511 :     my $self = shift;
512 :    
513 :     return $$self;
514 :     }
515 :    
516 :     # sets or returns the usable value of this data
517 :     sub value {
518 :     my $self = shift;
519 :     @_ ? ($$self = shift) : $$self;
520 :     }
521 :    
522 :     package Frontier::RPC2::Base64;
523 :    
524 :     use vars qw{@ISA};
525 :     @ISA = qw{Frontier::RPC2::DataType};
526 :    
527 :     package Frontier::RPC2::Boolean;
528 :    
529 :     use vars qw{@ISA};
530 :     @ISA = qw{Frontier::RPC2::DataType};
531 :    
532 :     package Frontier::RPC2::Integer;
533 :    
534 :     use vars qw{@ISA};
535 :     @ISA = qw{Frontier::RPC2::DataType};
536 :    
537 :     package Frontier::RPC2::String;
538 :    
539 :     use vars qw{@ISA};
540 :     @ISA = qw{Frontier::RPC2::DataType};
541 :    
542 :     package Frontier::RPC2::Double;
543 :    
544 :     use vars qw{@ISA};
545 :     @ISA = qw{Frontier::RPC2::DataType};
546 :    
547 :     package Frontier::RPC2::DateTime::ISO8601;
548 :    
549 :     use vars qw{@ISA};
550 :     @ISA = qw{Frontier::RPC2::DataType};
551 :    
552 :     =head1 NAME
553 :    
554 :     Frontier::RPC2 - encode/decode RPC2 format XML
555 :    
556 :     =head1 SYNOPSIS
557 :    
558 :     use Frontier::RPC2;
559 :    
560 :     $coder = Frontier::RPC2->new;
561 :    
562 :     $xml_string = $coder->encode_call($method, @args);
563 :     $xml_string = $coder->encode_response($result);
564 :     $xml_string = $coder->encode_fault($code, $message);
565 :    
566 :     $call = $coder->decode($xml_string);
567 :    
568 :     $response_xml = $coder->serve($request_xml, $methods);
569 :    
570 :     $boolean_object = $coder->boolean($boolean);
571 :     $date_time_object = $coder->date_time($date_time);
572 :     $base64_object = $coder->base64($base64);
573 :     $int_object = $coder->int(42);
574 :     $float_object = $coder->float(3.14159);
575 :     $string_object = $coder->string("Foo");
576 :    
577 :     =head1 DESCRIPTION
578 :    
579 :     I<Frontier::RPC2> encodes and decodes XML RPC calls.
580 :    
581 :     =over 4
582 :    
583 :     =item $coder = Frontier::RPC2->new( I<OPTIONS> )
584 :    
585 :     Create a new encoder/decoder. The following option is supported:
586 :    
587 :     =over 4
588 :    
589 :     =item encoding
590 :    
591 :     The XML encoding to be specified in the XML declaration of encoded RPC
592 :     requests or responses. Decoded results may have a different encoding
593 :     specified; XML::Parser will convert decoded data to UTF-8. The
594 :     default encoding is none, which uses XML 1.0's default of UTF-8. For
595 :     example:
596 :    
597 :     $server = Frontier::RPC2->new( 'encoding' => 'ISO-8859-1' );
598 :    
599 :     =item use_objects
600 :    
601 :     If set to a non-zero value will convert incoming E<lt>i4E<gt>,
602 :     E<lt>floatE<gt>, and E<lt>stringE<gt> values to objects instead of
603 :     scalars. See int(), float(), and string() below for more details.
604 :    
605 :     =back
606 :    
607 :     =item $xml_string = $coder->encode_call($method, @args)
608 :    
609 :     `C<encode_call>' converts a method name and it's arguments into an
610 :     RPC2 `C<methodCall>' element, returning the XML fragment.
611 :    
612 :     =item $xml_string = $coder->encode_response($result)
613 :    
614 :     `C<encode_response>' converts the return value of a procedure into an
615 :     RPC2 `C<methodResponse>' element containing the result, returning the
616 :     XML fragment.
617 :    
618 :     =item $xml_string = $coder->encode_fault($code, $message)
619 :    
620 :     `C<encode_fault>' converts a fault code and message into an RPC2
621 :     `C<methodResponse>' element containing a `C<fault>' element, returning
622 :     the XML fragment.
623 :    
624 :     =item $call = $coder->decode($xml_string)
625 :    
626 :     `C<decode>' converts an XML string containing an RPC2 `C<methodCall>'
627 :     or `C<methodResponse>' element into a hash containing three members,
628 :     `C<type>', `C<value>', and `C<method_name>'. `C<type>' is one of
629 :     `C<call>', `C<response>', or `C<fault>'. `C<value>' is array
630 :     containing the parameters or result of the RPC. For a `C<call>' type,
631 :     `C<value>' contains call's parameters and `C<method_name>' contains
632 :     the method being called. For a `C<response>' type, the `C<value>'
633 :     array contains call's result. For a `C<fault>' type, the `C<value>'
634 :     array contains a hash with the two members `C<faultCode>' and
635 :     `C<faultMessage>'.
636 :    
637 :     =item $response_xml = $coder->serve($request_xml, $methods)
638 :    
639 :     `C<serve>' decodes `C<$request_xml>', looks up the called method name
640 :     in the `C<$methods>' hash and calls it, and then encodes and returns
641 :     the response as XML.
642 :    
643 :     =item $boolean_object = $coder->boolean($boolean);
644 :    
645 :     =item $date_time_object = $coder->date_time($date_time);
646 :    
647 :     =item $base64_object = $coder->base64($base64);
648 :    
649 :     These methods create and return XML-RPC-specific datatypes that can be
650 :     passed to the encoder. The decoder may also return these datatypes.
651 :     The corresponding package names (for use with `C<ref()>', for example)
652 :     are `C<Frontier::RPC2::Boolean>',
653 :     `C<Frontier::RPC2::DateTime::ISO8601>', and
654 :     `C<Frontier::RPC2::Base64>'.
655 :    
656 :     You can change and retrieve the value of boolean, date/time, and
657 :     base64 data using the `C<value>' method of those objects, i.e.:
658 :    
659 :     $boolean = $boolean_object->value;
660 :    
661 :     $boolean_object->value(1);
662 :    
663 :     =item $int_object = $coder->int(42);
664 :    
665 :     =item $float_object = $coder->float(3.14159);
666 :    
667 :     =item $string_object = $coder->string("Foo");
668 :    
669 :     By default, you may pass ordinary Perl values (scalars) to be encoded.
670 :     RPC2 automatically converts them to XML-RPC types if they look like an
671 :     integer, float, or as a string. This assumption causes problems when
672 :     you want to pass a string that looks like "0096", RPC2 will convert
673 :     that to an E<lt>i4E<gt> because it looks like an integer. With these
674 :     methods, you could now create a string object like this:
675 :    
676 :     $part_num = $coder->string("0096");
677 :    
678 :     and be confident that it will be passed as an XML-RPC string. You can
679 :     change and retrieve values from objects using value() as described
680 :     above.
681 :    
682 :     =back
683 :    
684 :     =head1 SEE ALSO
685 :    
686 :     perl(1), Frontier::Daemon(3), Frontier::Client(3)
687 :    
688 :     <http://www.scripting.com/frontier5/xml/code/rpc.html>
689 :    
690 :     =head1 AUTHOR
691 :    
692 :     Ken MacLeod <ken@bitsko.slc.ut.us>
693 :    
694 :     =cut
695 :    
696 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9