Connector/TcpRpcXml/Server.pm

package MJAM::Connector::TcpRpcXml::Server;

use strict;
use warnings;

use Data::Dumper qw( Dumper );

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

BEGIN {
  foreach( qw( array int struct ) ) {
    my $f = substr( $_, 0, 1 );
    eval qq{
               {
                 package R::X::$f;
                 sub new { shift; RPC::XML::$_->new( \@_ ) }
               }
             };
  }
}

use POE qw( Session Component::RPCXML::Server );

use constant DEFAULT_PORT => 7777;

my $port = shift || DEFAULT_PORT;

my $debug = 1;

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

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

  POE::Component::RPCXML::Server->new(
                                      Alias         => 'rpcxml-server',
                                      Port          => $port,
                                      DispatchEvent => 'response',
                                     );

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

  print STDERR "## main::response: call for ", $req->name, "\n"
    if $debug;

  my $resp
    = RPC::XML::response->new( "OK: " . scalar localtime() );

  POE::Component::RPCXML::Server->send_resp( $wheel, $resp->as_string );

  return
}

my $session;
sub start {
  my $states = {
              _start   => \&_start,
              _stop    => \&_stop,
              _signal  => \&_signal,
              _default => \&_default,
              response => \&response,
             };
  $session = POE::Session->create( inline_states => $states, );
}

sub stop {
  $poe_kernel->signal('rpcxml-server', 'TERM');
  $poe_kernel->signal($session, 'TERM');
}

1;
1	package MJAM::Connector::TcpRpcXml::Server;
2
3	use strict;
4	use warnings;
5
6	use Data::Dumper qw( Dumper );
7
8	use RPC::XML ();
9	use RPC::XML::Parser ();
10
11	BEGIN {
12	foreach( qw( array int struct ) ) {
13	my $f = substr( $_, 0, 1 );
14	eval qq{
15	{
16	package R::X::$f;
17	sub new { shift; RPC::XML::$_->new( \@_ ) }
18	}
19	};
20	}
21	}
22
23	use POE qw( Session Component::RPCXML::Server );
24
25	use constant DEFAULT_PORT => 7777;
26
27	my $port = shift \|\| DEFAULT_PORT;
28
29	my $debug = 1;
30
31	sub _start {
32	my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
33
34	print STDERR "## main::start\n";
35
36	POE::Component::RPCXML::Server->new(
37	Alias => 'rpcxml-server',
38	Port => $port,
39	DispatchEvent => 'response',
40	);
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	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	print STDERR "## main::default: $event\r\n" if $debug;
78
79	return
80	}
81
82	sub response {
83	my( $heap, $req, $wheel ) = @_[ HEAP, ARG0..ARG1 ];
84
85	print STDERR "## main::response: call for ", $req->name, "\n"
86	if $debug;
87
88	my $resp
89	= RPC::XML::response->new( "OK: " . scalar localtime() );
90
91	POE::Component::RPCXML::Server->send_resp( $wheel, $resp->as_string );
92
93	return
94	}
95
96	my $session;
97	sub start {
98	my $states = {
99	_start => \&_start,
100	_stop => \&_stop,
101	_signal => \&_signal,
102	_default => \&_default,
103	response => \&response,
104	};
105	$session = POE::Session->create( inline_states => $states, );
106	}
107
108	sub stop {
109	$poe_kernel->signal('rpcxml-server', 'TERM');
110	$poe_kernel->signal($session, 'TERM');
111	}
112
113	1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26