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	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			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