aboutsummaryrefslogtreecommitdiffstatshomepage
path: root/ThirdParty/3Di/RegionMonitor/MonitorGUI/htdocs/XML/RPC.pm
blob: 5d9b38835b2396a7aac2c5469d95f08ed64b1c8b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
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;