1 |
#!/usr/bin/perl |
2 |
## |
3 |
## POE::Component::RPCXML::Client -- XML-RPC Client Component |
4 |
## |
5 |
## $Id: Client.pm,v 1.2 2001/09/20 01:32:38 fletch Exp $ |
6 |
## |
7 |
package POE::Component::RPCXML::Client; |
8 |
|
9 |
use strict; |
10 |
|
11 |
use Carp qw( croak carp ); |
12 |
|
13 |
use POE qw( Kernel Session Component::Client::HTTP ); |
14 |
|
15 |
use HTTP::Request (); |
16 |
use HTTP::Response (); |
17 |
|
18 |
use RPC::XML (); |
19 |
use RPC::XML::Parser (); |
20 |
|
21 |
my %default_args = ( |
22 |
Debug => undef, |
23 |
Alias => 'rpcxml', |
24 |
); |
25 |
|
26 |
my $states = { |
27 |
_start => 'start', |
28 |
_stop => 'stop', |
29 |
_signal => 'signal', |
30 |
_default => 'default', |
31 |
call => 'call', |
32 |
response => 'response', |
33 |
}; |
34 |
|
35 |
sub new { |
36 |
my $class = shift; |
37 |
$class = ref( $class ) || $class; |
38 |
my( %args ) = ( %default_args, @_ ); |
39 |
|
40 |
my $self = bless {}, $class; |
41 |
|
42 |
croak "${class}::new: Missing required URL parameter\n" |
43 |
unless exists $args{ URL }; |
44 |
|
45 |
$self->{ _debug } = $args{ Debug }; |
46 |
$self->{ _url } = $args{ URL }; |
47 |
$self->{ _alias } = $args{ Alias }; |
48 |
$self->{ _ua_alias } = $args{ Alias } . '_ua'; |
49 |
|
50 |
$self->{ _request } = HTTP::Request->new( POST => $self->{_url} ); |
51 |
|
52 |
## Create a client to make HTTP requests |
53 |
POE::Component::Client::HTTP->spawn( Alias => $self->{_ua_alias} ); |
54 |
|
55 |
## See $states defined up above . . . |
56 |
POE::Session->create( object_states => [ $self => $states, ], ); |
57 |
|
58 |
return $self; |
59 |
} |
60 |
|
61 |
sub spawn { shift()->new( @_ ) } |
62 |
|
63 |
## |
64 |
## start -- Startup state |
65 |
## |
66 |
sub start { |
67 |
my( $self, $kernel, $heap, $session ) = |
68 |
@_[ OBJECT, KERNEL, HEAP, SESSION ]; |
69 |
|
70 |
## Just pipe up if we're debugging |
71 |
print STDERR "## ", __PACKAGE__, "::start\r\n" if $self->{_debug}; |
72 |
|
73 |
$kernel->alias_set( $self->{_alias} ); |
74 |
|
75 |
return |
76 |
} |
77 |
|
78 |
## |
79 |
## stop -- Shutdown state |
80 |
## |
81 |
sub stop { |
82 |
my( $self, $kernel, $heap ) = @_[ OBJECT, KERNEL, HEAP ]; |
83 |
|
84 |
## Just pipe up if we're debugging |
85 |
print STDERR "## ", __PACKAGE__, "::stop\r\n" if $self->{_debug}; |
86 |
|
87 |
return |
88 |
} |
89 |
|
90 |
## |
91 |
## signal -- Handle any signals received |
92 |
## |
93 |
sub signal { |
94 |
my( $self, $heap, $signal ) = @_[ OBJECT, HEAP, ARG0 ]; |
95 |
|
96 |
## Just pipe up if we're debugging |
97 |
print STDERR "## ", __PACKAGE__, "::signal $signal\n" if $self->{_debug}; |
98 |
|
99 |
return |
100 |
} |
101 |
|
102 |
## |
103 |
## default -- Catch any unhandled events for debugging |
104 |
## |
105 |
sub default { |
106 |
my( $self, $heap, $event ) = @_[ OBJECT, HEAP, ARG0 ]; |
107 |
|
108 |
## Just pipe up if we're debugging |
109 |
print STDERR "## ", __PACKAGE__, "::default got $event\n" |
110 |
if $self->{_debug}; |
111 |
|
112 |
return |
113 |
} |
114 |
|
115 |
sub call { |
116 |
my( $self, $kernel, $heap, $sender, $request, $target ) |
117 |
= @_[ OBJECT, KERNEL, HEAP, SENDER, ARG0..ARG1 ]; |
118 |
|
119 |
## Just pipe up if we're debugging |
120 |
print STDERR "## ", __PACKAGE__, |
121 |
"::call got $request from $sender:$target\n" |
122 |
if $self->{_debug}; |
123 |
|
124 |
## Remember what session and state this goes back to |
125 |
my $tag = $sender . ':' . $target; |
126 |
$heap->{ targets }->{$tag} = [ $sender, $target ]; |
127 |
|
128 |
print STDERR "## tag is $tag\n" if $self->{_debug}; |
129 |
|
130 |
my $req = $self->{_request}->clone; |
131 |
$req->content( $request->as_string ); |
132 |
$req->push_header( 'Content-Type' => 'text/xml' ); |
133 |
$req->push_header( 'Content-Length' => length $req->content ); |
134 |
|
135 |
$kernel->post( $self->{_ua_alias} => request |
136 |
=> response => $req => $tag ); |
137 |
|
138 |
return; |
139 |
} |
140 |
|
141 |
## |
142 |
## response -- Handle replies from calls |
143 |
## |
144 |
sub response { |
145 |
my( $self, $kernel, $heap, $req, $resp ) |
146 |
= @_[ OBJECT, KERNEL, HEAP, ARG0..ARG1 ]; |
147 |
|
148 |
my $tag = $req->[1]; |
149 |
my( $target_session, $target_state ) = @{ $heap->{targets}->{$tag} }; |
150 |
|
151 |
## Just pipe up if we're debugging |
152 |
print STDERR "## ", __PACKAGE__, "::response\n## tag $tag\n" |
153 |
if $self->{_debug}; |
154 |
|
155 |
my $xmlrep = RPC::XML::Parser->new( )->parse( $resp->[0]->content ); |
156 |
if( ref $xmlrep ) { |
157 |
$kernel->post( $target_session, $target_state, $xmlrep ); |
158 |
} else { |
159 |
warn "RPCXML Client error: $xmlrep\n"; |
160 |
} |
161 |
|
162 |
return |
163 |
} |
164 |
|
165 |
|
166 |
1; |
167 |
|
168 |
__END__ |
169 |
|
170 |
=pod |
171 |
|
172 |
=head1 NAME |
173 |
|
174 |
POE::Component::RPCXML::Client - POE RPCXML client |
175 |
|
176 |
=head1 SYNOPSIS |
177 |
|
178 |
use POE qw(Component::RPXML::Client); |
179 |
|
180 |
=head1 DESCRIPTION |
181 |
|
182 |
This module implements a xmlrpc client interface in POE. |
183 |
|
184 |
Like many POE modules, Client does not create an object when the new() |
185 |
method is called, instead a new POE session is started. |
186 |
|
187 |
=head2 CONSTRUCTOR |
188 |
|
189 |
To create a new RPCXML client session, make a call like this: |
190 |
|
191 |
POE::Component::RPCXML::Client->new( |
192 |
Alias => 'rpcxml', |
193 |
URL => $url, |
194 |
); |
195 |
|
196 |
The alias should specify the name of the alias for the session to |
197 |
created, and the URL should refer to the server this RPCXML client will |
198 |
connect to. |
199 |
|
200 |
=head1 MESSAGES |
201 |
|
202 |
=head2 call |
203 |
|
204 |
To call a procedure on the server, send the following message: |
205 |
|
206 |
$kernel->post('rpcxml', 'call', $xmlreq, 'response_state'); |
207 |
|
208 |
C<rpcxml> should be replaced with the actual alias used for the session, |
209 |
or a reference to the session. C<$xmlreq> should be a RPCXML request |
210 |
object created with RPC::XML::request->new. |
211 |
|
212 |
The response state should expect to receive the RPC::XML response object |
213 |
in C<ARG0>. |
214 |
|
215 |
=head1 AUTHOR |
216 |
|
217 |
Fletch E<lt>fletch@phydeaux.orgE<gt> |
218 |
|
219 |
=cut |