123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100 |
- package XML::RPC;
- use strict;
- use Carp;
- use RPC::XML;
- use RPC::XML::Parser;
- use RPC::XML::Client;
- sub new {
- my ($this, $url) = @_;
- my %fields = (
- parser => new RPC::XML::Parser(),
- url => $url,
- );
- return bless \%fields, $this;
- }
- sub receive {
- my ($this, $xmldata, $handler) = @_;
- my $response = undef;
- eval {
- my $request = $this->{parser}->parse($xmldata);
- my @args = map {$_->value} @{$request->args};
- $response = $handler->($request->{name}, @args);
- };
- if ($@) {
- my %error = (
- "error" => "ERROR",
- "message" => $@,
- );
- $response = \%error;
- }
- if ( ref($response) eq "RPC::XML::response" ) {
- return $response->as_string;
- }
- else {
- return RPC::XML::response->new($response)->as_string;
- }
- }
- sub call {
- my ($this, $method_name, $param) = @_;
- if (!$this->{url}) {
- Carp::croak("XMLRPC: url not set for calling $method_name");
- }
- my $client = RPC::XML::Client->new($this->{url});
- my $request_param = undef;
- my $req = undef;
- if (ref $param eq "ARRAY") {
- $request_param = &_make_array_param($param);
- $req = RPC::XML::request->new(
- $method_name,
- @$request_param,
- );
- } elsif (ref $param eq "HASH"){
- $request_param = &_make_hash_param($param);
- $req = RPC::XML::request->new(
- $method_name,
- $request_param,
- );
- } else {
- Carp::croak("unexpected param type");
- }
- my $rpc_res = undef;
- eval {
- $rpc_res = $client->send_request($req);
- };
- if ($@) {
- Carp::croak("request " . $this->{url} . "/" . $method_name . " failed. $@" );
- }
- if (ref($rpc_res) eq "RPC::XML::struct") {
- my %res = map { $_ => $rpc_res->{$_}->value } keys %$rpc_res; # remember good perl !!
- return \%res;
- } elsif (ref($rpc_res) eq "RPC::XML::string") {
- return $rpc_res->value;
- } else {
- return undef;
- }
- }
- sub _make_array_param {
- my $param = shift;
- my @array_param = ();
- foreach (@$param) {
- push @array_param, RPC::XML::string->new($_); # @@@ only string type
- }
- return \@array_param;
- }
- sub _make_hash_param {
- my $param = shift;
- my %hash_param = ();
- foreach (keys %$param) {
- $hash_param{$_} = RPC::XML::string->new($param->{$_}); # @@@ only string type
- }
- return RPC::XML::struct->new(\%hash_param);
- }
- 1;
|