Документ взят из кэша поисковой машины. Адрес оригинального документа : http://rtm-cs.sinp.msu.ru/manual/xmlrpc-howto/xmlrpc-howto-perl-cgi.html
Дата изменения: Mon Jan 22 01:12:06 2001
Дата индексирования: Mon Oct 1 21:19:53 2012
Кодировка:
A CGI-Based Perl Server

A CGI-Based Perl Server

Frontier::RPC2 doesn't provide built-in support for CGI-based servers. It does, however, provide most of the pieces you'll need.

Save the following code as sumAndDifference.cgi in your web server's cgi-bin directory. (On Unix systems, you'll need to make it executable by typing chmod +x sumAndDifference.cgi.)

    #!/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
    Content-length: $length
    
    EOD
        # We want precise control over whitespace here.
        print $xml_string;
    }

You can copy the utility routines into your own CGI scripts.