Component/RPCXML/Client.pm

#!/usr/bin/perl
##
## POE::Component::RPCXML::Client -- XML-RPC Client Component
##
## $Id: Client.pm,v 1.2 2001/09/20 01:32:38 fletch Exp $
##
package POE::Component::RPCXML::Client;

use strict;

use Carp qw( croak carp );

use POE qw( Kernel Session Component::Client::HTTP );

use HTTP::Request ();
use HTTP::Response ();

use RPC::XML ();
use RPC::XML::Parser ();

my %default_args = (
                    Debug => undef,
                    Alias => 'rpcxml',
                   );

my $states = {
              _start   => 'start',
              _stop    => 'stop',
              _signal  => 'signal',
              _default => 'default',
              call     => 'call',
              response => 'response',
             };

sub new {
  my $class = shift;
  $class = ref( $class ) || $class;
  my( %args ) = ( %default_args, @_ );

  my $self = bless {}, $class;

  croak "${class}::new: Missing required URL parameter\n"
    unless exists $args{ URL };

  $self->{ _debug    } = $args{ Debug };
  $self->{ _url      } = $args{ URL   };
  $self->{ _alias    } = $args{ Alias };
  $self->{ _ua_alias } = $args{ Alias } . '_ua';

  $self->{ _request  } = HTTP::Request->new( POST => $self->{_url} );

  ## Create a client to make HTTP requests
  POE::Component::Client::HTTP->spawn( Alias => $self->{_ua_alias} );

  ## See $states defined up above . . .
  POE::Session->create( object_states => [ $self => $states, ], );

  return $self;
}

sub spawn { shift()->new( @_ ) }

##
## start -- Startup state
##
sub start {
  my( $self, $kernel, $heap, $session ) =
    @_[ OBJECT, KERNEL, HEAP, SESSION ];

  ## Just pipe up if we're debugging
  print STDERR "## ", __PACKAGE__, "::start\r\n" if $self->{_debug};

  $kernel->alias_set( $self->{_alias} );

  return
}

##
## stop -- Shutdown state
##
sub stop {
  my( $self, $kernel, $heap ) = @_[ OBJECT, KERNEL, HEAP ];

  ## Just pipe up if we're debugging
  print STDERR "## ", __PACKAGE__, "::stop\r\n" if $self->{_debug};

  return
}

##
## signal -- Handle any signals received
##
sub signal {
  my( $self, $heap, $signal ) = @_[ OBJECT, HEAP, ARG0 ];

  ## Just pipe up if we're debugging
  print STDERR "## ", __PACKAGE__, "::signal $signal\n" if $self->{_debug};

  return
}

##
## default -- Catch any unhandled events for debugging
##
sub default {
  my( $self, $heap, $event ) = @_[ OBJECT, HEAP, ARG0 ];

  ## Just pipe up if we're debugging
  print STDERR "## ", __PACKAGE__, "::default got $event\n"
    if $self->{_debug};

  return
}

sub call {
  my( $self, $kernel, $heap, $sender, $request, $target )
    = @_[ OBJECT, KERNEL, HEAP, SENDER, ARG0..ARG1 ];

  ## Just pipe up if we're debugging
  print STDERR "## ", __PACKAGE__,
               "::call got $request from $sender:$target\n"
    if $self->{_debug};

  ## Remember what session and state this goes back to
  my $tag = $sender . ':' . $target;
  $heap->{ targets }->{$tag} = [ $sender, $target ];

  print STDERR "## tag is $tag\n" if $self->{_debug};

  my $req = $self->{_request}->clone;
  $req->content( $request->as_string );
  $req->push_header( 'Content-Type'   => 'text/xml' );
  $req->push_header( 'Content-Length' => length $req->content );

  $kernel->post( $self->{_ua_alias} => request
                 => response => $req => $tag );

  return;
}

##
## response -- Handle replies from calls
##
sub response {
  my( $self, $kernel, $heap, $req, $resp )
    = @_[ OBJECT, KERNEL, HEAP, ARG0..ARG1 ];

  my $tag = $req->[1];
  my( $target_session, $target_state ) = @{ $heap->{targets}->{$tag} };

  ## Just pipe up if we're debugging
  print STDERR "## ", __PACKAGE__, "::response\n## tag $tag\n"
    if $self->{_debug};

  my $xmlrep = RPC::XML::Parser->new( )->parse( $resp->[0]->content );
  if( ref $xmlrep ) {
    $kernel->post( $target_session, $target_state, $xmlrep );
  } else {
    warn "RPCXML Client error: $xmlrep\n";
  }

  return
}


1;

__END__

=pod

=head1 NAME

POE::Component::RPCXML::Client - POE RPCXML client

=head1 SYNOPSIS

  use POE qw(Component::RPXML::Client);

=head1 DESCRIPTION

This module implements a xmlrpc client interface in POE.

Like many POE modules, Client does not create an object when the new()
method is called, instead a new POE session is started.

=head2 CONSTRUCTOR

To create a new RPCXML client session, make a call like this:

  POE::Component::RPCXML::Client->new(
                                      Alias => 'rpcxml',
                                      URL   => $url,
  );

The alias should specify the name of the alias for the session to
created, and the URL should refer to the server this RPCXML client will
connect to.

=head1 MESSAGES

=head2 call

To call a procedure on the server, send the following message:

  $kernel->post('rpcxml', 'call', $xmlreq, 'response_state');

C<rpcxml> should be replaced with the actual alias used for the session,
or a reference to the session. C<$xmlreq> should be a RPCXML request
object created with RPC::XML::request->new.

The response state should expect to receive the RPC::XML response object
in C<ARG0>.

=head1 AUTHOR

Fletch E<lt>fletch@phydeaux.orgE<gt>

=cut
1	jonen	1.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
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26