home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _df7d2408e3fe62d34f3dddb53e1c63d0 < prev    next >
Encoding:
Text File  |  2000-03-15  |  2.0 KB  |  96 lines
  1. package SOAP::Transport::HTTP::Client;
  2.  
  3. use strict;
  4. use vars qw($VERSION);
  5. $VERSION = '0.23';
  6.  
  7. use SOAP::Defs;
  8. use LWP::UserAgent;
  9. use Carp;
  10.  
  11. sub new {
  12.     my ($class) = @_;
  13.  
  14.     my $self = {
  15.         debug_request => 0,
  16.     };
  17.     bless $self, $class;
  18.  
  19.     $self;
  20. }
  21.  
  22. sub debug_request {
  23.     my ($self) = @_;
  24.     $self->{debug_request} = 1;
  25. }
  26.  
  27. sub send_receive {
  28.     my ($self, $endpoint, $method_uri, $method_name, $soap_request) = @_;
  29.  
  30.     my $ua = LWP::UserAgent->new();
  31.     $ua->env_proxy if $ENV{'HTTP_proxy'};
  32.         
  33.     my $post = HTTP::Request->new('POST', $endpoint, new HTTP::Headers, $soap_request);
  34.  
  35.     $post->proxy_authorization_basic(
  36.         $ENV{'HTTP_proxy_user'}, $ENV{'HTTP_proxy_pass'})
  37.             if ($ENV{'HTTP_proxy_user'} && $ENV{'HTTP_proxy_pass'});
  38.  
  39.     $post->header('SOAPMethodName' => $method_uri . '#' . $method_name);
  40.  
  41.     if ($self->{debug_request}) {
  42.         $post->header('DebugRequest' => '1');
  43.     }
  44.  
  45.     #
  46.     # TBD: content-length isn't taking into consideration CRLF translation
  47.     #
  48.     $post->content_type  ('text/xml');
  49.     $post->content_length(length($soap_request));
  50.     
  51.     my $http_response = $ua->request($post);
  52.  
  53.     my $code = $http_response->code();
  54.     unless (200 == $code) {
  55.         #
  56.         # TBD: need to deal with redirects, M-POST retrys, anything else?
  57.         #
  58.         my $content =$http_response->content();
  59.         croak 'HTTP ' . $post->method() . ' failed: ' . $http_response->code() .
  60.               ' (' . $http_response->message() .
  61.               "), in SOAP method call. Content of response:\n$content";
  62.     }
  63.     my $soap_response = $http_response->content();
  64.  
  65.     ($code, $http_response->content());
  66. }
  67.  
  68. 1;
  69. __END__
  70.  
  71. =head1 NAME
  72.  
  73. SOAP::Transport::HTTP::Client - Client side HTTP support for SOAP/Perl
  74.  
  75. =head1 SYNOPSIS
  76.  
  77.     use SOAP::Transport::HTTP::Client;
  78.  
  79. =head1 DESCRIPTION
  80.  
  81. Forthcoming...
  82.  
  83. =head1 DEPENDENCIES
  84.  
  85. LWP::UserAgent
  86. SOAP::Defs
  87.  
  88. =head1 AUTHOR
  89.  
  90. Keith Brown
  91.  
  92. =head1 SEE ALSO
  93.  
  94.  
  95. =cut
  96.