Connector/TcpRpcXml/Client.pm

package MJAM::Connector::TcpRpcXml::Client;

##
## 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 strict;
use warnings;


use MJAM::main;
use Data::Dumper qw( Dumper );
use RPC::XML ();
use RPC::XML::Parser ();
use POE qw( Session Component::RPCXML::Client );

my $debug = 1;

my $poe_alias;


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

  $kernel->alias_set($poe_alias);
  
  DEBUG() && print STDERR "## main::start\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 ];

  DEBUG() && 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 ];
  DEBUG() && print STDERR "## main::default: $event\r\n" if $debug;

  return
}


sub startAgent {

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

  my $conn = $heap->{meta}{Connection};
  
  my $url = 'http://' . $conn->{user} . '@' . $conn->{remote_host} . ':' . $conn->{remote_port} . '/';

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

  DEBUG() && print STDERR "## main::start create RPCXML::Client\n";
  
}

sub request {

  my( $kernel, $heap, $data ) = @_[ KERNEL, HEAP, ARG0 ];

  my $xmlreq = RPC::XML::request->new( 
                    $data->{method},
                                       #R::X::a->new( 8, 6, 7, 5, 3, 0, 9 ),
                                       $data->{args},
                                       #R::X::S->new( $data->{args} ),
                                     );
  #print Dumper($xmlreq);

  DEBUG() && print STDERR "## main::start posting call\n";

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

  DEBUG() && print STDERR "## main::start posted call\n";
  
}

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

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

sub setMeta {
  my ($heap, $arg) = @_[HEAP, ARG0];
  $heap->{meta} = $arg;
}


sub start {

  $poe_alias = shift;

  POE::Session->create(
                     inline_states => {
                                       _start => \&_start,
                                       _stop => \&_stop,
                                       _signal => \&_signal,
                                       _default => \&_default,
                                       request => \&request,
                                       response => \&response,
                                       setMeta => \&setMeta,
                                       startAgent => \&startAgent,
                                      },
                    );
}

sub stop {
  $poe_kernel->signal($poe_alias, "TERM");
}

1;
1	package MJAM::Connector::TcpRpcXml::Client;
2
3	##
4	## Define shorthand for RPC::XML::type
5	##
6	BEGIN {
7	my %short = (
8	array => 'a', struct => 's',
9	int => 'i', double => 'd',
10	boolean => 'b', string => 'S',
11	base64 => 'b64', fault => 'f',
12	datetime_iso8601 => 'dt',
13	);
14
15	eval qq{{package R::X::$short{$_};sub new{shift;RPC::XML::$_->new(\@_)}}}
16	foreach keys %short;
17	}
18
19	use strict;
20	use warnings;
21
22
23	use MJAM::main;
24	use Data::Dumper qw( Dumper );
25	use RPC::XML ();
26	use RPC::XML::Parser ();
27	use POE qw( Session Component::RPCXML::Client );
28
29	my $debug = 1;
30
31	my $poe_alias;
32
33
34
35	sub _start {
36	my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
37
38	$kernel->alias_set($poe_alias);
39
40	DEBUG() && print STDERR "## main::start\n";
41
42	return;
43	}
44
45	##
46	## stop -- Shutdown state
47	##
48	sub _stop {
49	my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
50
51	## Just pipe up if we're debugging
52	print STDERR "## main::stop\r\n" if $debug;
53
54	return
55	}
56
57	##
58	## signal -- Handle any signals received
59	##
60	sub _signal {
61	my( $heap, $signal ) = @_[ HEAP, ARG0 ];
62
63	DEBUG() && print STDERR "## main::signal: ", $signal, "\r\n" if $debug;
64
65	## Shut things down on TERM, QUIT, or INT
66	if( $signal =~ /^TERM\|QUIT\|INT/ ) {
67	}
68
69	return
70	}
71
72	##
73	## default -- Catch any unhandled events for debugging
74	##
75	sub _default {
76	my( $heap, $event ) = @_[ HEAP, ARG0 ];
77	DEBUG() && print STDERR "## main::default: $event\r\n" if $debug;
78
79	return
80	}
81
82
83
84	sub startAgent {
85
86	my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
87
88	my $conn = $heap->{meta}{Connection};
89
90	my $url = 'http://' . $conn->{user} . '@' . $conn->{remote_host} . ':' . $conn->{remote_port} . '/';
91
92	POE::Component::RPCXML::Client->new(
93	Alias => 'rpcxml',
94	URL => $url,
95	);
96
97	DEBUG() && print STDERR "## main::start create RPCXML::Client\n";
98
99	}
100
101	sub request {
102
103	my( $kernel, $heap, $data ) = @_[ KERNEL, HEAP, ARG0 ];
104
105	my $xmlreq = RPC::XML::request->new(
106	$data->{method},
107	#R::X::a->new( 8, 6, 7, 5, 3, 0, 9 ),
108	$data->{args},
109	#R::X::S->new( $data->{args} ),
110	);
111	#print Dumper($xmlreq);
112
113	DEBUG() && print STDERR "## main::start posting call\n";
114
115	$kernel->post( rpcxml => call => $xmlreq => 'response' );
116
117	DEBUG() && print STDERR "## main::start posted call\n";
118
119	}
120
121	sub response {
122	my( $kernel, $heap, $resp ) = @_[ KERNEL, HEAP, ARG0..ARG1 ];
123
124	unless( $resp->is_fault ) {
125	#print STDERR "## main::response:\n", $resp->value->value, "\n";
126	$kernel->post( $heap->{meta}{ResponseSession} => $heap->{meta}{ResponseState} => $resp->value->value );
127	} else {
128	print STDERR "## main::response was error\n";
129	print STDERR "##\t", $resp->value->{faultCode}->value, ":",
130	$resp->value->{faultString}->value, "\n";
131	}
132	#return
133	}
134
135	sub setMeta {
136	my ($heap, $arg) = @_[HEAP, ARG0];
137	$heap->{meta} = $arg;
138	}
139
140
141
142
143
144	sub start {
145
146	$poe_alias = shift;
147
148	POE::Session->create(
149	inline_states => {
150	_start => \&_start,
151	_stop => \&_stop,
152	_signal => \&_signal,
153	_default => \&_default,
154	request => \&request,
155	response => \&response,
156	setMeta => \&setMeta,
157	startAgent => \&startAgent,
158	},
159	);
160	}
161
162	sub stop {
163	$poe_kernel->signal($poe_alias, "TERM");
164	}
165
166	1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26