package SOAP::Transport::HTTP2;
use strict;
use vars qw($VERSION @ISA);
$VERSION = 0.73;
use SOAP::Lite;
use SOAP::Transport::HTTP;
@ISA = qw(SOAP::Transport::HTTP);
package SOAP::Transport::HTTP2::Client;
use vars qw(@ISA);
@ISA = qw(SOAP::Transport::HTTP::Client);
package SOAP::Transport::HTTP2::Server;
use vars qw(@ISA);
@ISA = qw(SOAP::Transport::HTTP::Server);
package SOAP::Transport::HTTP2::CGI;
use vars qw(@ISA);
@ISA = qw(SOAP::Transport::HTTP::CGI);
package SOAP::Transport::HTTP2::Daemon;
use vars qw(@ISA);
@ISA = qw(SOAP::Transport::HTTP::Daemon);
package SOAP::Transport::HTTP2::Apache;
use vars qw(@ISA);
@ISA = qw(SOAP::Transport::HTTP::Server);
sub DESTROY { SOAP::Trace::objects('()') }
sub new {
my $self = shift;
unless (ref $self) {
my $class = ref($self) || $self;
$self = $class->SUPER::new(@_);
SOAP::Trace::objects('()');
}
MOD_PERL: {
( (exists $ENV{MOD_PERL_API_VERSION}) &&
($ENV{MOD_PERL_API_VERSION} == 2) ) and do {
require Apache2::RequestRec;
require Apache2::RequestUtil;
require Apache2::RequestIO;
require Apache2::Const;
require APR::Table;
Apache2::Const->import(-compile => 'OK');
$self->{'MOD_PERL_VERSION'} = 2;
last MOD_PERL;
};
(eval { require Apache;} ) and do {
require Apache::Constants;
Apache::Constants->import('OK');
$self->{'MOD_PERL_VERSION'} = 1;
last MOD_PERL;
};
die "Unsupported version of mod_perl";
}
return $self;
}
sub handler {
my $self = shift->new;
my $r = shift;
unless ($r) {
$r = ($self->{'MOD_PERL_VERSION'} == 1) ?
Apache->request : Apache2::RequestUtil->request();
}
my $cl = ($self->{'MOD_PERL_VERSION'} == 1) ?
$r->header_in('Content-length') : $r->headers_in->{'Content-length'};
$self->request(HTTP::Request->new(
$r->method() => $r->uri,
HTTP::Headers->new($r->headers_in),
do { my ($c,$buf); while ($r->read($buf,$cl)) { $c.=$buf; } $c; }
));
$self->SUPER::handle;
if ($self->{'MOD_PERL_VERSION'} == 1 ) {
$self->response->headers->scan(sub { $r->header_out(@_) });
$r->send_http_header(join '; ', $self->response->content_type);
$r->print($self->response->content);
return &Apache::Constants::OK;
}
else {
$self->response->headers->scan(sub {
my %h = @_;
for (keys %h) {
$r->headers_out->{$_} = $h{$_};
}
});
$r->content_type(join '; ', $self->response->content_type);
$r->print($self->response->content);
return &Apache2::Const::OK;
}
}
sub configure {
my $self = shift->new;
my $config = shift->dir_config;
foreach (%$config) {
$config->{$_} =~ /=>/
? $self->$_({split /\s*(?:=>|,)\s*/, $config->{$_}})
: ref $self->$_() ? () : $self->$_(split /\s+|\s*,\s*/, $config->{$_})
if $self->can($_);
}
$self;
}
{ sub handle; *handle = \&handler }
package SOAP::Transport::HTTP2::FCGI;
use vars qw(@ISA);
@ISA = qw(SOAP::Transport::HTTP::FCGI);
1;