RPC.pm 2.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100
  1. package XML::RPC;
  2. use strict;
  3. use Carp;
  4. use RPC::XML;
  5. use RPC::XML::Parser;
  6. use RPC::XML::Client;
  7. sub new {
  8. my ($this, $url) = @_;
  9. my %fields = (
  10. parser => new RPC::XML::Parser(),
  11. url => $url,
  12. );
  13. return bless \%fields, $this;
  14. }
  15. sub receive {
  16. my ($this, $xmldata, $handler) = @_;
  17. my $response = undef;
  18. eval {
  19. my $request = $this->{parser}->parse($xmldata);
  20. my @args = map {$_->value} @{$request->args};
  21. $response = $handler->($request->{name}, @args);
  22. };
  23. if ($@) {
  24. my %error = (
  25. "error" => "ERROR",
  26. "message" => $@,
  27. );
  28. $response = \%error;
  29. }
  30. if ( ref($response) eq "RPC::XML::response" ) {
  31. return $response->as_string;
  32. }
  33. else {
  34. return RPC::XML::response->new($response)->as_string;
  35. }
  36. }
  37. sub call {
  38. my ($this, $method_name, $param) = @_;
  39. if (!$this->{url}) {
  40. Carp::croak("XMLRPC: url not set for calling $method_name");
  41. }
  42. my $client = RPC::XML::Client->new($this->{url});
  43. my $request_param = undef;
  44. my $req = undef;
  45. if (ref $param eq "ARRAY") {
  46. $request_param = &_make_array_param($param);
  47. $req = RPC::XML::request->new(
  48. $method_name,
  49. @$request_param,
  50. );
  51. } elsif (ref $param eq "HASH"){
  52. $request_param = &_make_hash_param($param);
  53. $req = RPC::XML::request->new(
  54. $method_name,
  55. $request_param,
  56. );
  57. } else {
  58. Carp::croak("unexpected param type");
  59. }
  60. my $rpc_res = undef;
  61. eval {
  62. $rpc_res = $client->send_request($req);
  63. };
  64. if ($@) {
  65. Carp::croak("request " . $this->{url} . "/" . $method_name . " failed. $@" );
  66. }
  67. if (ref($rpc_res) eq "RPC::XML::struct") {
  68. my %res = map { $_ => $rpc_res->{$_}->value } keys %$rpc_res; # remember good perl !!
  69. return \%res;
  70. } elsif (ref($rpc_res) eq "RPC::XML::string") {
  71. return $rpc_res->value;
  72. } else {
  73. return undef;
  74. }
  75. }
  76. sub _make_array_param {
  77. my $param = shift;
  78. my @array_param = ();
  79. foreach (@$param) {
  80. push @array_param, RPC::XML::string->new($_); # @@@ only string type
  81. }
  82. return \@array_param;
  83. }
  84. sub _make_hash_param {
  85. my $param = shift;
  86. my %hash_param = ();
  87. foreach (keys %$param) {
  88. $hash_param{$_} = RPC::XML::string->new($param->{$_}); # @@@ only string type
  89. }
  90. return RPC::XML::struct->new(\%hash_param);
  91. }
  92. 1;