| Protocol-XMLRPC documentation | Contained in the Protocol-XMLRPC distribution. |
Protocol::XMLRPC::Method - methodCall and methodResponse base class
package Protocol::XMLRPC::MethodCall;
use warnings;
use strict;
use base 'Protocol::XMLRPC::Method';
...
1;
A base class for Protocol::XMLRPC::MethodCall and Protocol::XMLRPC::MethodCall. Used internally.
parseParses xml.
Viacheslav Tykhanovskyi, vti@cpan.org.
Copyright (C) 2009, Viacheslav Tykhanovskyi.
This program is free software, you can redistribute it and/or modify it under the same terms as Perl 5.10.
| Protocol-XMLRPC documentation | Contained in the Protocol-XMLRPC distribution. |
package Protocol::XMLRPC::Method; use strict; use warnings; use Protocol::XMLRPC::Value::Double; use Protocol::XMLRPC::Value::String; use Protocol::XMLRPC::Value::Integer; use Protocol::XMLRPC::Value::Array; use Protocol::XMLRPC::Value::Boolean; use Protocol::XMLRPC::Value::DateTime; use Protocol::XMLRPC::Value::Struct; use Protocol::XMLRPC::Value::Base64; use XML::LibXML; use overload '""' => sub { shift->to_string }, fallback => 1; sub new { my $class = shift; my $self = {@_}; bless $self, $class; return $self; } sub parse { my $class = shift; my ($xml) = @_; my $parser = XML::LibXML->new; my $doc; eval {$doc = $parser->parse_string($xml); }; return if $@; return $class->_parse_document($doc); } sub _parse_document { } sub _parse_value { my $self = shift; my ($value) = @_; my @types = $value->childNodes; if (@types == 1 && !$types[0]->isa('XML::LibXML::Element')) { return Protocol::XMLRPC::Value::String->new($types[0]->textContent); } my ($type) = grep { $_->isa('XML::LibXML::Element') } @types; if ($type->getName eq 'string') { my $value = $type->textContent; return Protocol::XMLRPC::Value::String->new($value); } elsif ($type->getName eq 'i4' || $type->getName eq 'int') { my $value = $type->textContent; return unless $value =~ m/^(?:\+|-)?\d+$/; return Protocol::XMLRPC::Value::Integer->new($type->textContent, alias => $type->getName); } elsif ($type->getName eq 'double') { my $value = $type->textContent; return unless $value =~ m/^(?:\+|-)?\d+(?:\.\d+)?$/; return Protocol::XMLRPC::Value::Double->new($type->textContent); } elsif ($type->getName eq 'boolean') { my $value = $type->textContent; return unless $value =~ m/^(?:0|false|1|true)$/; return Protocol::XMLRPC::Value::Boolean->new($type->textContent); } elsif ($type->getName eq 'dateTime.iso8601') { my $value = $type->textContent; return unless $value =~ m/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d):(\d\d):(\d\d)$/; return Protocol::XMLRPC::Value::DateTime->parse($type->textContent); } elsif ($type->getName eq 'base64') { my $value = $type->textContent; return unless $value =~ m/^[A-Za-z0-9\+\/=]+$/; return Protocol::XMLRPC::Value::Base64->parse($value); } elsif ($type->getName eq 'struct') { my $struct = Protocol::XMLRPC::Value::Struct->new; my @members = $type->getElementsByTagName('member'); foreach my $member (@members) { my ($name) = $member->getElementsByTagName('name'); my ($value) = $member->getElementsByTagName('value'); if (my $param = $self->_parse_value($value)) { $struct->add_member($name->textContent => $param); } else { last; } } return $struct; } elsif ($type->getName eq 'array') { my $array = Protocol::XMLRPC::Value::Array->new; my ($data) = $type->getElementsByTagName('data'); my (@values) = grep {$_->isa('XML::LibXML::Element')} $data->childNodes; foreach my $value (@values) { if (my $param = $self->_parse_value($value)) { $array->add_data($param); } else { last; } } return $array; } return; } 1; __END__