rpc/rpcxml/testserver.plx

#!/usr/bin/perl
use strict;

#use blib;

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;

my $states = {
              _start   => \&start,
              _stop    => \&stop,
              _signal  => \&signal,
              _default => \&default,
              response => \&response,
             };

POE::Session->create( inline_states => $states, );

$poe_kernel->run( );

exit 0;

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
}

__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	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	my $states = {
32	_start => \&start,
33	_stop => \&stop,
34	_signal => \&signal,
35	_default => \&default,
36	response => \&response,
37	};
38
39	POE::Session->create( inline_states => $states, );
40
41	$poe_kernel->run( );
42
43	exit 0;
44
45	sub start {
46	my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
47
48	print STDERR "## main::start\n";
49
50	POE::Component::RPCXML::Server->new(
51	Alias => 'rpcxml-server',
52	Port => $port,
53	DispatchEvent => 'response',
54	);
55
56	return
57	}
58
59	##
60	## stop -- Shutdown state
61	##
62	sub stop {
63	my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
64
65	## Just pipe up if we're debugging
66	print STDERR "## main::stop\r\n" if $debug;
67
68	return
69	}
70
71	##
72	## signal -- Handle any signals received
73	##
74	sub signal {
75	my( $heap, $signal ) = @_[ HEAP, ARG0 ];
76
77	print STDERR "## main::signal: ", $signal, "\r\n" if $debug;
78
79	## Shut things down on TERM, QUIT, or INT
80	if( $signal =~ /^TERM\|QUIT\|INT/ ) {
81	}
82
83	return
84	}
85
86	##
87	## default -- Catch any unhandled events for debugging
88	##
89	sub default {
90	my( $heap, $event ) = @_[ HEAP, ARG0 ];
91	print STDERR "## main::default: $event\r\n" if $debug;
92
93	return
94	}
95
96	sub response {
97	my( $heap, $req, $wheel ) = @_[ HEAP, ARG0..ARG1 ];
98
99	print STDERR "## main::response: call for ", $req->name, "\n"
100	if $debug;
101
102	my $resp
103	= RPC::XML::response->new( "OK: " . scalar localtime() );
104
105	POE::Component::RPCXML::Server->send_resp( $wheel, $resp->as_string );
106
107	return
108	}
109
110	__END__
111
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26