$ ./d.pl $ ./tickle localhost system.introspection #### package D; use strict; sub new { my $self; $self = {}; $self->{Server} = undef; $self->{InitialMethods} = undef; my $parser = XML::LibXML->new(); bless $self; return $self; } sub setServer { my ($self, $server) = @_; $self->{InitialMethods} = { map { $_ => 1 } keys %{$server->{__method_table}} }; $self->{Server} = $server; } sub initialize { my ($self) = @_; my $server = $self->{Server}; # General exported functions for D $server->add_method( { name => 'd.apply', version => '1.0', hidden => 0, code => sub { $self->apply(@_) }, signature => [ 'string string' ], help => q{ prints a string } } ); $self->getMethodList(); } sub getMethodList { my ($self) = @_; my $server = $self->{Server}; # Not all RPC::XML version implement list_methods print "DEBUG($$): getMethodList called.\n"; my @list = keys %{$server->{__method_table}}; my @ordered_list = sort @list; print "DEBUG($$): first_method: "; print join("\nDEBUG($$): next_method: ", @ordered_list); print "\n"; return \@ordered_list; } sub apply { my ($self, $server, $string) = @_; print "apply: entered\n"; my $temp = "we are now in the apply function: $string\n"; return $temp; } 1; #### #!/usr/bin/perl -w BEGIN {push @INC, (".", "..")}; use strict; use XML::LibXML; use XML::LibXSLT; use Getopt::Long; use RPC::XML::Server; use RPC::XML::Client; use D; use Data::Dumper; $|=1; my $debug=1; $SIG{CHLD} = "IGNORE"; while (1) { my ($server, $d); $server = RPC::XML::Server->new( port => 9000, queue => 1024 ); $d = D->new(); $d->setServer($server); $d->initialize(); eval { # This loop will not exit unless the server dies $server->server_loop('INT', sub { die("AAAAACK!!!");} ); }; print "Restarting loop!\n"; exec($0, @ARGV); } #### #!/usr/bin/perl use RPC::XML::Client; use Data::Dumper; # Usage: ticket server function [ argument ] $server = shift @ARGV; $function = shift @ARGV; $client = RPC::XML::Client->new("http://$server:9000/"); if ($#ARGV) { #if (defined $argument and length($argument) > 0) { #print "tickle: sending with argument: ".Dumper($argument)."\n"; $response = $client->send_request($function, @ARGV); } else { $response = $client->send_request($function); } my $response_ref_type = ref($response); my $dump; # upon shutdown, there is no response, since function does not return if ($function eq "xcd.shutdown") { $dump = "no response: shutting down"; } elsif (! ref $response) { $dump = $response; } elsif (! $response->is_fault) { $dump = Dumper($response->value); } else { $dump = Dumper($response); } print << Return: reponse ref type: $response_ref_type ------------------------------------ $dump ------------------------------------ ;