import SOAP-WSDL 1.24 from CPAN
git-cpan-module: SOAP-WSDL git-cpan-version: 1.24 git-cpan-authorid: MKUTTER git-cpan-file: authors/id/M/MK/MKUTTER/SOAP-WSDL-1.24.tar.gz
This commit is contained in:
Martin Kutter
committed by
Michael G. Schwern
Michael G. Schwern
parent
7ba2f93e44
commit
9e85f63aa0
@@ -1,101 +0,0 @@
|
||||
package SOAP::WSDL::Transport::HTTP;
|
||||
use strict;
|
||||
use base qw(LWP::UserAgent);
|
||||
|
||||
# create methods normally inherited from SOAP::Client
|
||||
SUBFACTORY: {
|
||||
no strict qw(refs);
|
||||
foreach my $method ( qw(code message status is_success) ) {
|
||||
*{ $method } = sub {
|
||||
my $self = shift;
|
||||
return $self->{ $method } if not @_;
|
||||
return $self->{ $method } = shift;
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
sub send_receive {
|
||||
my ($self, %parameters) = @_;
|
||||
my ($envelope, $soap_action, $endpoint, $encoding, $content_type) =
|
||||
@parameters{qw(envelope action endpoint encoding content_type)};
|
||||
|
||||
$encoding = defined($encoding)
|
||||
? 'utf8'
|
||||
: lc($encoding);
|
||||
|
||||
# TODO check whether we need this with current LWP::UserAgent - we're
|
||||
# not here to fix LWP::UserAgent bugs...
|
||||
#
|
||||
# what's this all about?
|
||||
# unfortunately combination of LWP and Perl 5.6.1 and later has bug
|
||||
# in sending multibyte characters. LWP uses length() to calculate
|
||||
# content-length header and starting 5.6.1 length() calculates chars
|
||||
# instead of bytes. 'use bytes' in THIS file doesn't work, because
|
||||
# it's lexically scoped. Unfortunately, content-length we calculate
|
||||
# here doesn't work either, because LWP overwrites it with
|
||||
# content-length it calculates (which is wrong) AND uses length()
|
||||
# during syswrite/sysread, so we are in a bad shape anyway.
|
||||
#
|
||||
# what to do? we calculate proper content-length (using
|
||||
# bytelength() function from SOAP::Utils) and then drop utf8 mark
|
||||
# from string (doing pack with 'C0A*' modifier) if length and
|
||||
# bytelength are not the same
|
||||
|
||||
# use bytes is lexically scoped
|
||||
my $bytelength = do { use bytes; length $envelope };
|
||||
$envelope = pack('C0A*', $envelope)
|
||||
if length($envelope) != $bytelength;
|
||||
|
||||
# END TODO
|
||||
|
||||
my $request = HTTP::Request->new( 'POST',
|
||||
$endpoint,
|
||||
[ 'Content-Type', "$content_type; charset=$encoding",
|
||||
'Content-Length', $bytelength,
|
||||
'SOAPAction', $soap_action,
|
||||
],
|
||||
$envelope );
|
||||
|
||||
my $response = $self->request( $request );
|
||||
|
||||
$self->code( $response->code);
|
||||
$self->message( $response->message);
|
||||
$self->is_success($response->is_success);
|
||||
$self->status($response->status_line);
|
||||
|
||||
return $response->content();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Transport::HTTP - Fallback http(s) transport class
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Provides a thin transport class used by SOAP::WSDL::Transport when
|
||||
SOAP::Lite is not available.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 218 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: HTTP.pm 218 2007-09-10 16:19:23Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Transport/HTTP.pm $
|
||||
|
||||
=cut
|
||||
|
||||
@@ -1,129 +0,0 @@
|
||||
package SOAP::WSDL::Transport::Test;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::Factory::Transport;
|
||||
|
||||
our $VERSION = '2.00_14';
|
||||
|
||||
SOAP::WSDL::Factory::Transport->register( http => __PACKAGE__ );
|
||||
SOAP::WSDL::Factory::Transport->register( https => __PACKAGE__ );
|
||||
|
||||
my %code_of :ATTR(:name<code> :default<()>);
|
||||
my %status_of :ATTR(:name<status> :default<()>);
|
||||
my %message_of :ATTR(:name<message> :default<()>);
|
||||
my %is_success_of :ATTR(:name<is_success> :default<()>);
|
||||
my %base_dir_of :ATTR(:name<base_dir> :init_arg<base_dir> :default<.>);
|
||||
|
||||
# create methods normally inherited from SOAP::Client
|
||||
SUBFACTORY: {
|
||||
no strict qw(refs);
|
||||
foreach my $method ( qw(code message status is_success) ) {
|
||||
*{ $method } = *{ "get_$method" };
|
||||
}
|
||||
}
|
||||
|
||||
sub send_receive {
|
||||
my ($self, %parameters) = @_;
|
||||
my ($envelope, $soap_action, $endpoint, $encoding, $content_type) =
|
||||
@parameters{qw(envelope action endpoint encoding content_type)};
|
||||
|
||||
my $filename = $soap_action;
|
||||
$filename =~s{ \A(:?'|") }{}xms;
|
||||
$filename =~s{ (:?'|")\z }{}xms;
|
||||
$filename =~s{ \A [^:]+ : (:? /{2})? }{}xms;
|
||||
|
||||
$filename = join '/', $base_dir_of{ ident $self }, "$filename.xml";
|
||||
|
||||
if (not -r $filename) {
|
||||
warn "cannot access $filename";
|
||||
$self->set_code( 500 );
|
||||
$self->set_message( "Failed" );
|
||||
$self->set_is_success(0);
|
||||
$self->set_status("500 Failed");
|
||||
return;
|
||||
}
|
||||
|
||||
open my $fh, '<', $filename or die "cannot open $filename: $!";
|
||||
binmode $fh;
|
||||
my $response = <$fh>;
|
||||
close $fh or die "cannot close $filename: $!";
|
||||
|
||||
$self->set_code( 200 );
|
||||
$self->set_message( "OK" );
|
||||
$self->set_is_success(1);
|
||||
$self->set_status("200 OK");
|
||||
return $response;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Transport::Test - Test transport class for SOAP::WSDL
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use SOAP::WSDL::Client;
|
||||
use SOAP::WSDL::Transport::Test;
|
||||
|
||||
my $soap = SOAP::WSDL::Client->new()
|
||||
$soap->get_transport->set_base_dir('.');
|
||||
$soap->call('method', \%body, \%header);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL::Transport::Test is a file-based test transport backend for
|
||||
SOAP::WSDL.
|
||||
|
||||
When SOAP::WSDL::Transport::Test is used as transport backend, the reponse is
|
||||
read from a XML file and the request message is discarded. This is particularly
|
||||
useful for testing SOAP::WSDL plugins.
|
||||
|
||||
=head2 Filename resolution
|
||||
|
||||
SOAP::WSDL::Transport makes up the response XML file name from the SOAPAction
|
||||
of the request. The following filename is used:
|
||||
|
||||
base_dir / soap_action .xml
|
||||
|
||||
The protocol scheme (e.g. http:) and two heading slashes (//) are stripped from
|
||||
the soap_action.
|
||||
|
||||
base_dir defaults to '.'
|
||||
|
||||
Examples:
|
||||
|
||||
SOAPAction: http://somewhere.over.the.rainbow/webservice/webservice.asmx
|
||||
Filename: ./somewhere.over.the.rainbow/webservice/webservice.asmx.xml
|
||||
|
||||
SOAPAction: uri:MyWickedService/test
|
||||
Filename: ./MyWickedService/test.xml
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 set_base_dir
|
||||
|
||||
Sets the base directory SOAP::WSDL::Transport::Test should look for response
|
||||
files.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 218 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: HTTP.pm 218 2007-09-10 16:19:23Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Transport/HTTP.pm $
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user