1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251
|
package SOAP::WSDL::Factory::Transport;
use strict;
use warnings;
our $VERSION = 3.004;
my %registered_transport_of = ();
# Local constants
# Could be made readonly, but that's just for the paranoid...
my %SOAP_LITE_TRANSPORT_OF = (
ftp => 'SOAP::Transport::FTP',
http => 'SOAP::Transport::HTTP',
https => 'SOAP::Transport::HTTP',
mailto => 'SOAP::Transport::MAILTO',
'local' => 'SOAP::Transport::LOCAL',
jabber => 'SOAP::Transport::JABBER',
mq => 'SOAP::Transport::MQ',
);
my %SOAP_WSDL_TRANSPORT_OF = (
http => 'SOAP::WSDL::Transport::HTTP',
https => 'SOAP::WSDL::Transport::HTTP',
);
# class methods only
sub register {
my ($class, $scheme, $package) = @_;
die "Cannot use reference as scheme" if ref $scheme;
$registered_transport_of{ $scheme } = $package;
}
sub get_transport {
my ($class, $url, %attrs) = @_;
my $scheme = $url;
$scheme =~s{ \:.+$ }{}xm;
if (defined $registered_transport_of{ $scheme }) {
no strict qw(refs);
$registered_transport_of{ $scheme }->can('new') or
eval "require $registered_transport_of{ $scheme }"
or die "Cannot load transport class $registered_transport_of{ $scheme } : $@";
# try "foo::Client" class first - SOAP::Tranport always requires
# a package withoug the ::Client appended, and then
# instantiates a ::Client object...
# ... pretty weird ...
# ... must be from some time when the max number of files was a
# sparse resource ...
# ... but we've decided to mimic SOAP::Lite...
return $registered_transport_of{ $scheme }->new( %attrs );
}
# try SOAP::Lite's Transport module - just skip if not require'able
SOAP_Lite: {
if (exists $SOAP_LITE_TRANSPORT_OF{ $scheme }) {
no strict qw(refs);
# behaves interestingly different under different versions of perl
# maybe true even if it's not available
my $protocol_class = $SOAP_LITE_TRANSPORT_OF{ $scheme } . '::Client';
$protocol_class->can('new')
or eval "require $SOAP_LITE_TRANSPORT_OF{ $scheme }"
or last SOAP_Lite;
# may fail if it's not available
my $transport = eval { $protocol_class->new( %attrs ) }
or last SOAP_Lite;
return $transport;
}
}
if (exists $SOAP_WSDL_TRANSPORT_OF{ $scheme }) {
no strict qw(refs);
$SOAP_WSDL_TRANSPORT_OF{ $scheme }->can('new')
or eval "require $SOAP_WSDL_TRANSPORT_OF{ $scheme }"
or die "Cannot load transport class $SOAP_WSDL_TRANSPORT_OF{ $scheme } : $@";
return $SOAP_WSDL_TRANSPORT_OF{ $scheme }->new( %attrs );
}
die "no transport class found for scheme <$scheme>";
}
1;
=pod
=head1 NAME
SOAP::WSDL::Factory::Transport - Factory for retrieving transport objects
=head1 SYNOPSIS
# from SOAP::WSDL::Client:
$transport = SOAP::WSDL::Factory::Transport->get_transport( $url, @opt );
# in transport class:
package MyWickedTransport;
use SOAP::WSDL::Factory::Transport;
# register class as transport module for httpr and https
# (httpr is "reliable http", a protocol developed by IBM).
SOAP::WSDL::Factory::Transport->register( 'httpr' , __PACKAGE__ );
SOAP::WSDL::Factory::Transport->register( 'https' , __PACKAGE__ );
=head1 DESCRIPTION
SOAP::WSDL::Transport serves as factory for retrieving transport objects for
SOAP::WSDL.
The actual work is done by specific transport classes.
SOAP::WSDL::Transport tries to load one of the following classes:
=over
=item * the class registered for the scheme via register()
=item * the SOAP::Lite class matching the scheme
=item * the SOAP::WSDL class matching the scheme
=back
=head1 METHODS
=head2 register
SOAP::WSDL::Transport->register('https', 'MyWickedTransport');
Globally registers a class for use as transport class.
=head2 proxy
$trans->proxy('http://soap-wsdl.sourceforge.net');
Sets the proxy (endpoint).
Returns the transport for this protocol.
=head2 set_transport
Sets the current transport object.
=head2 get_transport
Gets the current transport object.
=head1 WRITING YOUR OWN TRANSPORT CLASS
=head2 Registering a transport class
Transport classes must be registered with SOAP::WSDL::Factory::Transport.
This is done by executing the following code where $scheme is the URL scheme
the class should be used for, and $module is the class' module name.
SOAP::WSDL::Factory::Transport->register( $scheme, $module);
To auto-register your transport class on loading, execute register() in your
tranport class (see L<SYNOPSIS|SYNOPSIS> above).
Multiple protocols or multiple classes are registered by multiple calls to
register().
=head2 Transport plugin package layout
You may only use transport classes whose name is either
the module name or the module name with '::Client' appended.
=head2 Methods to implement
Transport classes must implement the interface required for SOAP::Lite
transport classes (see L<SOAP::Lite::Transport> for details,
L<SOAP::WSDL::Transport::HTTP|SOAP::WSDL::Transport::HTTP> for an example).
To provide this interface, transport modules must implement the following
methods:
=over
=item * new
=item * send_receive
Dispatches a request and returns the content of the response.
=item * code
Returns the status code of the last send_receive call (if any).
=item * message
Returns the status message of the last send_receive call (if any).
=item * status
Returns the status of the last send_receive call (if any).
=item * is_success
Returns true after a send_receive was successful, false if it was not.
=back
SOAP::Lite requires transport modules to pack client and server
classes in one file, and to follow this naming scheme:
Module name:
"SOAP::Transport::" . uc($scheme)
Client class (additional package in module):
"SOAP::Transport::" . uc($scheme) . "::Client"
Server class (additional package in module):
"SOAP::Transport::" . uc($scheme) . "::Client"
SOAP::WSDL does not require you to follow these restrictions.
There is only one restriction in SOAP::WSDL:
You may only use transport classes whose name is either the module name or
the module name with '::Client' appended.
SOAP::WSDL will try to instantiate an object of your transport class with
'::Client' appended to allow using transport classes written for SOAP::Lite.
This may lead to errors when a different module with the name of your
transport module suffixed with ::Client is also loaded.
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2007 Martin Kutter. All rights reserved.
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: 851 $
$LastChangedBy: kutterma $
$Id: Transport.pm 851 2009-05-15 22:45:18Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Transport.pm $
=cut
|