rpc/rpcxml/testclient.plx

#!/usr/bin/perl
use strict;

#use blib;

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 POE qw( Session Component::RPCXML::Client );

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::RPCXML::Client->new(
                                      Alias => 'rpcxml',
                                      URL   => $url,
                                     );

  print STDERR "## main::start create RPCXML::Client\n";

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

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

  $kernel->post( rpcxml => call => $xmlreq => 'response' );

  $kernel->post( rpcxml => call =>
                 RPC::XML::request->new( 'spoo' )
                 => 'response' );

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

  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, $resp ) = @_[ HEAP, ARG0..ARG1 ];

  unless( $resp->is_fault ) {
    print STDERR "## main::response:\n", $resp->value->value, "\n";
  } else {
    print STDERR "## main::response was error\n";
    print STDERR "##\t", $resp->value->{faultCode}->value, ":",
                 $resp->value->{faultString}->value, "\n";
  }
  return
}

__END__

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