rpc/rpcxml/samplecl.plx

#!/usr/bin/perl
##
## Simple client showing how to make XML-RPC calls `by hand' just
## using RPC::XML and POE::Component::Client::HTTP yourself
##
## $Id: samplecl.plx,v 1.1.1.1 2001/08/09 17:27:30 fletch Exp $
##
use strict;

use Data::Dumper qw( Dumper );

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

##
## Define shorthand for RPC::XML::type
##
BEGIN {
  my %short = (
               array   => 'a',   struct => 's',
               int     => 'i',   double => 'd',
               boolean => 'b',   string => 'S',
               base64  => 'b64', fault  => 'f',
               datetime_iso8601 => 'dt',
              );

  eval qq{{package R::X::$short{$_};sub new{shift;RPC::XML::$_->new(\@_)}}}
    foreach keys %short;
}

use HTTP::Request ();
use HTTP::Response ();
use POE qw( Session Component::Client::HTTP );

use constant DEFAULT_URL => 'http://localhost:7777/';

my $url = shift || DEFAULT_URL;

my $debug = 1;

POE::Session->create(
                     inline_states => {
                                       _start => \&start,
                                       _stop => \&stop,
                                       _signal => \&signal,
                                       _default => \&default,
                                       response => \&response,
                                      },
                    );

$poe_kernel->run( );

exit 0;

sub start {
  my( $kernel, $heap ) = @_[ KERNEL, HEAP ];

  print STDERR "## main::start\n";

  POE::Component::Client::HTTP->spawn( Alias => 'ua' );

  my $xmlreq = RPC::XML::request->new( 'spoo',
                                       R::X::a->new( 8, 6, 7, 5, 3, 0, 9 ),
                                     );

  my $req = HTTP::Request->new( POST => $url );
  $req->content( $xmlreq->as_string );
  $req->push_header( 'Content-Type' => 'text/xml' );
  $req->push_header( 'Content-Length' => length $req->content );

#  print STDERR "## request:\n", $req->as_string, "## end request\n";

  $kernel->post( ua => request => response => $req );

  return
}

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

  ## Just pipe up if we're debugging
  print STDERR "## main::stop\r\n" if $debug;

  return
}

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

  print STDERR "## main::signal: ", $signal, "\r\n" if $debug;

  ## Shut things down on TERM, QUIT, or INT
  if( $signal =~ /^TERM|QUIT|INT/ ) {
  }

  return
}

##
## default -- Catch any unhandled events for debugging
##
sub default {
  my( $heap, $event ) = @_[ HEAP, ARG0 ];
  print STDERR "## main::default: $event\r\n" if $debug;

  return
}

sub response {
  my( $heap, $req, $resp ) = @_[ HEAP, ARG0..ARG1 ];

#  print STDERR "## main::response:\n", $resp->[0]->content, "\n";

  my $xmlrep = RPC::XML::Parser->new( )->parse( $resp->[0]->content );
  if( ref $xmlrep ) {
    print $xmlrep->value->value, "\n";
  } else {
    warn "$xmlrep\n";
  }

  return
}

__END__

1	joko	1.1	#!/usr/bin/perl
2			##
3			## Simple client showing how to make XML-RPC calls `by hand' just
4			## using RPC::XML and POE::Component::Client::HTTP yourself
5			##
6			## $Id: samplecl.plx,v 1.1.1.1 2001/08/09 17:27:30 fletch Exp $
7			##
8			use strict;
9
10			use Data::Dumper qw( Dumper );
11
12			use RPC::XML ();
13			use RPC::XML::Parser ();
14
15			##
16			## Define shorthand for RPC::XML::type
17			##
18			BEGIN {
19			my %short = (
20			array => 'a', struct => 's',
21			int => 'i', double => 'd',
22			boolean => 'b', string => 'S',
23			base64 => 'b64', fault => 'f',
24			datetime_iso8601 => 'dt',
25			);
26
27			eval qq{{package R::X::$short{$_};sub new{shift;RPC::XML::$_->new(\@_)}}}
28			foreach keys %short;
29			}
30
31			use HTTP::Request ();
32			use HTTP::Response ();
33			use POE qw( Session Component::Client::HTTP );
34
35			use constant DEFAULT_URL => 'http://localhost:7777/';
36
37			my $url = shift \|\| DEFAULT_URL;
38
39			my $debug = 1;
40
41			POE::Session->create(
42			inline_states => {
43			_start => \&start,
44			_stop => \&stop,
45			_signal => \&signal,
46			_default => \&default,
47			response => \&response,
48			},
49			);
50
51			$poe_kernel->run( );
52
53			exit 0;
54
55			sub start {
56			my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
57
58			print STDERR "## main::start\n";
59
60			POE::Component::Client::HTTP->spawn( Alias => 'ua' );
61
62			my $xmlreq = RPC::XML::request->new( 'spoo',
63			R::X::a->new( 8, 6, 7, 5, 3, 0, 9 ),
64			);
65
66			my $req = HTTP::Request->new( POST => $url );
67			$req->content( $xmlreq->as_string );
68			$req->push_header( 'Content-Type' => 'text/xml' );
69			$req->push_header( 'Content-Length' => length $req->content );
70
71			# print STDERR "## request:\n", $req->as_string, "## end request\n";
72
73			$kernel->post( ua => request => response => $req );
74
75			return
76			}
77
78			##
79			## stop -- Shutdown state
80			##
81			sub stop {
82			my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
83
84			## Just pipe up if we're debugging
85			print STDERR "## main::stop\r\n" if $debug;
86
87			return
88			}
89
90			##
91			## signal -- Handle any signals received
92			##
93			sub signal {
94			my( $heap, $signal ) = @_[ HEAP, ARG0 ];
95
96			print STDERR "## main::signal: ", $signal, "\r\n" if $debug;
97
98			## Shut things down on TERM, QUIT, or INT
99			if( $signal =~ /^TERM\|QUIT\|INT/ ) {
100			}
101
102			return
103			}
104
105			##
106			## default -- Catch any unhandled events for debugging
107			##
108			sub default {
109			my( $heap, $event ) = @_[ HEAP, ARG0 ];
110			print STDERR "## main::default: $event\r\n" if $debug;
111
112			return
113			}
114
115			sub response {
116			my( $heap, $req, $resp ) = @_[ HEAP, ARG0..ARG1 ];
117
118			# print STDERR "## main::response:\n", $resp->[0]->content, "\n";
119
120			my $xmlrep = RPC::XML::Parser->new( )->parse( $resp->[0]->content );
121			if( ref $xmlrep ) {
122			print $xmlrep->value->value, "\n";
123			} else {
124			warn "$xmlrep\n";
125			}
126
127			return
128			}
129
130			__END__
131
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26