6. Perl $B$G$N(B XML-RPC $B$N;H$$J}(B

Ken MacLeod $B$O(B Perl $BMQ(B XML-RPC $B$r$B%&%'%V%5%$%H(B$B$b$7$/$O(B CPAN $B$rDL$8$FF~

Frontier::RPC $B$r%$%s%9%H!<%k$9$k$K$O!"I8=`E*$J$d$jJ}$G%Q%C%1!<(B $B%8$r%@%&%s%m!<%I$7$F%3%s%Q%$%k$7$^$9(B -

bash$ gunzip -c Frontier-RPC-0.07b1.tar.gz | tar xvf -
bash$ cd Frontier-RPC-0.07b1
bash$ perl Makefile.PL
bash$ make
bash$ make test
bash$ su -c 'make install'

($B%&%#%s%I%&4D6-$d%k!<%H8"8B$NL5$$>l9g!"$o$:$+$K0c$C$?\:Y$O(B Perl $B$NJ8=q$r;29M$K$7$F$/$@$5$$!#(B)

6.1. Perl $B%/%i%$%"%s%H(B

$B
use Frontier::Client;

# Make an object to represent the XML-RPC server.
$server_url = 'http://xmlrpc-c.sourceforge.net/api/sample.php';
$server = Frontier::Client->new(url => $server_url);

# Call the remote server and get our result.
$result = $server->call('sample.sumAndDifference', 5, 3);
$sum = $result->{'sum'};
$difference = $result->{'difference'};

print "Sum: $sum, Difference: $difference\n";

6.2. $BFHN)7?(B Perl $B%5!<%P(B

The following program shows how to write an XML-RPC server in Perl:

$B
use Frontier::Daemon;

sub sumAndDifference {
    my ($x, $y) = @_;
    return {'sum' => $x + $y, 'difference' => $x - $y};
}

# Call me as http://localhost:8080/RPC2
$methods = {'sample.sumAndDifference' => \&sumAndDifference};
Frontier::Daemon->new(LocalPort => 8080, methods => $methods)
    or die "Couldn't start HTTP server: $!";

6.3. CGI $B%Y!<%9$N(B Perl $B%5!<%P(B

Frontier::RPC2 $B$O(B CGI $B%Y!<%9%5!<%PMQ$N%5(B $B%]!<%H$OK\MhHw$($i$l$F$$$^$;$s!#$7$+$7(B$BBg>fIW(B$B!"(B $BI,MW$J$[$H$s$I$N5!G=$OMQ0U$5$l$F$$$^$9!#(B

$BsumAndDifference.cgi $B$H$7$F!"%&%'%V%5!<%P$N(B cgi-bin $B%G%#%l%/%H%j$KJ]B8$7$F$/$@$5$$(B (Unix $B%7%9%F%`>e$G!"(Bchmod +x sumAndDifference.cgi $B$H(B $BF~NO$7!"
#!/usr/bin/perl -w

use strict;
use Frontier::RPC2;

sub sumAndDifference {
    my ($x, $y) = @_;
    return {'sum' => $x + $y, 'difference' => $x - $y};
}

process_cgi_call({'sample.sumAndDifference' => \&sumAndDifference});


#==========================================================================
#  CGI Support
#==========================================================================
#  Simple CGI support for Frontier::RPC2. You can copy this into your CGI
#  scripts verbatim, or you can package it into a library.
#  (Based on xmlrpc_cgi.c by Eric Kidd <http://xmlrpc-c.sourceforge.net/>.)

# Process a CGI call.
sub process_cgi_call ($) {
    my ($methods) = @_;

    # Get our CGI request information.
    my $method = $ENV{'REQUEST_METHOD'};
    my $type = $ENV{'CONTENT_TYPE'};
    my $length = $ENV{'CONTENT_LENGTH'};

    # Perform some sanity checks.
    http_error(405, "Method Not Allowed") unless $method eq "POST";
    http_error(400, "Bad Request") unless $type eq "text/xml";
    http_error(411, "Length Required") unless $length > 0;

    # Fetch our body.
    my $body;
    my $count = read STDIN, $body, $length;
    http_error(400, "Bad Request") unless $count == $length; 

    # Serve our request.
    my $coder = Frontier::RPC2->new;
    send_xml($coder->serve($body, $methods));
}

# Send an HTTP error and exit.
sub http_error ($$) {
    my ($code, $message) = @_;
    print <<"EOD";
Status: $code $message
Content-type: text/html

<title>$code $message</title>
<h1>$code $message</h1>
<p>Unexpected error processing XML-RPC request.</p>
EOD
    exit 0;
}

# Send an XML document (but don't exit).
sub send_xml ($) {
    my ($xml_string) = @_;
    my $length = length($xml_string);
    print <<"EOD";
Status: 200 OK
Content-type: text/xml

EOD
    # We want precise control over whitespace here.
    print $xml_string;
}

$B$"$J$?<+?H$N(B CGI $B%9%/%j%W%H$K%f!<%F%#%j%F%#%k!<%A%s$r%3%T!<(B $B$7$F$b$+$^$$$^$;$s!#(B