Parent Directory
|
Revision Log
Experimental xmlrpc WeBWorK webservices
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$ 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$=~/\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 = new RPC::XML::struct $_; 98 } 99 elsif ($type eq 'ARRAY') 100 { 101 $type = new RPC::XML::array $_; 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 = new RPC::XML::int $_; 113 } 114 # Pattern taken from perldata(1) 115 elsif (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) 116 { 117 $type = new RPC::XML::double $_; 118 } 119 else 120 { 121 $type = new RPC::XML::string $_; 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 138 ############################################################################### 139 # 140 # Package: RPC::XML::simple_type 141 # 142 # Description: A base class for the simpler type-classes to inherit from, 143 # for default constructor, stringification, etc. 144 # 145 # Globals: None. 146 # 147 # Environment: None. 148 # 149 ############################################################################### 150 package RPC::XML::simple_type; 151 152 use strict; 153 use vars qw(@ISA); 154 155 @ISA = qw(RPC::XML::datatype); 156 157 # new - a generic constructor that presumes the value being stored is scalar 158 sub new 159 { 160 my $class = shift; 161 my $value = shift; 162 163 $RPC::XML::ERROR = ''; 164 $class = ref($class) || $class; 165 bless \$value, $class; 166 } 167 168 # value - a generic accessor 169 sub value 170 { 171 my $self = shift; 172 173 $$self; 174 } 175 176 # as_string - return the value as an XML snippet 177 sub as_string 178 { 179 my $self = shift; 180 my $indent = shift || 0; 181 182 my $class; 183 return unless ($class = ref($self)); 184 $class =~ s/^.*\://; 185 $class =~ s/_/./g; 186 substr($class, 0, 8) = 'dateTime' if (substr($class, 0, 8) eq 'datetime'); 187 my $padding = ' ' x $indent; 188 189 "$padding<$class>$$self</$class>"; 190 } 191 192 ############################################################################### 193 # 194 # Package: RPC::XML::int 195 # 196 # Description: Data-type class for integers 197 # 198 # Globals: None. 199 # 200 # Environment: None. 201 # 202 ############################################################################### 203 package RPC::XML::int; 204 205 use strict; 206 use vars qw(@ISA); 207 208 @ISA = qw(RPC::XML::simple_type); 209 210 ############################################################################### 211 # 212 # Package: RPC::XML::i4 213 # 214 # Description: Data-type class for i4. Forces data into an int object. 215 # 216 # Globals: None. 217 # 218 # Environment: None. 219 # 220 ############################################################################### 221 package RPC::XML::i4; 222 223 use strict; 224 use vars qw(@ISA); 225 226 @ISA = qw(RPC::XML::simple_type); 227 228 ############################################################################### 229 # 230 # Package: RPC::XML::double 231 # 232 # Description: The "double" type-class 233 # 234 # Globals: None. 235 # 236 # Environment: None. 237 # 238 ############################################################################### 239 package RPC::XML::double; 240 241 use strict; 242 use vars qw(@ISA); 243 244 @ISA = qw(RPC::XML::simple_type); 245 246 ############################################################################### 247 # 248 # Package: RPC::XML::string 249 # 250 # Description: The "string" type-class 251 # 252 # Globals: None. 253 # 254 # Environment: None. 255 # 256 ############################################################################### 257 package RPC::XML::string; 258 259 use strict; 260 use vars qw(@ISA); 261 262 @ISA = qw(RPC::XML::datatype); 263 264 sub new 265 { 266 my $class = shift; 267 my $value = shift; 268 269 $value =~ s/&/&/g; 270 $value =~ s/</</g; 271 $value =~ s/>/>/g; 272 273 bless \$value, $class; 274 } 275 276 # value - a generic accessor 277 sub value 278 { 279 my $self = shift; 280 281 my $text = $$self; 282 $text =~ s/</</g; 283 $text =~ s/>/>/g; 284 $text =~ s/&/&/g; 285 286 $text; 287 } 288 289 # as_string - return the value as an XML snippet 290 sub as_string 291 { 292 my $self = shift; 293 my $indent = shift || 0; 294 295 my ($class, $text); 296 297 return unless ($class = ref($self)); 298 $class =~ s/^.*\://; 299 $text = $self->value; 300 my $padding = ' ' x $indent; 301 302 "$padding<$class>$text</$class>"; 303 } 304 305 ############################################################################### 306 # 307 # Package: RPC::XML::boolean 308 # 309 # Description: The type-class for boolean data. Handles some "extra" cases 310 # 311 # Globals: None. 312 # 313 # Environment: None. 314 # 315 ############################################################################### 316 package RPC::XML::boolean; 317 318 use strict; 319 use vars qw(@ISA); 320 321 @ISA = qw(RPC::XML::simple_type); 322 323 # This constructor allows any of true, false, yes or no to be specified 324 sub new 325 { 326 my $class = shift; 327 my $value = shift || 0; 328 329 $RPC::XML::ERROR = ''; 330 if ($value =~ /true|yes/i) 331 { 332 $value = 1; 333 } 334 elsif ($value =~ /false|no/i) 335 { 336 $value = 0; 337 } 338 339 unless ($value == 1 or $value == 0) 340 { 341 $class = ref($class) || $class; 342 $RPC::XML::ERROR = "${class}::new: Value must be one of yes, no, " . 343 'true, false, 1, 0 (case-insensitive)'; 344 return undef; 345 } 346 347 bless \$value, $class; 348 } 349 350 ############################################################################### 351 # 352 # Package: RPC::XML::datetime_iso8601 353 # 354 # Description: This is the class to manage ISO8601-style date/time values 355 # 356 # Globals: None. 357 # 358 # Environment: None. 359 # 360 ############################################################################### 361 package RPC::XML::datetime_iso8601; 362 363 use strict; 364 use vars qw(@ISA); 365 366 @ISA = qw(RPC::XML::simple_type); 367 368 sub type { 'dateTime.iso8601' }; 369 370 ############################################################################### 371 # 372 # Package: RPC::XML::array 373 # 374 # Description: This class encapsulates the array data type. Each element 375 # within the array should be one of the datatype classes. 376 # 377 # Globals: None. 378 # 379 # Environment: None. 380 # 381 ############################################################################### 382 package RPC::XML::array; 383 384 use strict; 385 use vars qw(@ISA); 386 387 @ISA = qw(RPC::XML::datatype); 388 389 # The constructor for this class mainly needs to sanity-check the value data 390 sub new 391 { 392 my $class = shift; 393 my @args = (ref($_[0]) eq 'ARRAY') ? @{$_[0]} : @_; 394 395 # First ensure that each argument passed in is itself one of the data-type 396 # class instances. 397 for (@args) 398 { 399 $_ = RPC::XML::smart_encode($_) 400 unless (UNIVERSAL::isa($_, 'RPC::XML::datatype')); 401 } 402 403 bless \@args, $class; 404 } 405 406 # This became more complex once it was shown that there may be a need to fetch 407 # the value while preserving the underlying objects. 408 sub value 409 { 410 my $self = shift; 411 my $no_recurse = shift || 0; 412 my $ret; 413 414 if ($no_recurse) 415 { 416 $ret = [ @$self ]; 417 } 418 else 419 { 420 $ret = [ map { $_->value } @$self ]; 421 } 422 423 $ret; 424 } 425 426 sub as_string 427 { 428 my $self = shift; 429 my $indent = shift || 0; 430 my @text; 431 432 # 433 # Since this is a reference implementation, I want the output of an array 434 # when stringified to be somewhat readable. To help with this, I allow a 435 # second parameter here that will be used in recursive calls to set a base 436 # indent level. Also, the <data> tag will be used for compatibility. 437 # 438 my $padding = ' ' x $indent; 439 440 push(@text, 441 "$padding<array>", 442 "$padding <data>", 443 (map { 444 ("$padding <value>", 445 $_->as_string($indent + 3), 446 "$padding </value>") 447 } (@$self)), 448 "$padding </data>", 449 "$padding</array>"); 450 451 join("\n", @text); 452 } 453 454 ############################################################################### 455 # 456 # Package: RPC::XML::struct 457 # 458 # Description: This is the "struct" data class. The struct is like Perl's 459 # hash, with the constraint that all values are instances 460 # of the datatype classes. 461 # 462 # Globals: None. 463 # 464 # Environment: None. 465 # 466 ############################################################################### 467 package RPC::XML::struct; 468 469 use strict; 470 use vars qw(@ISA); 471 472 @ISA = qw(RPC::XML::datatype); 473 474 # The constructor for this class mainly needs to sanity-check the value data 475 sub new 476 { 477 my $class = shift; 478 my %args = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_; 479 480 # First ensure that each argument passed in is itself one of the data-type 481 # class instances. 482 for (keys %args) 483 { 484 $args{$_} = RPC::XML::smart_encode($args{$_}) 485 unless (UNIVERSAL::isa($args{$_}, 'RPC::XML::datatype')); 486 } 487 488 bless \%args, $class; 489 } 490 491 # This became more complex once it was shown that there may be a need to fetch 492 # the value while preserving the underlying objects. 493 sub value 494 { 495 my $self = shift; 496 my $no_recurse = shift || 0; 497 my %value; 498 499 if ($no_recurse) 500 { 501 %value = map { $_, $self->{$_} } (keys %$self); 502 } 503 else 504 { 505 %value = map { $_, $self->{$_}->value } (keys %$self); 506 } 507 508 \%value; 509 } 510 511 sub as_string 512 { 513 my $self = shift; 514 my $indent = shift || 0; 515 516 # 517 # Since this is a reference implementation, I want the output of a struct 518 # when stringified to be somewhat readable. To help with this, I allow a 519 # second parameter here that will be used in recursive calls to set a base 520 # indent level. 521 # 522 my $padding = ' ' x $indent; 523 524 join("\n", 525 "$padding<struct>", 526 (map { 527 ("$padding <member>", 528 "$padding <name>$_</name>", 529 "$padding <value>", 530 $self->{$_}->as_string($indent + 3), 531 "$padding </value>", 532 "$padding </member>") 533 } (keys %$self)), 534 "$padding</struct>"); 535 } 536 537 ############################################################################### 538 # 539 # Package: RPC::XML::base64 540 # 541 # Description: This is the base64-encoding type. Plain data is passed in, 542 # plain data is returned. Plain is always returned. All the 543 # encoding/decoding is done behind the scenes. 544 # 545 # Globals: None. 546 # 547 # Environment: None. 548 # 549 ############################################################################### 550 package RPC::XML::base64; 551 552 use strict; 553 use vars qw(@ISA); 554 555 @ISA = qw(RPC::XML::simple_type); 556 557 use MIME::Base64; 558 559 sub new 560 { 561 my ($class, $value, $encoded) = @_; 562 563 $RPC::XML::ERROR = ''; 564 $value = $$value if (ref $value); 565 unless (defined $value and length $value) 566 { 567 $class = ref($class) || $class; 568 $RPC::XML::ERROR = "${class}::new: Must be called with non-null data"; 569 return undef; 570 } 571 if ($encoded) 572 { 573 $value = MIME::Base64::decode_base64 $value; 574 } 575 576 bless \$value, $class; 577 } 578 579 # The value needs to be encoded before being output 580 sub as_string 581 { 582 my $self = shift; 583 my $indent = shift || 0; 584 585 my $padding = $indent x ' '; 586 587 "$padding<value>" . MIME::Base64::encode_base64($$self) . "</value>\n"; 588 } 589 590 ############################################################################### 591 # 592 # Package: RPC::XML::fault 593 # 594 # Description: This is the class that encapsulates the data for a RPC 595 # fault-response. Like the others, it takes the relevant 596 # information and maintains it internally. This is put 597 # at the end of the datum types, though it isn't really a 598 # data type in the sense that it cannot be passed in to a 599 # request. But it is separated so as to better generalize 600 # responses. 601 # 602 # Globals: None. 603 # 604 # Environment: None. 605 # 606 ############################################################################### 607 package RPC::XML::fault; 608 609 use strict; 610 use vars qw(@ISA); 611 612 @ISA = qw(RPC::XML::struct); 613 614 # For our new(), we only need to ensure that we have the two required members 615 sub new 616 { 617 my $class = shift; 618 my @args = @_; 619 620 my ($self, %args); 621 622 $RPC::XML::ERROR = ''; 623 if (ref($args[0]) and UNIVERSAL::isa($args[0], 'RPC::XML::struct')) 624 { 625 # Take the keys and values from the struct object as our own 626 %args = %{$args[0]->value('shallow')}; 627 } 628 elsif (@args == 2) 629 { 630 # This is a special convenience-case to make simple new() calls clearer 631 %args = (faultCode => RPC::XML::int->new($args[0]), 632 faultString => RPC::XML::string->new($args[1])); 633 } 634 else 635 { 636 %args = @args; 637 } 638 639 unless ($args{faultCode} and $args{faultString}) 640 { 641 $class = ref($class) || $class; 642 $RPC::XML::ERROR = "${class}::new: Missing required struct fields"; 643 return undef; 644 } 645 if (scalar(keys %args) > 2) 646 { 647 $class = ref($class) || $class; 648 $RPC::XML::ERROR = "${class}::new: Extra struct fields not allowed"; 649 return undef; 650 } 651 652 $self = $class->SUPER::new(%args); 653 } 654 655 # This only differs from the display of a struct in that it has some extra 656 # wrapped around it. Let the superclass as_string method do most of the work. 657 sub as_string 658 { 659 my $self = shift; 660 my $indent = shift || 0; 661 662 my $padding = ' ' x $indent; 663 664 join("\n", 665 "$padding<fault>", 666 "$padding <value>", 667 $self->SUPER::as_string($indent + 2), 668 "$padding </value>", 669 "$padding</fault>"); 670 } 671 672 ############################################################################### 673 # 674 # Package: RPC::XML::request 675 # 676 # Description: This is the class that encapsulates the data for a RPC 677 # request. It takes the relevant information and maintains 678 # it internally until asked to stringify. Only then is the 679 # XML generated, encoding checked, etc. This allows for 680 # late-selection of <methodCall> or <methodCallSet> as a 681 # containing tag. 682 # 683 # This class really only needs a constructor and a method 684 # to stringify. 685 # 686 # Globals: None. 687 # 688 # Environment: None. 689 # 690 ############################################################################### 691 package RPC::XML::request; 692 693 use strict; 694 use vars qw(@ISA); 695 696 ############################################################################### 697 # 698 # Sub Name: new 699 # 700 # Description: Creating a new request object, in this (reference) case, 701 # means checking the list of arguments for sanity and 702 # packaging it up for later use. 703 # 704 # Arguments: NAME IN/OUT TYPE DESCRIPTION 705 # $class in scalar Class/ref to bless into 706 # @argz in list The exact disposition of the 707 # arguments is based on the 708 # type of the various elements 709 # 710 # Globals: None. 711 # 712 # Environment: None. 713 # 714 # Returns: Success: object ref 715 # Failure: undef, error in $RPC::XML::ERROR 716 # 717 ############################################################################### 718 sub new 719 { 720 my $class = shift; 721 my @argz = @_; 722 723 my ($self, $name); 724 725 $class = ref($class) || $class; 726 727 if (! ref($argz[0])) 728 { 729 # Assume that this is the method name to be called 730 $name = shift(@argz); 731 } 732 733 $RPC::XML::ERROR = ''; 734 if (UNIVERSAL::isa($argz[0], 'RPC::XML::request')) 735 { 736 # Maybe this will be a clone operation 737 } 738 elsif (! $name) 739 { 740 $RPC::XML::ERROR = 'RPC::XML::request::new: At least a method name ' . 741 'must be specified'; 742 } 743 else 744 { 745 # All the remaining args must be datatypes. 746 @argz = RPC::XML::smart_encode(@argz); 747 $self = { args => [ @argz ], name => $name }; 748 bless $self, $class; 749 } 750 751 $self; 752 } 753 754 # Accessor methods 755 sub name { shift->{name} } 756 sub args { shift->{args} || [] } 757 758 ############################################################################### 759 # 760 # Sub Name: as_string 761 # 762 # Description: This is a fair bit more complex than the simple as_string 763 # methods for the datatypes. Express the invoking object as 764 # a well-formed XML document. 765 # 766 # Arguments: NAME IN/OUT TYPE DESCRIPTION 767 # $self in ref Invoking object 768 # $indent in scalar Indention level for output 769 # 770 # Globals: None. 771 # 772 # Environment: None. 773 # 774 # Returns: Success: text 775 # Failure: undef 776 # 777 ############################################################################### 778 sub as_string 779 { 780 my $self = shift; 781 my $indent = shift || 0; 782 783 my ($text, $padding, $container); 784 785 $RPC::XML::ERROR = ''; 786 787 $text = qq(<?xml version="1.0"?>\n); 788 $padding = ' ' x $indent; 789 790 $text .= "$padding<methodCall>\n"; 791 $text .= "$padding <methodName>$self->{name}</methodName>\n"; 792 $text .= "$padding <params>\n"; 793 for (@{$self->{args}}) 794 { 795 $text .= "$padding <param>\n"; 796 $text .= "$padding <value>\n"; 797 $text .= $_->as_string($indent + 4) . "\n"; 798 $text .= "$padding </value>\n"; 799 $text .= "$padding </param>\n"; 800 } 801 $text .= "$padding </params>\n"; 802 $text .= "$padding</methodCall>\n"; 803 804 $text; 805 } 806 807 ############################################################################### 808 # 809 # Package: RPC::XML::response 810 # 811 # Description: This is the class that encapsulates the data for a RPC 812 # response. As above, it takes the information and maintains 813 # it internally until asked to stringify. Only then is the 814 # XML generated, encoding checked, etc. This allows for 815 # late-selection of <methodResponse> or <methodResponseSet> 816 # as above. 817 # 818 # Globals: None. 819 # 820 # Environment: None. 821 # 822 ############################################################################### 823 package RPC::XML::response; 824 825 use strict; 826 use vars qw(@ISA); 827 828 ############################################################################### 829 # 830 # Sub Name: new 831 # 832 # Description: Creating a new response object, in this (reference) case, 833 # means checking the outgoing parameter(s) for sanity. 834 # 835 # Arguments: NAME IN/OUT TYPE DESCRIPTION 836 # $class in scalar Class/ref to bless into 837 # @argz in list The exact disposition of the 838 # arguments is based on the 839 # type of the various elements 840 # 841 # Globals: None. 842 # 843 # Environment: None. 844 # 845 # Returns: Success: object ref 846 # Failure: undef, error in $RPC::XML::ERROR 847 # 848 ############################################################################### 849 sub new 850 { 851 my $class = shift; 852 my @argz = @_; 853 854 my ($self, %extra, %attr); 855 856 $class = ref($class) || $class; 857 858 $RPC::XML::ERROR = ''; 859 if (! @argz) 860 { 861 $RPC::XML::ERROR = 'RPC::XML::response::new: One of a datatype ' . 862 'value or a fault object must be specified'; 863 } 864 elsif (UNIVERSAL::isa($argz[0], 'RPC::XML::response')) 865 { 866 # This will be a clone-op 867 } 868 elsif (@argz > 1) 869 { 870 $RPC::XML::ERROR = 'RPC::XML::response::new: Responses may take ' . 871 'only one argument'; 872 } 873 else 874 { 875 $argz[0] = RPC::XML::smart_encode($argz[0]); 876 877 $self = { value => $argz[0] }; 878 bless $self, $class; 879 } 880 881 $self; 882 } 883 884 # Accessor/status methods 885 sub value { shift->{value} } 886 sub is_fault { ($_[0]->{value}->isa('RPC::XML::fault')) ? 1 : 0 } 887 888 ############################################################################### 889 # 890 # Sub Name: as_string 891 # 892 # Description: This is a fair bit more complex than the simple as_string 893 # methods for the datatypes. Express the invoking object as 894 # a well-formed XML document. 895 # 896 # Arguments: NAME IN/OUT TYPE DESCRIPTION 897 # $self in ref Invoking object 898 # $indent in scalar Indention level for output 899 # 900 # Globals: None. 901 # 902 # Environment: None. 903 # 904 # Returns: Success: text 905 # Failure: undef 906 # 907 ############################################################################### 908 sub as_string 909 { 910 my $self = shift; 911 my $indent = shift || 0; 912 913 my ($text, $padding); 914 915 $RPC::XML::ERROR = ''; 916 917 $text = qq(<?xml version="1.0"?>\n); 918 $padding = ' ' x $indent; 919 920 $text .= "$padding<methodResponse>\n"; 921 if ($self->{value}->isa('RPC::XML::fault')) 922 { 923 $text .= $self->{value}->as_string($indent + 1) . "\n"; 924 } 925 else 926 { 927 $text .= "$padding <params>\n"; 928 $text .= "$padding <param>\n"; 929 $text .= "$padding <value>\n"; 930 $text .= $self->{value}->as_string($indent + 4) . "\n"; 931 $text .= "$padding </value>\n"; 932 $text .= "$padding </param>\n"; 933 $text .= "$padding </params>\n"; 934 } 935 $text .= "$padding</methodResponse>\n"; 936 937 $text; 938 } 939 940 941 __END__ 942 943 =head1 NAME 944 945 RPC::XML - A set of classes for core data, message and XML handling 946 947 =head1 SYNOPSIS 948 949 use RPC::XML; 950 951 $req = new RPC::XML::request ('fetch_prime_factors', 952 RPC::XML::int->new(985120528)); 953 ... 954 $resp = RPC::XML::Parser->new()->parse(STREAM); 955 if (ref($resp)) 956 { 957 return $resp->value->value; 958 } 959 else 960 { 961 die $resp; 962 } 963 964 =head1 DESCRIPTION 965 966 The B<RPC::XML> package is a reference implementation of the XML-RPC 967 standard. As a reference implementation, it is geared more towards clarity and 968 readability than efficiency. 969 970 The package provides a set of classes for creating values to pass to the 971 constructors for requests and responses. These are lightweight objects, most 972 of which are implemented as tied scalars so as to associate specific type 973 information with the value. Classes are also provided for requests, responses, 974 faults (errors) and a parser based on the L<XML::Parser> package from CPAN. 975 976 This module does not actually provide any transport implementation or 977 server basis. For these, see L<RPC::XML::Client> and L<RPC::XML::Server>, 978 respectively. 979 980 =head1 EXPORTABLE FUNCTIONS 981 982 At present, only two functions are available for import. They must be 983 explicitly imported as part of the C<use> statement, or with a direct call to 984 C<import>: 985 986 =over 4 987 988 =item time2iso8601($time) 989 990 Convert the integer time value in C<$time> to a ISO 8601 string in the UTC 991 time zone. This is a convenience function for occassions when the return value 992 needs to be of the B<dateTime.iso8601> type, but the value on hand is the 993 return from the C<time> built-in. 994 995 =item smart_encode(@args) 996 997 Converts the passed-in arguments to datatype objects. Any that are already 998 encoded as such are passed through unchanged. The routine is called recursively 999 on hash and array references. Note that this routine can only deduce a certain 1000 degree of detail about the values passed. Boolean values will be wrongly 1001 encoded as integers. Pretty much anything not specifically recognizable will 1002 get encoded as a string object. Thus, for types such as C<fault>, the ISO 1003 time value, base-64 data, etc., the program must still explicitly encode it. 1004 However, this routine will hopefully simplify things a little bit for a 1005 majority of the usage cases. 1006 1007 =back 1008 1009 =head1 CLASSES 1010 1011 The classes provided by this module are broken into two groups: I<datatype> 1012 classes and I<message> classes. 1013 1014 =head2 Data Classes 1015 1016 The following data classes are provided by this library. Each of these provide 1017 at least C<new>, C<value> and C<as_string> methods. Note that these classes 1018 are designed to create throw-away objects. There is currently no mechanism for 1019 changing the value stored within one of these object after the constructor 1020 returns. It is assumed that a new object would be created, instead. 1021 1022 The C<new> methods are constructors, C<value> returns the value stored within 1023 the object (processed recursively for arrays and structs), and C<as_string> 1024 stringifies the object as a chunk of XML with relative indention for 1025 clarity. The C<as_string> method takes as its first argument a numeric 1026 indention level, which is applied as a base indention for output. Other 1027 arguments are specified with the classes. 1028 1029 =over 4 1030 1031 =item RPC::XML::int 1032 1033 Creates an integer value. Constructor expects the integer value as an 1034 argument. 1035 1036 =item RPC::XML::i4 1037 1038 This is like the C<int> class. 1039 1040 =item RPC::XML::double 1041 1042 Creates a floating-point value. 1043 1044 =item RPC::XML::string 1045 1046 Creates an arbitrary string. No special encoding is done to the string (aside 1047 from XML document encoding, covered later) with the exception of the C<E<lt>>, 1048 C<E<gt>> and C<&> characters, which are XML-escaped during object creation, 1049 and then reverted when the C<value> method is called. 1050 1051 =item RPC::XML::boolean 1052 1053 Creates a boolean value. The value returned will always be either of B<1> 1054 or B<0>, for true or false, respectively. When calling the constructor, the 1055 program may specify any of: C<0>, C<no>, C<false>, C<1>, C<yes>, C<true>. 1056 1057 =item RPC::XML::datetime_iso8601 1058 1059 Creates an instance of the XML-RPC C<dateTime.iso8601> type. The specification 1060 for ISO 8601 may be found elsewhere. No processing is done to the data. 1061 1062 =item RPC::XML::base64 1063 1064 Creates an object that encapsulates a chunk of data that will be treated as 1065 base-64 for transport purposes. The value may be passed in as either a string 1066 or as a scalar reference. Additionally, a second (optional) parameter may be 1067 passed, that if true identifies the data as already base-64 encoded. If so, 1068 the data is decoded before storage. The C<value> method returns decoded data, 1069 and the C<as_string> method encodes it before stringification. 1070 1071 =item RPC::XML::array 1072 1073 Creates an array object. The constructor takes zero or more data-type 1074 instances as arguments, which are inserted into the array in the order 1075 specified. C<value> returns an array reference of native Perl types. If a 1076 non-null value is passed as an argument to C<value()>, then the array 1077 reference will contain the datatype objects (a shallow copy rather than a deep 1078 one). 1079 1080 =item RPC::XML::struct 1081 1082 Creates a struct object, the analogy of a hash table in Perl. The keys are 1083 ordinary strings, and the values must all be data-type objects. The C<value> 1084 method returns a hash table reference, with native Perl types in the values. 1085 Key order is not preserved. Key strings are not encoded for special XML 1086 characters, so the use of such (C<E<lt>>, C<E<gt>>, etc.) is discouraged. If a 1087 non-null value is passed as an argument to C<value()>, then the hash 1088 reference will contain the datatype objects (a shallow copy rather than a deep 1089 one). 1090 1091 =item RPC::XML::fault 1092 1093 A fault object is a special case of the struct object that checks to ensure 1094 that there are two keys, C<faultCode> and C<faultString>. 1095 1096 As a matter of convenience, since the contents of a B<RPC::XML::fault> 1097 structure are specifically defined, the constructor may be called with exactly 1098 two arguments, the first of which will be taken as the code, and the second 1099 as the string. They will be converted to RPC::XML types automatically and 1100 stored by the pre-defined key names. 1101 1102 =back 1103 1104 =head2 Message Classes 1105 1106 The message classes are used both for constructing messages for outgoing 1107 communication as well as representing the parsed contents of a received 1108 message. Both implement the following methods: 1109 1110 =over 4 1111 1112 =item new 1113 1114 This is the constructor method for the two message classes. The response class 1115 may have only a single value (as a response is currently limited to a single 1116 return value), and requests may have as many arguments as appropriate. In both 1117 cases, the arguments are passed to the exported C<smart_encode> routine 1118 described earlier. 1119 1120 =item as_string([INDENT]) 1121 1122 Returns the message object expressed as an XML document. The optional indent 1123 parameter causes the body to be indented that many steps (each step is two 1124 spaces). 1125 1126 =back 1127 1128 The two message-object classes are: 1129 1130 =over 4 1131 1132 =item RPC::XML::request 1133 1134 This creates a request object. A request object expects the first argument to 1135 be the name of the remote routine being called, and all remaining arguments 1136 are the arguments to that routine. Request objects have the following methods 1137 (besides C<new> and C<as_string>): 1138 1139 =over 4 1140 1141 =item name 1142 1143 The name of the remote routine that the request will call. 1144 1145 =item args 1146 1147 Returns a list reference with the arguments that will be passed. No arguments 1148 will result in a reference to an empty list. 1149 1150 =back 1151 1152 =item RPC::XML::response 1153 1154 The response object is much like the request object in most ways. They may 1155 take only one argument, as that is all the specification allows for in a 1156 response. Responses have the following methods (in addition to C<new> and 1157 C<as_string>): 1158 1159 =over 4 1160 1161 =item name 1162 1163 The name of the remote method that was called. This will not be set in 1164 compatibility mode. 1165 1166 =item value 1167 1168 The value the response is returning. It will be a RPC::XML data-type. 1169 1170 =item is_fault 1171 1172 A boolean test whether or not the response is signalling a fault. This is 1173 the same as taking the C<value> method return value and testing it, but is 1174 provided for clarity and simplicity. 1175 1176 =back 1177 1178 =back 1179 1180 =head1 DIAGNOSTICS 1181 1182 All constructors return C<undef> upon failure, with the error message available 1183 in the package-global variable B<C<$RPC::XML::ERROR>>. 1184 1185 =head1 CAVEATS 1186 1187 As was stated at the beginning, this is a reference implementation in which 1188 clarity of process and readability of the code took precedence over general 1189 efficiency. Much, if not all, of this can be written more compactly and/or 1190 efficiently. However, if done that will be done in a separate module so that 1191 this remains legible to the casual programmer. 1192 1193 =head1 CREDITS 1194 1195 The B<XML-RPC> standard is Copyright (c) 1998-2001, UserLand Software, Inc. 1196 See <http://www.xmlrpc.com> for more information about the B<XML-RPC> 1197 specification. 1198 1199 =head1 LICENSE 1200 1201 This module is licensed under the terms of the Artistic License that covers 1202 Perl itself. See <http://language.perl.com/misc/Artistic.html> for the 1203 license itself. 1204 1205 =head1 SEE ALSO 1206 1207 L<RPC::XML::Client>, L<RPC::XML::Server>, L<RPC::XML::Parser>, L<XML::Parser> 1208 1209 =head1 AUTHOR 1210 1211 Randy J. Ray <rjray@blackperl.com> 1212 1213 =cut
aubreyja at gmail dot com | ViewVC Help |
Powered by ViewVC 1.0.9 |