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	#!/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