home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _f3d4b1961b2a8c15166c555f140a6882 < prev    next >
Text File  |  2000-03-15  |  4KB  |  136 lines
  1. package SOAP::Transport::HTTP::CGI;
  2.  
  3. use strict;
  4. use vars qw($VERSION);
  5. $VERSION = '0.23';
  6.  
  7. use SOAP::Transport::HTTP::Server;
  8.  
  9. my $status_strings = {
  10.     400 => "Bad Request",
  11. };
  12.  
  13. sub handler {
  14.     my (undef, $safe_classes, $optional_dispatcher) = @_;
  15.  
  16.     unless ($ENV{QUERY_STRING} =~ /class=(.+$)/) {
  17.         return _send_status(400);
  18.     }
  19.     my $request_class = $1;
  20.  
  21.     unless (exists $safe_classes->{$request_class}) {
  22.         return _send_status(400);
  23.     }
  24.  
  25.     my $http_method   = $ENV{REQUEST_METHOD};
  26.  
  27.     my $request_header_reader = sub {
  28.         my ($base_name, $standard_cgi_header) = @_;
  29.         my $s = uc($base_name);
  30.         $s =~ s/-/_/g;
  31.         $s = 'HTTP_' . $s unless $standard_cgi_header;
  32.         $ENV{$s};
  33.     };
  34.  
  35.     my $request_content_reader = sub {
  36.         read STDIN, $_[0], $_[1];
  37.     };
  38.  
  39.     my $response_header_writer = sub {
  40.         print $_[0] . ":" . $_[1] . "\n";
  41.     };
  42.  
  43.     my $sent_headers = 0;
  44.     my $response_content_writer = sub {
  45.         print "\n" unless $sent_headers++;
  46.         print shift;
  47.     };
  48.  
  49.     my $s = SOAP::Transport::HTTP::Server->new();
  50.  
  51.     $s->handle_request($http_method, $request_class,
  52.                        $request_header_reader, 
  53.                        $request_content_reader,
  54.                        $response_header_writer,
  55.                $response_content_writer,
  56.               $optional_dispatcher);
  57. }
  58.  
  59. sub _send_status {
  60.     my ($status_code) = @_;
  61.     my $status_string = $status_strings->{$status_code};
  62.     print "Status: $status_code $status_string\n\n";
  63. }
  64.  
  65. 1;
  66. __END__
  67.  
  68. =head1 NAME
  69.  
  70. SOAP::Transport::HTTP::CGI - Generic SOAP CGI handler
  71.  
  72. =head1 SYNOPSIS
  73.  
  74. Use this class to expose SOAP endpoints using vanilla CGI.
  75. Here's an example SOAP endpoint exposed using this class:
  76.  
  77.     package ServerDemo;
  78.     use strict;
  79.     use SOAP::Transport::HTTP::CGI;
  80.  
  81.     sub handler {
  82.     my $safe_classes = {
  83.         Calculator => undef,
  84.     };
  85.       SOAP::Transport::HTTP::CGI->handler($safe_classes);
  86.     }
  87.  
  88.     1;
  89.  
  90. (I leave it up to you to figure out how to get Perl scripts
  91. to run as CGI scripts - please see your Perl docs for details)
  92.  
  93. =head1 DESCRIPTION
  94.  
  95. This class encapsulates the details of hooking up to CGI,
  96. and then calls SOAP::Transport::HTTP::Server to do the SOAP-specific
  97. stuff. This way the Server class can be reused with any web server
  98. configuration (including mod_perl), by simply composing it with a different
  99. front-end (for instance, SOAP::Transport::HTTP::Apache, for instance.
  100.  
  101. =head2 handler(SafeClassHash, OptionalDispatcher)
  102.  
  103. This is the only method on the class, and you must pass a
  104. hash reference whose keys contain the collection of classes
  105. that may be invoked at this endpoint. If you specify class
  106. FooBar in this list, for instance, and a client sends a SOAP
  107. request to http://yourserver/soap?class=FooBar, then the
  108. SOAP::Transport::HTTP::Server class will eventually attempt
  109. to load FooBar.pm, instatiate a FooBar, and call
  110. its handle_request function (see SOAP::Transport::HTTP::Server
  111. for more detail). If you don't include a class in this hash,
  112. SOAP/Perl won't run it. I promise.
  113.  
  114. By the way, only the keys in this hash are important, the
  115. values are ignored. 
  116.  
  117. Also, nothing is stopping you from messing around with the response
  118. yourself if you'd like to add some headers or whatever;
  119. you can always call print() dump more headers to STDOUT.
  120. Just make sure you finish what you're doing before you
  121. return to SOAP::Transport::HTTP::Server, because at that
  122. point the response is marshaled and sent back.
  123.  
  124. See SOAP::Transport::HTTP::Server for details on the
  125. OptionalDispatcher parameter.
  126.  
  127. =head1 DEPENDENCIES
  128.  
  129. SOAP::Transport::HTTP::Server
  130.  
  131. =head1 AUTHOR
  132.  
  133. Keith Brown
  134.  
  135. =cut
  136.