r1749 - in packages: . soap-lite soap-lite/branches
soap-lite/branches/upstream soap-lite/branches/upstream/current
soap-lite/branches/upstream/current/bin
soap-lite/branches/upstream/current/examples
soap-lite/branches/upstream/current/examples/COM
soap-lite/branches/upstream/current/examples/JABBER
soap-lite/branches/upstream/current/examples/MQ
soap-lite/branches/upstream/current/examples/My
soap-lite/branches/upstream/current/examples/SOAP
soap-lite/branches/upstream/current/examples/SOAP/Transport
soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP
soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/Daemon
soap-lite/branches/upstream/current/examples/UDDI
soap-lite/branches/upstream/current/examples/WSDL
soap-lite/branches/upstream/current/examples/XML
soap-lite/branches/upstream/current/examples/XMLRPC
soap-lite/branches/upstream/current/examples/forms
soap-lite/branches/upstream/current/examples/server
soap-lite/branches/upstream/current/lib
soap-lite/branches/upstream/current/lib/Apache
soap-lite/branches/upstream/current/lib/Apache/XMLRPC
soap-lite/branches/upstream/current/lib/IO
soap-lite/branches/upstream/current/lib/OldDocs
soap-lite/branches/upstream/current/lib/OldDocs/SOAP
soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport
soap-lite/branches/upstream/current/lib/SOAP
soap-lite/branches/upstream/current/lib/SOAP/Transport
soap-lite/branches/upstream/current/lib/UDDI
soap-lite/branches/upstream/current/lib/XML
soap-lite/branches/upstream/current/lib/XML/Parser
soap-lite/branches/upstream/current/lib/XMLRPC
soap-lite/branches/upstream/current/lib/XMLRPC/Transport
soap-lite/branches/upstream/current/t
Krzysztof Krzyzaniak
eloy at costa.debian.org
Sun Dec 25 18:17:49 UTC 2005
Author: eloy
Date: 2005-12-25 18:17:11 +0000 (Sun, 25 Dec 2005)
New Revision: 1749
Added:
packages/soap-lite/
packages/soap-lite/branches/
packages/soap-lite/branches/upstream/
packages/soap-lite/branches/upstream/current/
packages/soap-lite/branches/upstream/current/Changes
packages/soap-lite/branches/upstream/current/MANIFEST
packages/soap-lite/branches/upstream/current/META.yml
packages/soap-lite/branches/upstream/current/Makefile.PL
packages/soap-lite/branches/upstream/current/README
packages/soap-lite/branches/upstream/current/ReleaseNotes.txt
packages/soap-lite/branches/upstream/current/bin/
packages/soap-lite/branches/upstream/current/bin/SOAPsh.pl
packages/soap-lite/branches/upstream/current/bin/XMLRPCsh.pl
packages/soap-lite/branches/upstream/current/bin/stubmaker.pl
packages/soap-lite/branches/upstream/current/examples/
packages/soap-lite/branches/upstream/current/examples/COM/
packages/soap-lite/branches/upstream/current/examples/COM/README
packages/soap-lite/branches/upstream/current/examples/COM/SOAP-Lite-COM-minimal.ctrl
packages/soap-lite/branches/upstream/current/examples/COM/SOAP-Lite-COM-standalone.ctrl
packages/soap-lite/branches/upstream/current/examples/COM/hash.vbs
packages/soap-lite/branches/upstream/current/examples/COM/hashecho.vbs
packages/soap-lite/branches/upstream/current/examples/COM/local.vbs
packages/soap-lite/branches/upstream/current/examples/COM/make-com-minimal.bat
packages/soap-lite/branches/upstream/current/examples/COM/make-com-standalone.bat
packages/soap-lite/branches/upstream/current/examples/COM/remote.cs
packages/soap-lite/branches/upstream/current/examples/COM/remote.vba
packages/soap-lite/branches/upstream/current/examples/COM/remote.vbs
packages/soap-lite/branches/upstream/current/examples/COM/remote.xls
packages/soap-lite/branches/upstream/current/examples/COM/service.vbs
packages/soap-lite/branches/upstream/current/examples/COM/soap.asp
packages/soap-lite/branches/upstream/current/examples/COM/soap.vbs
packages/soap-lite/branches/upstream/current/examples/COM/soap_perl.asp
packages/soap-lite/branches/upstream/current/examples/COM/states.html
packages/soap-lite/branches/upstream/current/examples/COM/states.pl
packages/soap-lite/branches/upstream/current/examples/COM/states.vba
packages/soap-lite/branches/upstream/current/examples/COM/states.vbs
packages/soap-lite/branches/upstream/current/examples/COM/states.xls
packages/soap-lite/branches/upstream/current/examples/COM/temper.vbs
packages/soap-lite/branches/upstream/current/examples/COM/xmlrpc.vbs
packages/soap-lite/branches/upstream/current/examples/JABBER/
packages/soap-lite/branches/upstream/current/examples/JABBER/jabclient.pl
packages/soap-lite/branches/upstream/current/examples/JABBER/jabserver.pl
packages/soap-lite/branches/upstream/current/examples/MQ/
packages/soap-lite/branches/upstream/current/examples/MQ/mqclient.pl
packages/soap-lite/branches/upstream/current/examples/MQ/mqserver.pl
packages/soap-lite/branches/upstream/current/examples/My/
packages/soap-lite/branches/upstream/current/examples/My/Chat.pm
packages/soap-lite/branches/upstream/current/examples/My/Examples.pm
packages/soap-lite/branches/upstream/current/examples/My/Parameters.pm
packages/soap-lite/branches/upstream/current/examples/My/PersistentIterator.pm
packages/soap-lite/branches/upstream/current/examples/My/PingPong.pm
packages/soap-lite/branches/upstream/current/examples/My/SessionIterator.pm
packages/soap-lite/branches/upstream/current/examples/SOAP/
packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/
packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/
packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/Daemon/
packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/Daemon/ForkAfterProcessing.pm
packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/Daemon/ForkOnAccept.pm
packages/soap-lite/branches/upstream/current/examples/SOAP/simple1.pl
packages/soap-lite/branches/upstream/current/examples/SOAP/simple2.pl
packages/soap-lite/branches/upstream/current/examples/SOAP/simple3.pl
packages/soap-lite/branches/upstream/current/examples/UDDI/
packages/soap-lite/branches/upstream/current/examples/UDDI/inquire1.pl
packages/soap-lite/branches/upstream/current/examples/UDDI/publish1.pl
packages/soap-lite/branches/upstream/current/examples/UDDI/simple1.pl
packages/soap-lite/branches/upstream/current/examples/UDDI/simple2.pl
packages/soap-lite/branches/upstream/current/examples/UDDI/syntax1.pl
packages/soap-lite/branches/upstream/current/examples/UDDI/syntax2.pl
packages/soap-lite/branches/upstream/current/examples/UDDI/syntax3.pl
packages/soap-lite/branches/upstream/current/examples/WSDL/
packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic1.pl
packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic2.pl
packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic3.pl
packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic4.pl
packages/soap-lite/branches/upstream/current/examples/WSDL/stub1.pl
packages/soap-lite/branches/upstream/current/examples/WSDL/stub2.pl
packages/soap-lite/branches/upstream/current/examples/WSDL/stub3.pl
packages/soap-lite/branches/upstream/current/examples/XML/
packages/soap-lite/branches/upstream/current/examples/XML/customxml.pl
packages/soap-lite/branches/upstream/current/examples/XMLRPC/
packages/soap-lite/branches/upstream/current/examples/XMLRPC/mod_xmlrpc.htaccess
packages/soap-lite/branches/upstream/current/examples/XMLRPC/simple1.pl
packages/soap-lite/branches/upstream/current/examples/XMLRPC/xmlrpc.cgi
packages/soap-lite/branches/upstream/current/examples/XMLRPC/xmlrpc.daemon
packages/soap-lite/branches/upstream/current/examples/allclients.pl
packages/soap-lite/branches/upstream/current/examples/authentication.pl
packages/soap-lite/branches/upstream/current/examples/autoexamples.pl
packages/soap-lite/branches/upstream/current/examples/chat.pl
packages/soap-lite/branches/upstream/current/examples/compress.pl
packages/soap-lite/branches/upstream/current/examples/cookie.pl
packages/soap-lite/branches/upstream/current/examples/cookieauth.pl
packages/soap-lite/branches/upstream/current/examples/customschema.pl
packages/soap-lite/branches/upstream/current/examples/forms/
packages/soap-lite/branches/upstream/current/examples/forms/style.cgi
packages/soap-lite/branches/upstream/current/examples/forms/style.html
packages/soap-lite/branches/upstream/current/examples/fullsearch.pl
packages/soap-lite/branches/upstream/current/examples/getdom.pl
packages/soap-lite/branches/upstream/current/examples/google.pl
packages/soap-lite/branches/upstream/current/examples/inline.daemon
packages/soap-lite/branches/upstream/current/examples/iterator.pl
packages/soap-lite/branches/upstream/current/examples/joke.pl
packages/soap-lite/branches/upstream/current/examples/oneliners
packages/soap-lite/branches/upstream/current/examples/oo-apache.pl
packages/soap-lite/branches/upstream/current/examples/parametersbyname.pl
packages/soap-lite/branches/upstream/current/examples/pingpong.pl
packages/soap-lite/branches/upstream/current/examples/server/
packages/soap-lite/branches/upstream/current/examples/server/Apache.pm
packages/soap-lite/branches/upstream/current/examples/server/mod_soap.htaccess
packages/soap-lite/branches/upstream/current/examples/server/soap.asp
packages/soap-lite/branches/upstream/current/examples/server/soap.cgi
packages/soap-lite/branches/upstream/current/examples/server/soap.daemon
packages/soap-lite/branches/upstream/current/examples/server/soap.daemon.forkafterprocessing
packages/soap-lite/branches/upstream/current/examples/server/soap.daemon.forkonaccept
packages/soap-lite/branches/upstream/current/examples/server/soap.fcgi
packages/soap-lite/branches/upstream/current/examples/server/soap.io
packages/soap-lite/branches/upstream/current/examples/server/soap.jabber
packages/soap-lite/branches/upstream/current/examples/server/soap.mod_cgi
packages/soap-lite/branches/upstream/current/examples/server/soap.mq
packages/soap-lite/branches/upstream/current/examples/server/soap.pop3
packages/soap-lite/branches/upstream/current/examples/server/soap.tcp
packages/soap-lite/branches/upstream/current/examples/server/soap.vbs
packages/soap-lite/branches/upstream/current/examples/server/soap_perl.asp
packages/soap-lite/branches/upstream/current/examples/soapmark.pl
packages/soap-lite/branches/upstream/current/examples/soapsmtp.pl
packages/soap-lite/branches/upstream/current/examples/tcpclient.pl
packages/soap-lite/branches/upstream/current/examples/terraserver.pl
packages/soap-lite/branches/upstream/current/examples/weblog.pl
packages/soap-lite/branches/upstream/current/lib/
packages/soap-lite/branches/upstream/current/lib/Apache/
packages/soap-lite/branches/upstream/current/lib/Apache/SOAP.pm
packages/soap-lite/branches/upstream/current/lib/Apache/XMLRPC/
packages/soap-lite/branches/upstream/current/lib/Apache/XMLRPC/Lite.pm
packages/soap-lite/branches/upstream/current/lib/IO/
packages/soap-lite/branches/upstream/current/lib/IO/SessionData.pm
packages/soap-lite/branches/upstream/current/lib/IO/SessionSet.pm
packages/soap-lite/branches/upstream/current/lib/OldDocs/
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Lite.pm
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/FTP.pm
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/HTTP.pm
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/IO.pm
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/JABBER.pm
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/LOCAL.pm
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/MAILTO.pm
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/MQ.pm
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/POP3.pm
packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/TCP.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/
packages/soap-lite/branches/upstream/current/lib/SOAP/Client.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Constants.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Data.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Deserializer.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Fault.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Header.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Lite.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Packager.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/SOM.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Schema.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Serializer.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Server.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Test.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Trace.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/FTP.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/HTTP.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/IO.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/JABBER.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/LOCAL.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/MAILTO.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/MQ.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/POP3.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/TCP.pm
packages/soap-lite/branches/upstream/current/lib/SOAP/Utils.pm
packages/soap-lite/branches/upstream/current/lib/UDDI/
packages/soap-lite/branches/upstream/current/lib/UDDI/Lite.pm
packages/soap-lite/branches/upstream/current/lib/XML/
packages/soap-lite/branches/upstream/current/lib/XML/Parser/
packages/soap-lite/branches/upstream/current/lib/XML/Parser/Lite.pm
packages/soap-lite/branches/upstream/current/lib/XMLRPC/
packages/soap-lite/branches/upstream/current/lib/XMLRPC/Lite.pm
packages/soap-lite/branches/upstream/current/lib/XMLRPC/Test.pm
packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/
packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/HTTP.pm
packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/POP3.pm
packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/TCP.pm
packages/soap-lite/branches/upstream/current/t/
packages/soap-lite/branches/upstream/current/t/01-core.t
packages/soap-lite/branches/upstream/current/t/02-payload.t
packages/soap-lite/branches/upstream/current/t/03-server.t
packages/soap-lite/branches/upstream/current/t/04-attach.t
packages/soap-lite/branches/upstream/current/t/05-customxml.t
packages/soap-lite/branches/upstream/current/t/06-modules.t
packages/soap-lite/branches/upstream/current/t/07-xmlrpc_payload.t
packages/soap-lite/branches/upstream/current/t/08-schema.t
packages/soap-lite/branches/upstream/current/t/11-cgi.t
packages/soap-lite/branches/upstream/current/t/12-cgi_https.t
packages/soap-lite/branches/upstream/current/t/13-mod_perl.t
packages/soap-lite/branches/upstream/current/t/14-cgi_apache.t
packages/soap-lite/branches/upstream/current/t/15-daemon.t
packages/soap-lite/branches/upstream/current/t/16-tcp.t
packages/soap-lite/branches/upstream/current/t/17-mod_soap.t
packages/soap-lite/branches/upstream/current/t/19-apachesoap.t
packages/soap-lite/branches/upstream/current/t/21-public.t
packages/soap-lite/branches/upstream/current/t/22-interop_apache.t
packages/soap-lite/branches/upstream/current/t/23-ppm.t
packages/soap-lite/branches/upstream/current/t/24-wsdl.t
packages/soap-lite/branches/upstream/current/t/25-uddi.t
packages/soap-lite/branches/upstream/current/t/26-xmlrpc.t
packages/soap-lite/branches/upstream/current/t/27-xmlparserlite.t
packages/soap-lite/branches/upstream/current/t/28-uddi_search.t
packages/soap-lite/branches/upstream/current/t/29-uddi_publishing.t
packages/soap-lite/branches/upstream/current/t/36-leaks.t
packages/soap-lite/branches/upstream/current/t/37-mod_xmlrpc.t
packages/soap-lite/branches/upstream/current/t/38-packager.t
packages/soap-lite/branches/upstream/current/t/TEST.pl
packages/soap-lite/tags/
Log:
[svn-inject] Installing original source of soap-lite
Added: packages/soap-lite/branches/upstream/current/Changes
===================================================================
--- packages/soap-lite/branches/upstream/current/Changes 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/Changes 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,603 @@
+#
+# Revision history for Perl extension SOAP::Lite.
+#
+# $Id: Changes,v 1.19 2005/12/25 07:52:17 byrnereese Exp $
+
+The contents of this file provides a change history for the SOAP::Lite
+Perl module. New features are designated with a '+' and bug fixes with
+a '!'.
+
+-----------------------------------------------------------------------
+THIS RELEASE
+-----------------------------------------------------------------------
+
+0.65-beta7 May 12 2005
+
+ + Added default_ns and ns to replace the confusing use of uri() and
+ use_prefex()
+
+0.65-beta6 June 3 2005
+
+ ! Fixed bug resulting in XMLRPC requests to be serialized using the
+ doc/literal serializer if serializing arrays
+
+0.65-beta5 May 6 2005
+
+ ! Fixed critical bug which prevented all XMLRPC servers from working
+
+0.65-beta4 Apr 3 2005
+
+ ! Fixed bug 1160881 - HTTP headers are now terminated by \r\n for
+ compatibility with .NET and compliance with HTTP spec.
+ ! Fixed 1158666 - stubmaker.pl no longer call deprecated subroutine
+ + stubmaker.pl got a lot of enhancements - now has help and version
+ output, run time options, etc. See 'man stubmaker.pl' for more.
+ + Classes generated by stub_maker.pl now have a special subroutine
+ called 'want_som.' When set to 1, the stub class will return a
+ SOAP::SOM object for every request.
+ ! Fixed bug 1149427 - now capable of returning SOAP::SOM objects
+ from generated stub classes.
+
+0.65-beta3 Mon Oct 25 2004
+
+ + SOAP::Lite will only warn you once when you call a doc/literal
+ service
+ + Added SOAP::Schema->cache_dir() and SOAP::Schema->cache_ttl(),
+ which control how code stubs generated from WSDLs are cached to
+ prevent constant reparsing of WSDL files.
+ ! Tested SOAP::Lite against Google, Salesforce, and FedEx. So far,
+ clients can successfully call these service providers (at least
+ some of their operations) - testing does not provide 100% coverage
+ of their APIs.
+
+0.65-beta2.1 Mon Oct 25 2004
+
+ + Fixed bug in unit tests in which MIME::Tools was not properly detected
+ resulting in failed unit tests for some users.
+ + Fixed some documentation issues (speling, etc).
+
+0.65-beta2 Mon Oct 25 2004
+ ** WARNING ** substantial changes have been made to SOAP::Lite in
+ this release in regards to how it manages attachments. The changes
+ may introduce instabilities into your software that relies on this
+ functionality. Please test your software with 0.65 prior to moving it
+ to a production environment.
+
+ + Added ReleaseNotes.txt
+ + Added section REPORTING BUGS to pod comments
+ + Deprecated SOAP::Lite->schema removed
+ + Deprecated SOAP::Lite->on_debug removed
+ + Deprecated SOAP::Schema->schema in favor of SOAP::Schema->schema_url
+ + Added SOAP::Schema->useragent - which returns the LWP::UserAgent instance
+ that will be used when accessing WSDLs via the SOAP::Lite->service call.
+ This is helpful when access to a WSDL requires authentication, etc.
+ + Made changes that allow messages to be constructed using a NULL body:
+ <Envelope><Body /></Envelope>
+ + Added constant OBJS_BY_REF_KEEPALIVE which defaults to 600 - this is
+ so that services can configure how long to cache objects marked as persistent
+ using SOAP::Server::Object->objects_by_reference()
+ + Added the ability for a user to modify the UserAgent class used
+ by SOAP::Transport::HTTP::Client, updated Transport.pm's documentation
+ to reflect this. Added $SOAP::Transport::HTTP::Client::USERAGENT_CLASS
+ variable as a means of setting this.
+ + Added initial DIME support
+ + SOAP Packager package/unpackage now take in a context variable as
+ input because DIME needs to know what version of SOAP you are using.
+ + Refactored and rewrote README
+ + Renamed SOAP::Schema->stub() to SOAP::Schema->generate_stub. This populates
+ a private variable called C<stub> with the autogenerate Perl code.
+ + Added SOAP::Schema->stub() which returns the autogenerated Perl code used
+ internally by SOAP::Lite. This can be helpful for debugging SOAP::Lite's
+ utilization of WSDL, as well as helpful to developers working on S::L's
+ WSDL support.
+
+0.65-beta1 Mon Oct 18 15:55:00 2004
+
+ + Made SOAP::Serializer->readable actually produce readable XML!
+ ! Fixed bug 747312 - Made XML Schema 2001 the default schema
+ + Changed typelookup of base64 to base64Binary to conform with 2001
+ schema
+ + Added support for [almost] all XML Schema 2001 built-in datatypes
+ + Added register_ns subroutine to SOAP::Serializer
+ + Added find_prefix subroutine to SOAP::Serializer
+ + Added use_prefix subroutine to SOAP::Serializer
+ + Added a necessary set of initial subroutinues to support wsdl2perl
+ project
+ + Added format_datetime to SOAP::Utils
+ + Documented SOAP::SOM->parts
+ + Added SOAP::SOM->is_multipart
+ + Properly escaped characters to facilitate emacs syntax highlighting
+ + Ran podchecker to validate all POD comments
+ ! Fixed bug 749636 - changed a croak to a warn to enable socket
+ timeouts in SOAP::Transport::TCP::Server
+ + Added support for UDDI 2/3
+ + Majorly revamped product documentation thanks to the kind
+ contribution made by O'Reilly. Appendix B from "Programming Web
+ Services with Perl" has been completely integrated.
+ + To better segment SOAP::Lite documentation, many modules have been
+ added that contain documentation only. For those who loved the old
+ documentation, it can be found in lib/OldDocs/SOAP/*.pm and
+ lib/OldDocs/SOAP/Transport/*.pm
+ ! Fix a bug in which doclit style arrays were not being deserialized
+ properly. IOW, Repeated elements were not made into an array, only
+ the last occurring value was recorded.
+ + Added the ability for a SOAP Client to gain direct access to the
+ HTTP::Request and HTTP::Response objects.
+ + Changed default envelope namespace prefix from SOAP-ENV to soap
+ + Changed default encoding namespace prefix from SOAP-ENC to soapenc
+ + Reachitected MIME support to decouple MIME layer from transport
+ layer. This only impacts the HTTP layer since that is the only
+ transport in SOAP::Lite that supports attachments.
+ + Creation of SOAP::Packager - decoupled in an extensible way the
+ packaging of parts (a.k.a. attachments). This is used for encoding
+ and decoding. This enables a more seemless addition of DIME
+ support. Changes were made throughout SOAP::Lite to accomodate this
+ functionality.
+ - a call "context" was added to SOAP::Server and SOAP::Deserializer
+ so that those classes could have access to the global
+ SOAP::Packager instance
+ - deprecated many function calls and packages having to do with
+ attachment support
+ - fixed several of the SOAP::*::new() methods so that they don't
+ inadvertantly reinitialize themselves and destroy precious context
+ information in the process
+ + Gave developers direct access to MIME::Parser object so that they
+ can optimize its use. See the following URL to optimize it for
+ memory consumption, parsing speed, disk utilization, etc:
+ http://search.cpan.org/dist/MIME-tools/lib/MIME/Parser.pm#OPTIMIZING_YOUR_PARSER
+ + Added a context variable to SOAP::Serializer and SOAP::Deserializer
+ so that they have mechanisms for getting instance data from the
+ calling context. The value of context is either SOAP::Lite or
+ SOAP::Server depending upon the role the service is playing in the
+ transaction. Contexts are initialized when a call is made, and
+ destroyed when a call is completed.
+ + Greater than character '>' has been added to list of characters
+ that will be automatically escaped. This is not a requirement by
+ the XML spec, it is a MAY, but I am doing it after seeing a minority
+ of people report a compatibility problem.
+ - Removed deprecated methods: SOAP::Serializer::namespace and
+ encodingspace
+ + Added SOAP::Serializer::encodingStyle method which allows users to
+ set the URI for default encodingStyle.
+ + Added initial support for literal encoding style. EXPERIMENTAL
+ + Added some true constant values representing various SOAP namespace
+ URIs
+ + Added SOAP::Constants::SUPPORTED_ENCODING_STYLES for better tracking
+ of the set of encoding styles that the toolkit can [de]serialize
+ ! Fixed bug 840172 - "Makefile.PL --noprompt flag broken," now fixed
+ + Updated SOAP 1.2 URIs to the latest (TODO - maintain support for
+ older ones)
+ + Added HTTPS support for HTTP::Server Daemon class - thanks to Nils
+ Sowen for this contribution
+
+-----------------------------------------------------------------------
+PREVIOUS RELEASES
+-----------------------------------------------------------------------
+
+0.60 Mon Aug 18 12:10:27 2003
+ + Merged SOAP::MIME into SOAP::Lite's core
+ + Cleaned up the UI for the Makefile.PL script - it now detects and
+ indicated whether certain Perl modules have been detected. The
+ table displaying installation preferences has been substantially
+ cleaned up, the code is much more modular and relies on a simple
+ data structure representing potential module dependencies.
+ + Made the Makefile.PL script iterative - meaning, the user will be
+ continually be presented with their preferences until they
+ explicity choose to accept them and continue (bug 747295)
+ + Differentiate between xsd:int and xsd:long to fix interoperability
+ bug with Java Web services
+ ! Fixed MIME interoperability bug with Apache Axis - Axis' MIME
+ parser requires that MIME boundaries are terminiated by a CRLF
+ character where the MIME::Tools package only outputs a CR
+ character. A patch was integrated into the MIME::Tools module
+ which allows SOAP::Lite to specify its own MIME Boundary delimiter
+ ! SOAP Faultcodes are now properly typed a xsd:QName, whereas
+ before they were xsd:string - to be honest, they are left untyped
+ so that toolkits can serialize them according to the schema
+ (bug 747283)
+ ! Fixed documentation error around turning on a trace for multiple
+ "channels" (bug 747310)
+ ! Disabled SOAPStruct (bug 747316)
+ ! Fixed XML::Parser::Expat vulnerability (bug 747265)
+ ! Added item in TROUBLESHOOTING section explaining that there is a
+ bug in Perl 5.8 that prevents +autodispatch from working properly.
+ The workaround is to use dispatch_from instead (bug 747290)
+ ! Fixed warning when autodispatched call has no parameters
+ (bug 747286)
+ ! Fixed warning when empty SOAPAction specified (bug 747278)
+ ! Turned off HTTP keep alive patch by default, however users can now
+ turn on the patch by setting the constant PATCH_HTTP_KEEPALIVE to
+ 1 (bug 747281)
+ ! Removed dependency on the URI module for non-HTTP transports
+ (bug 747306)
+
+0.55 Mon Apr 15 22:20:39 2002
+ ! fixed security vulnerability with fully qualified method names
+ (thanks to Randal Schwartz, Ilya Martynov and many others)
+ ! fixed problem with TCP transport and SSL (thanks to Chris Hurd)
+ ! fixed TCP transport to specify correct length with utf8 strings
+ (thanks to Robin Fuller)
+ ! fixed incorrect encoding when parameters list includes undefined
+ values (thanks to Chris Radcliff)
+ ! updated 'xmlsoap' prefix (thanks to Pierre Denis)
+ ! updated MIME parser to accept messages that start with 'From'
+ (thanks to Chris Davies)
+ + added check for TCP transport on Mac (thanks to Robin Fuller)
+ + added check for shutdown() method on AIX (thanks to Jos Clijmans)
+ + added check for blocking() method in TCP transport
+ (thanks to Jos Clijmans)
+ + optimized parsing strings with entity encoding (thanks to Mathieu
+ Longtin)
+ + added check for entity size for CGI transport
+ ($SOAP::Constant::MAX_CONTENT_SIZE) (thanks to J. Klunder)
+ + added example (google.pl)
+ + updated tests and examples with new endpoints
+
+0.52 Mon Oct 18 21:20:19 2001
+ ! fixed content_type returned under mod_perl with 500 SERVER ERROR
+ status (thanks to Geoffrey Young and Scott Hutton)
+ ! fixed problem with multiple bindings in WSDL file generated by
+ MS SOAP toolkit
+ ! fixed handling of boolean type in 1999 Schema and hexBinary type
+ in 2001 Schema
+ ! fixed warning and problem with WOULDBLOCK state in IO::SessionData
+ (thanks to Marty Pauley)
+ ! fixed miscalculation in position within sparse arrays
+ ! fixed problem with URI when methods of SOAP::Data are called in
+ certain order (thanks to Taras Shkvarchuk)
+ ! fixed CRLF problem in CGI module on Windows platform under IIS
+ (thanks to Werner Ackerl)
+ ! fixed hex and hexBinary datatypes generation
+ ! fixed content-length calculation when payload has multibyte utf8
+ characters
+ ! fixed problem with XMLRPC and nested packages with more than two
+ levels (thanks to Leonid Gernovski)
+ ! fixed (again) memory leak in SOAP::Parser (thanks to Craig
+ Johnston)
+ + updated Jabber interface for new format of 'use Net::Jabber ...'
+ does not work with Net::Jabber 1.022 and later
+ + updated XMLRPC::Lite to not detect value as float for 'NaN' and
+ 'INF' strings
+ + updated XMLRPC::Lite to return 200OK on errors
+ + updated XMLRPC do not specify charset in content-type
+ + updated Makefile.PL to allow configuration from command line
+ (thanks to Dana Powers)
+ + updated publishing API tests for UDDI server to call a new server
+ (GLUE)
+ + changed close() to shutdown() in Daemon transport (thanks to Sean
+ Meisner)
+ + added support for HTTP_proxy and HTTP_proxy_* in WSDL access
+ (thanks to Stephen Shortland)
+ + added XMLRPC support in COM interface. XMLRPC client and server
+ can be created using COM interface
+ + added DO_NOT_PROCESS_XML_IN_MIME option for MIME parts with
+ text/xml content type
+ + modified deserialization algorithm that allows to properly
+ deserialize SOAP1.2 messages when default is set to SOAP1.1 and
+ vice versa
+ + added fault in XMLRPC::Lite for incorrect datatypes specified by
+ user (thanks to Paul Prescod)
+ + added option to not generate XML declaration
+ + added encoding for ']]>' (thanks to Matt Sergeant and James
+ Amrhein)
+ + added '\r' => '
' conversion in strings
+ + added complaint on incorrect simple types
+ + added byNameOrOrder and byName functions for
+ SOAP::Server::Parameters (thanks to Matt Stum)
+ + added handling relative locations in <import> in WSDL
+ + added stringification of SOAP::Fault (thanks to Tim Jenness)
+ + added documentation for SSL certificate authentication
+ + added more examples (terraserver.pl, joke.pl, weblog.pl)
+ + added more tests
+
+0.51 Tue Jul 18 15:15:14 2001
+ ! fixed memory leak in SOAP::Parser (thanks to Ryan Adams and Michael
+ Brown)
+ ! fixed skipping undef elements in arrays under Perl 5.005 (thanks to
+ Arne Georg Gleditsch)
+ ! fixed warning from undefined type in out parameters (thanks to
+ J†rg Ziefle)
+ ! fixed autovivification warnings on 5.7.x (thanks to Igor Pechersky)
+ ! fixed tests on 64bit systems (thanks to Gurusamy Sarathy)
+ ! fixed installation problem with long filenames on MacOS (thanks to
+ Alex Harper)
+ ! fixed POP3 server (thanks to Kevin Hutchinson)
+ ! number of fixes in XMLRPC::Lite
+ o fixed <string> requirement (thanks to Matthew Krenzer and Dana
+ Powers)
+ o fixed empty slot skipping (thanks to Jon Udell)
+ o fixed serialization of "0"/""/undef values (thanks to Michael E.
+ Gage)
+ o fixed autodispatch (thanks to Craig Kelley)
+ + added support for SOAP 1.2 (spec is still in draft, implementation
+ is subject to change)
+ + added extended array support (only in deserializer)
+ sparse arrays
+ multidimensional arrays (deserialized as array of arrays)
+ partially transmitted arrays
+ + modified XML::Parser::Lite to work on Perl 5.005 (thanks to John
+ Gotts)
+ fixed handling empty attributes as undef
+ fixed minors (thanks to Duncan Cameron)
+ + modified deserializer to work with different schemas (1999/2001)
+ + added JABBER transport
+ + added MQ transport
+ + added mod_xmlrpc transport (Apache::XMLRPC::Lite)
+ + added TCP over SSL transport
+ + added non-blocking TCP multiserver
+ + included FastCGI transport (thanks to Marko Asplund)
+ + added support for APOP authentication in POP3 transport
+ + added Encoding parameter for MAILTO transport (to choose
+ base64/binary)
+ + added 'autoresult' option (thanks to Mathieu Longtin)
+ + added support for import directive in WSDL
+ + added support for short (tModel) WSDL service descriptions
+ + added support for multiple services/ports and allowed non-SOAP
+ bindings in WSDL
+ + added full search example UDDI->WSDL->SOAP (fullsearch.pl)
+ + added charset in response message for HTTP transport
+ + modified SOAPsh/XMLRPCsh to return all parameters (thanks to Chris
+ Davies)
+ + modified dispatch for XMLRPC server to work exactly as for SOAP
+ server examples included in examples/XMLRPC directory
+ + added example with Inline::C module (inline.daemon).
+ Dispatch to C, C++, assembler, Java, Python and Tcl :).
+ Thanks to Brian Ingerson for his Inline module.
+ + all transport are available for both SOAP::Lite and XMLRPC::Lite:
+ HTTP (daemon, CGI, mod_perl), SMTP/POP3, TCP, IO, JABBER, MQ
+ + updated INCOMPATIBILITY section in README file
+ + tested on Perl 5.00503, 5.6.0, 5.6.1, 5.7.1 and 5.7.2
+ + added SOAP Cookbook (http://cookbook.soaplite.com/)
+ + added server scripts for MQ and JABBER transports
+ + added roundtrip example for JABBER transport
+ + updated documentation and added new examples
+ + added more tests (more than 700 for now)
+
+0.50 Wed Apr 18 11:45:14 2001
+ ! fixed tests on Windows platform
+ ! fixed authInfo in UDDI publishing interface
+ ! fixed mod_soap (Apache::SOAP) on Perl 5.005/5.004
+ ! fixed namespace prefix on arrays of arrays
+ ! modified Content-encoding from 'compress' to 'deflate'
+ + added XML::Parser::Lite, regexp-based XML parser
+ used automatically when XML::Parser is not available
+ + added examples of custom serialization and deserialization
+ (XML::DOM)
+ + added XMLRPC::Lite (XMLRPC client and server interface)
+ all transports and features of SOAP::Lite should be available
+ + added XMLRPC interactive shell (XMLRPCsh.pl)
+ + added dispatching based on URI and SOAPAction (dispatch_with)
+ + added dispatching to object (in addition to class/method)
+ + added dispatch from specific class(es) (dispatch_from)
+ + added limited support for mustUnderstand and actor attributes
+ + added SOAP::Fault class for customization of returning Fault
+ message
+ + added charset in HTTP header for requests
+ + added check for namespace and types resolving
+ + added namespaces declarations from WSDL interface
+ + added INCOMPATIBILITY section in README file
+ + added live tests/examples for UDDI publishing interface
+ + added live tests/examples for basic authentication
+ + added XMLRPC server code that validates with Userland's validator
+ + added more examples, tests and documentation
+
+0.47 Wed Feb 21 17:11:12 2001
+ ! fixed lack of parameter in MAILTO transport
+ ! fixed minimal version of COM interface to not require absent
+ modules
+ + added compression for HTTP transport
+ + added mod_soap interface, add SOAP server functionality
+ with couple of lines in .htaccess or httpd.conf file
+ + added proper serialization of circular multiple references
+ + significantly redesigned handling types and URIs
+ ! incompatibilities with ApacheSOAP clients may occur
+ + added handling PIPE and INT signals in Daemon server implementation
+ + changed return from autodispatched calls:
+ result() in scalar context and paramsall() in list context
+ + redesigned tests and split on core and optional for smooth CPAN
+ installation
+ + added examples for cookie-based authorization
+ + added examples in C# and PerlScript for COM interface
+ + added more documentation for COM interface
+ + updated documentation and added new examples
+
+0.46 Wed Jan 31 16:30:24 2001
+ ! fixed SOAP:: prefix with SOAP::Lite objects
+ ! fixed documentation installation on Unix
+ ! changed interface of schema() method. Use service() instead
+ + added COM interface
+ single dll (standalone or minimal version, downloadable separately)
+ doesn't require ROPE.dll, MSXML.dll or listener.asp
+ tested on Windows 98/2K, and should work on Windows 9x/Me/NT/2K
+ ASP and daemon server implementations
+ examples in VB/VBS, Excel/VBA, JavaScript, Perl and ASP
+ + added parsing multipart/form-data
+ SOAP server can accept SOAP requests directly from web form
+ examples are provided (examples/forms/*)
+ + added Map type for hash encoding. Tested with ApacheSOAP
+ + added function that maps classes to URI (maptype)
+ + allowed multiple ports in WSDL
+ + tested object interoperability with Apache SOAP
+ + optimized internal functions
+
+0.45 Tue Jan 16 00:38:04 2001
+ ! fixed interoperability problem with incorrect Array prefix for
+ Apache SOAP
+ + added interoperability tests for Apache SOAP
+ + added interoperability tests with MS SOAP, 4s4c and Lucin
+ implementations
+ + added attachment parsing (singlepart/multipart MIME)
+ Content-ID and Content-Location are supported
+ text/xml fragments are supported and parsed
+ all implementations support MIME encoded messages
+ + added IO server implementation (for pipes, mail handlers, FTP and
+ file processing)
+ + added FTP client implementation
+ + added global settings, shareable between objects
+ + allowed empty URI and non-prefixed method (documentation included)
+ + added tests for xml, xml with headers, single and multipart MIME
+ + updated documentation and added examples
+ + more that 300 tests in test suite
+
+0.44 Tue Dec 12 23:52:12 2000
+ ! fixed mod_perl server to return '500 Server Error' in case of error
+ ! fixed CGI server to work under PerlIS and PerlEx (thanks to Murray
+ Nesbitt)
+ + tested publishing API for UDDI::Lite, examples provided
+ (thanks to Petr Janata for access to UDDI server and provided help)
+ + added bi-directional TCP client/server, examples and tests provided
+ + enabled de/serializer overloading on server side (in addition to
+ client)
+ + added optimization for objects-by-reference
+ + added ForkingDaemon server implementation (thanks to Peter
+ Fraenkel)
+ + added SOAP::Custom::XML for XML processing, examples and tests
+ provided
+ + added SOAP::Test as simple test framework
+ + added documentation for UDDI publishing API
+ + redesigned examples and tests (~240 tests for now)
+
+0.43 Tue Nov 28 01:47:02 2000
+ ! fixed bug in UDDI interface that made UDDI client almost useless
+ ! fixed Makefile.PL
+ ! tests confirmed that memory leak is gone
+ + changed syntax for UDDI client to more flexible/convenient
+ + added limited support for WSDL schemas. Dynamic and stub access
+ supported
+ + added script for stub generation (stubmaker.pl)
+ + optimized code on server side
+ + object interface for SOAP, UDDI and schemas are supported
+ consistently
+ + allowed manipulation of method's attributes and namespaces
+ + added attributes encoding ('&', '<' and '"' are encoded)
+ + updated documentation
+ (thanks to Robert Barta who basically did this work)
+ + added more examples and tests (154 for now)
+
+0.42 Tue Nov 14 23:14:18 2000
+ + added UDDI client (UDDI::Lite) with documentation
+ + added M-POST functionality in HTTP::Client
+ + added redirect (3??) functionality in HTTP::Client
+ + added session cache for M-POSTs and redirects
+ + added conversion of all objects to o-b-r in parameters
+ + changed passing envelope into method
+ + allowed \x0d and \x0a in strings (will not do base64 encode)
+ + added die with object that allows to specify complex Fault detail
+ + optimized XML encoding
+ + allowed function call with autodispatch
+ + improved syntax for 'use SOAP::Lite'
+ + added soap.tcp example for TCP server implementation
+ + added tests with Microsoft implementation
+ + added documentation and tests (145 for now)
+
+0.41 Tue Oct 31 01:24:51 2000
+ ! fixed memory leak on server side
+ ! fixed die on absence of HTTP::* modules on server side
+ ! fixed working with keep-alive connections (added test with
+ Xmethods)
+ + changed autotyping from double to float
+ + added support for proxy authorization (thanks to Murray Nesbitt)
+ + added TCP client/server implementation
+ + added benchmark for all implementations except smtp/pop3
+ + added SOAP::Trace for detail logging on client/server side
+ + added examples/tests for Apache::Registry implementations
+ + added more examples, documentation and tests (127 for now)
+
+0.40 Sun Oct 15 18:20:55 2000
+ ! fixed die in mailto: protocol if you don't have URI::URL installed
+ ! fixed misbehavior on Mac platform (thanks to Carl K. Cunningham)
+ + added default namespace processing [xmlns] (thanks to Petr Janata)
+ + added objects-by-reference, simple garbage collection and
+ activation
+ + added full access to envelope on server side
+ + added versionMismatch reaction
+ + added local: protocol for local binding without any transport
+ + added examples for objects-by-reference: persistent/session
+ iterators and chat (40 lines on server and 25 lines on client side)
+
+0.39 Sun Oct 8 22:55:20 2000
+ ! fixed incompatibility with Perl 5.005
+ + added interactive Makefile.PL for CPAN installation
+
+0.38 Thu Oct 5 22:06:20 2000
+ ! fixed namespace for base64 encoding
+ ! fixed security problem on server side, upgrade is highly
+ recommended
+ + added HTTPS/SSL support
+ + added SMTP client implementation
+ + added POP3 server implementation
+ + added support for Basic/Digest server authentication
+ + added support for header(s) on client/server side with SOAP::Header
+ + added Array and SOAPStruct for interoperability with ApacheSOAP
+ + added generic class for server support SOAP::Server
+ + added Actor attribute
+ + added more examples, documentation and tests (88 for now)
+
+0.36 Sun Sep 24 20:12:10 2000
+ ! fixed output parameters autobinding
+ + added mod_perl server implementation
+ + added recognizing all simple types mentioned in specification
+ + added support for 'hex' type
+ + added more documentation (twice as much as before)
+ + added more tests (74 for now)
+
+0.35 Sun Sep 17 23:57:10 2000
+ ! fixed minors (Response instead of Respond, server will map client's
+ URI)
+ + cleaned HTTP::Server internals (will go to SOAP::Server in the
+ future)
+ + test.pl won't abort on transport errors. Failed test will be
+ skipped
+ + added daemon server implementation
+ + added cgi/daemon server implementation examples
+ + added deserialization into blessed reference
+ + added dynamic/static class/method binding
+ + added output parameters matching based on signature (name/type)
+ + added real object transferring back and forth (see example of
+ Chatbot::Eliza, fixed for CODE references)
+ + added more interoperability with on_action on client and server
+ side
+ + added new events (on_action, on_fault, on_nonserialized)
+ + added global class settings with 'use SOAP::Lite ...'
+ + added code for returning application errors on server
+ + added autodispatch
+ + added SOAP prefix to method calls
+ + added more documentation
+ + added more tests (54 for now)
+ + added more examples (Chatbot::Eliza, My::PingPong)
+
+0.32 Sun Sep 10 23:27:10 2000
+ ! fixed warnings with -w
+ ! fixed blessed reference serialization. Assigned type has top
+ priority
+ + added working with current node in SOAP::SOM
+ + SOAP::SOM::valueof returns nodeset
+ + SOAP::SOM::match returns boolean in boolean context
+ + added raw xml accepting and output
+ + added UserAgent parameters to SOAP::Transport (understands timeout)
+ + added better diagnostic on transport errors in test.pl
+ + added 'method', 'fault', 'freeform' types of Envelope
+ + added server implementation
+ + added CGI interface to server implementation
+ + added My::Examples.pm as example of loaded class for SOAP server
+ + added more tests (47 for now)
+
+0.31 Wed Sep 6 00:36:15 2000
+ + added expressions to SOAP::SOM->match method
+ + added deserialization of circular references
+ + added tests for deserialization
+ + added documentation
+
+0.3 Mon Sep 4 00:59:04 2000
+ + first public beta version
+ + added live SOAP calls
+ + added test suite (25 tests)
+ + added documentation
+ + added interactive shell (SOAPsh.pl)
+
+0.2 Mon Aug 24 19:34:24 2000
+ - next stable version; works with public test servers
+
+0.1 Mon Aug 11 23:12:02 2000
+ - first version; serialization part only
+
Added: packages/soap-lite/branches/upstream/current/MANIFEST
===================================================================
--- packages/soap-lite/branches/upstream/current/MANIFEST 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/MANIFEST 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,182 @@
+bin/SOAPsh.pl SOAP shell
+bin/stubmaker.pl Script for creating stubs from schema description
+bin/XMLRPCsh.pl XMLRPC shell
+Changes
+examples/allclients.pl Different client implementations
+examples/authentication.pl Example for Basic/Digest server authentication
+examples/autoexamples.pl Script for My::Examples with autodispatching
+examples/chat.pl Client side for Chat implementation
+examples/COM/hash.vbs Example in VBScript, hash manipulation
+examples/COM/hashecho.vbs
+examples/COM/local.vbs Example in VBScript, client for local service
+examples/COM/make-com-minimal.bat
+examples/COM/make-com-standalone.bat
+examples/COM/README Examples and description for COM interface
+examples/COM/remote.cs Example in C#, client for remote service
+examples/COM/remote.vba
+examples/COM/remote.vbs Example in VB, client for remote service
+examples/COM/remote.xls
+examples/COM/service.vbs Example in VB, client with WSDL
+examples/COM/SOAP-Lite-COM-minimal.ctrl
+examples/COM/SOAP-Lite-COM-standalone.ctrl
+examples/COM/soap.asp SOAP server, ASP/VBScript implementation
+examples/COM/soap.vbs SOAP server, VB/Daemon implementation
+examples/COM/soap_perl.asp SOAP server, ASP/PerlScript implementation
+examples/COM/states.html Example in JavaScript, client for local service
+examples/COM/states.pl Example in Perl, client for local service
+examples/COM/states.vba Source code for macroses in states.xls
+examples/COM/states.vbs Example in VBScript, client for local service
+examples/COM/states.xls Example in Excel/VBA, client for local service
+examples/COM/temper.vbs Example in VB, client for remote service
+examples/COM/xmlrpc.vbs
+examples/compress.pl Example for compression options
+examples/cookie.pl Fortune cookie for you
+examples/cookieauth.pl Example for cookie-based authentication
+examples/customschema.pl
+examples/forms/style.cgi Example for form-data parsing, server side
+examples/forms/style.html Example for form-data parsing, client side
+examples/fullsearch.pl
+examples/getdom.pl
+examples/google.pl Example for Google Web API
+examples/inline.daemon
+examples/iterator.pl Example for Session/Persistent iterators
+examples/JABBER/jabclient.pl
+examples/JABBER/jabserver.pl
+examples/joke.pl
+examples/MQ/mqclient.pl
+examples/MQ/mqserver.pl
+examples/My/Chat.pm Module with Chat server implementation
+examples/My/Examples.pm Module with Examples backend
+examples/My/Parameters.pm Module with Paramaters backend
+examples/My/PersistentIterator.pm Module with Persistent Iterator backend
+examples/My/PingPong.pm Module with PingPong backend
+examples/My/SessionIterator.pm Module with Session Iterator backend
+examples/oneliners Couple of one-line SOAP calls
+examples/oo-apache.pl Example of object interoperability
+examples/parametersbyname.pl Example for passing parameters-by-name
+examples/pingpong.pl Example for local/remote access to the same object
+examples/server/Apache.pm Module for SOAP server, mod_perl implementation
+examples/server/mod_soap.htaccess .htaccess file, configuration for mod_soap
+examples/server/soap.asp SOAP server, ASP/VBScript implementation
+examples/server/soap.cgi SOAP server, CGI implementation
+examples/server/soap.daemon SOAP server, daemon implementation
+examples/server/soap.daemon.forkafterprocessing SOAP server, forking daemon implementation
+examples/server/soap.daemon.forkonaccept SOAP server, forking daemon implementation
+examples/server/soap.fcgi
+examples/server/soap.io SOAP server, IO implementation
+examples/server/soap.jabber
+examples/server/soap.mod_cgi SOAP server, Apache::Registry implementation
+examples/server/soap.mq
+examples/server/soap.pop3 SOAP server, POP3 implementation
+examples/server/soap.tcp SOAP server, TCP implementation
+examples/server/soap.vbs SOAP server, VB/Daemon implementation
+examples/server/soap_perl.asp SOAP server, ASP/PerlScript implementation
+examples/SOAP/simple1.pl Example for SOAP interface
+examples/SOAP/simple2.pl Example for SOAP interface
+examples/SOAP/simple3.pl Example for SOAP interface
+examples/SOAP/Transport/HTTP/Daemon/ForkAfterProcessing.pm
+examples/SOAP/Transport/HTTP/Daemon/ForkOnAccept.pm
+examples/soapmark.pl Simple test for different implementations
+examples/soapsmtp.pl Example for SMTP/sendmail message sending
+examples/tcpclient.pl Simple test for local TCP client
+examples/terraserver.pl
+examples/UDDI/inquire1.pl Example for UDDI inquire interface
+examples/UDDI/publish1.pl Example for UDDI publishing interface
+examples/UDDI/simple1.pl Example for UDDI interface
+examples/UDDI/simple2.pl Example for UDDI interface
+examples/UDDI/syntax1.pl Example for UDDI publishing interface
+examples/UDDI/syntax2.pl Example for UDDI publishing interface
+examples/UDDI/syntax3.pl Example for UDDI publishing interface
+examples/weblog.pl
+examples/WSDL/dynamic1.pl Example for WSDL dynamic interface
+examples/WSDL/dynamic2.pl Example for WSDL dynamic interface
+examples/WSDL/dynamic3.pl Example for WSDL dynamic interface
+examples/WSDL/dynamic4.pl
+examples/WSDL/stub1.pl Example for WSDL stub interface
+examples/WSDL/stub2.pl Example for WSDL stub interface
+examples/WSDL/stub3.pl Example for WSDL stub interface
+examples/XML/customxml.pl Example for XML processing (SOAP::Custom::XML)
+examples/XMLRPC/mod_xmlrpc.htaccess
+examples/XMLRPC/simple1.pl
+examples/XMLRPC/xmlrpc.cgi
+examples/XMLRPC/xmlrpc.daemon
+lib/Apache/SOAP.pm mod_soap module
+lib/Apache/XMLRPC/Lite.pm
+lib/IO/SessionData.pm
+lib/IO/SessionSet.pm
+lib/OldDocs/SOAP/Lite.pm
+lib/OldDocs/SOAP/Transport/FTP.pm
+lib/OldDocs/SOAP/Transport/HTTP.pm
+lib/OldDocs/SOAP/Transport/IO.pm
+lib/OldDocs/SOAP/Transport/JABBER.pm
+lib/OldDocs/SOAP/Transport/LOCAL.pm
+lib/OldDocs/SOAP/Transport/MAILTO.pm
+lib/OldDocs/SOAP/Transport/MQ.pm
+lib/OldDocs/SOAP/Transport/POP3.pm
+lib/OldDocs/SOAP/Transport/TCP.pm
+lib/SOAP/Client.pm
+lib/SOAP/Constants.pm
+lib/SOAP/Data.pm
+lib/SOAP/Deserializer.pm
+lib/SOAP/Fault.pm
+lib/SOAP/Header.pm
+lib/SOAP/Lite.pm Main SOAP::Lite module
+lib/SOAP/Packager.pm
+lib/SOAP/Schema.pm
+lib/SOAP/Serializer.pm
+lib/SOAP/Server.pm
+lib/SOAP/SOM.pm
+lib/SOAP/Test.pm Simple test framework
+lib/SOAP/Trace.pm
+lib/SOAP/Transport.pm
+lib/SOAP/Transport/FTP.pm FTP transport, client
+lib/SOAP/Transport/HTTP.pm HTTP transport, client and server
+lib/SOAP/Transport/IO.pm IO transport, client
+lib/SOAP/Transport/JABBER.pm
+lib/SOAP/Transport/LOCAL.pm LOCAL transport, client and server
+lib/SOAP/Transport/MAILTO.pm SMTP/sendmail transport, client
+lib/SOAP/Transport/MQ.pm
+lib/SOAP/Transport/POP3.pm POP3 transport, server
+lib/SOAP/Transport/TCP.pm TCP transport, client and server
+lib/SOAP/Utils.pm
+lib/UDDI/Lite.pm Main UDDI::Lite module
+lib/XML/Parser/Lite.pm
+lib/XMLRPC/Lite.pm
+lib/XMLRPC/Test.pm
+lib/XMLRPC/Transport/HTTP.pm
+lib/XMLRPC/Transport/POP3.pm
+lib/XMLRPC/Transport/TCP.pm
+Makefile.PL
+MANIFEST
+META.yml Module meta-data (added by MakeMaker)
+README
+ReleaseNotes.txt
+t/01-core.t
+t/02-payload.t
+t/03-server.t
+t/04-attach.t
+t/05-customxml.t
+t/06-modules.t
+t/07-xmlrpc_payload.t
+t/08-schema.t
+t/11-cgi.t
+t/12-cgi_https.t
+t/13-mod_perl.t
+t/14-cgi_apache.t
+t/15-daemon.t
+t/16-tcp.t
+t/17-mod_soap.t
+t/19-apachesoap.t
+t/21-public.t
+t/22-interop_apache.t
+t/23-ppm.t
+t/24-wsdl.t
+t/25-uddi.t
+t/26-xmlrpc.t
+t/27-xmlparserlite.t
+t/28-uddi_search.t
+t/29-uddi_publishing.t
+t/36-leaks.t
+t/37-mod_xmlrpc.t
+t/38-packager.t
+t/TEST.pl
Added: packages/soap-lite/branches/upstream/current/META.yml
===================================================================
--- packages/soap-lite/branches/upstream/current/META.yml 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/META.yml 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,21 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: SOAP-Lite
+version: 0.66
+version_from: lib/SOAP/Lite.pm
+installdirs: site
+requires:
+ Compress::Zlib: 0
+ Crypt::SSLeay: 0
+ HTTP::Daemon: 0
+ IO::File: 0
+ MIME::Base64: 0
+ MIME::Lite: 0
+ MIME::Parser: 6.106
+ Net::FTP: 0
+ Net::POP3: 0
+ URI: 0
+ XML::Parser: 2.23
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: packages/soap-lite/branches/upstream/current/Makefile.PL
===================================================================
--- packages/soap-lite/branches/upstream/current/Makefile.PL 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/Makefile.PL 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,179 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+require 5.004;
+use strict;
+
+my @PREREQS = (
+# ["<feature>","<installed module>",<dependency hash>,<install by default, 2=always>];
+ ["Core Package","SOAP::Lite",{"XML::Parser" => "2.23","MIME::Base64" => 0, "URI" => 0},2],
+ ["Client HTTP support","",{"LWP::UserAgent" => 0},1],
+ ["Client HTTPS support","SOAP::Transport::HTTPS::Client",{"Crypt::SSLeay" => 0},0],
+ ["Client SMTP/sendmail support","SOAP::Transport::MAILTO::Client",{"MIME::Lite" => 0},1],
+ ["Client FTP support","SOAP::Transport::FTP::Client",{"Net::FTP" => 0,"IO::File" => 0},0],
+ ["Standalone HTTP server","SOAP::Transport::HTTP::Daemon",{"HTTP::Daemon" => 0},1],
+ ["Apache/mod_perl server","SOAP::Transport::HTTP::Apache",{"Apache" => 0},0],
+ ["FastCGI server","SOAP::Transport::HTTP::FCGI",{"FCGI" => 0},0],
+ ["POP3 server","SOAP::Transport::POP3::Server",{"Net::POP3" => 0,"MIME::Parser" => 0},1],
+ ["IO server","SOAP::Transport::IO::Server",{"IO::File" => 0},0],
+ ["MQ transport support","SOAP::Transport::MQ",{"MQSeries" => 0},1],
+ ["JABBER transport support","SOAP::Transport::JABBER",{"Net::Jabber" => 0},0],
+ ["MIME messages","SOAP::Packager::MIME",{"MIME::Parser" => 0},1],
+ ["DIME messages","SOAP::Packager::DIME",{"IO::Scalar" => "2.105", "DIME::Tools" => 0.03, "Data::UUID" => "0.11"},0],
+ ["SSL Support for TCP Transport","SOAP::Transport::TCP",{"IO::Socket::SSL" => 0},0],
+ ["Compression support for HTTP","SOAP::Transport::HTTP",{"Compress::Zlib" => 0},0],
+ ["MIME interoperability w/ Axis","SOAP::Lite",{"MIME::Parser" => "6.106"},0],
+);
+
+use Getopt::Long;
+
+my $helptext = <<EOI;
+Usage: perl Makefile.PL <options>
+
+Possible options are:
+
+ --noprompt Disable interactive dialog
+ --alltests Perform extra testing
+ --help, -? Display this help text
+
+ [Do not] install prerequisites for appropriate module:
+
+EOI
+
+# Create config parameters using module names and expand help text
+# We will create a hash (%config) that has each module => (1|0) for install
+my(%options, %config, %has_module_cache);
+
+# Initialize the prereq table and all help text
+foreach my $prereq (@PREREQS) {
+ my ($feature,$dep,$modules,$default) = @$prereq;
+ next unless $dep ne "";
+ $prereq->[3] = has_all_modules($modules) unless $prereq->[3] == 2;
+
+ my $module = do { $dep =~ s/::/-/g; $dep };
+ my $shortcut = do { (my $t = $module) =~ s/SOAP-(?:Transport-)?//; $t };
+ $config{$dep} = has_all_modules($modules);
+ $options{"install-$dep|$shortcut!"} = \$config{$dep};
+ $helptext .= sprintf " --[no]install-%-28s --[no]%s\n", $dep, $shortcut;
+}
+
+use vars qw($noprompt $alltests $help $intro);
+#my ($noprompt,$alltests,$help);
+
+GetOptions (
+ "noprompt" => \$noprompt,
+ "alltests" => \$alltests,
+ "help|?" => \$help,
+);
+
+$help and print($helptext), exit;
+
+$intro = <<EOI;
+We are about to install SOAP::Lite and for your convenience will provide
+you with list of modules and prerequisites, so you'll be able to choose
+only modules you need for your configuration.
+
+XMLRPC::Lite, UDDI::Lite, and XML::Parser::Lite are included by default.
+Installed transports can be used for both SOAP::Lite and XMLRPC::Lite.
+
+EOI
+
+if ($noprompt) {
+ print "These are the modules that will get installed:\n\n";
+} else {
+ ExtUtils::MakeMaker::prompt($intro . "Press <enter> to see the detailed list.");
+}
+
+# This hash will contain a list of all perl modules we would like to
+# explicitly depend upon in our Makefile
+my %prereqs;
+my $proceed = 0;
+do {
+
+ print "\n".generate_prereq_table()."\n";
+ # Ask the user if this is the configuration they desire
+ if ($noprompt) {
+ $proceed = 1;
+ } else {
+ $proceed = ExtUtils::MakeMaker::prompt("Do you want to proceed with this configuration?" => 'yes') =~ /^\s*y/i;
+ }
+ # Loop through each prerequisite and ask the user if they wish to
+ # install it or not - reset prereqs, cause they change each time
+ %prereqs = ();
+ for my $prereq (@PREREQS) {
+ my ($feature,$dep,$modules,$default) = @$prereq;
+ next unless $dep ne "";
+ unless ($proceed || $prereq->[3] == 2) { # need to use $prereq, because we modify actual value
+ $prereq->[3] = (ExtUtils::MakeMaker::prompt("Do you plan to use ${feature}?" => ($prereq->[3] ? 'yes' : 'no')) =~ /^\s*(y)/i);
+ }
+ (%prereqs = (%prereqs, map { $_,$modules->{$_} } keys %$modules)) if $prereq->[3];
+ }
+} while (!$proceed);
+
+# Warn the user about the testing that will occur
+my $noncoretests = !$noprompt ? ExtUtils::MakeMaker::prompt('
+During "make test" phase we may run tests with several SOAP servers
+that may take long and may fail due to server/connectivity problems.
+
+Do you want to perform these tests in addition to core tests?', $alltests ? 'yes' : 'no') =~ /^\s*(y)/i : $alltests;
+
+my $tests = join ' ', glob ($noncoretests ? 't/*.t' : 't/0*.t');
+
+WriteMakefile(
+ 'NAME' => 'SOAP::Lite',
+ 'VERSION_FROM' => 'lib/SOAP/Lite.pm',
+ 'PREREQ_PM' => \%prereqs,
+ 'EXE_FILES' => ['bin/SOAPsh.pl', 'bin/XMLRPCsh.pl', 'bin/stubmaker.pl'],
+ test => {TESTS => $tests},
+);
+
+######################################################
+# Supporting subroutines
+######################################################
+# Maintains a cache of what 3rd party modules you have
+# installed
+sub has_module {
+ my ($mod, $version) = @_;
+ $version ||= '';
+ # use "require Foo; Exporter::require_version('Foo' => 1)" instead of
+ # obvious "use Foo 1". The later doesn't work with MIME::Parser
+ # wonder why? --PK
+ return ($has_module_cache{"$mod$version"} ||= eval("require $mod; Exporter::require_version('$mod', $version) if ($version); 1"));
+}
+
+# Return 1 if all modules contained in the inputed array
+# are installed, 0 otherwise
+sub has_all_modules {
+ my ($mods) = @_;
+ foreach my $mod (keys %$mods) {
+ return 0 if !has_module($mod, $mods->{$mod});
+ }
+ return 1;
+}
+
+# Print a single prerequisite to the screen
+sub generate_prereq {
+ my ($feature,$dep,$modules,$install) = @_;
+ my $i = 0;
+ my $buf = "";
+ foreach my $module (keys %$modules) {
+ my $detected = (has_module($module, $modules->{$module}) ? "*" : " ");
+ $buf .= sprintf("%-29s [%s] %-24s %-8s\n",($i++ ? "" : $feature),$detected,$module . ($modules->{$module} ? " (v$modules->{$module})" : ""),($i == 1 ? ($install ? ($install == 2 ? "always" : "[ yes ]") : "[ no ]") : ""));
+ }
+ return $buf;
+}
+
+# Print the entire prerequisites table
+sub generate_prereq_table {
+ my $buf = sprintf("%-29s %-28s %-8s\n","Feature","Prerequisites","Install?");
+ $buf .= sprintf("%s %s %s\n","-" x 29,"-" x 28,"-" x 8);
+ foreach my $pre (@PREREQS) {
+ my ($feature,$dep,$modules,$default) = @{$pre};
+ $buf .= generate_prereq(@{$pre});
+ }
+ $buf .= "--- An asterix '[*]' indicates if the module is currently installed.\n";
+ return $buf;
+}
+
+1;
Added: packages/soap-lite/branches/upstream/current/README
===================================================================
--- packages/soap-lite/branches/upstream/current/README 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/README 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,141 @@
+#
+# Filename: README
+#
+# $Id: README,v 1.3 2004/10/26 15:26:47 byrnereese Exp $
+
+SOAP::Lite for Perl is a collection of Perl modules which provides a simple
+and lightweight interface to the Simple Object Access Protocol (SOAP) both
+on client and server side.
+
+This version of SOAP::Lite supports a subset of the SOAP 1.1 specification
+and has initial support for SOAP 1.2 specification.
+See http://www.w3.org/TR/SOAP for details.
+
+SUPPORTED PLATFORMS
+
+This library has been tested by the author with Perl versions 5.005
+and 5.6.0 on different platforms: Windows 98/2K, Solaris 2.6, Linux 2.2.
+Should run everywhere where Perl 5.004 or later runs.
+
+PREREQUISITES
+
+Some modules within this package depend on other packages that are
+distributed separately from Perl. It supposes that you have the
+following distributions installed before you install SOAP::Lite:
+
+ XML::Parser
+ MIME::Base64
+ URI
+ libwww-perl
+
+Following modules will be loaded on demand only, and are considered optional:
+
+ Crypt::SSLeay HTTPS/SSL support
+ Apache mod_perl server implementation (included with mod_perl)
+ Net::POP3 POP3 server implementation
+ MIME::Lite SMTP client implementation
+ IO::File FTP client and IO server
+ Net::FTP FTP client
+ MQSeries MQSeries transport
+ Net::Jabber Jabber transport
+ FCGI FastCGI server implementation
+ IO::Socket::SSL SSL support for TCP transport
+ MIME::Tools MIME attachment support
+ DIME::Tools DIME attachment support
+ Compress::Zlib HTTP compression support
+
+These modules should be available from CPAN (http://search.cpan.org/).
+
+INSTALLATION ON UNIX
+
+You install SOAP::Lite as you would install any perl module library,
+by running these commands:
+
+If you have CPAN.pm installed and are connected to the Internet
+
+ > perl -MCPAN -e 'install SOAP::Lite'
+
+From the command line, try the following:
+
+ > perl Makefile.PL
+ > make
+ > make test
+ > make install
+
+INSTALLATION ON WIN32 PLATFORMS
+
+ > perl Makefile.PL
+ > nmake
+ > nmake test
+ > nmake install
+
+ACTIVESTATE USERS
+
+It is important that the same version of Perl is used to build the module, as
+used to run the module. Otherwise, you may experience page faults in some
+instances. Some people have found the following thread helpful in resolving
+this:
+
+http://groups.yahoo.com/group/soaplite/message/1371.
+
+If this does not help, you may consider trying the following:
+
+Build Lite.dll and perlapp using the same distribution. You can build Lite.dll
+using the make-com-minimal and make-com-standalone batch files (found in
+the "examples/COM/" directory of the SOAP-Lite distribution package).
+
+DOCUMENTATION
+
+See lib/SOAP/Lite.pm for an overview of the library. Documentation is
+included in modules and scripts. These are normally converted to manual
+pages and installed as part of the "make install" process. You should
+also be able to use the 'perldoc' utility to extract and read
+documentation from the module files directly.
+
+SUPPORT
+
+Questions about how to use this library should be directed to the SOAP
+mailing list (http://discuss.develop.com/soap.html). Bug reports and
+suggestions for improvements can also be sent there. This mailing list is
+also the place for general discussions and development of the SOAP protocol
+itself.
+
+Feel free to send mail directly to author with your comments, suggestions,
+bug reports and complaints.
+
+CHANGE HISTORY and RELEASE NOTES
+
+For extensive list of changes to the SOAP::Lite module consult the "Changes"
+file.
+
+Also, consult ReleaseNotes.txt for a list of known issues and common problems
+people have reported.
+
+ACKNOWLEDGEMENTS
+
+Special thanks to Randy J. Ray, author of I<Programming Web Services with Perl>,
+who has contributed greatly to the documentation effort of SOAP::Lite.
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite
+to republish and redistribute the SOAP::Lite reference manual found in Appendix B
+of I<Programming Web Services with Perl>.
+
+And special gratitude to all the developers who have contributed patches, ideas,
+time, energy, and help in a million different forms to the development of this
+software.
+
+COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+SOAP::Lite's documentation is made available under the Creative Commons
+Attribution-NoDerivs 2.0 license.
+http://creativecommons.org/licenses/by-nd/2.0/
+
+AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+Byrne Reese (byrne at majordojo.com)
Added: packages/soap-lite/branches/upstream/current/ReleaseNotes.txt
===================================================================
--- packages/soap-lite/branches/upstream/current/ReleaseNotes.txt 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/ReleaseNotes.txt 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,57 @@
+#
+# ReleaseNotes.txt
+#
+# $Id: ReleaseNotes.txt,v 1.1 2004/10/26 16:05:40 byrnereese Exp $
+
+The following is a compilation of various issues developers should be aware of
+when developing Web services using SOAP::Lite.
+
+LIMITED WSDL SUPPORT - SOAP::Lite is not capable of generating WSDLs
+automatically. If you require a WSDL for a service written using SOAP::Lite,
+please consider using a tool like XML Spy, or CapeClear's WSDL Editor.
+
+NO ENTITY DECODING
+SOAP::Lite uses XML::Parser::Lite which relies on Unicode support in Perl and
+therefore doesn't perform XML ENTITY decoding.
+
+LIMITED SUPPORT FOR MUSTUNDERSTAND and ACTOR ATTRIBUTES
+SOAP::Lite does not currently heed the soap:mustUnderstand XML attribute, or
+SOAP actor attributes.
+
+DOCUMENT-LITERAL SUPPORT
+All literal encoding support for SOAP::Lite is marked EXPERIMENTAL, and it is
+incomplete. Developers are encouraged to use this capability but should be
+fore-warned.
+
+CLIENT SIDE WSDL SUPPORT
+SOAP::Lites ability to consume a WSDL and generate the necessary message based
+on that WSDL is improving, but it does not work with complex types.
+
+SERVICE SIDE WSDL SUPPORT
+Perl is a loosely typed language making it extraordinarily difficult to generate
+a reliable WSDL based upon reflection of somekind. Therefore, no WSDL can be
+generated using SOAP::Lite.
+
+SOAP FAULT NOT GETTING SERIALIZED PROPERLY
+A user reported that when a service run under Perl version 5.5003 issues the
+die command with a SOAP::Fault as input, that SOAP::Lite does not properly
+serialize the Fault object. However, the same code works under 5.6 and above.
+
+NULL BODIES
+SOAP::Lite currently allows users to construct an Envelope using a null body,
+e.g. <Envelope><Body /></Envelope>. However, SOAP::Lite services have no way
+of processing such a message.
+
+XML NAMESPACES ABSENT FROM RESPONSES
+A user reported that under mod_perl for a series of requests which were using
+SOAP 1.1 and 1.2, that some of the responses to incoming messages lacked the
+XSD and XSI namespace declarations causing an error with the receiving .NET
+client for those response lacking these attributes.
+
+OBJECTS BY REFERENCE
+SOAP::Server->objects_by_reference is marked EXPERIMENTAL
+
+SOAP CLIENT CRASHES ON WINDOWS 98 WITH BIG MESSAGES
+Some users using Windows 98, and an older version of Perl experience a page
+fault error in perl58.dll when transmitting/receiving messages over a certain
+size. This problem is fixed by upgrading to the latest version of Perl.
Added: packages/soap-lite/branches/upstream/current/bin/SOAPsh.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/bin/SOAPsh.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/bin/SOAPsh.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,79 @@
+#!/bin/env perl
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use SOAP::Lite;
+use Data::Dumper; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 1;
+
+ at ARGV or die "Usage: $0 proxy [uri [commands...]]\n";
+my($proxy, $uri) = (shift, shift);
+my %can;
+my $soap = SOAP::Lite->proxy($proxy)->on_fault(sub{});
+ $soap->uri($uri) if $uri;
+print STDERR "Usage: method[(parameters)]\n> ";
+while (defined($_ = shift || <>)) {
+ next unless /\w/;
+ my($method) = /\s*(\w+)/;
+ $can{$method} = $soap->can($method) unless exists $can{$method};
+ my $res = eval "\$soap->$_";
+ $@ ? print(STDERR join "\n", "--- SYNTAX ERROR ---", $@, '') :
+ $can{$method} && !UNIVERSAL::isa($res => 'SOAP::SOM')
+ ? print(STDERR join "\n", "--- METHOD RESULT ---", $res || '', '') :
+ defined($res) && $res->fault ? print(STDERR join "\n", "--- SOAP FAULT ---", $res->faultcode, $res->faultstring, '') :
+ !$soap->transport->is_success ? print(STDERR join "\n", "--- TRANSPORT ERROR ---", $soap->transport->status, '') :
+ print(STDERR join "\n", "--- SOAP RESULT ---", Dumper($res->paramsall), '')
+} continue {
+ print STDERR "\n> ";
+}
+
+__END__
+
+=head1 NAME
+
+SOAPsh.pl - Interactive shell for SOAP calls
+
+=head1 SYNOPSIS
+
+ perl SOAPsh.pl http://services.soaplite.com/examples.cgi http://www.soaplite.com/My/Examples
+ > getStateName(2)
+ > getStateNames(1,2,3,7)
+ > getStateList([1,9])
+ > getStateStruct({a=>1, b=>24})
+ > Ctrl-D (Ctrl-Z on Windows)
+
+or
+
+ # all parameters after uri will be executed as methods
+ perl SOAPsh.pl http://soap.4s4c.com/ssss4c/soap.asp http://simon.fell.com/calc doubler([10,20,30])
+ > Ctrl-D (Ctrl-Z on Windows)
+
+=head1 DESCRIPTION
+
+SOAPsh.pl is a shell for making SOAP calls. It takes two parameters:
+mandatory endpoint and optional uri (actually it will tell you about it
+if you try to run it). Additional commands can follow.
+
+After that you'll be able to run any methods of SOAP::Lite, like autotype,
+readable, encoding, etc. You can run it the same way as you do it in
+your Perl script. You'll see output from method, result of SOAP call,
+detailed info on SOAP faulure or transport error.
+
+For full list of available methods see documentation for SOAP::Lite.
+
+Along with methods of SOAP::Lite you'll be able (and that's much more
+interesting) run any SOAP methods you know about on remote server and
+see processed results. You can even switch on debugging (with call
+something like: C<on_debug(sub{print at _})>) and see SOAP code with
+headers sent and recieved.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000 Paul Kulchenko. All rights reserved.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/bin/XMLRPCsh.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/bin/XMLRPCsh.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/bin/XMLRPCsh.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,78 @@
+#!/bin/env perl
+#!d:\perl\bin\perl.exe
+
+# -- XMLRPC::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use XMLRPC::Lite;
+use Data::Dumper; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 1;
+
+ at ARGV or die "Usage: $0 endpoint [commands...]\n";
+my $proxy = shift;
+my %can;
+my $xmlrpc = XMLRPC::Lite->proxy($proxy)->on_fault(sub{});
+print STDERR "Usage: method[(parameters)]\n> ";
+while (defined($_ = shift || <>)) {
+ next unless /\w/;
+ my($method, $parameters) = /^\s*([.\w]+)(.*)/;
+ $can{$method} = $xmlrpc->can($method) unless exists $can{$method};
+ my $res = $method =~ /\./ ? eval "\$xmlrpc->call(\$method, $parameters)" : eval "\$xmlrpc->$_";
+ $@ ? print(STDERR join "\n", "--- SYNTAX ERROR ---", $@, '') :
+ $can{$method} && !UNIVERSAL::isa($res => 'XMLRPC::SOM')
+ ? print(STDERR join "\n", "--- METHOD RESULT ---", $res || '', '') :
+ defined($res) && $res->fault ? print(STDERR join "\n", "--- XMLRPC FAULT ---", @{$res->fault}{'faultCode', 'faultString'}, '') :
+ !$xmlrpc->transport->is_success ? print(STDERR join "\n", "--- TRANSPORT ERROR ---", $xmlrpc->transport->status, '') :
+ print(STDERR join "\n", "--- XMLRPC RESULT ---", Dumper($res->paramsall), '')
+} continue {
+ print STDERR "\n> ";
+}
+
+__END__
+
+=head1 NAME
+
+XMLRPCsh.pl - Interactive shell for XMLRPC calls
+
+=head1 SYNOPSIS
+
+ perl XMLRPCsh.pl http://betty.userland.com/RPC2
+ > examples.getStateName(2)
+ > examples.getStateNames(1,2,3,7)
+ > examples.getStateList([1,9])
+ > examples.getStateStruct({a=>1, b=>24})
+ > Ctrl-D (Ctrl-Z on Windows)
+
+or
+
+ # all parameters after uri will be executed as methods
+ perl XMLRPCsh.pl http://betty.userland.com/RPC2 examples.getStateName(2)
+ > Ctrl-D (Ctrl-Z on Windows)
+
+=head1 DESCRIPTION
+
+XMLRPCsh.pl is a shell for making XMLRPC calls. It takes one parameter,
+endpoint (actually it will tell you about it if you try to run it).
+Additional commands can follow.
+
+After that you'll be able to run any methods of XMLRPC::Lite, like autotype,
+readable, etc. You can run it the same way as you do it in
+your Perl script. You'll see output from method, result of XMLRPC call,
+detailed info on XMLRPC faulure or transport error.
+
+For full list of available methods see documentation for XMLRPC::Lite.
+
+Along with methods of XMLRPC::Lite you'll be able (and that's much more
+interesting) run any XMLRPC methods you know about on remote server and
+see processed results. You can even switch on debugging (with call
+something like: C<on_debug(sub{print at _})>) and see XMLRPC code with
+headers sent and recieved.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000 Paul Kulchenko. All rights reserved.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/bin/stubmaker.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/bin/stubmaker.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/bin/stubmaker.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,138 @@
+#!/usr/bin/env perl
+#!d:\perl\bin\perl.exe
+#
+# Filename: stubmaker.pl
+# Authors: Byrne Reese <byrne at majordojo dot com>
+# Paul Kulchenko
+#
+# Copyright (C) 2005 Byrne Reese
+#
+# Usage:
+# stubmaker.pl -[vd] <WSDL URL>
+###################################################
+
+use SOAP::Lite;
+use Getopt::Long;
+
+my $VERBOSE = 0;
+my $DIRECTORY = ".";
+GetOptions(
+ 'd=s' => \$DIRECTORY,
+ 'v' => \$VERBOSE,
+ help => sub { HELP_MESSAGE(); },
+ version => sub { VERSION_MESSAGE(); exit(0); },
+ ) or HELP_MESSAGE();
+
+HELP_MESSAGE() unless $ARGV[0];
+
+my $WSDL_URL = shift;
+
+print "Writing stub files...\n" if $VERBOSE;
+my %services = %{SOAP::Schema->schema_url($WSDL_URL)
+ ->cache_ttl(1)
+ ->cache_dir($DIRECTORY)
+ ->parse()
+ ->load
+ ->services};
+Carp::croak "More than one service in service description. Service and port names have to be specified\n"
+ if keys %services > 1;
+
+sub VERSION_MESSAGE {
+ print "$0 $SOAP::Lite::VERSION (C) 2005 Byrne Reese.\n";
+}
+
+sub HELP_MESSAGE {
+ VERSION_MESSAGE();
+ print <<EOT;
+usage: $0 -[options] <WSDL URL>
+options:
+ -v Verbose Outputbe quiet
+ -d <dirname> Output directory
+EOT
+exit 0;
+}
+
+__END__
+
+=pod
+
+=head1 NAME
+
+stubmaker.pl - Generates client stubs from a WSDL file.
+
+=head1 OPTIONS
+
+=over
+
+=item -d <dirname>
+
+Specifies the directory you wish to output the files to. The directory must already exist.
+
+=item -v
+
+Turns on "verbose" output during the code stub generation process. To be honest, there is not much the program outputs, but if you must see something output to the console, then this fits the bill.
+
+=item --help
+
+Outputs a short help message.
+
+=item --version
+
+Outputs the current version of stubmaker.pl.
+
+=cut
+
+=head1 STUB FILES
+
+=head2 STUB SUBROUTINES
+
+The "class" or "package" created by stubmaker.pl is actually a sub-class of
+the core SOAP::Lite object. As a result, all methods one can call upon
+L<SOAP::Lite> one can also call upon generated stubs.
+
+For example, suppose you wanted to obtain readable output from the generated
+stub, then simply call C<readable(1)> on the stub's instance. See the example
+below.
+
+The following subroutines are unique to generated stub classes, and help the
+user control and configure the stub class.
+
+=over
+
+=item want_som(boolean)
+
+When set to 1, SOAP::Lite will return SOAP::SOM objects to the user upon
+invoking a method on a remote service. This is very helpful when you need
+to check to see if the return value is a SOAP::Fault or not. When set to 0,
+SOAP::Lite will return the return value of the method.
+
+=cut
+
+=head1 EXAMPLES
+
+=head2 Invoking stubmaker.pl from the command line
+
+> perl stubmaker.pl http://www.xmethods.net/sd/StockQuoteService.wsdl
+Or:
+> perl "-MStockQuoteService qw(:all)" -le "print getQuote('MSFT')"
+
+=head2 Working with stub classes
+
+Command line:
+> perl stubmaker.pl http://ws1.api.re2.yahoo.com/ws/soap-demo/full.wsdl
+
+File: echo.pl
+> use full;
+> use SOAP::Lite +trace => qw( debug );
+> my $f = new full;
+> $f->use_prefix(0);
+> $f->readable(1);
+> $f->want_som(1);
+> $som = $f->echoViaBase64("foo");
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2005 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
Added: packages/soap-lite/branches/upstream/current/examples/COM/README
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/README 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/README 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,162 @@
+ SOAP::Lite for COM interface
+ ============================
+
+SOAP::Lite for COM interface gives you ability to access SOAP services
+from your COM applications. Examples in Visual Basic, Excel/VBA, Perl,
+JavaScript and ASP are provided.
+
+Interface comes in two versions: standalone and minimal.
+Both versions were tested on Windows 2K and XP, but should work on
+Windows 9x/Me/NT/2K/XP.
+Minimal version requires Perl installation, but comes in a small size.
+Standalone version doesn't require ANYTHING (including Perl), but comes
+as one big dll. Both libraries are compiled using the latest version of
+ActivePerl available (5.8.6 build 811).
+
+Standalone: http://www.soaplite.com/download/SOAP-Lite-COM-standalone-latest.zip
+Minimal (Perl required): http://www.soaplite.com/download/SOAP-Lite-COM-minimal-latest.zip
+
+You may create your own version (all source code and batch files are provided),
+but it'll require PerlCtrl utility that comes with Perl Development Kit
+from ActiveState (http://activestate.com/). Batch files are written for the
+latest PDK version (v6). The library can ONLY be created on Windows NT, 2K, or
+XP, but will work on any Windows platform.
+
+INSTALLATION
+
+To register library:
+
+ regsvr32 Lite.dll
+
+You can now try out the example programs.
+
+To unregister library:
+
+ regsvr32 /u Lite.dll
+
+VISUAL BASIC EXAMPLES
+
+remote.vbs and temper.vbs connect to remote services, delayed stock
+quotes and temperature conversion.
+
+local.vbs connects to local ASP server.
+
+VISUAL BASIC, PERL AND JAVASCRIPT EXAMPLE
+
+These examples (states.vbs, states.pl, states.html) connect to the local
+SOAP server and call service that will return name of the state.
+
+C# EXAMPLE
+
+remote.cs example connects to remote service (XMethod.com) which echoes
+back string 'Hello'.
+
+MICROSOFT EXCEL EXAMPLE
+
+Open the Excel (states.xls) document. Be warned, this document contains
+macroses, so you can get the warning.
+If you want to run examples you need to enable macroses. For those who
+don't trust anybody code of macroses is provided in states.vba file, so
+they can disable macroses and add them from this file.
+
+By default this example will connect to local SOAP server
+(see VISUAL BASIC SERVER EXAMPLE). You may alter the address by
+changing parameter for proxy() method.
+
+Supply a number of state and click 'Get State Name' button.
+
+VISUAL BASIC SERVER EXAMPLE
+
+You may start local SOAP server by running soap.vbs script. By default
+server will accept requests on 'http://localhost/', but you can modify
+this URL. Probably you'll also need to modify dispatch_to() parameters
+where you can specify path to your Perl modules.
+
+ASP SERVER EXAMPLE (VBScript and PerlScript)
+
+Example of ASP SOAP server is provided. This implementation doesn't
+require ROPE or MSXML dlls, so all that you need is register Lite.dll
+and put soap.asp and/or soap_perl.asp in appropriate place (for example,
+c:\inetpub\wwwroot\).
+
+Now you can direct your SOAP requests to http://localhost/soap.asp
+(VBScript) or http://localhost/soap_perl.asp (PerlScript).
+
+XML-RPC examples (VBScript)
+
+Example of XML-PRC client is provided. You can use XML-RPC in a way you
+use SOAP protocol, only instead of new() method xmlrpc() method should
+be called to create an object. For example:
+
+ MsgBox CreateObject("SOAP.Lite").xmlrpc( _
+ "proxy", "http://betty.userland.com/RPC2" _
+ ).call("examples.getStateName", 25).result
+
+ISSUES AND LIMITATIONS
+
+HASHES
+
+Since not all languages have primitive data type that is equivalent to Perl's
+hashes, hashes don't map neatly between Perl and languages like Visual Basic
+and Visual C++. However, SOAP::Lite derived a way to move hashes around.
+hash() method allow you create hash and manipulate it.
+If your Perl program returns a hash reference, it'll be wrapped in object
+around it. This wrapper object allows you to manipulate the hash in the
+host language.
+
+Set hash = CreateObject("SOAP.Lite").hash("a", 1, "b", 2)
+hash.c = 3
+
+See hash.vbs for example that moves hashes around.
+
+See hashecho.cvs for hash of hash example.
+
+ARRAYS
+
+COM interface provides a simple way of returning arrays to the host language.
+Instead of returning an array, return an array reference (such as \@myarray
+instead of @myarray). when you return an array reference from a subroutine,
+it is automatically converted into an array in the host language.
+
+Although an array can be passed to a SOAP::Lite COM interface, a reference to
+the array can not be passed. Therefore any manipulation of the array elements
+must be returned to the caller.
+
+REFERENCES
+
+When you pass a reference (to an array, scalar, or hash) to, or return a
+reference from a COM interface, a copy of your data is passed, not a true
+reference to your data. Thus, when you manipulate the data from within a
+COM interface, you are not manipulating the calling script's data.
+The ability to use references in a traditional manner will be addressed
+in a future versions.
+
+CONTEXT
+
+How do I call a method in a list/array context?
+
+You can coerce any method call into a list context. Instead of invoking:
+
+Dim arrayFoo
+arrayFoo = myPerlObj.some_method()
+
+Use the List property to invoke the method:
+
+Dim arrayFoo
+arrayFoo = myPerlObj.List.some_method()
+
+How do I call a method in a scalar context?
+
+By default, methods are invoked in a scalar context. If, for some reason,
+you find that you need to explicitly invoke a method in a scalar context,
+you can invoke the method on the Scalar property of the object. Instead of:
+
+cntFoo = myPerlObj.some_method()
+
+Use the Scalar property to invoke the method:
+
+cntFoo = myPerlObj.Scalar.some_method()
+
+MORE INFORMATION
+
+For more information, see http://aspn.activestate.com/ASPN/docs/PDK/6.0/PerlCtrl_overview.html
Added: packages/soap-lite/branches/upstream/current/examples/COM/SOAP-Lite-COM-minimal.ctrl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/SOAP-Lite-COM-minimal.ctrl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/SOAP-Lite-COM-minimal.ctrl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,85 @@
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# used by PerlCtrl for creating minimal COM interface
+
+package SOAP::Lite::COM;
+
+use SOAP::Lite;
+
+__END__
+
+=pod
+
+=begin PerlCtrl
+
+ %TypeLib = (
+ PackageName => 'SOAP::Lite::COM',
+ TypeLibGUID => '{35794C5E-478D-4746-81FA-CF0194CC2417}', # do NOT edit this line
+ ControlGUID => '{A0FE6F60-95D4-435B-98AE-93475FDCAA83}', # do NOT edit this line either
+ DispInterfaceIID=> '{23767C1D-DA9B-4FAC-A6B3-3639F8CC0C29}', # or this one
+ ControlName => 'SOAP.Lite',
+ ControlVer => 0.52, # increment if new object with same ProgID
+ ProgID => 'SOAP.Lite',
+ DefaultMethod => 'new',
+ Methods => {
+ 'new' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'create' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'soap' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'xmlrpc' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'server' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'instanceof' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'hash' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'data' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'header' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ }, # end of 'Methods'
+ Properties => {
+ }, # end of 'Properties'
+ ); # end of %TypeLib
+
+=end PerlCtrl
Added: packages/soap-lite/branches/upstream/current/examples/COM/SOAP-Lite-COM-standalone.ctrl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/SOAP-Lite-COM-standalone.ctrl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/SOAP-Lite-COM-standalone.ctrl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,99 @@
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# used by PerlCtrl for creating standalone COM interface
+
+package SOAP::Lite::COM;
+
+use SOAP::Lite;
+
+use URI::_foreign;
+use URI::http;
+use URI::https;
+use LWP::Protocol::http;
+use LWP::Protocol::https;
+use LWP::Authen::Basic;
+use LWP::Authen::Digest;
+use HTTP::Daemon;
+use Compress::Zlib;
+use XML::Parser;
+use SOAP::Transport::HTTP;
+use XMLRPC::Lite;
+use XMLRPC::Transport::HTTP;
+
+__END__
+
+=pod
+
+=begin PerlCtrl
+
+ %TypeLib = (
+ PackageName => 'SOAP::Lite::COM',
+ TypeLibGUID => '{35794C5E-478D-4746-81FA-CF0194CC2417}', # do NOT edit this line
+ ControlGUID => '{A0FE6F60-95D4-435B-98AE-93475FDCAA83}', # do NOT edit this line either
+ DispInterfaceIID=> '{23767C1D-DA9B-4FAC-A6B3-3639F8CC0C29}', # or this one
+ ControlName => 'SOAP.Lite',
+ ControlVer => 0.52, # increment if new object with same ProgID
+ ProgID => 'SOAP.Lite',
+ DefaultMethod => 'new',
+ Methods => {
+ 'new' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'create' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'soap' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'xmlrpc' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'server' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'instanceof' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'hash' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'data' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ 'header' => {
+ RetType => VT_DISPATCH,
+ TotalParams => 0,
+ NumOptionalParams => 0,
+ ParamList =>[ ]
+ },
+ }, # end of 'Methods'
+ Properties => {
+ }, # end of 'Properties'
+ ); # end of %TypeLib
+
+=end PerlCtrl
Added: packages/soap-lite/branches/upstream/current/examples/COM/hash.vbs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/hash.vbs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/hash.vbs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,12 @@
+' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+' Connect to local ASP/Daemon server
+
+Set hashRes = CreateObject("SOAP.Lite").new( _
+ "proxy", "http://localhost/soap.asp", _
+ "uri", "http://www.soaplite.com/My/Examples" _
+).getStateStruct(CreateObject("SOAP.Lite").hash("a", 1, "b", 2)) _
+ .result
+
+MsgBox hashRes.a
+MsgBox hashRes.b
\ No newline at end of file
Added: packages/soap-lite/branches/upstream/current/examples/COM/hashecho.vbs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/hashecho.vbs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/hashecho.vbs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,19 @@
+' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+' Connect to remote SOAP server
+
+Set soaplite = CreateObject("SOAP.Lite")
+' values can be stored in hash using "hash" method
+Set subhash = soaplite.hash("key_c", "Value C")
+Set hash = soaplite.hash("key_a", "Value A", "key_b", subhash)
+' or can be assigned directly
+hash.key_b.key_d = "Value D"
+
+Set echohash = soaplite.new( _
+ "proxy", "http://services.soaplite.com/echo.cgi", _
+ "uri", "http://namespaces.soaplite.com/Echo" _
+).echo(hash).result
+
+MsgBox "key_a: " & echohash.key_a & chr(13) & _
+ "key_b+key_c: " & echohash.key_b.key_c & chr(13) & _
+ "key_b+key_d: " & echohash.key_b.key_d
Added: packages/soap-lite/branches/upstream/current/examples/COM/local.vbs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/local.vbs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/local.vbs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,8 @@
+' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+' Connect to local ASP/Daemon server
+
+MsgBox CreateObject("SOAP.Lite").new( _
+ "proxy", "http://localhost/soap.asp", _
+ "uri", "http://www.soaplite.com/My/Examples" _
+).getStateName(1).result
Added: packages/soap-lite/branches/upstream/current/examples/COM/make-com-minimal.bat
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/make-com-minimal.bat 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/make-com-minimal.bat 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,3 @@
+ at echo off
+copy SOAP-Lite-COM-minimal.ctrl Lite.ctrl >nul
+call perlctrl Lite.ctrl @make-com.args -dependent
\ No newline at end of file
Property changes on: packages/soap-lite/branches/upstream/current/examples/COM/make-com-minimal.bat
___________________________________________________________________
Name: svn:executable
+
Added: packages/soap-lite/branches/upstream/current/examples/COM/make-com-standalone.bat
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/make-com-standalone.bat 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/make-com-standalone.bat 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,3 @@
+ at echo off
+copy SOAP-Lite-COM-standalone.ctrl Lite.ctrl >nul
+call perlctrl Lite.ctrl @make-com.args -freestanding
\ No newline at end of file
Property changes on: packages/soap-lite/branches/upstream/current/examples/COM/make-com-standalone.bat
___________________________________________________________________
Name: svn:executable
+
Added: packages/soap-lite/branches/upstream/current/examples/COM/remote.cs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/remote.cs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/remote.cs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,27 @@
+// -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+// Lots of thanks to Tony Hong (xmethods.net) for provided help and examples
+
+// Connect to remote SOAP server
+
+using System;
+using System.Reflection;
+
+public class test {
+ public static void Main() {
+ Type typ = Type.GetTypeFromProgID("SOAP.Lite");
+ object obj = Activator.CreateInstance(typ);
+ object soaplite = typ.InvokeMember("new",BindingFlags.InvokeMethod,null,obj,null);
+
+ Object[] uri = {"urn:xmethodsInterop"};
+ Object[] proxy = {"http://services.xmethods.net:80/perl/soaplite.cgi"};
+
+ typ.InvokeMember("uri",BindingFlags.InvokeMethod,null,soaplite,uri);
+ typ.InvokeMember("proxy",BindingFlags.InvokeMethod,null,soaplite,proxy);
+
+ object [] input = {"Hello"};
+
+ object resultObject = typ.InvokeMember("echoString",BindingFlags.InvokeMethod,null,soaplite,input);
+ Console.WriteLine(typ.InvokeMember("result",BindingFlags.InvokeMethod,null,resultObject,null));
+ }
+}
Added: packages/soap-lite/branches/upstream/current/examples/COM/remote.vba
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/remote.vba 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/remote.vba 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,18 @@
+Function GetSOAPObject() As Object
+ Static SOAPObject As Object
+ If SOAPObject Is Nothing Then
+ Set SOAPObject = CreateObject("SOAP.Lite").new
+ If SOAPObject Is Nothing Then
+ MsgBox ("Oops, no SOAP.Lite on this machine")
+ Exit Function
+ End If
+ SOAPObject.proxy("http://soaplite:authtest@services.soaplite.com/auth/examples.cgi").uri ("http://www.soaplite.com/My/Examples")
+ End If
+ Set GetSOAPObject = SOAPObject
+End Function
+
+Sub GetStateNameRemotely()
+ Application.StatusBar = "Running SOAP call..."
+ Range("Current").FormulaR1C1 = GetSOAPObject.getStateName(Sheet1.TextBox1.Value).result
+ Application.StatusBar = False
+End Sub
Added: packages/soap-lite/branches/upstream/current/examples/COM/remote.vbs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/remote.vbs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/remote.vbs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,8 @@
+' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+' Connect to remote SOAP server
+
+MsgBox CreateObject("SOAP.Lite").new( _
+ "proxy", "http://services.xmethods.net/soap", _
+ "uri", "urn:xmethods-delayed-quotes" _
+).getQuote("MSFT").result
Added: packages/soap-lite/branches/upstream/current/examples/COM/remote.xls
===================================================================
(Binary files differ)
Property changes on: packages/soap-lite/branches/upstream/current/examples/COM/remote.xls
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: packages/soap-lite/branches/upstream/current/examples/COM/service.vbs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/service.vbs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/service.vbs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,3 @@
+' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+MsgBox CreateObject("SOAP.Lite").new.service("http://www.xmethods.net/sd/StockQuoteService.wsdl").getQuote("MSFT")
Added: packages/soap-lite/branches/upstream/current/examples/COM/soap.asp
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/soap.asp 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/soap.asp 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,14 @@
+<%
+ ' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+ ' SOAP server. requires SOAP.Lite COM object (regsvr32 Lite.dll)
+ ' Path to Perl modules can be specified
+ ' as '/PATH/TO/MODULES' or as 'drive:/PATH/TO/MODULES'
+
+ Response.ContentType = "text/xml"
+ Response.Write(Server.CreateObject("SOAP.Lite") _
+ .server("SOAP::Server") _
+ .dispatch_to("/Your/Path/To/Deployed/Modules") _
+ .handle(Request.BinaryRead(Request.TotalBytes)) _
+ )
+%>
Added: packages/soap-lite/branches/upstream/current/examples/COM/soap.vbs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/soap.vbs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/soap.vbs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,14 @@
+' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+' SOAP server. requires SOAP.Lite COM object (regsvr32 Lite.dll)
+' Doesn't require web server
+' Path to Perl modules can be specified
+' as '/PATH/TO/MODULES' or as 'drive:/PATH/TO/MODULES'
+
+call CreateObject("SOAP.Lite") _
+ .server("SOAP::Transport::HTTP::Daemon", _
+ "LocalAddr", "localhost", _
+ "LocalPort", 80) _
+ .dispatch_to("/Your/Path/To/Deployed/Modules") _
+ .options(CreateObject("SOAP.Lite").hash("compress_threshold", 10000)) _
+ .handle
Added: packages/soap-lite/branches/upstream/current/examples/COM/soap_perl.asp
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/soap_perl.asp 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/soap_perl.asp 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,14 @@
+<%@Language=PerlScript%>
+<%
+ # -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+ # SOAP server. requires SOAP.Lite COM object (regsvr32 Lite.dll)
+ # Path to Perl modules can be specified as '/PATH/TO/MODULES'
+
+ $Response->{ContentType} = "text/xml";
+ $Response->Write($Server->CreateObject("SOAP.Lite")
+ -> server("SOAP::Server")
+ -> dispatch_to("/Your/Path/To/Deployed/Modules")
+ -> handle($Request->BinaryRead($Request->{TotalBytes}))
+ );
+%>
Added: packages/soap-lite/branches/upstream/current/examples/COM/states.html
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/states.html 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/states.html 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,47 @@
+<html>
+<head><title>JavaScript SOAP::Lite for COM Examples</title></head>
+<body>
+
+<script language="javascript"><!--
+
+// .create() here is synonim for .new(), because new() is reserved in JavaScript
+
+var objPerlCOM = new ActiveXObject("SOAP.Lite");
+var SOAP = objPerlCOM.create();
+SOAP.proxy("http://localhost/")
+ .uri("http://www.soaplite.com/My/Examples");
+
+function getStateName (form) {
+ form.result.value = SOAP.getStateName(form.state.value).result();
+}
+
+//--></script>
+
+<h1>SOAP::Lite Examples</h1>
+<hr>
+
+<form name="states">
+<input type="text" name="state" value="25" size="3" maxlength="3">
+<input type="button" value="getStateName" onclick="getStateName(states);">
+<input type="text" name="result" readonly>
+</form>
+
+<hr>
+
+<pre>
+<script language="javascript"><!--
+
+var objPerlCOM = new ActiveXObject("SOAP.Lite");
+var SOAP = objPerlCOM.create();
+SOAP.proxy("http://localhost/")
+ .uri("http://www.soaplite.com/My/Examples");
+
+function getStateName (form) {
+ form.result.value = SOAP.getStateName(form.state.value).result();
+}
+
+//--></script>
+</pre>
+
+</body>
+</html>
Added: packages/soap-lite/branches/upstream/current/examples/COM/states.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/states.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/states.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,15 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use Win32::OLE;
+
+$soap = Win32::OLE->CreateObject('SOAP.Lite')->new
+ or die "SOAP::Lite for COM is not installed";
+
+$soap->proxy('http://localhost/')
+ ->uri('http://www.soaplite.com/My/Examples');
+
+print $soap->getStateName(shift || 25)->result;
+
Added: packages/soap-lite/branches/upstream/current/examples/COM/states.vba
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/states.vba 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/states.vba 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,18 @@
+Function GetSOAPObject() As Object
+ Static SOAPObject As Object
+ If SOAPObject Is Nothing Then
+ Set SOAPObject = CreateObject("SOAP.Lite").new
+ If SOAPObject Is Nothing Then
+ MsgBox ("Oops, no SOAP.Lite on this machine")
+ Exit Function
+ End If
+ SOAPObject.proxy("http://localhost/").uri ("http://www.soaplite.com/My/Examples")
+ End If
+ Set GetSOAPObject = SOAPObject
+End Function
+
+Sub GetStateNameRemotely()
+ Application.StatusBar = "Running SOAP call..."
+ Range("Current").FormulaR1C1 = GetSOAPObject.getStateName(Sheet1.TextBox1.Value).result
+ Application.StatusBar = False
+End Sub
Added: packages/soap-lite/branches/upstream/current/examples/COM/states.vbs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/states.vbs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/states.vbs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,6 @@
+' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+MsgBox CreateObject("SOAP.Lite").new( _
+ "proxy", "http://localhost/", _
+ "uri", "http://www.soaplite.com/My/Examples" _
+).getStateName(2).result
Added: packages/soap-lite/branches/upstream/current/examples/COM/states.xls
===================================================================
(Binary files differ)
Property changes on: packages/soap-lite/branches/upstream/current/examples/COM/states.xls
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: packages/soap-lite/branches/upstream/current/examples/COM/temper.vbs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/temper.vbs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/temper.vbs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,8 @@
+' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+' Connect to remote SOAP server
+
+MsgBox CreateObject("SOAP.Lite").new( _
+ "proxy", "http://services.soaplite.com/temper.cgi", _
+ "uri", "http://www.soaplite.com/Temperatures" _
+).c2f(37.5).result
Added: packages/soap-lite/branches/upstream/current/examples/COM/xmlrpc.vbs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/COM/xmlrpc.vbs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/COM/xmlrpc.vbs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,7 @@
+' -- XMLRPC::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+' Connect to remote XMLRPC server
+
+MsgBox CreateObject("SOAP.Lite").xmlrpc( _
+ "proxy", "http://betty.userland.com/RPC2" _
+).call("examples.getStateName", 25).result
Added: packages/soap-lite/branches/upstream/current/examples/JABBER/jabclient.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/JABBER/jabclient.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/JABBER/jabclient.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,16 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+# real user/passwords are used to give you a chance to try it out-of-the-box
+# you may put your own user/password
+
+my $s = SOAP::Lite
+ -> proxy('jabber://soaplite_client:soapliteclient@jabber.org:5222/soaplite_server@jabber.org/')
+;
+
+my $r = $s->echo('Hello, Jabber world!');
+print $r->fault ? $r->faultstring : $r->result;
Added: packages/soap-lite/branches/upstream/current/examples/JABBER/jabserver.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/JABBER/jabserver.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/JABBER/jabserver.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,20 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::JABBER;
+
+# real user/passwords are used to give you a chance to try it out-of-the-box
+# you may put your own user/password
+
+my $server = SOAP::Transport::JABBER::Server
+ -> new('jabber://soaplite_server:soapliteserver@jabber.org:5222')
+ -> dispatch_to('echo')
+;
+
+print "Contact to SOAP server\n";
+
+do { $server->handle } while sleep 1;
+
+sub echo { $_[1] }
Added: packages/soap-lite/branches/upstream/current/examples/MQ/mqclient.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/MQ/mqclient.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/MQ/mqclient.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,13 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+$s = SOAP::Lite
+ ->proxy('mq://server:port?Channel=CHAN1;QueueManager=QM_SOAP;RequestQueue=SOAPREQ1;ReplyQueue=SOAPRESP1')
+;
+
+print $s->add(1,2)->result;
+
Added: packages/soap-lite/branches/upstream/current/examples/MQ/mqserver.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/MQ/mqserver.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/MQ/mqserver.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,17 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::MQ;
+
+my $server = SOAP::Transport::MQ::Server
+ ->new('mq://server:port?Channel=CHAN1;QueueManager=QM_SOAP;RequestQueue=SOAPREQ1;ReplyQueue=SOAPRESP1')
+ ->dispatch_to('add')
+;
+
+print "Contact to SOAP server\n";
+
+do { $server->handle } while sleep 1;
+
+sub add { $_[1] + $_[2] };
Added: packages/soap-lite/branches/upstream/current/examples/My/Chat.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/My/Chat.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/My/Chat.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,40 @@
+package My::Chat;
+
+my @messages;
+my %users;
+
+sub join {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ my $nick = shift or die "User cannot join chat anonymously\n";
+ !exists $users{$nick} or die "User '$nick' is already in chatroom. Choose another nick\n";
+ $users{$nick} = time;
+ my $messages = shift || 10;
+ bless {
+ _nick => $nick,
+ _users => \%users,
+ _messages => \@messages,
+ _lastmessage => ($#messages > $messages ? $#messages - $messages : -1),
+ } => $class;
+}
+
+sub get {
+ my $self = shift;
+ my $nick = $self->{_nick};
+ my @mess = grep {exists $users{$_->[0]} && $_->[0] ne $nick} @messages[($self->{_lastmessage}+1)..$#messages];
+ $self->{_lastmessage} = $#messages;
+ [@mess];
+}
+
+sub send {
+ push @messages, [shift->{_nick} => shift, time];
+ splice(@messages, 0, -12); # we'll keep only last 12 messages
+}
+
+sub whois { shift->{_users} }
+
+sub quit { my $self = shift; delete $self->{_users}->{$self->{_nick}} }
+
+sub DESTROY { shift->quit }
+
+1;
Added: packages/soap-lite/branches/upstream/current/examples/My/Examples.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/My/Examples.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/My/Examples.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,36 @@
+package My::Examples;
+
+my @states = (undef, # we want to start from one :)
+ qw/Alabama Alaska Arizona Arkansas California Colorado Connecticut
+ Delaware Florida Georgia Hawaii Idaho Illinois Indiana Iowa Kansas
+ Kentucky Louisiana Maine Maryland Massachusetts Michigan Minnesota
+ Mississippi Missouri Montana Nebraska Nevada/, 'New Hampshire',
+ 'New Jersey', 'New Mexico', 'New York', 'North Carolina',
+ 'North Dakota', qw/Ohio Oklahoma Oregon Pennsylvania/, 'Rhode Island',
+ 'South Carolina', 'South Dakota', qw/Tennessee Texas Utah Vermont
+ Virginia Washington/, 'West Virginia', 'Wisconsin', 'Wyoming'
+);
+
+sub getStateName {
+ my $self = shift;
+ $states[shift];
+}
+
+sub getStateNames {
+ my $self = shift;
+ join "\n", map {$states[$_]} @_;
+}
+
+sub getStateList {
+ my $self = shift;
+ [map {$states[$_]} @{shift()}];
+}
+
+sub getStateStruct {
+ my $self = shift;
+ my %states = %{shift()};
+ # be careful to distinguish block from hash. Just {} won't work
+ +{map {$_ => $states[$states{$_}]} keys %states};
+}
+
+1;
Added: packages/soap-lite/branches/upstream/current/examples/My/Parameters.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/My/Parameters.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/My/Parameters.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,70 @@
+package My::Parameters;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Server::Parameters);
+
+sub echo {
+ my $self = shift;
+ pop; # last parameter is envelope (SOAP::SOM object)
+ # don't want to echo it
+ @_;
+}
+
+sub echodata {
+ my $self = shift;
+ my @parameters = pop->dataof(SOAP::SOM::paramsin);
+ @parameters;
+}
+
+sub echotwo {
+ SOAP::Data->type(xml => "<a>$_[1]</a><b>$_[2]</b>");
+}
+
+sub autobind {
+ my $self = shift;
+ my $param1 = shift;
+ my $param2 = SOAP::Data->name('myparam' => shift() * 2);
+ return $param1, $param2;
+}
+
+sub addheader {
+ my $self = shift;
+ my $param1 = shift;
+ my $header = pop->headerof(SOAP::SOM::headers);
+ return $param1, $header->value($header->value x 2);
+}
+
+sub byorder {
+ my $self = shift;
+ my($a, $b, $c) = @_;
+ return "1=$a, 2=$b, 3=$c";
+}
+
+sub byname { # input parameter(s), envelope (SOAP::SOM object)
+ my $self = shift;
+ my($a, $b, $c) = SOAP::Server::Parameters::byName([qw(a b c)], @_);
+ return "a=$a, b=$b, c=$c";
+}
+
+sub bynameororder { # input parameter(s), envelope (SOAP::SOM object)
+ my $self = shift;
+ my($a, $b, $c) = SOAP::Server::Parameters::byNameOrOrder([qw(a b c)], @_);
+ return "a=$a, b=$b, c=$c";
+}
+
+sub die_simply {
+ die 'Something bad happened in our method';
+}
+
+sub die_with_object {
+ die SOAP::Data->name(something => 'value')->uri('http://www.soaplite.com/');
+}
+
+sub die_with_fault {
+ die SOAP::Fault->faultcode('Server.Custom') # will be qualified
+ ->faultstring('Died in server method')
+ ->faultdetail(bless {code => 1} => 'BadError')
+ ->faultactor('http://www.soaplite.com/custom');
+}
+
+1;
\ No newline at end of file
Added: packages/soap-lite/branches/upstream/current/examples/My/PersistentIterator.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/My/PersistentIterator.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/My/PersistentIterator.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,16 @@
+package My::PersistentIterator;
+
+my $iterator;
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ $iterator ||= (bless {_num=>shift} => $class);
+}
+
+sub next {
+ my $self = shift;
+ $self->{_num}++;
+}
+
+1;
\ No newline at end of file
Added: packages/soap-lite/branches/upstream/current/examples/My/PingPong.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/My/PingPong.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/My/PingPong.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,19 @@
+package My::PingPong;
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ bless {_num=>shift} => $class;
+}
+
+sub next {
+ my $self = shift;
+ $self->{_num}++;
+}
+
+sub value {
+ my $self = shift;
+ $self->{_num};
+}
+
+1;
\ No newline at end of file
Added: packages/soap-lite/branches/upstream/current/examples/My/SessionIterator.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/My/SessionIterator.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/My/SessionIterator.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,14 @@
+package My::SessionIterator;
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ bless {_num=>shift} => $class;
+}
+
+sub next {
+ my $self = shift;
+ $self->{_num}++;
+}
+
+1;
\ No newline at end of file
Added: packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/Daemon/ForkAfterProcessing.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/Daemon/ForkAfterProcessing.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/Daemon/ForkAfterProcessing.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,27 @@
+package SOAP::Transport::HTTP::Daemon::ForkAfterProcessing;
+
+use strict;
+use vars qw(@ISA);
+use SOAP::Transport::HTTP;
+
+# Idea and implementation of Peter Fraenkel (Peter.Fraenkel at msdw.com)
+
+ at ISA = qw(SOAP::Transport::HTTP::Daemon);
+
+sub handle {
+ my $self = shift->new;
+ CLIENT:
+ while (my $c = $self->accept) {
+ my $first = 1;
+ while (my $r = $c->get_request) {
+ $self->request($r);
+ $self->SOAP::Transport::HTTP::Server::handle;
+ if ($first && fork) { $first=0; $c->close; next CLIENT }
+ $c->send_response($self->response)
+ }
+ $c->close;
+ undef $c;
+ }
+}
+
+1;
Added: packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/Daemon/ForkOnAccept.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/Daemon/ForkOnAccept.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/SOAP/Transport/HTTP/Daemon/ForkOnAccept.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,40 @@
+package SOAP::Transport::HTTP::Daemon::ForkOnAccept;
+
+use strict;
+use vars qw(@ISA);
+use SOAP::Transport::HTTP;
+
+# Idea and implementation of Michael Douglass
+
+ at ISA = qw(SOAP::Transport::HTTP::Daemon);
+
+sub handle {
+ my $self = shift->new;
+
+ CLIENT:
+ while (my $c = $self->accept) {
+ my $pid = fork();
+
+ # We are going to close the new connection on one of two conditions
+ # 1. The fork failed ($pid is undefined)
+ # 2. We are the parent ($pid != 0)
+ unless( defined $pid && $pid == 0 ) {
+ $c->close;
+ next;
+ }
+ # From this point on, we are the child.
+
+ $self->close; # Close the listening socket (always done in children)
+
+ # Handle requests as they come in
+ while (my $r = $c->get_request) {
+ $self->request($r);
+ $self->SOAP::Transport::HTTP::Server::handle;
+ $c->send_response($self->response);
+ }
+ $c->close;
+ return;
+ }
+}
+
+1;
Added: packages/soap-lite/branches/upstream/current/examples/SOAP/simple1.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/SOAP/simple1.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/SOAP/simple1.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,13 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+# simple object interface
+print SOAP::Lite
+ -> uri('http://simon.fell.com/calc')
+ -> proxy('http://soap.4s4c.com/ssss4c/soap.asp')
+ -> doubler(SOAP::Data->name(nums => [10,20,30,50,100]))
+ -> result ->[1];
Added: packages/soap-lite/branches/upstream/current/examples/SOAP/simple2.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/SOAP/simple2.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/SOAP/simple2.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,12 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# using autodispatch feature
+use SOAP::Lite +autodispatch =>
+ uri => 'http://simon.fell.com/calc',
+ proxy => 'http://soap.4s4c.com/ssss4c/soap.asp'
+;
+
+print doubler(SOAP::Data->name(nums => [10,20,30,50,100]))->[2];
Added: packages/soap-lite/branches/upstream/current/examples/SOAP/simple3.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/SOAP/simple3.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/SOAP/simple3.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,11 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+# using WSDL
+print SOAP::Lite
+ -> service('http://soap.4s4c.com/ssss4c/soap.asp?WSDL')
+ -> doubler([10,20,30,50,100])->[2], "\n";
Added: packages/soap-lite/branches/upstream/current/examples/UDDI/inquire1.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/UDDI/inquire1.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/UDDI/inquire1.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,37 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- UDDI::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use UDDI::Lite
+ import => 'UDDI::Data',
+ import => ['UDDI::Lite' => ':find', ':get'],
+ proxy => 'http://uddi.microsoft.com/inquire',
+;
+
+my @parameters = (
+ findQualifiers([findQualifier('sortByNameAsc'),
+ findQualifier('caseSensitiveMatch')]),
+ name('M'),
+
+# OR
+
+# findQualifiers(findQualifier('sortByNameAsc',
+# 'caseSensitiveMatch')),
+# name('M'),
+);
+
+my $b = find_business(@parameters);
+for ($b->businessInfos->businessInfo) {
+ print $_->name, "\n";
+ if ($_->name eq "Microsoft Corporation") {
+ my $key = $_->businessKey;
+ print "$key\n";
+ my $e = get_businessDetail($key)->businessEntity;
+ my @services = $e->businessServices->businessService;
+ for (@services) {
+ print " ", $_->name, "\n";
+ }
+ }
+}
Added: packages/soap-lite/branches/upstream/current/examples/UDDI/publish1.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/UDDI/publish1.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/UDDI/publish1.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,36 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- UDDI::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# You may run these tests/examples for UDDI publishing API against
+# UDDI registry that was kindly provided with following disclamer:
+# "This is a free registry provided by XMethods.net and
+# implemented using GLUE platform (Graham Glass, TheMindElectric)."
+# Thanks to Tony Hong for his help and support
+
+use strict;
+use UDDI::Lite
+ import => 'UDDI::Data',
+ import => 'UDDI::Lite',
+ proxy => "https://uddi.xmethods.net:8005/glue/publish/uddi",
+;
+
+my $name = 'Sample business ' . $$ . time; # just to make it unique
+
+print "Authorizing...\n";
+my $auth = get_authToken({userID => 'soaplite', cred => 'soaplite'})->authInfo;
+my $busent = businessEntity(name($name))->businessKey('');
+
+print "Saving business '$name'...\n";
+my $newent = save_business($auth, $busent)->businessEntity;
+my $newkey = $newent->businessKey;
+
+print "Created...\n";
+print $newkey, "\n";
+print $newent->discoveryURLs->discoveryURL, "\n";
+
+print "Deleting '$newkey'...\n";
+my $result = delete_business($auth, $newkey)->result;
+
+print $result->errInfo, "\n";
Added: packages/soap-lite/branches/upstream/current/examples/UDDI/simple1.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/UDDI/simple1.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/UDDI/simple1.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,15 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- UDDI::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use UDDI::Lite +autodispatch =>
+ proxy => 'http://uddi.microsoft.com/inquire',
+;
+
+my $list = find_business(name => 'microsoft');
+my $bis = $list->businessInfos;
+for ($bis->businessInfo) {
+ my $s = $_->serviceInfos->serviceInfo or next; # skip if no service information
+ print $s->name, ' ', $s->businessKey, "\n";
+}
Added: packages/soap-lite/branches/upstream/current/examples/UDDI/simple2.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/UDDI/simple2.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/UDDI/simple2.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,13 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- UDDI::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use UDDI::Lite
+ import => 'UDDI::Data',
+ import => 'UDDI::Lite',
+ proxy => 'http://uddi.microsoft.com/inquire'
+;
+
+print find_business(name('xmethods'))
+ -> businessInfos->businessInfo->serviceInfos->serviceInfo->name;
Added: packages/soap-lite/branches/upstream/current/examples/UDDI/syntax1.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/UDDI/syntax1.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/UDDI/syntax1.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,28 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- UDDI::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use UDDI::Lite
+ import => 'UDDI::Data',
+ import => 'UDDI::Lite',
+ proxy => "https://some.server.com/endpoint_fot_publishing_API",
+;
+
+my $name = 'Sample business';
+
+print "Authorizing...\n";
+my $auth = get_authToken({userID => 'USERID', cred => 'CRED'})->authInfo;
+
+my $tmodel = tModelInstanceInfo(description('some tModel'))->tModelKey('UUID:C1ACF26D-9672-4404-9D70-39B756E62AB4');
+my $tmodels = tModelInstanceDetails($tmodel);
+my $bindtmpl = bindingTemplate([accessPoint('someurl'), $tmodels]);
+my $bindtmpls = bindingTemplates($bindtmpl);
+my $bussvc = businessService([name('Test Service'), $bindtmpls]);
+my $bussvcs = businessServices($bussvc);
+my $busent = businessEntity([name($name), $bussvcs])->businessKey('');
+
+print "Saving business '$name'...\n";
+my $newent = save_business($auth, $busent)->businessEntity;
+my $newkey = $newent->businessKey;
Added: packages/soap-lite/branches/upstream/current/examples/UDDI/syntax2.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/UDDI/syntax2.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/UDDI/syntax2.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,57 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- UDDI::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use UDDI::Lite
+ import => 'UDDI::Data',
+ import => 'UDDI::Lite',
+ proxy => "https://some.server.com/endpoint_fot_publishing_API",
+ on_fault => sub {}, # do nothing for fault, will check it in the code
+;
+
+print "Authorizing...\n";
+my $auth = get_authToken({userID => 'USERID', cred => 'CRED'})->authInfo;
+
+# NB! order of elements DOES matter (and DOES NOT for attributes)
+
+my $busent = with businessEntity =>
+ name("Contoso Manufacturing"),
+ description("We make components for business"),
+ businessKey(''),
+ businessServices with businessService =>
+ name("Buy components"),
+ description("Bindings for buying our components"),
+ serviceKey(''),
+ bindingTemplates with bindingTemplate =>
+ description("BASDA invoices over HTTP post"),
+ accessPoint('http://www.contoso.com/buy.asp'),
+ bindingKey(''),
+ tModelInstanceDetails with tModelInstanceInfo =>
+ description('some tModel'),
+ tModelKey('UUID:C1ACF26D-9672-4404-9D70-39B756E62AB4')
+;
+
+my $newent = save_business($auth, $busent);
+print $newent->businessEntity->businessKey if ref $newent;
+
+#
+# (almost) the same code from Microsoft UDDI toolkit
+#
+# With be.AddbusinessEntity
+# .Name = "Contoso Manufacturing"
+# .Adddescription = "We make components for business"
+# With .businessServices.AddbusinessService
+# .Name = "Buy components"
+# .Adddescription = "Bindings for buying our components"
+# With .bindingTemplates.AddbindingTemplate
+# .accessPoint = "http://www.contoso.com/buy.asp"
+# .addescription = "BASDA invoices over HTTP post"
+# With .tModelInstanceDetails.AddtModelInstanceInfo
+# .tModelKey = GUID_BASDA_INVOICE
+# End With
+# End With
+# End With
+# End With
+#
Added: packages/soap-lite/branches/upstream/current/examples/UDDI/syntax3.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/UDDI/syntax3.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/UDDI/syntax3.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,43 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- UDDI::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use UDDI::Lite
+ import => 'UDDI::Data',
+ import => 'UDDI::Lite',
+ proxy => "https://some.server.com/endpoint_fot_publishing_API",
+ on_fault => sub {}, # do nothing for fault, will check it in the code
+;
+
+print "Authorizing...\n";
+my $auth = get_authToken({userID => 'USERID', cred => 'CRED'})->authInfo;
+
+# MAY also work without businessKey, serviceKey and bindingKey assignments,
+# however specification requires them to be assigned to the empty strings
+
+# NB! order of elements DOES matter
+
+my $busent = businessEntity([
+ name("Contoso Manufacturing"),
+ description("We make components for business"),
+ businessServices(
+ businessService([
+ name("Buy components"),
+ description("Bindings for buying our components"),
+ bindingTemplates(
+ bindingTemplate([
+ description("BASDA invoices over HTTP post"),
+ accessPoint("http://www.contoso.com/buy.asp"),
+ tModelInstanceDetails(
+ tModelInstanceInfo->tModelKey('UUID:C1ACF26D-9672-4404-9D70-39B756E62AB4')
+ ),
+ ])->bindingKey(''),
+ ),
+ ])->serviceKey(''),
+ ),
+])->businessKey('');
+
+my $newent = save_business($auth, $busent);
+print $newent->businessEntity->businessKey if ref $newent;
Added: packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic1.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic1.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic1.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,16 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+BEGIN { warn "Started...\n" }
+
+# import interface. All methods from loaded service are imported by default
+use SOAP::Lite
+ service => 'http://services.xmethods.net/soap/urn:xmethods-delayed-quotes.wsdl',
+ # service => 'file:/your/local/path/xmethods-delayed-quotes.wsdl',
+ # service => 'file:./xmethods-delayed-quotes.wsdl',
+;
+
+warn "Loaded...\n";
+print getQuote('MSFT'), "\n";
Added: packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic2.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic2.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic2.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,11 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+# object interface
+print SOAP::Lite
+ -> service('http://services.xmethods.net/soap/urn:xmethods-delayed-quotes.wsdl')
+ -> getQuote('MSFT'), "\n";
Added: packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic3.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic3.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic3.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,12 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+# object interface
+my $service = SOAP::Lite
+ -> service('http://services.xmethods.net/soap/urn:xmethods-delayed-quotes.wsdl');
+
+print $service->getQuote('MSFT'), "\n";
Added: packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic4.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic4.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/WSDL/dynamic4.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,12 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+# object interface
+# WSDL with <import> element and multiple ports (non-SOAP bindings)
+print SOAP::Lite
+ -> service('http://www.xmethods.net/sd/StockQuoteImport.wsdl')
+ -> getQuote('MSFT'), "\n";
Added: packages/soap-lite/branches/upstream/current/examples/WSDL/stub1.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/WSDL/stub1.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/WSDL/stub1.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,11 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# stub interface (created with stubmaker.pl)
+# perl stubmaker.pl http://www.xmethods.net/sd/StockQuoteService.wsdl
+
+use StockQuoteService ':all';
+
+print getQuote('MSFT'), "\n";
Added: packages/soap-lite/branches/upstream/current/examples/WSDL/stub2.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/WSDL/stub2.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/WSDL/stub2.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,11 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# stub interface (created with stubmaker.pl)
+# perl stubmaker.pl http://www.xmethods.net/sd/StockQuoteService.wsdl
+
+use StockQuoteService;
+
+print StockQuoteService->getQuote('MSFT'), "\n";
Added: packages/soap-lite/branches/upstream/current/examples/WSDL/stub3.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/WSDL/stub3.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/WSDL/stub3.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,12 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# stub interface (created with stubmaker.pl)
+# perl stubmaker.pl http://www.xmethods.net/sd/StockQuoteService.wsdl
+
+use StockQuoteService;
+
+my $service = StockQuoteService->new;
+print $service->getQuote('MSFT'), "\n";
Added: packages/soap-lite/branches/upstream/current/examples/XML/customxml.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/XML/customxml.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/XML/customxml.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,181 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+my $d = SOAP::Custom::XML::Deserializer
+ -> deserialize(join '', <DATA>)
+ -> valueof('/Envelope/Body');
+
+foreach my $portfolio ($d->Report->Request->Composition->PortfolioDistribution) {
+ print $portfolio->type, " ", $portfolio->date, "\n";
+ foreach my $row ($portfolio->Row) {
+ print " ", $row->Element, " ", $row->Value, "\n";
+ }
+}
+
+__DATA__
+<?xml version="1.0" encoding="UTF-8"?>
+<Envelope version="1.1">
+ <Header />
+ <Body>
+ <Report>
+ <Header>
+ <ClientRef />
+ <FundCusip>61744J366</FundCusip>
+ <SepAcctDesc />
+ </Header>
+ <Request>
+ <Errors>
+ <Error>Returned no data for request: PortfolioDistribution</Error>
+ <Error>Returned no data for request: PortfolioDistribution</Error>
+ <Error>Returned no data for request: PortfolioDistribution</Error>
+ <Error>Returned no data for request: PortfolioDistribution</Error>
+ <Error>Could not retrieve PortfolioDistribution</Error>
+ <Error>Could not retrieve PortfolioDistribution</Error>
+ <Error>Could not retrieve PortfolioDistribution</Error>
+ <Error>Could not retrieve PortfolioDistribution</Error>
+ </Errors>
+ <Composition>
+ <PortfolioDistribution type="CE" date="09/30/2000" />
+ <PortfolioDistribution type="GB" date="09/30/2000" />
+ <PortfolioDistribution type="ST" date="09/30/2000">
+ <Row>
+ <Element>Common Stocks</Element>
+ <Value>0.9991</Value>
+ </Row>
+ <Row>
+ <Element>Other</Element>
+ <Value>0.0021</Value>
+ </Row>
+ <Row>
+ <Element>Cash & Cash Equivalents</Element>
+ <Value>-0.0012</Value>
+ </Row>
+ </PortfolioDistribution>
+ <PortfolioDistribution type="TT" date="09/30/2000">
+ <Row>
+ <Element>General Electric Company</Element>
+ <Value>0.0458</Value>
+ </Row>
+ <Row>
+ <Element>Cisco Systems Inc</Element>
+ <Value>0.033</Value>
+ </Row>
+ <Row>
+ <Element>Microsoft Corporation</Element>
+ <Value>0.0263</Value>
+ </Row>
+ <Row>
+ <Element>Exxon Mobil Corp.</Element>
+ <Value>0.0263</Value>
+ </Row>
+ <Row>
+ <Element>Pfizer, Inc.</Element>
+ <Value>0.0231</Value>
+ </Row>
+ <Row>
+ <Element>Intel Corporation</Element>
+ <Value>0.0209</Value>
+ </Row>
+ <Row>
+ <Element>Citigroup Inc</Element>
+ <Value>0.02</Value>
+ </Row>
+ <Row>
+ <Element>Emc Corp.</Element>
+ <Value>0.0185</Value>
+ </Row>
+ <Row>
+ <Element>American International Group, Inc.</Element>
+ <Value>0.0181</Value>
+ </Row>
+ <Row>
+ <Element>Oracle Corporation</Element>
+ <Value>0.0172</Value>
+ </Row>
+ </PortfolioDistribution>
+ <PortfolioDistribution type="IB" date="09/30/2000">
+ <Row>
+ <Element>Pharmaceuticals</Element>
+ <Value>0.0941</Value>
+ </Row>
+ <Row>
+ <Element>Communications Equipment</Element>
+ <Value>0.0857</Value>
+ </Row>
+ <Row>
+ <Element>Computers & Peripherals</Element>
+ <Value>0.0764</Value>
+ </Row>
+ <Row>
+ <Element>Diversified Financials</Element>
+ <Value>0.0724</Value>
+ </Row>
+ <Row>
+ <Element>Industrial Conglomerates</Element>
+ <Value>0.0581</Value>
+ </Row>
+ <Row>
+ <Element>Diversified Telecommunication Services</Element>
+ <Value>0.058</Value>
+ </Row>
+ <Row>
+ <Element>Software</Element>
+ <Value>0.056</Value>
+ </Row>
+ <Row>
+ <Element>Other</Element>
+ <Value>0.5002</Value>
+ </Row>
+ <Row>
+ <Element>Cash & Cash Equivalents</Element>
+ <Value>-0.0012</Value>
+ </Row>
+ </PortfolioDistribution>
+ <PortfolioDistribution type="SB" date="09/30/2000">
+ <Row>
+ <Element>Information Technology</Element>
+ <Value>0.2964</Value>
+ </Row>
+ <Row>
+ <Element>Financials</Element>
+ <Value>0.154</Value>
+ </Row>
+ <Row>
+ <Element>Health Care</Element>
+ <Value>0.1265</Value>
+ </Row>
+ <Row>
+ <Element>Consumer Discretionary</Element>
+ <Value>0.1026</Value>
+ </Row>
+ <Row>
+ <Element>Industrials</Element>
+ <Value>0.0874</Value>
+ </Row>
+ <Row>
+ <Element>Telecommunication Services</Element>
+ <Value>0.0632</Value>
+ </Row>
+ <Row>
+ <Element>Consumer Staples</Element>
+ <Value>0.0575</Value>
+ </Row>
+ <Row>
+ <Element>Other</Element>
+ <Value>0.1136</Value>
+ </Row>
+ <Row>
+ <Element>Cash & Cash Equivalents</Element>
+ <Value>-0.0012</Value>
+ </Row>
+ </PortfolioDistribution>
+ </Composition>
+ </Request>
+ </Report>
+ </Body>
+</Envelope>
+
Added: packages/soap-lite/branches/upstream/current/examples/XMLRPC/mod_xmlrpc.htaccess
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/XMLRPC/mod_xmlrpc.htaccess 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/XMLRPC/mod_xmlrpc.htaccess 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,19 @@
+# -- XMLRPC::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# put this file into mod_xmlrpc directory (for tests) or anywhere you want
+
+SetHandler perl-script
+PerlHandler Apache::XMLRPC::Lite
+
+# you may specify almost ANY method of XMLRPC::Transport::HTTP::Apache here
+# see documentation for more information
+
+# if more than one, parameters should be quoted and can be separated with commas
+PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, \
+ Module::Name, Module::method"
+
+# or with spaces
+PerlSetVar objects_by_reference "My::PersistentIterator My::SessionIterator My::Chat"
+
+# for methods that accept hashes, specify parameters as "key1 => value1, key2 => value2"
+PerlSetVar options "compress_threshold => 10000"
Added: packages/soap-lite/branches/upstream/current/examples/XMLRPC/simple1.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/XMLRPC/simple1.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/XMLRPC/simple1.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,11 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use XMLRPC::Lite;
+
+print XMLRPC::Lite
+ -> proxy('http://betty.userland.com/RPC2')
+ -> call('examples.getStateName', 25)
+ -> result;
Added: packages/soap-lite/branches/upstream/current/examples/XMLRPC/xmlrpc.cgi
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/XMLRPC/xmlrpc.cgi 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/XMLRPC/xmlrpc.cgi 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+
+# -- XMLRPC::Lite -- services.soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use XMLRPC::Transport::HTTP;
+
+XMLRPC::Transport::HTTP::CGI
+ -> dispatch_to('validator1')
+ -> handle
+;
+
+package validator1;
+
+sub whichToolkit { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ return +{
+ toolkitDocsUrl => 'http://www.soaplite.com/',
+ toolkitName => 'XMLRPC::Lite',
+ toolkitVersion => XMLRPC::Lite->VERSION,
+ toolkitOperatingSystem => $^O,
+ }
+}
+
+sub countTheEntities { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $string = shift;
+ my $res;
+ $res->{ctLeftAngleBrackets} = ($string =~ s/<//g) || 0;
+ $res->{ctRightAngleBrackets} = ($string =~ s/>//g) || 0;
+ $res->{ctAmpersands} = ($string =~ s/&//g) || 0;
+ $res->{ctApostrophes} = ($string =~ s/'//g) || 0;
+ $res->{ctQuotes} = ($string =~ s/"//g) || 0;
+ return $res;
+}
+
+sub arrayOfStructsTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $array = shift;
+ my $curly_sum = 0;
+ for my $struct (@$array) {
+ $curly_sum += $struct->{'curly'};
+ }
+ return $curly_sum;
+}
+
+sub easyStructTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $struct = shift;
+ return $struct->{'moe'} + $struct->{'larry'} + $struct->{'curly'};
+}
+
+sub echoStructTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ return shift;
+}
+
+sub manyTypesTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ return [@_];
+}
+
+sub moderateSizeArrayCheck { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $array = shift;
+ return join('', $array->[0], $array->[-1]);
+}
+
+sub nestedStructTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $calendar = shift;
+ my $april_1_2000 = $calendar->{'2000'}{'04'}{'01'};
+ return ($april_1_2000->{moe} + $april_1_2000->{larry}
+ + $april_1_2000->{curly});
+}
+
+sub simpleStructReturnTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $number = shift;
+ return +{
+ times10 => $number * 10,
+ times100 => $number * 100,
+ times1000 => $number * 1000
+ };
+}
Added: packages/soap-lite/branches/upstream/current/examples/XMLRPC/xmlrpc.daemon
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/XMLRPC/xmlrpc.daemon 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/XMLRPC/xmlrpc.daemon 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,77 @@
+#!/usr/bin/env perl
+
+# -- XMLRPC::Lite -- services.soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use XMLRPC::Transport::HTTP;
+
+my $daemon = XMLRPC::Transport::HTTP::Daemon
+ -> new (LocalPort => 80)
+ -> dispatch_to('validator1')
+;
+print "Contact to XMLRPC server at ", $daemon->url, "\n";
+$daemon->handle;
+
+package validator1;
+
+sub whichToolkit { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ return +{
+ toolkitDocsUrl => 'http://www.soaplite.com/',
+ toolkitName => 'XMLRPC::Lite',
+ toolkitVersion => XMLRPC::Lite->VERSION,
+ toolkitOperatingSystem => $^O,
+ }
+}
+
+sub countTheEntities { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $string = shift;
+ my $res;
+ $res->{ctLeftAngleBrackets} = ($string =~ s/<//g) || 0;
+ $res->{ctRightAngleBrackets} = ($string =~ s/>//g) || 0;
+ $res->{ctAmpersands} = ($string =~ s/&//g) || 0;
+ $res->{ctApostrophes} = ($string =~ s/'//g) || 0;
+ $res->{ctQuotes} = ($string =~ s/"//g) || 0;
+ return $res;
+}
+
+sub arrayOfStructsTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $array = shift;
+ my $curly_sum = 0;
+ for my $struct (@$array) {
+ $curly_sum += $struct->{'curly'};
+ }
+ return $curly_sum;
+}
+
+sub easyStructTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $struct = shift;
+ return $struct->{'moe'} + $struct->{'larry'} + $struct->{'curly'};
+}
+
+sub echoStructTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ return shift;
+}
+
+sub manyTypesTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ return [@_];
+}
+
+sub moderateSizeArrayCheck { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $array = shift;
+ return join('', $array->[0], $array->[-1]);
+}
+
+sub nestedStructTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $calendar = shift;
+ my $april_1_2000 = $calendar->{'2000'}{'04'}{'01'};
+ return ($april_1_2000->{moe} + $april_1_2000->{larry}
+ + $april_1_2000->{curly});
+}
+
+sub simpleStructReturnTest { shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $number = shift;
+ return +{
+ times10 => $number * 10,
+ times100 => $number * 100,
+ times1000 => $number * 1000
+ };
+}
Added: packages/soap-lite/branches/upstream/current/examples/allclients.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/allclients.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/allclients.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,28 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite
+ uri => 'http://www.soaplite.com/My/Examples',
+ proxy => 'http://localhost/',
+# proxy => 'http://localhost/cgi-bin/soap.cgi', # local CGI server
+# proxy => 'http://localhost/', # local daemon server
+# proxy => 'http://localhost/soap', # local mod_perl server
+# proxy => 'https://localhost/soap', # local mod_perl SECURE server
+# proxy => 'tcp://localhost:82/', # local tcp server
+# proxy => 'http://login:password@localhost/cgi-bin/soap.cgi', # local CGI server with authentication
+
+# proxy => 'jabber://user:password@server:port/to@address/', # JABBER transport
+
+# proxy => ['local:', dispatch_to => 'My::Examples'], # LOCAL transport
+
+# following examples are one-way only, they don't return any response
+# proxy => 'ftp://login:password@ftp.somewhere.com/relative/path/to/file.xml', # FTP transport
+# proxy => 'ftp://login:password@ftp.somewhere.com//absolute/path/to/file.xml', # FTP transport
+
+# you can always pass more than one parameter for proxy
+# proxy => ['mailto:destination.email at address', smtp => 'smtp.server', From => 'your.email', Subject => 'SOAP message'], # SMTP transport
+;
+
+print SOAP::Lite->new->getStateName(1)->result;
Added: packages/soap-lite/branches/upstream/current/examples/authentication.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/authentication.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/authentication.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,29 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite +autodispatch =>
+ uri => 'http://www.soaplite.com/My/Examples',
+ proxy => 'http://localhost/',
+# proxy => 'http://localhost/cgi-bin/soap.cgi', # local CGI server
+# proxy => 'http://localhost/soap', # local mod_perl server
+# proxy => 'https://localhost/soap', # local mod_perl SECURE server
+ on_fault => sub { my($soap, $res) = @_;
+ die ref $res ? $res->faultdetail : $soap->transport->status, "\n";
+ }
+;
+sub SOAP::Transport::HTTP::Client::get_basic_credentials { return ('user' => 'password') };
+
+print getStateName(1), "\n\n";
+print getStateNames(12,24,26,13), "\n\n";
+print getStateList([11,12,13,42])->[0], "\n\n";
+print getStateStruct({item1 => 10, item2 => 4})->{item2}, "\n\n";
+
+# OR if you have SOAP::Lite object you can do
+# $s->transport->credentials('host_port', 'realm', 'user' => 'password');
+
+# see LWP::UserAgent for difference and more documentation
+
+# OR add user and password to your URL as follows:
+# proxy => 'http://user:password@localhost/'
Added: packages/soap-lite/branches/upstream/current/examples/autoexamples.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/autoexamples.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/autoexamples.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,22 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite +autodispatch =>
+ uri => 'http://www.soaplite.com/My/Examples',
+ proxy => 'http://localhost/',
+# proxy => 'http://localhost/cgi-bin/soap.cgi', # local CGI server
+# proxy => 'http://localhost/', # local daemon server
+# proxy => 'http://localhost/soap', # local mod_perl server
+# proxy => 'https://localhost/soap', # local mod_perl SECURE server
+# proxy => 'tcp://localhost:82', # local tcp server
+ on_fault => sub { my($soap, $res) = @_;
+ die ref $res ? $res->faultdetail : $soap->transport->status, "\n";
+ }
+;
+
+print getStateName(1), "\n\n";
+print getStateNames(12,24,26,13), "\n\n";
+print getStateList([11,12,13,42])->[0], "\n\n";
+print getStateStruct({item1 => 10, item2 => 4})->{item2}, "\n\n";
Added: packages/soap-lite/branches/upstream/current/examples/chat.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/chat.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/chat.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,33 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite +autodispatch =>
+ uri => 'http://www.soaplite.com/My/Chat',
+ proxy => 'http://localhost/soap',
+# proxy => 'http://localhost/', # local daemon server
+# proxy => 'http://localhost/soap', # local mod_perl server
+# proxy => 'https://localhost/soap', # local mod_perl SECURE server
+# proxy => 'tcp://localhost:82', # local tcp server
+ on_fault => sub { my($soap, $res) = @_;
+ die ref $res ? $res->faultstring : $soap->transport->status, "\n";
+ }
+;
+
+my $nick = shift or die "Usage: $0 nickname\n";
+my $c = My::Chat->join($nick);
+my %whois = %{$c->whois};
+print map { "$_ [" . mktime($whois{$_}) . "]\n" } keys %whois;
+for (;;) {
+ print map {
+ my($nick, $text, $time) = @$_; chomp($text);
+ join '', mktime($time), ' ', $nick, '>', ' ', $text, "\n";
+ } @{$c->get};
+ print "$nick> ";
+ defined($_ = <>) or last;
+ $c->send($_) if $_ =~ /\S/;
+}
+$c->quit;
+
+sub mktime { use POSIX qw(strftime); strftime("%m/%d %H:%M", localtime shift) }
Added: packages/soap-lite/branches/upstream/current/examples/compress.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/compress.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/compress.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,20 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+$s = SOAP::Lite
+ -> uri('http://localhost/My/Parameters')
+ -> proxy('http://localhost/soap')
+;
+
+use Benchmark;
+
+$s->echo; # ignore the first call
+
+Benchmark::cmpthese(10, {
+ 'nocompress' => sub { $s->transport->options({}); $s->echo(1 x 100000) },
+ 'compress' => sub { $s->transport->options({compress_threshold => 10000}); $s->echo(1 x 100000) },
+})
Added: packages/soap-lite/branches/upstream/current/examples/cookie.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/cookie.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/cookie.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,15 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+$r = SOAP::Lite
+ -> uri('urn:lemurlabs-Fortune')
+ -> proxy('http://www.lemurlabs.com/rpcrouter')
+ -> getFortuneByDictionary('work')
+ -> result || '';
+
+print $r && ref($r = SOAP::Deserializer->deserialize($r)) && ($r = $r->valueof('//fortune') || '')
+ ? "Your fortune cookie:\n$r" : "No fortune cookies for you today\n";
Added: packages/soap-lite/branches/upstream/current/examples/cookieauth.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/cookieauth.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/cookieauth.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,15 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+use HTTP::Cookies;
+
+my $soap = SOAP::Lite
+ -> uri('urn:xmethodsInterop')
+ -> proxy('http://services.xmethods.net:80/soap/servlet/rpcrouter',
+ cookie_jar => HTTP::Cookies->new(ignore_discard => 1))
+;
+
+print $soap->echoString('Hello')->result;
Added: packages/soap-lite/branches/upstream/current/examples/customschema.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/customschema.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/customschema.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,80 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# example that shows how to handle types specified in other schemas
+
+package EncodedTypes;
+
+sub as_TickDirection { $_[1] }
+sub as_Exchanges { $_[1] }
+
+package main;
+
+use SOAP::Lite;
+
+$d = SOAP::Deserializer->new;
+$d->xmlschemas->{'http://marketdata.earthconnect.net/encodedTypes'} = 'EncodedTypes';
+
+$r = $d->deserialize(q!<?xml version="1.0" encoding="utf-8"?>
+<soap:Envelope
+xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+xmlns:tns="http://marketdata.earthconnect.net/"
+xmlns:types="http://marketdata.earthconnect.net/encodedTypes"
+xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+xmlns:xsd="http://www.w3.org/2001/XMLSchema">
+
+<soap:Body soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<tns:GetProfessionalQuoteResponse>
+ <GetProfessionalQuoteResult href="#id1" />
+</tns:GetProfessionalQuoteResponse>
+
+<soapenc:Array id="id1" soapenc:arrayType="types:ProfessionalQuote[1]">
+ <Item href="#id2" />
+</soapenc:Array>
+
+<types:ProfessionalQuote id="id2" xsi:type="types:ProfessionalQuote">
+ <CompanyName xsi:type="xsd:string">EarthConnect Corporation</CompanyName>
+ <LastPrice xsi:type="xsd:decimal">66.7</LastPrice>
+ <LastPriceTime xsi:type="xsd:dateTime">2001-07-17T14:19:45.3310450-07:00</LastPriceTime>
+ <Change xsi:type="xsd:decimal">0.34</Change>
+ <Volume xsi:type="xsd:long">23456778</Volume>
+ <Tick xsi:type="types:TickDirection">Down</Tick>
+ <Bid xsi:type="xsd:decimal">88.21</Bid>
+ <Ask xsi:type="xsd:decimal">88.22</Ask>
+ <BidSize xsi:type="xsd:int">300</BidSize>
+ <AskSize xsi:type="xsd:int">5800</AskSize>
+ <DayLow xsi:type="xsd:decimal">64.8987</DayLow>
+ <DayHigh xsi:type="xsd:decimal">68.4356</DayHigh>
+ <Open xsi:type="xsd:decimal">87.43</Open>
+ <PreviousClose xsi:type="xsd:decimal">86.34</PreviousClose>
+ <LastTradeVolume xsi:type="xsd:int">640</LastTradeVolume>
+ <Exchange xsi:type="types:Exchanges"> one of NASDAQ or NYSE or AMEX or INDEX</Exchange>
+ <Valid href="#id3" />
+</types:ProfessionalQuote>
+
+<types:ProfessionalQuoteValues id="id3" xsi:type="types:ProfessionalQuoteValues">
+ <CompanyName xsi:type="xsd:boolean">false</CompanyName>
+ <LastPrice xsi:type="xsd:boolean">false</LastPrice>
+ <LastPriceTime xsi:type="xsd:boolean">false</LastPriceTime>
+ <Change xsi:type="xsd:boolean">false</Change>
+ <Volume xsi:type="xsd:boolean">false</Volume>
+ <Tick xsi:type="xsd:boolean">false</Tick>
+ <Bid xsi:type="xsd:boolean">false</Bid>
+ <Ask xsi:type="xsd:boolean">false</Ask>
+ <BidSize xsi:type="xsd:boolean">false</BidSize>
+ <AskSize xsi:type="xsd:boolean">false</AskSize>
+ <DayLow xsi:type="xsd:boolean">false</DayLow>
+ <DayHigh xsi:type="xsd:boolean">false</DayHigh>
+ <Open xsi:type="xsd:boolean">false</Open>
+ <PreviousClose xsi:type="xsd:boolean">false</PreviousClose>
+ <LastTradeVolume xsi:type="xsd:boolean">false</LastTradeVolume>
+</types:ProfessionalQuoteValues>
+</soap:Body>
+
+</soap:Envelope>!)->result;
+
+print "Tick (types:TickDirection): ", $r->[0]->{Tick}, "\n";
+print "Exchange (types:Exchanges): ", $r->[0]->{Exchange}, "\n";
Added: packages/soap-lite/branches/upstream/current/examples/forms/style.cgi
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/forms/style.cgi 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/forms/style.cgi 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,19 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::HTTP;
+
+SOAP::Transport::HTTP::CGI
+ -> dispatch_to('Style')
+ -> handle;
+
+package Style;
+
+sub echo {
+ return SOAP::Data->name(echo => $_[1]),
+ SOAP::Header->name('html:style' => <<EOS)->uri('http://www.w3.org/Profiles/XHTML-transitional');
+echo { display: block; color: red; }
+EOS
+}
Added: packages/soap-lite/branches/upstream/current/examples/forms/style.html
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/forms/style.html 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/forms/style.html 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,14 @@
+<html>
+<head><title>SOAP::Lite POST Examples</title></head>
+<body>
+
+<h1>SOAP::Lite Examples</h1>
+<hr>
+
+<form action="http://services.soaplite.com/style.cgi" method="POST" enctype="multipart/form-data">
+<input type="hidden" name="payload" value='<?xml version="1.0" encoding="UTF-8"?><SOAP-ENV:Envelope xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/" SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/1999/XMLSchema"><SOAP-ENV:Body><namesp1:echo xmlns:namesp1="http://www.soaplite.com/Style"><c-gensym5 href="#echo"/></namesp1:echo></SOAP-ENV:Body></SOAP-ENV:Envelope>'>
+<input name="echo" value="37.5">
+<input type="submit">
+</form>
+
+</html>
Added: packages/soap-lite/branches/upstream/current/examples/fullsearch.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/fullsearch.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/fullsearch.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,47 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- UDDI::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use UDDI::Lite
+ import => 'UDDI::Data',
+ import => 'UDDI::Lite',
+ proxy => 'http://www-3.ibm.com/services/uddi/inquiryapi'
+;
+
+$\="\n"; $,=", "; # specify separators for print()
+
+my($serviceInfo) = grep { $_->name =~ /stock quote/i } find_business(name('XMethods'))
+ -> businessInfos
+ -> businessInfo
+ -> serviceInfos
+ -> serviceInfo
+;
+
+print $serviceInfo->name, $serviceInfo->serviceKey;
+
+my $bindingTemplate = get_serviceDetail($serviceInfo->serviceKey)
+ -> businessService
+ -> bindingTemplates
+ -> bindingTemplate
+;
+
+my $accessPoint = $bindingTemplate->accessPoint->value;
+my $tModelKey = $bindingTemplate
+ -> tModelInstanceDetails
+ -> tModelInstanceInfo
+ -> tModelKey
+;
+
+print $accessPoint, $tModelKey;
+
+my $wsdl = get_tModelDetail($tModelKey)
+ -> tModel
+ -> overviewDoc
+ -> overviewURL
+ -> value
+;
+
+print $wsdl;
+
+print SOAP::Lite->service($wsdl)->proxy($accessPoint)->getQuote('MSFT');
Added: packages/soap-lite/branches/upstream/current/examples/getdom.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/getdom.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/getdom.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,52 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+# example of custom serialization/deserialization
+
+BEGIN {
+ use XML::DOM;
+
+ # deserializer has to specify new() and deserialize() methods
+ package My::Deserializer;
+ sub new { bless { _parser => XML::DOM::Parser->new } => ref($_[0]) || $_[0] }
+ sub deserialize { shift->{_parser}->parse(shift) }
+
+ # serializer is inherited from SOAP::Serializer
+ package My::Serializer; @My::Serializer::ISA = 'SOAP::Serializer';
+
+ # nothing special here. as_OBJECT_TYPE() method will catch serialization
+ # of the specified type (use '__' instead of '::'), so object of this
+ # type will be properly serializer even being inside complex data structures
+ sub as_XML__DOM__Document {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+
+ return [
+ $name || $self->SUPER::gen_name(), # name
+ {%$attr, 'xsi:type' => $self->maptypetouri($type)}, # attributes (optional)
+ $value->toString, # value
+ $self->gen_id($value), # multiref id (optional)
+ ];
+ }
+}
+
+print "Deserialize to XML::DOM\n";
+my $dom = My::Deserializer->new->deserialize('<a>1</a>');
+
+print ref $dom, ': ', $dom->toString, "\n";
+
+# serialize SOAP message using XML::DOM value
+my $a = My::Serializer->maptype({'XML::DOM::Document' => 'http://my.something/'})
+ ->freeform(SOAP::Data->name('a' => [1, $dom, 2]));
+print "Serialize array with @{[ref $dom]} element\n";
+print $a, "\n";
+
+print "Deserialize with default deserializer\n";
+my $r = SOAP::Deserializer->deserialize($a)->freeform;
+
+use Data::Dumper; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 1;
+print Dumper($r);
Added: packages/soap-lite/branches/upstream/current/examples/google.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/google.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/google.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,24 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# Google Web API: http://www.google.com/apis/
+# NB: Register and get your own key first
+# see also:
+# http://interconnected.org/home/more/GoogleSearch.pl.txt
+# http://aaronland.net/weblog/archive/4205
+# http://www.oreillynet.com/cs/weblog/view/wlg/1283
+
+use SOAP::Lite;
+
+my $key = '0'; # <<< put your key here
+my $query = shift || 'soap';
+
+# use GoogleSearch.wsdl file from Google developer's kit
+my $google = SOAP::Lite->service('file:./GoogleSearch.wsdl');
+my $result = $google->doGoogleSearch(
+ $key, $query, 0, 10, 'false', '', 'false', '', 'latin1', 'latin1');
+
+die $google->call->faultstring if $google->call->fault;
+print "About $result->{'estimatedTotalResultsCount'} results.\n";
Added: packages/soap-lite/branches/upstream/current/examples/inline.daemon
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/inline.daemon 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/inline.daemon 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,27 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# that's OO call, so first parameter is scalar (class name)
+
+use Inline C => <<ENDC;
+SV* greet(SV* o, char* x) { newSVpvf("Hello, %s world", x); }
+ENDC
+
+use SOAP::Transport::HTTP;
+
+$SIG{PIPE} = $SIG{INT} = 'IGNORE'; # don't want to die on 'Broken pipe' or Ctrl-C
+
+my $daemon = SOAP::Transport::HTTP::Daemon
+ -> new (LocalAddr => 'localhost', LocalPort => 81)
+ -> dispatch_to('greet')
+;
+print "Contact to SOAP server at ", $daemon->url, "\n";
+$daemon->handle;
+
+# you can see the result with:
+#
+# % perl SOAPsh.pl http://localhost:81/
+# > greet('cruel')
+#
\ No newline at end of file
Added: packages/soap-lite/branches/upstream/current/examples/iterator.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/iterator.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/iterator.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,26 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite +autodispatch =>
+ uri => 'http://www.soaplite.com/My/Parameters',
+ proxy => 'http://localhost/soap',
+# proxy => 'http://localhost/', # local daemon server
+# proxy => 'http://localhost/soap', # local mod_perl server
+# proxy => 'https://localhost/soap', # local mod_perl SECURE server
+# proxy => 'tcp://localhost:82', # local tcp server
+ on_fault => sub { my($soap, $res) = @_;
+ die ref $res ? $res->faultdetail : $soap->transport->status, "\n";
+ }
+;
+
+print "Session iterator\n";
+my $p = My::SessionIterator->new(10);
+print $p->next, "\n";
+print $p->next, "\n";
+
+print "Persistent iterator\n";
+$p = My::PersistentIterator->new(10);
+print $p->next, "\n";
+print $p->next, "\n";
Added: packages/soap-lite/branches/upstream/current/examples/joke.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/joke.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/joke.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,19 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use SOAP::Lite;
+use Text::Wrap;
+
+my $res = SOAP::Lite
+ -> uri('urn:vgx-joke')
+ -> proxy('http://services.xmltoday.com/vx_engine/soap-trigger.pperl')
+ -> JokeOfTheDay
+;
+
+die $res->faultstring if $res->fault;
+
+printf "%s [%s]\n", $res->result->{title}, $res->result->{score};
+print wrap("\t", '', split( /\n/, $res->result->{text})), "\n";
Added: packages/soap-lite/branches/upstream/current/examples/oneliners
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/oneliners 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/oneliners 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,2 @@
+perl "-MSOAP::Lite service=>'http://www.xmethods.net/sd/StockQuoteService.wsdl'" -le "print getQuote('MSFT')"
+perl "-MSOAP::Lite service=>'file:./quote.wsdl'" -le "print getQuote('MSFT')"
\ No newline at end of file
Added: packages/soap-lite/branches/upstream/current/examples/oo-apache.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/oo-apache.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/oo-apache.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,24 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# ---------------------------------------------------------------------
+# Object interaction
+# connect to service that described by Graham Glass:
+# http://www-106.ibm.com/developerworks/library/ws-peer3/?dwzone=ws
+# ---------------------------------------------------------------------
+
+use SOAP::Lite;
+
+my $invoice = bless {name => 'My invoice', amount => 41} => 'Invoice';
+
+my $soap = SOAP::Lite
+ -> proxy('http://localhost:8080/soap/servlet/rpcrouter')
+ -> maptype({Invoice => 'urn:my_encoding'})
+ -> uri('urn:demo2:purchasing');
+
+$a = $soap->receive($invoice)->result;
+print 'type: ', ref $a, "\n";
+print ' name: ', $a->{name}, "\n";
+print ' amount: ', $a->{amount}, "\n";
Added: packages/soap-lite/branches/upstream/current/examples/parametersbyname.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/parametersbyname.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/parametersbyname.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,27 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite +autodispatch =>
+ uri => 'http://www.soaplite.com/My/Parameters',
+ proxy => 'http://localhost/',
+# proxy => 'http://localhost/cgi-bin/soap.cgi', # local CGI server
+# proxy => 'http://localhost/', # local daemon server
+# proxy => 'http://localhost/soap', # local mod_perl server
+# proxy => 'https://localhost/soap', # local mod_perl SECURE server
+# proxy => 'tcp://localhost:82', # local tcp server
+ on_fault => sub { my($soap, $res) = @_;
+ die ref $res ? $res->faultdetail : $soap->transport->status, "\n";
+ }
+;
+
+my @parameters = (
+ SOAP::Data->name(b => 222),
+ SOAP::Data->name(c => 333),
+ SOAP::Data->name(a => 111)
+);
+
+print "Parameters: ", join(' ', map {$_->value} @parameters), "\n";
+print "By order: ", byorder(@parameters), "\n";
+print "By name: ", byname(@parameters), "\n";
Added: packages/soap-lite/branches/upstream/current/examples/pingpong.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/pingpong.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/pingpong.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,25 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite +autodispatch =>
+ uri => 'http://www.soaplite.com/',
+ proxy => 'http://localhost/',
+# proxy => 'http://localhost/cgi-bin/soap.cgi', # local CGI server
+# proxy => 'http://localhost/', # local daemon server
+# proxy => 'http://localhost/soap', # local mod_perl server
+# proxy => 'https://localhost/soap', # local mod_perl SECURE server
+# proxy => 'tcp://localhost:82', # local tcp server
+ on_fault => sub { my($soap, $res) = @_;
+ die ref $res ? $res->faultdetail : $soap->transport->status, "\n";
+ }
+;
+
+use My::PingPong;
+# you can manipulate same object on remote and local machine
+my $p = My::PingPong->new(10); # local
+# my $p = My::PingPong->SOAP::new(10); # same thing remotely
+print 'remote: ', $p->SOAP::next, "\n"; # remote
+print 'local: ', $p->next, "\n"; # local
+print 'remote: ', $p->SOAP::value, "\n"; # remote
Added: packages/soap-lite/branches/upstream/current/examples/server/Apache.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/Apache.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/Apache.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,25 @@
+package SOAP::Apache;
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::HTTP;
+
+my $server = SOAP::Transport::HTTP::Apache
+
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+
+ # if you want to use module from BOTH mod_perl and mod_soap
+ # you should use either static or mixed dispatching
+ # -> dispatch_to(qw(My::Examples My::Parameters My::PersistentIterator My::SessionIterator My::PingPong))
+
+ # enable compression support
+ -> options({compress_threshold => 10000})
+;
+
+sub handler { $server->handler(@_) }
+
+1;
Added: packages/soap-lite/branches/upstream/current/examples/server/mod_soap.htaccess
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/mod_soap.htaccess 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/mod_soap.htaccess 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,23 @@
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# put this file into mod_soap directory (for tests) or anywhere you want
+
+SetHandler perl-script
+PerlHandler Apache::SOAP
+
+# you may specify almost ANY method of SOAP::Transport::HTTP::Apache here
+# see documentation for more information
+
+# if more than one, parameters should be quoted and can be separated with commas
+PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, \
+ Module::Name, Module::method"
+
+# or with spaces
+PerlSetVar objects_by_reference "My::PersistentIterator My::SessionIterator My::Chat"
+
+# if you want to use module from BOTH mod_perl and mod_soap
+# you should use either static or mixed dispatching
+# PerlSetVar dispatch_to "My::Examples My::Parameters My::PersistentIterator My::SessionIterator My::PingPong"
+
+# for methods that accept hashes, specify parameters as "key1 => value1, key2 => value2"
+PerlSetVar options "compress_threshold => 10000"
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.asp
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.asp 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.asp 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,14 @@
+<%
+ ' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+ ' SOAP server. requires SOAP.Lite COM object (regsvr32 Lite.dll)
+ ' Path to Perl modules can be specified
+ ' as '/PATH/TO/MODULES' or as 'drive:/PATH/TO/MODULES'
+
+ Response.ContentType = "text/xml"
+ Response.Write(Server.CreateObject("SOAP.Lite") _
+ .server("SOAP::Server") _
+ .dispatch_to("/Your/Path/To/Deployed/Modules") _
+ .handle(Request.BinaryRead(Request.TotalBytes)) _
+ )
+%>
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.cgi
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.cgi 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.cgi 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,16 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::HTTP;
+
+SOAP::Transport::HTTP::CGI
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules',
+ 'Module::Name',
+ 'Module::method')
+ # enable compression support
+ -> options({compress_threshold => 10000})
+ -> handle
+;
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.daemon
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.daemon 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.daemon 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,30 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::HTTP;
+
+$SIG{PIPE} = $SIG{INT} = 'IGNORE'; # don't want to die on 'Broken pipe' or Ctrl-C
+
+# change LocalPort to 81 if you want to test it with soapmark.pl
+
+my $daemon = SOAP::Transport::HTTP::Daemon
+ # if you do not specify LocalAddr then you can access it with
+ # any hostname/IP alias, including localhost or 127.0.0.1.
+ # if do you specify LocalAddr in ->new() then you can only access it
+ # from that interface. -- Michael Percy <mpercy at portera.com>
+ -> new (LocalAddr => 'localhost', LocalPort => 80)
+ # you may also add other options, like 'Reuse' => 1 and/or 'Listen' => 128
+
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+
+ # enable compression support
+ -> options({compress_threshold => 10000})
+;
+print "Contact to SOAP server at ", $daemon->url, "\n";
+$daemon->handle;
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.daemon.forkafterprocessing
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.daemon.forkafterprocessing 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.daemon.forkafterprocessing 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,25 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+eval { require SOAP::Transport::HTTP::Daemon::ForkAfterProcessing } or die <<EOW;
+$@
+ WARNING: module for Daemon::ForkAfterProcessing is not installed by default.
+ It's in examples/SOAP/Transport/HTTP/ directory
+ you can install it yourself.
+ Forking behavior IS specific: it is forking AFTER handling request.
+ Feel free to modify this behavior. It's just an example.
+EOW
+
+$SIG{PIPE} = $SIG{INT} = 'IGNORE'; # don't want to die on 'Broken pipe' or Ctrl-C
+$SIG{CHLD} = 'IGNORE'; # do not create zombies
+
+my $daemon = SOAP::Transport::HTTP::Daemon::ForkAfterProcessing
+ -> new (LocalAddr => 'localhost', LocalPort => 80)
+ # you may also add other options, like 'Reuse' => 1 and/or 'Listen' => 128
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+;
+print "Contact to SOAP server at ", $daemon->url, "\n";
+$daemon->handle;
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.daemon.forkonaccept
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.daemon.forkonaccept 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.daemon.forkonaccept 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,24 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+eval { require SOAP::Transport::HTTP::Daemon::ForkOnAccept } or die <<EOW;
+$@
+ WARNING: module for Daemon::ForkOnAccept is not installed by default.
+ It's in examples/SOAP/Transport/HTTP/ directory
+ you can install it yourself.
+ Feel free to modify it. It's just an example.
+EOW
+
+$SIG{PIPE} = $SIG{INT} = 'IGNORE'; # don't want to die on 'Broken pipe' or Ctrl-C
+$SIG{CHLD} = 'IGNORE'; # do not create zombies
+
+my $daemon = SOAP::Transport::HTTP::Daemon::ForkOnAccept
+ -> new (LocalAddr => 'localhost', LocalPort => 80)
+ # you may also add other options, like 'Reuse' => 1 and/or 'Listen' => 128
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+;
+print "Contact to SOAP server at ", $daemon->url, "\n";
+$daemon->handle;
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.fcgi
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.fcgi 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.fcgi 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,14 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::HTTP;
+
+SOAP::Transport::HTTP::FCGI
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ # enable compression support
+ -> options({compress_threshold => 10000})
+ -> handle
+;
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.io
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.io 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.io 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,38 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::IO;
+
+SOAP::Transport::IO::Server
+
+ # you may specify as parameters for new():
+ # -> new( in => 'in_file_name' [, out => 'out_file_name'] )
+ # -> new( in => IN_HANDLE [, out => OUT_HANDLE] )
+ # -> new( in => *IN_HANDLE [, out => *OUT_HANDLE] )
+ # -> new( in => \*IN_HANDLE [, out => \*OUT_HANDLE] )
+
+ # -- OR --
+ # any combinations
+ # -> new( in => *STDIN, out => 'out_file_name' )
+ # -> new( in => 'in_file_name', => \*OUT_HANDLE )
+
+ # -- OR --
+ # use in() and/or out() methods
+ # -> in( *STDIN ) -> out( *STDOUT )
+
+ # -- OR --
+ # use default (when nothing specified):
+ # in => *STDIN, out => *STDOUT
+
+ # don't forget, if you want to accept parameters from command line
+ # \*HANDLER will be understood literally, so this syntax won't work
+ # and server will complain
+
+ -> new(@ARGV)
+
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ -> handle
+;
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.jabber
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.jabber 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.jabber 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,18 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::JABBER;
+
+my $server = SOAP::Transport::JABBER::Server
+ -> new('jabber://user:password@jabber.org:5222')
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+;
+
+print "Contact to SOAP server\n";
+
+do { $server->handle } while sleep 10;
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.mod_cgi
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.mod_cgi 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.mod_cgi 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,20 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# you'd better don't try to use dynamic deployment with Apache::Registry
+# because it won't work anyway, however you can specify path to your
+# modules either in dispatch_to or in 'use lib qw(path_to_modules)'
+
+use SOAP::Transport::HTTP;
+
+SOAP::Transport::HTTP::CGI
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ -> dispatch_to('/Your/Path/To/Deployed/Modules',
+ qw(My::PersistentIterator My::SessionIterator My::Chat
+ My::Examples My::Parameters My::PingPong))
+ # enable compression support
+ -> options({compress_threshold => 10000})
+ -> handle
+;
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.mq
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.mq 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.mq 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,18 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::MQ;
+
+my $server = SOAP::Transport::MQ::Server
+ ->new('mq://server:port?Channel=CHANNEL;QueueManager=QUEUEMANAGER;RequestQueue=REQUESTQUEUE;ReplyQueue=REPLYQUEUE')
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+;
+
+print "Contact to SOAP server\n";
+
+do { $server->handle } while sleep 1;
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.pop3
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.pop3 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.pop3 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,26 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::POP3;
+
+my $server = SOAP::Transport::POP3::Server
+ -> new('pop://pop.mail.server')
+ # if you want to have all in one place
+ # -> new('pop://user:password@pop.mail.server')
+ # or, if you have server that supports MD5 protected passwords
+ # -> new('pop://user:password;AUTH=+APOP@pop.mail.server')
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+;
+# you don't need to use next line if you specified your password in new()
+$server->login('user' => 'password') or die "Can't authenticate to POP3 server\n";
+
+# handle will return number of processed mails
+# you can organize loop if you want
+do { $server->handle } while sleep 10;
+
+# you may also call $server->quit explicitly to purge deleted messages
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.tcp
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.tcp 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.tcp 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,17 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Transport::TCP;
+
+$SIG{PIPE} = $SIG{INT} = 'IGNORE'; # don't want to die on 'Broken pipe' or Ctrl-C
+
+my $daemon = SOAP::Transport::TCP::Server
+ -> new (LocalAddr => 'localhost', LocalPort => 82, Listen => 5, Reuse => 1)
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+;
+print "Contact to SOAP server at ", join(':', $daemon->sockhost, $daemon->sockport), "\n";
+$daemon->handle;
Added: packages/soap-lite/branches/upstream/current/examples/server/soap.vbs
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap.vbs 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap.vbs 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,14 @@
+' -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+' SOAP server. requires SOAP.Lite COM object (regsvr32 Lite.dll)
+' Doesn't require web server
+' Path to Perl modules can be specified
+' as '/PATH/TO/MODULES' or as 'drive:/PATH/TO/MODULES'
+
+call CreateObject("SOAP.Lite") _
+ .server("SOAP::Transport::HTTP::Daemon", _
+ "LocalAddr", "localhost", _
+ "LocalPort", 80) _
+ .dispatch_to("/Your/Path/To/Deployed/Modules") _
+ .options(CreateObject("SOAP.Lite").hash("compress_threshold", 10000)) _
+ .handle
Added: packages/soap-lite/branches/upstream/current/examples/server/soap_perl.asp
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/server/soap_perl.asp 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/server/soap_perl.asp 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,14 @@
+<%@Language=PerlScript%>
+<%
+ # -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+ # SOAP server. requires SOAP.Lite COM object (regsvr32 Lite.dll)
+ # Path to Perl modules can be specified as '/PATH/TO/MODULES'
+
+ $Response->{ContentType} = "text/xml";
+ $Response->Write($Server->CreateObject("SOAP.Lite")
+ -> server("SOAP::Server")
+ -> dispatch_to("/Your/Path/To/Deployed/Modules")
+ -> handle($Request->BinaryRead($Request->{TotalBytes}))
+ );
+%>
Added: packages/soap-lite/branches/upstream/current/examples/soapmark.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/soapmark.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/soapmark.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,57 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use Benchmark;
+use SOAP::Lite on_fault => sub {my($soap, $res) = @_; die ref $res ? $res->faultdetail : $soap->transport->status, "\n"};
+use My::Examples;
+
+my %dests = (
+ local => ['local://localhost/cgi-bin/soap.cgi' => 'http://www.soaplite.com/My/Examples'],
+ mod_perl => ['http://localhost/soap/' => 'http://www.soaplite.com/My/Examples'],
+ CGI => ['http://localhost/cgi-bin/soap.cgi' => 'http://www.soaplite.com/My/Examples'],
+ daemon => ['http://localhost:81/' => 'http://www.soaplite.com/My/Examples'],
+ 'Apache::Registry' => ['http://localhost/mod_perl/soap.mod_cgi' => 'http://www.soaplite.com/My/Examples'],
+ tcpip => ['tcp://localhost:82' => 'http://www.soaplite.com/My/Examples'],
+ direct => ['' => 'My::Examples'],
+);
+
+my $s;
+
+my %tests = (
+ simple => sub {$s->getStateName(1)},
+ array => sub {$s->getStateName((1) x 100)},
+ string => sub {$s->getStateName(1 x 100)},
+);
+
+my $testnum = 3;
+my $testtime = 5;
+my %result;
+
+print STDERR <<DISCLAIMER;
+
+This test should be used only for comparison different Perl server
+implementations running in your environment.
+
+DISCLAIMER
+
+print STDERR "All tests may take up to ", keys(%dests) * keys(%tests) * $testnum * $testtime, " sec\n";
+
+foreach my $dest (keys %dests) {
+ my($proxy, $uri) = @{$dests{$dest}};
+ $s = $proxy ? SOAP::Lite->proxy($proxy)->uri($uri) : $uri;
+ foreach my $test (keys %tests) {
+ printf STDERR "%s [%s] ", $dest, $test;
+ eval {$tests{$test}->()}; warn('skipped, ', $@), next if $@;
+ my($tps) = 0;
+ for (1..$testnum) {
+ my $r = Benchmark::countit($testtime => $tests{$test});
+ my($pu, $ps, $n) = @{$r}[1,2,5];
+ $tps += $n / ($pu + $ps);
+ print STDERR ".";
+ }
+ printf STDERR " %.5s call/s\n", $result{$dest}{$test} = $tps / $testnum;
+ }
+}
Added: packages/soap-lite/branches/upstream/current/examples/soapsmtp.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/soapsmtp.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/soapsmtp.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,21 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+SOAP::Lite
+ -> uri('http://www.soaplite.com/My/Examples')
+ -> proxy('mailto:destination.email at address', smtp => 'smtp.server', From => 'your.email', Subject => 'SOAP message')
+
+ # or
+ # -> proxy('mailto:destination.email at address?From=your.email&Subject=SOAP%20message', smtp => 'smtp.server')
+
+ # or if you want to send with sendmail
+ # -> proxy('mailto:destination.email at address?From=your.email&Subject=SOAP%20message')
+
+ # or if your sendmail is in undiscoverable place
+ # -> proxy('mailto:destination.email at address?From=your.email&Subject=SOAP%20message', sendmail => 'command to run your sendmail')
+
+ -> getStateName(12);
Added: packages/soap-lite/branches/upstream/current/examples/tcpclient.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/tcpclient.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/tcpclient.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,17 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite +autodispatch =>
+ uri => 'http://www.soaplite.com/My/Examples',
+ proxy => 'tcp://localhost:82', # local tcp server
+ on_fault => sub { my($soap, $res) = @_;
+ die ref $res ? $res->faultdetail : $soap->transport->status, "\n";
+ }
+;
+
+print getStateName(1), "\n\n";
+print getStateNames(12,24,26,13), "\n\n";
+print getStateList([11,12,13,42])->[0], "\n\n";
+print getStateStruct({item1 => 10, item2 => 4})->{item2}, "\n\n";
Added: packages/soap-lite/branches/upstream/current/examples/terraserver.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/terraserver.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/terraserver.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,47 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# example for Microsoft's TerraServer http://terraserver.microsoft.net/
+# thanks to Ivan R. Judson <judson at mcs.anl.gov> for his help
+
+use SOAP::Lite;
+
+# terraserver doesn't like charset in content-type
+$SOAP::Constants::DO_NOT_USE_CHARSET = 1;
+
+my $terra = SOAP::Lite
+ ->proxy('http://terraserver.microsoft.net/TerraService.asmx')
+ ->on_action(sub { join '/', 'http://terraservice.net/terraserver', $_[1] })
+ ->uri('http://tempuri.org/')
+;
+
+my $response = $terra->GetTheme(SOAP::Data->name(theme => 'Photo'));
+
+if ($response->fault) {
+ die $response->faultstring;
+} else {
+ my %result = %{$response->result};
+ print map("$_: @{[$result{$_} || '']}\n", keys %result), "\n";
+}
+
+my $method = SOAP::Data->name('GetPlaceList')
+ ->attr({xmlns => 'http://tempuri.org/'});
+
+my @params = (
+ SOAP::Data->name(placeName => 'Chicago'),
+ SOAP::Data->name(MaxItems => 10),
+ SOAP::Data->name(imagePresence => 'true')
+);
+
+$response = $terra->call($method => @params);
+
+if ($response->fault) {
+ print $response->faultcode, " ", $response->faultstring, "\n";
+} else {
+ foreach ($response->valueof('//PlaceFacts')) {
+ my %result = %{$_->{Place}};
+ print map("$_: $result{$_}\n", keys %result), "\n";
+ }
+}
Added: packages/soap-lite/branches/upstream/current/examples/weblog.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/examples/weblog.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/examples/weblog.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,17 @@
+#!perl -w
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+# example for Weblogs SOAP interface (http://www.soapware.org/weblogsCom)
+
+use SOAP::Lite;
+
+my $weblogs = SOAP::Lite
+ -> proxy("http://rpc.weblogs.com/weblogUpdates")
+ -> on_action(sub{'"/weblogUpdates"'});
+
+print $weblogs->ping(
+ SOAP::Data->name(weblogname=>'Scripting News'),
+ SOAP::Data->name(weblogurl=>'http://www.scripting.com/'),
+)->result->{message};
Added: packages/soap-lite/branches/upstream/current/lib/Apache/SOAP.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/Apache/SOAP.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/Apache/SOAP.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,132 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: SOAP.pm,v 1.2 2004/11/14 19:30:49 byrnereese Exp $
+#
+# ======================================================================
+
+package Apache::SOAP;
+
+use strict;
+use vars qw(@ISA $VERSION);
+use SOAP::Transport::HTTP;
+
+ at ISA = qw(SOAP::Transport::HTTP::Apache);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+my $server = __PACKAGE__->new;
+
+sub handler {
+ $server->configure(@_);
+ $server->SUPER::handler(@_);
+}
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+Apache::SOAP - mod_perl-based SOAP server with minimum configuration
+
+=head1 SYNOPSIS
+
+=over 4
+
+=item httpd.conf (Location), directory-based access
+
+ <Location /mod_soap>
+ SetHandler perl-script
+ PerlHandler Apache::SOAP
+ PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
+ PerlSetVar options "compress_threshold => 10000"
+ </Location>
+
+=item httpd.conf (Files), file-based access
+
+ <FilesMatch "\.soap$">
+ SetHandler perl-script
+ PerlHandler Apache::SOAP
+ PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
+ PerlSetVar options "compress_threshold => 10000"
+ </FilesMatch>
+
+=item .htaccess, directory-based access
+
+ SetHandler perl-script
+ PerlHandler Apache::SOAP
+ PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
+ PerlSetVar options "compress_threshold => 10000"
+
+=back
+
+=head1 DESCRIPTION
+
+This Apache Perl module provides the ability to add support for SOAP (Simple
+Object Access Protocol) protocol with easy configuration (either in .conf or
+in .htaccess file). This functionality should give you lightweight option
+for hosting SOAP services and greatly simplify configuration aspects. This
+module inherites functionality from SOAP::Transport::HTTP::Apache component
+of SOAP::Lite module.
+
+=head1 CONFIGURATION
+
+The module can be placed in <Location>, <Directory>, <Files>, <FilesMatch>
+directives in main server configuration areas or directly in .htaccess file.
+
+All parameters should be quoted and can be separated with commas or spaces
+for lists ("a, b, c") and with 'wide arrows' and commas for hash parameters
+("key1 => value1, key2 => value2").
+
+All options that you can find in SOAP::Transport::HTTP::Apache component
+are available for configuration. Here is the description of most important
+ones.
+
+=over 4
+
+=item dispatch_to (LIST)
+
+Specifies path to directory that contains Perl modules you'd like to give
+access to, or just list of modules (for preloaded modules).
+
+ PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
+
+=item options (HASH)
+
+Specifies list of options for your module, for example threshold for
+compression. Future versions will support more options. See
+SOAP::Transport::HTTP documentation for other options.
+
+ PerlSetVar options "compress_threshold => 10000"
+
+=back
+
+=head1 DEPENDENCIES
+
+ SOAP::Lite
+ mod_perl
+
+=head1 SEE ALSO
+
+ SOAP::Transport::HTTP::Apache for implementation details,
+ SOAP::Lite for general information, and
+ F<examples/server/mod_soap.htaccess> for .htaccess example
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/Apache/XMLRPC/Lite.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/Apache/XMLRPC/Lite.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/Apache/XMLRPC/Lite.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,132 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Lite.pm,v 1.2 2004/11/14 19:30:49 byrnereese Exp $
+#
+# ======================================================================
+
+package Apache::XMLRPC::Lite;
+
+use strict;
+use vars qw(@ISA $VERSION);
+use XMLRPC::Transport::HTTP;
+
+ at ISA = qw(XMLRPC::Transport::HTTP::Apache);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $XMLRPC::Lite::VERSION;
+
+my $server = __PACKAGE__->new;
+
+sub handler {
+ $server->configure(@_);
+ $server->SUPER::handler(@_);
+}
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+Apache::XMLRPC::Lite - mod_perl-based XML-RPC server with minimum configuration
+
+=head1 SYNOPSIS
+
+=over 4
+
+=item httpd.conf (Location), directory-based access
+
+ <Location /mod_xmlrpc>
+ SetHandler perl-script
+ PerlHandler Apache::XMLRPC::Lite
+ PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
+ PerlSetVar options "compress_threshold => 10000"
+ </Location>
+
+=item httpd.conf (Files), file-based access
+
+ <FilesMatch "\.xmlrpc$">
+ SetHandler perl-script
+ PerlHandler Apache::XMLRPC::Lite
+ PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
+ PerlSetVar options "compress_threshold => 10000"
+ </FilesMatch>
+
+=item .htaccess, directory-based access
+
+ SetHandler perl-script
+ PerlHandler Apache::XMLRPC::Lite
+ PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
+ PerlSetVar options "compress_threshold => 10000"
+
+=back
+
+=head1 DESCRIPTION
+
+This Apache Perl module provides the ability to add support for XML-RPC
+protocol with easy configuration (either in .conf or in .htaccess file).
+This functionality should give you lightweight option
+for hosting SOAP services and greatly simplify configuration aspects. This
+module inherites functionality from XMLRPC::Transport::HTTP::Apache component
+of XMLRPC::Lite module.
+
+=head1 CONFIGURATION
+
+The module can be placed in <Location>, <Directory>, <Files>, <FilesMatch>
+directives in main server configuration areas or directly in .htaccess file.
+
+All parameters should be quoted and can be separated with commas or spaces
+for lists ("a, b, c") and with 'wide arrows' and commas for hash parameters
+("key1 => value1, key2 => value2").
+
+All options that you can find in XMLRPC::Transport::HTTP::Apache component
+are available for configuration. Here is the description of most important
+ones.
+
+=over 4
+
+=item dispatch_to (LIST)
+
+Specifies path to directory that contains Perl modules you'd like to give
+access to, or just list of modules (for preloaded modules).
+
+ PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
+
+=item options (HASH)
+
+Specifies list of options for your module, for example threshold for
+compression. Future versions will support more options. See
+XMLRPC::Transport::HTTP documentation for other options.
+
+ PerlSetVar options "compress_threshold => 10000"
+
+=back
+
+=head1 DEPENDENCIES
+
+ XMLRPC::Lite
+ mod_perl
+
+=head1 SEE ALSO
+
+ XMLRPC::Transport::HTTP::Apache for implementation details,
+ XMLRPC::Lite for general information, and
+ F<examples/server/mod_xmlrpc.htaccess> for .htaccess example
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/IO/SessionData.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/IO/SessionData.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/IO/SessionData.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,201 @@
+# ======================================================================
+#
+# Copyright (C) 2000 Lincoln D. Stein
+# Slightly modified by Paul Kulchenko to work on multiple platforms
+#
+# ======================================================================
+
+package IO::SessionData;
+
+use strict;
+use Carp;
+use IO::SessionSet;
+use vars '$VERSION';
+$VERSION = 1.02;
+
+use constant BUFSIZE => 3000;
+
+BEGIN {
+ my @names = qw(EWOULDBLOCK EAGAIN EINPROGRESS);
+ my %WOULDBLOCK =
+ (eval {require Errno} ? map {Errno->can($_)->() => 1} grep {Errno->can($_)} @names : ()),
+ (eval {require POSIX} ? map {POSIX->can($_)->() => 1} grep {POSIX->can($_)} @names : ());
+
+ sub WOULDBLOCK { $WOULDBLOCK{$_[0]+0} }
+}
+
+# Class method: new()
+# Create a new IO::SessionData object. Intended to be called from within
+# IO::SessionSet, not directly.
+sub new {
+ my $pack = shift;
+ my ($sset,$handle,$writeonly) = @_;
+ # make the handle nonblocking (but check for 'blocking' method first)
+ # thanks to Jos Clijmans <jos.clijmans at recyfin.be>
+ $handle->blocking(0) if $handle->can('blocking');
+ my $self = bless {
+ outbuffer => '',
+ sset => $sset,
+ handle => $handle,
+ write_limit => BUFSIZE,
+ writeonly => $writeonly,
+ choker => undef,
+ choked => 0,
+ },$pack;
+ $self->readable(1) unless $writeonly;
+ return $self;
+}
+
+# Object method: handle()
+# Return the IO::Handle object corresponding to this IO::SessionData
+sub handle { return shift->{handle} }
+
+# Object method: sessions()
+# Return the IO::SessionSet controlling this object.
+sub sessions { return shift->{sset} }
+
+# Object method: pending()
+# returns number of bytes pending in the out buffer
+sub pending { return length shift->{outbuffer} }
+
+# Object method: write_limit([$bufsize])
+# Get or set the limit on the size of the write buffer.
+# Write buffer will grow to this size plus whatever extra you write to it.
+sub write_limit {
+ my $self = shift;
+ return defined $_[0] ? $self->{write_limit} = $_[0]
+ : $self->{write_limit};
+}
+
+# set a callback to be called when the contents of the write buffer becomes larger
+# than the set limit.
+sub set_choke {
+ my $self = shift;
+ return defined $_[0] ? $self->{choker} = $_[0]
+ : $self->{choker};
+}
+
+# Object method: write($scalar)
+# $obj->write([$data]) -- append data to buffer and try to write to handle
+# Returns number of bytes written, or 0E0 (zero but true) if data queued but not
+# written. On other errors, returns undef.
+sub write {
+ my $self = shift;
+ return unless my $handle = $self->handle; # no handle
+ return unless defined $self->{outbuffer}; # no buffer for queued data
+
+ $self->{outbuffer} .= $_[0] if defined $_[0];
+
+ my $rc;
+ if ($self->pending) { # data in the out buffer to write
+ local $SIG{PIPE}='IGNORE';
+ # added length() to make it work on Mac. Thanks to Robin Fuller <rfuller at broadjump.com>
+ $rc = syswrite($handle,$self->{outbuffer},length($self->{outbuffer}));
+
+ # able to write, so truncate out buffer apropriately
+ if ($rc) {
+ substr($self->{outbuffer},0,$rc) = '';
+ } elsif (WOULDBLOCK($!)) { # this is OK
+ $rc = '0E0';
+ } else { # some sort of write error, such as a PIPE error
+ return $self->bail_out($!);
+ }
+ } else {
+ $rc = '0E0'; # nothing to do, but no error either
+ }
+
+ $self->adjust_state;
+
+ # Result code is the number of bytes successfully transmitted
+ return $rc;
+}
+
+# Object method: read($scalar,$length [,$offset])
+# Just like sysread(), but returns the number of bytes read on success,
+# 0EO ("0 but true") if the read would block, and undef on EOF and other failures.
+sub read {
+ my $self = shift;
+ return unless my $handle = $self->handle;
+ my $rc = sysread($handle,$_[0],$_[1],$_[2]||0);
+ return $rc if defined $rc;
+ return '0E0' if WOULDBLOCK($!);
+ return;
+}
+
+# Object method: close()
+# Close the session and remove it from the monitored list.
+sub close {
+ my $self = shift;
+ unless ($self->pending) {
+ $self->sessions->delete($self);
+ CORE::close($self->handle);
+ } else {
+ $self->readable(0);
+ $self->{closing}++; # delayed close
+ }
+}
+
+# Object method: adjust_state()
+# Called periodically from within write() to control the
+# status of the handle on the IO::SessionSet's IO::Select sets
+sub adjust_state {
+ my $self = shift;
+
+ # make writable if there's anything in the out buffer
+ $self->writable($self->pending > 0);
+
+ # make readable if there's no write limit, or the amount in the out
+ # buffer is less than the write limit.
+ $self->choke($self->write_limit <= $self->pending) if $self->write_limit;
+
+ # Try to close down the session if it is flagged
+ # as in the closing state.
+ $self->close if $self->{closing};
+}
+
+# choke gets called when the contents of the write buffer are larger
+# than the limit. The default action is to inactivate the session for further
+# reading until the situation is cleared.
+sub choke {
+ my $self = shift;
+ my $do_choke = shift;
+ return if $self->{choked} == $do_choke; # no change in state
+ if (ref $self->set_choke eq 'CODE') {
+ $self->set_choke->($self,$do_choke);
+ } else {
+ $self->readable(!$do_choke);
+ }
+ $self->{choked} = $do_choke;
+}
+
+# Object method: readable($flag)
+# Flag the associated IO::SessionSet that we want to do reading on the handle.
+sub readable {
+ my $self = shift;
+ my $is_active = shift;
+ return if $self->{writeonly};
+ $self->sessions->activate($self,'read',$is_active);
+}
+
+# Object method: writable($flag)
+# Flag the associated IO::SessionSet that we want to do writing on the handle.
+sub writable {
+ my $self = shift;
+ my $is_active = shift;
+ $self->sessions->activate($self,'write',$is_active);
+}
+
+# Object method: bail_out([$errcode])
+# Called when an error is encountered during writing (such as a PIPE).
+# Default behavior is to flush all buffered outgoing data and to close
+# the handle.
+sub bail_out {
+ my $self = shift;
+ my $errcode = shift; # save errorno
+ delete $self->{outbuffer}; # drop buffered data
+ $self->close;
+ $! = $errcode; # restore errno
+ return;
+}
+
+1;
Added: packages/soap-lite/branches/upstream/current/lib/IO/SessionSet.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/IO/SessionSet.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/IO/SessionSet.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,159 @@
+# ======================================================================
+#
+# Copyright (C) 2000 Lincoln D. Stein
+#
+# ======================================================================
+
+package IO::SessionSet;
+
+use strict;
+use Carp;
+use IO::Select;
+use IO::Handle;
+use IO::SessionData;
+
+use vars '$DEBUG';
+$DEBUG = 0;
+
+# Class method new()
+# Create a new Session set.
+# If passed a listening socket, use that to
+# accept new IO::SessionData objects automatically.
+sub new {
+ my $pack = shift;
+ my $listen = shift;
+ my $self = bless {
+ sessions => {},
+ readers => IO::Select->new(),
+ writers => IO::Select->new(),
+ },$pack;
+ # if initialized with an IO::Handle object (or subclass)
+ # then we treat it as a listening socket.
+ if ( defined($listen) and $listen->can('accept') ) {
+ $self->{listen_socket} = $listen;
+ $self->{readers}->add($listen);
+ }
+ return $self;
+}
+
+# Object method: sessions()
+# Return list of all the sessions currently in the set.
+sub sessions { return values %{shift->{sessions}} };
+
+# Object method: add()
+# Add a handle to the session set. Will automatically
+# create a IO::SessionData wrapper around the handle.
+sub add {
+ my $self = shift;
+ my ($handle,$writeonly) = @_;
+ warn "Adding a new session for $handle.\n" if $DEBUG;
+ return $self->{sessions}{$handle} =
+ $self->SessionDataClass->new($self,$handle,$writeonly);
+}
+
+# Object method: delete()
+# Remove a session from the session set. May pass either a handle or
+# a corresponding IO::SessionData wrapper.
+sub delete {
+ my $self = shift;
+ my $thing = shift;
+ my $handle = $self->to_handle($thing);
+ my $sess = $self->to_session($thing);
+ warn "Deleting session $sess handle $handle.\n" if $DEBUG;
+ delete $self->{sessions}{$handle};
+ $self->{readers}->remove($handle);
+ $self->{writers}->remove($handle);
+}
+
+# Object method: to_handle()
+# Return a handle, given either a handle or a IO::SessionData object.
+sub to_handle {
+ my $self = shift;
+ my $thing = shift;
+ return $thing->handle if $thing->isa('IO::SessionData');
+ return $thing if defined (fileno $thing);
+ return; # undefined value
+}
+
+# Object method: to_session
+# Return a IO::SessionData object, given either a handle or the object itself.
+sub to_session {
+ my $self = shift;
+ my $thing = shift;
+ return $thing if $thing->isa('IO::SessionData');
+ return $self->{sessions}{$thing} if defined (fileno $thing);
+ return; # undefined value
+}
+
+# Object method: activate()
+# Called with parameters ($session,'read'|'write' [,$activate])
+# If called without the $activate argument, will return true
+# if the indicated handle is on the read or write IO::Select set.
+# May use either a session object or a handle as first argument.
+sub activate {
+ my $self = shift;
+ my ($thing,$rw,$act) = @_;
+ croak 'Usage $obj->activate($session,"read"|"write" [,$activate])'
+ unless @_ >= 2;
+ my $handle = $self->to_handle($thing);
+ my $select = lc($rw) eq 'read' ? 'readers' : 'writers';
+ my $prior = defined $self->{$select}->exists($handle);
+ if (defined $act && $act != $prior) {
+ $self->{$select}->add($handle) if $act;
+ $self->{$select}->remove($handle) unless $act;
+ warn $act ? 'Activating' : 'Inactivating',
+ " handle $handle for ",
+ $rw eq 'read' ? 'reading':'writing',".\n" if $DEBUG;
+ }
+ return $prior;
+}
+
+# Object method: wait()
+# Wait for I/O. Handles writes automatically. Returns a list of
+# IO::SessionData objects ready for reading.
+# If there is a listen socket, then will automatically do an accept()
+# and return a new IO::SessionData object for that.
+use Data::Dumper;
+sub wait {
+ my $self = shift;
+ my $timeout = shift;
+
+ # Call select() to get the list of sessions that are ready for
+ # reading/writing.
+ warn "IO::Select->select() returned error: $!"
+ unless my ($read,$write) =
+ IO::Select->select($self->{readers},$self->{writers},undef,$timeout);
+
+ # handle queued writes automatically
+ foreach (@$write) {
+ my $session = $self->to_session($_);
+ warn "Writing pending data (",$session->pending+0," bytes) for $_.\n"
+ if $DEBUG;
+ my $rc = $session->write;
+ }
+
+ # Return list of sessions that are ready for reading.
+ # If one of the ready handles is the listen socket, then
+ # create a new session.
+ # Otherwise return the ready handles as a list of IO::SessionData objects.
+ my @sessions;
+ foreach (@$read) {
+ if ($_ eq $self->{listen_socket}) {
+ my $newhandle = $_->accept;
+ warn "Accepting a new handle $newhandle.\n" if $DEBUG;
+ my $newsess = $self->add($newhandle) if $newhandle;
+ push @sessions,$newsess;
+ } else {
+ push @sessions,$self->to_session($_);
+ }
+ }
+ return @sessions;
+}
+
+# Class method: SessionDataClass
+# Return the string containing the name of the session data
+# wrapper class. Subclass and override to use a different
+# session data class.
+sub SessionDataClass { return 'IO::SessionData'; }
+
+1;
Added: packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Lite.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Lite.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Lite.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,2193 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2003 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Lite.pm,v 1.1 2004/10/16 17:45:17 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Lite - Client and server side SOAP implementation
+
+=head1 SYNOPSIS
+
+ use SOAP::Lite;
+ print SOAP::Lite
+ -> uri('http://www.soaplite.com/Temperatures')
+ -> proxy('http://services.soaplite.com/temper.cgi')
+ -> f2c(32)
+ -> result;
+
+The same code with autodispatch:
+
+ use SOAP::Lite +autodispatch =>
+ uri => 'http://www.soaplite.com/Temperatures',
+ proxy => 'http://services.soaplite.com/temper.cgi';
+
+ print f2c(32);
+
+Code in OO-style:
+
+ use SOAP::Lite +autodispatch =>
+ uri => 'http://www.soaplite.com/Temperatures',
+ proxy => 'http://services.soaplite.com/temper.cgi';
+
+ my $temperatures = Temperatures->new(32); # get object
+ print $temperatures->as_celsius; # invoke method
+
+Code with service description:
+
+ use SOAP::Lite;
+ print SOAP::Lite
+ -> service('http://www.xmethods.net/sd/StockQuoteService.wsdl')
+ -> getQuote('MSFT');
+
+Code for SOAP server (CGI):
+
+ use SOAP::Transport::HTTP;
+ SOAP::Transport::HTTP::CGI
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ -> handle;
+
+Visual Basic client (through COM interface):
+
+ MsgBox CreateObject("SOAP.Lite").new( _
+ "proxy", "http://services.xmethods.net/soap", _
+ "uri", "urn:xmethods-delayed-quotes" _
+ ).getQuote("MSFT").result
+
+mod_soap enabled SOAP server:
+
+ .htaccess
+
+ SetHandler perl-script
+ PerlHandler Apache::SOAP
+ PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name"
+
+ASP/VB SOAP server:
+
+ <%
+ Response.ContentType = "text/xml"
+ Response.Write(Server.CreateObject("SOAP.Lite") _
+ .server("SOAP::Server") _
+ .dispatch_to("/Your/Path/To/Deployed/Modules") _
+ .handle(Request.BinaryRead(Request.TotalBytes)) _
+ )
+ %>
+
+=head1 DESCRIPTION
+
+SOAP::Lite is a collection of Perl modules which provides a
+simple and lightweight interface to the Simple Object Access Protocol
+(SOAP) both on client and server side.
+
+This version of SOAP::Lite supports the SOAP 1.1 specification ( http://www.w3.org/TR/SOAP ).
+
+The main features of the library are:
+
+=over 3
+
+=item *
+
+Supports SOAP 1.1 spec.
+
+=item *
+
+Interoperability tests with different implementations: Apache SOAP, Apache Axis, Frontier, Microsoft SOAP, Microsoft .NET, DevelopMentor, XMethods, 4s4c, Phalanx, PocketSOAP, Kafka, SQLData, Lucin (in Java, Perl, C++, Python, VB, COM, XSLT).
+
+=item *
+
+Provides COM interface. Single dll (standalone [2.5MB] or minimal [32kB]).
+Works on Windows 9x/Me/NT/2K. Doesn't require ROPE or MSXML.
+Examples in VB, Excel/VBA, C#, ASP, JavaScript, PerlScript and Perl.
+
+=item *
+
+Provides transparent compression support for HTTP transport.
+
+=item *
+
+Provides mod_soap module. Make SOAP server with a few lines in .htaccess
+or .conf file.
+
+=item *
+
+Includes XML::Parser::Lite (regexp-based XML parser) which runs instead
+of XML::Parser where Perl 5.6 runs (even on WinCE) with some limitations.
+
+=item *
+
+Includes XMLRPC::Lite, implementation of XML-RPC protocol on client and
+server side. All transports and features of SOAP::Lite are available.
+
+=item *
+
+Supports multipart/form-data MIME attachments.
+
+=item *
+
+Supports circular linked lists and multiple references.
+
+=item *
+
+Supports Map datatype (encoding of maps/hashes with arbitrary keys).
+
+=item *
+
+Supports HTTPS protocol.
+
+=item *
+
+Provides proxy support.
+
+=item *
+
+Provides CGI/daemon/mod_perl/Apache::Registry server implementations.
+
+=item *
+
+Provides TCP server implementation.
+
+=item *
+
+Provides IO (STDIN/STDOUT/File) server implementation.
+
+=item *
+
+Provides FTP client implementation.
+
+=item *
+
+Supports single/multipart MIME attachment (parsing side only).
+
+=item *
+
+Supports SMTP protocol.
+
+=item *
+
+Provides POP3 server implementation.
+
+=item *
+
+Supports M-POST and redirects in HTTP transport.
+
+=item *
+
+Supports Basic/Digest server authentication.
+
+=item *
+
+Works with CGI accelerators, like VelociGen and PerlEx.
+
+=item *
+
+Supports UDDI interface on client side. See UDDI::Lite for details.
+
+=item *
+
+Supports UDDI publishing API. Examples and documentation provided.
+
+=item *
+
+Supports WSDL schema with stub and run-time access.
+
+=item *
+
+Supports blessed object references.
+
+=item *
+
+Supports arrays (both serialization and deserialization with autotyping).
+
+=item *
+
+Supports custom serialization.
+
+=item *
+
+Provides exception transport with custom exceptions
+
+=item *
+
+Supports Base64 encoding.
+
+=item *
+
+Supports XML entity encoding.
+
+=item *
+
+Supports header attributes.
+
+=item *
+
+Supports dynamic and static class/method binding.
+
+=item *
+
+Supports objects-by-reference with simple garbage collection and activation.
+
+=item *
+
+Provides shell for interactive SOAP sessions.
+
+=item *
+
+Supports out parameters binding.
+
+=item *
+
+Supports transparent SOAP calls with autodispatch feature.
+
+=item *
+
+Provides easy services deployment. Put module in specified directory and
+it'll be accessible.
+
+=item *
+
+Has tests, examples and documentation to let you be up and running in no time.
+
+=back
+
+=head2 WHERE TO FIND EXAMPLES
+
+See F<t/*.t>, F<examples/*.pl> and the module documentation for a client-side
+examples that demonstrate the serialization of a SOAP request, sending it
+via HTTP to the server and receiving the response, and the deserialization
+of the response. See F<examples/server/*> for server-side implementations.
+
+=head1 OVERVIEW OF CLASSES AND PACKAGES
+
+This table should give you a quick overview of the classes provided by the
+library.
+
+ SOAP::Lite.pm
+ -- SOAP::Lite -- Main class provides all logic
+ -- SOAP::Transport -- Supports transport architecture
+ -- SOAP::Data -- Provides extensions for serialization architecture
+ -- SOAP::Header -- Provides extensions for header serialization
+ -- SOAP::Parser -- Parses XML file into object tree
+ -- SOAP::Serializer -- Serializes data structures to SOAP package
+ -- SOAP::Deserializer -- Deserializes results of SOAP::Parser into objects
+ -- SOAP::SOM -- Provides access to deserialized object tree
+ -- SOAP::Constants -- Provides access to common constants
+ -- SOAP::Trace -- Provides tracing facilities
+ -- SOAP::Schema -- Provides access and stub(s) for schema(s)
+ -- SOAP::Schema::WSDL -- WSDL implementation for SOAP::Schema
+ -- SOAP::Server -- Handles requests on server side
+ -- SOAP::Server::Object -- Handles objects-by-reference
+ -- SOAP::Fault -- Provides support for Faults on server side
+ -- SOAP::Utils -- A set of private and public utility subroutines
+
+ SOAP::Transport::HTTP.pm
+ -- SOAP::Transport::HTTP::Client -- Client interface to HTTP transport
+ -- SOAP::Transport::HTTP::Server -- Server interface to HTTP transport
+ -- SOAP::Transport::HTTP::CGI -- CGI implementation of server interface
+ -- SOAP::Transport::HTTP::Daemon -- Daemon implementation of server interface
+ -- SOAP::Transport::HTTP::Apache -- mod_perl implementation of server interface
+
+ SOAP::Transport::POP3.pm
+ -- SOAP::Transport::POP3::Server -- Server interface to POP3 protocol
+
+ SOAP::Transport::MAILTO.pm
+ -- SOAP::Transport::MAILTO::Client -- Client interface to SMTP/sendmail
+
+ SOAP::Transport::LOCAL.pm
+ -- SOAP::Transport::LOCAL::Client -- Client interface to local transport
+
+ SOAP::Transport::TCP.pm
+ -- SOAP::Transport::TCP::Server -- Server interface to TCP protocol
+ -- SOAP::Transport::TCP::Client -- Client interface to TCP protocol
+
+ SOAP::Transport::IO.pm
+ -- SOAP::Transport::IO::Server -- Server interface to IO transport
+
+=head2 SOAP::Lite
+
+All methods that C<SOAP::Lite> provides can be used for both
+setting and retrieving values. If you provide no parameters, you will
+get current value, and if parameters are provided, a new value
+will be assigned to the object and the method in question will return
+the current object (if not stated otherwise). This is suitable for stacking
+these calls like:
+
+ $lite = SOAP::Lite
+ -> uri('http://simon.fell.com/calc')
+ -> proxy('http://soap.4s4c.com/ssss4c/soap.asp')
+ ;
+
+The order is insignificant and you may call the new() method first. If you
+don't do it, SOAP::Lite will do it for you. However, the new() method
+gives you an additional syntax:
+
+ $lite = new SOAP::Lite
+ uri => 'http://simon.fell.com/calc',
+ proxy => 'http://soap.4s4c.com/ssss4c/soap.asp'
+ ;
+
+=over 4
+
+=item new()
+
+new() accepts a hash with method names as keys. It will call the
+appropriate methods together with the passed values. Since new() is
+optional it won't be mentioned anymore.
+
+=item transport()
+
+Provides access to the L</"SOAP::Transport"> object. The object will be created
+for you. You can reassign it (but generally you should not).
+
+=item serializer()
+
+Provides access to the L</"SOAP::Serializer"> object. The object will be
+created for you. You can reassign it (but generally you should not).
+
+=item proxy()
+
+Shortcut for C<< transport->proxy() >>. This lets you specify an endpoint
+(service address) and also loads the required module at the same time. It is
+required for dispatching SOAP calls. The name of the module will be defined
+depending on the protocol specific for the endpoint. The prefix
+C<SOAP::Transport> will be prepended, the module will be loaded and object of
+class (with appended C<::Client>) will be created.
+
+For example, for F<http://localhost/>, the class for creating objects will
+look for C<SOAP::Transport:HTTP::Client>;
+
+In addition to endpoint parameter, proxy() can accept any transport specific
+parameters that could be passed as name => value pairs. For example, to
+specify proxy settings for HTTP protocol you may do:
+
+ $soap->proxy('http://endpoint.server/',
+ proxy => ['http' => 'http://my.proxy.server/']);
+
+Notice that since proxy (second one) expects to get more than one
+parameter you should wrap them in array.
+
+Another useful example can be the client that is sensitive to cookie-based
+authentication. You can provide this with:
+
+ $soap->proxy('http://localhost/',
+ cookie_jar => HTTP::Cookies->new(ignore_discard => 1));
+
+You may specify timeout for HTTP transport with following code:
+
+ $soap->proxy('http://localhost/', timeout => 5);
+
+=item endpoint()
+
+Lets you specify an endpoint B<without> changing/loading the protocol module.
+This is useful for switching endpoints without switching protocols. You should
+call C<proxy()> first. No checks for protocol equivalence will be made.
+
+=item outputxml()
+
+Lets you specify the kind of output from all method calls. If C<true>, all
+methods will return unprocessed, raw XML code. You can parse it with
+XML::Parser, SOAP::Deserializer or any other appropriate module.
+
+=item autotype()
+
+Shortcut for C<< serializer->autotype() >>. This lets you specify whether
+the serializer will try to make autotyping for you or not. Default setting
+is C<true>.
+
+=item readable()
+
+Shortcut for C<< serializer->readable() >>. This lets you specify the format
+for the generated XML code. Carriage returns <CR> and indentation will be
+added for readability. Useful in the case you want to see the generated code
+in a debugger. By default, there are no additional characters in generated
+XML code.
+
+=item use_prefix()
+
+Shortcut for C<< serializer->use_prefix() >>. This lets you turn on/off the
+use of a namespace prefix for the children of the /Envelope/Body element.
+Default is 'true'. (This was introduced in 0.61 for better .NET compatibility)
+
+When use_prefix is set to 'true', serialized XML will look like this:
+
+ <SOAP-ENV:Envelope ...attributes skipped>
+ <SOAP-ENV:Body>
+ <namesp1:mymethod xmlns:namesp1="urn:MyURI" />
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+When use_prefix is set to 'true', serialized XML will look like this:
+
+ <SOAP-ENV:Envelope ...attributes skipped>
+ <SOAP-ENV:Body>
+ <mymethod xmlns="urn:MyURI" />
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+=item namespace()
+
+Shortcut for C<< serializer->namespace() >>. This lets you specify the default
+namespace for generated envelopes (C<'SOAP-ENV'> by default).
+
+=item encodingspace()
+
+Shortcut for C<< serializer->encodingspace() >>. This lets you specify the
+default encoding namespace for generated envelopes (C<'SOAP-ENC'> by default).
+
+=item encoding()
+
+Shortcut for C<< serializer->encoding() >>. This lets you specify the encoding
+for generated envelopes. It does not actually change envelope
+encoding, it will just modify the XML declaration (C<'UTF-8'> by default).
+Use C<undef> value to B<not> generate XML declaration.
+
+=item typelookup()
+
+Shortcut for C<< serializer->typelookup() >>. This gives you access to
+the C<typelookup> table that is used for autotyping. For more information
+see L</"SOAP::Serializer">.
+
+=item uri()
+
+Shortcut for C<< serializer->uri() >>. This lets you specify the uri for SOAP
+methods. Nothing is specified by default and your call will definitely fail
+if you don't specify the required uri.
+
+B<WARNING>: URIs are just identifiers. They may B<look like URLs>, but they are
+not guaranteed to point to anywhere and shouldn't be used as such pointers.
+URIs assume to be unique within the space of all XML documents, so consider
+them as unique identifiers and nothing else.
+
+=item multirefinplace()
+
+Shortcut for C<< serializer->multirefinplace() >>. If true, the serializer will
+put values for multireferences in the first occurrence of the reference.
+Otherwise it will be encoded as top independent element, right after C<method>
+element inside C<Body>. Default value is C<false>.
+
+=item header()
+
+B<DEPRECATED>: Use SOAP::Header instead.
+
+Shortcut for C<< serializer->header() >>. This lets you specify the header for
+generated envelopes. You can specify C<root>, C<mustUnderstand> or any
+other header using L</"SOAP::Data"> class:
+
+ $serializer = SOAP::Serializer->envelope('method' => 'mymethod', 1,
+ SOAP::Header->name(t1 => 5)->mustUnderstand(1),
+ SOAP::Header->name(t2 => 7)->mustUnderstand(2),
+ );
+
+will be serialized into:
+
+ <SOAP-ENV:Envelope ...attributes skipped>
+ <SOAP-ENV:Header>
+ <t1 xsi:type="xsd:int" SOAP-ENV:mustUnderstand="1">5</t1>
+ <t2 xsi:type="xsd:int" SOAP-ENV:mustUnderstand="1">7</t2>
+ </SOAP-ENV:Header>
+ <SOAP-ENV:Body>
+ <namesp1:mymethod xmlns:namesp1="urn:SOAP__Serializer">
+ <c-gensym6 xsi:type="xsd:int">1</c-gensym6>
+ </namesp1:mymethod>
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+You can mix C<SOAP::Header> parameters with other parameters and you can also
+return C<SOAP::Header> parameters as a result of a remote call. They will be
+placed into the header. See C<My::Parameters::addheader> as an example.
+
+=item on_action()
+
+This lets you specify a handler for C<on_action event>. It is triggered when
+creating SOAPAction. The default handler will set SOAPAction to
+C<"uri#method">. You can change this behavior globally
+(see L</"DEFAULT SETTINGS">) or locally, for a particular object.
+
+=item on_fault()
+
+This lets you specify a handler for C<on_fault> event. The default behavior is
+to B<die> on an transport error and to B<do nothing> on other error conditions. You
+may change this behavior globally (see L</"DEFAULT SETTINGS">) or locally, for a
+particular object.
+
+=item on_debug()
+
+This lets you specify a handler for C<on_debug event>. Default behavior is to
+do nothing. Use C<+trace/+debug> option for SOAP::Lite instead. If you use if
+be warned that since this method is just interface to C<+trace/+debug> it has
+B<global> effect, so if you install it for one object it'll be in effect for
+all subsequent calls (even for other objects).
+
+See also: L<SOAP::Trace>;
+
+=item on_nonserialized()
+
+This lets you specify a handler for C<on_nonserialized event>. The default
+behavior is to produce a warning if warnings are on for everything that cannot
+be properly serialized (like CODE references or GLOBs).
+
+=item call()
+
+Provides alternative interface for remote method calls. You can always
+run C<< SOAP::Lite->new(...)->method(@parameters) >>, but call() gives
+you several additional options:
+
+=over
+
+=item prefixed method
+
+If you want to specify prefix for generated method's element one of the
+available options is do it with call() interface:
+
+ print SOAP::Lite
+ -> new(....)
+ -> call('myprefix:method' => @parameters)
+ -> result;
+
+This example will work on client side only. If you want to change prefix
+on server side you should override default serializer. See
+F<examples/server/soap.*> for examples.
+
+=item access to any method
+
+If for some reason you want to get access to remote procedures that have
+the same name as methods of SOAP::Lite object these calls (obviously) won't
+be dispatched. In that case you can originate your call trough call():
+
+ print SOAP::Lite
+ -> new(....)
+ -> call(new => @parameters)
+ -> result;
+
+=item implementation of OO interface
+
+With L<autodispatch|/"AUTODISPATCHING AND SOAP:: PREFIX"> you can make CLASS/OBJECT calls like:
+
+ my $obj = CLASS->new(@parameters);
+ print $obj->method;
+
+However, because of side effects L<autodispatch|/"AUTODISPATCHING AND SOAP:: PREFIX">
+has, it's not always possible to use this syntax. call() provides you with
+alternative:
+
+ # you should specify uri()
+ my $soap = SOAP::Lite
+ -> uri('http://my.own.site/CLASS') # <<< CLASS goes here
+ # ..... other parameters
+ ;
+
+ my $obj = $soap->call(new => @parameters)->result;
+ print $soap->call(method => $obj)->result;
+ # $obj object will be updated here if necessary,
+ # as if you call $obj->method() and method() updates $obj
+
+ # Update of modified object MAY not work if server on another side
+ # is not SOAP::Lite
+
+=item ability to set method's attributes
+
+Additionally this syntax lets you specify attributes for method element:
+
+ print SOAP::Lite
+ -> new(....)
+ -> call(SOAP::Data->name('method')->attr({xmlns => 'mynamespace'})
+ => @parameters)
+ -> result;
+
+You can specify B<any> attibutes and C<name> of C<SOAP::Data> element becomes
+name of method. Everything else except attributes is ignored and parameters
+should be provided as usual.
+
+Be warned, that though you have more control using this method, you B<should>
+specify namespace attribute for method explicitely, even if you made uri()
+call earlier. So, if you have to have namespace on method element, instead of:
+
+ print SOAP::Lite
+ -> new(....)
+ -> uri('mynamespace') # will be ignored
+ -> call(SOAP::Data->name('method') => @parameters)
+ -> result;
+
+do
+
+ print SOAP::Lite
+ -> new(....)
+ -> call(SOAP::Data->name('method')->attr({xmlns => 'mynamespace'})
+ => @parameters)
+ -> result;
+
+because in the former call uri() will be ignored and namespace won't be
+specified. If you run script with C<-w> option (as recommended) SOAP::Lite
+gives you a warning:
+
+ URI is not provided as attribute for method (method)
+
+Moreover, it'll become fatal error if you try to call it with prefixed name:
+
+ print SOAP::Lite
+ -> new(....)
+ -> uri('mynamespace') # will be ignored
+ -> call(SOAP::Data->name('a:method') => @parameters)
+ -> result;
+
+gives you:
+
+ Can't find namespace for method (a:method)
+
+because nothing is associated with prefix C<'a'>.
+
+=back
+
+One more comment. One case when SOAP::Lite will change something that
+you specified is when you specified prefixed name and empty namespace name:
+
+ print SOAP::Lite
+ -> new(....)
+ -> uri('')
+ -> call('a:method' => @parameters)
+ -> result;
+
+This code will generate:
+
+ <method xmlns="">....</method>
+
+instead of
+
+ <a:method xmlns:a="">....</method>
+
+because later is not allowed according to XML Namespace specification.
+
+In all other aspects C<< ->call(mymethod => @parameters) >> is just a
+synonim for C<< ->mymethod(@parameters) >>.
+
+=item self()
+
+Returns object reference to B<global> defaul object specified with
+C<use SOAP::Lite ...> interface. Both class method and object method return
+reference to B<global> object, so:
+
+ use SOAP::Lite
+ proxy => 'http://my.global.server'
+ ;
+
+ my $soap = SOAP::Lite->proxy('http://my.local.server');
+
+ print $soap->self->proxy;
+
+prints C<'http://my.global.server'> (the same as C<< SOAP::Lite->self->proxy >>).
+See L</"DEFAULT SETTINGS"> for more information.
+
+=item dispatch_from()
+
+Does exactly the same as L<autodispatch|/"AUTODISPATCHING AND SOAP:: PREFIX">
+does, but doesn't install UNIVERSAL::AUTOLOAD handler and only install
+AUTOLOAD handlers in specified classes. Can be used only with C<use SOAP::Lite ...>
+clause and should be specified first:
+
+ use SOAP::Lite
+ dispatch_from => ['A', 'B'], # use "dispatch_from => 'A'" for one class
+ uri => ....,
+ proxy => ....,
+ ;
+
+ A->a;
+ B->b;
+
+=back
+
+=head2 SOAP::Header
+
+The SOAP::Header class is a subclass of the L</"SOAP::Data"> class. It is used
+in the same way as a SOAP::Data object, however SOAP::Lite will serialize
+objects of this type into the SOAP Envelope's Header block.
+
+=head2 SOAP::Data
+
+You can use this class if you want to specify a value, a name, atype, a uri or
+attributes for SOAP elements (use C<value()>, C<name()>, C<type()>,
+C<uri()> and C<attr()> methods correspondingly).
+For example, C<< SOAP::Data->name('abc')->value(123) >> will be serialized
+into C<< <abc>123</abc> >>, as well as will C<< SOAP::Data->name(abc => 123) >>.
+Each of them (except the value() method) can accept a value as the second
+parameter. All methods return the current value if you call them without
+parameters. The return the object otherwise, so you can stack them. See tests
+for more examples. You can import these methods with:
+
+ SOAP::Data->import('name');
+
+or
+
+ import SOAP::Data 'name';
+
+and then use C<< name(abc => 123) >> for brevity.
+
+An interface for specific attributes is also provided. You can use the C<actor()>,
+C<mustUnderstand()>, C<encodingStyle()> and C<root()> methods to set/get
+values of the correspondent attributes.
+
+ SOAP::Data
+ ->name(c => 3)
+ ->encodingStyle('http://xml.apache.org/xml-soap/literalxml')
+
+will be serialized into:
+
+ <c SOAP-ENV:encodingStyle="http://xml.apache.org/xml-soap/literalxml"
+ xsi:type="xsd:int">3</c>
+
+=head2 SOAP::Serializer
+
+Usually you don't need to interact directly with this module. The only
+case when you need it, it when using autotyping. This feature lets you specify
+types for your data according to your needs as well as to introduce new
+data types (like ordered hash for example).
+
+You can specify a type with C<< SOAP::Data->type(float => 123) >>. During
+the serialization stage the module will try to serialize your data with the
+C<as_float> method. It then calls the C<typecast> method (you can override it
+or inherit your own class from L</"SOAP::Data">) and only then it will try to
+serialize it according to data type (C<SCALAR>, C<ARRAY> or C<HASH>). For example:
+
+ SOAP::Data->type('ordered_hash' => [a => 1, b => 2])
+
+will be serialized as an ordered hash, using the C<as_ordered_hash> method.
+
+If you do not specify a type directly, the serialization module will try
+to autodefine the type for you according to the C<typelookup> hash. It contains
+the type name as key and the following 3-element array as value:
+
+ priority,
+ check_function (CODE reference),
+ typecast function (METHOD name or CODE reference)
+
+For example, if you want to add C<uriReference> to autodefined types,
+you should add something like this:
+
+ $s->typelookup->{uriReference} =
+ [11, sub { $_[0] =~ m!^http://! }, 'as_uriReference'];
+
+and add the C<as_uriReference> method to the L</"SOAP::Serializer"> class:
+
+ sub SOAP::Serializer::as_uriReference {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'xsi:type' => 'xsd:uriReference', %$attr}, $value];
+ }
+
+The specified methods will work for both autotyping and direct typing, so you
+can use either
+
+ SOAP::Data->type(uriReference => 'http://yahoo.com')>
+
+or just
+
+ 'http://yahoo.com'
+
+and it will be serialized into the same type. For more examples see C<as_*>
+methods in L</"SOAP::Serializer">.
+
+The SOAP::Serializer provides you with C<autotype()>, C<readable()>, C<namespace()>,
+C<encodingspace()>, C<encoding()>, C<typelookup()>, C<uri()>, C<multirefinplace()> and
+C<envelope()> methods. All methods (except C<envelope()>) are described in the
+L</"SOAP::Lite"> section.
+
+=over 4
+
+=item envelope()
+
+This method allows you to build three kind of envelopes depending on the first
+parameter:
+
+=over 4
+
+=item method
+
+ envelope(method => 'methodname', @parameters);
+
+or
+
+ method('methodname', @parameters);
+
+Lets you build a request/response envelope.
+
+=item fault
+
+ envelope(fault => 'faultcode', 'faultstring', $details);
+
+or
+
+ fault('faultcode', 'faultstring', $details);
+
+Lets you build a fault envelope. Faultcode will be properly qualified and
+details could be string or object.
+
+=item freeform
+
+ envelope(freeform => 'something that I want to serialize');
+
+or
+
+ freeform('something that I want to serialize');
+
+Reserved for nonRPC calls. Lets you build your own payload inside a SOAP
+envelope. All SOAP 1.1 specification rules are enforced, except method
+specific ones. See UDDI::Lite as example.
+
+=item register_ns
+
+The register_ns subroutine allows users to register a global namespace
+with the SOAP Envelope. The first parameter is the namespace, the second
+parameter to this subroutine is an optional prefix. If a prefix is not
+provided, one will be generated automatically for you. All namespaces
+registered with the serializer get declared in the <soap:Envelope />
+element.
+
+=item find_prefix
+
+The find_prefix subroutine takes a namespace as a parameter and returns
+the assigned prefix to that namespace. This eliminates the need to declare
+and redeclare namespaces within an envelope. This subroutine is especially
+helpful in determining the proper prefix when assigning a type to a
+SOAP::Data element. A good example of how this might be used is as follows:
+
+SOAP::Data->name("foo" => $inputParams{'foo'})
+ ->type($client->serializer->find_prefix('urn:Foo').':Foo');
+
+=item xmlschema
+
+The xmlschema subroutine tells SOAP::Lite what XML Schema to use when
+serializing XML element values. There are two supported schemas of
+SOAP::Lite, they are:
+
+ http://www.w3.org/1999/XMLSchema, and
+ http://www.w3.org/2001/XMLSchema (default)
+
+=back
+
+=back
+
+For more examples see tests and SOAP::Transport::HTTP.pm
+
+=head2 SOAP::SOM
+
+All calls you are making through object oriented interface will
+return SOAP::SOM object, and you can access actual values with it.
+Next example gives you brief overview of the class:
+
+ my $soap = SOAP::Lite .....;
+ my $som = $soap->method(@parameters);
+
+ if ($som->fault) { # will be defined if Fault element is in the message
+ print $som->faultdetail; # returns value of 'detail' element as
+ # string or object
+ $som->faultcode; #
+ $som->faultstring; # also available
+ $som->faultactor; #
+ } else {
+ $som->result; # gives you access to result of call
+ # it could be any data structure, for example reference
+ # to array if server didi something like: return [1,2];
+
+ $som->paramsout; # gives you access to out parameters if any
+ # for example, you'll get array (1,2) if
+ # server returns ([1,2], 1, 2);
+ # [1,2] will be returned as $som->result
+ # and $som->paramsall will return ([1,2], 1, 2)
+ # see section IN/OUT, OUT PARAMETERS AND AUTOBINDING
+ # for more information
+
+ $som->paramsall; # gives access to result AND out parameters (if any)
+ # and returns them as one array
+
+ $som->valueof('//myelement'); # returns value(s) (as perl data) of
+ # 'myelement' if any. All elements in array
+ # context and only first one in scalar
+
+ $h = $som->headerof('//myheader'); # returns element as SOAP::Header, so
+ # you can access attributes and values
+ # with $h->mustUnderstand, $h->actor
+ # or $h->attr (for all attributes)
+ }
+
+SOAP::SOM object gives you access to the deserialized envelope via several
+methods. All methods accept a node path (similar to XPath notations).
+SOM interprets '/' as the root node, '//' as relative location path
+('//Body' will find all bodies in document, as well as
+'/Envelope//nums' will find all 'nums' nodes under Envelope node),
+'[num]' as node number and '[op num]' with C<op> being a comparison
+operator ('<', '>', '<=', '>=', '!', '=').
+
+All nodes in nodeset will be returned in document order.
+
+=over 4
+
+=item match()
+
+Accepts a path to a node and returns true/false in a boolean context and
+a SOM object otherwise. C<valueof()> and C<dataof()> can be used to get
+value(s) of matched node(s).
+
+=item valueof()
+
+Returns the value of a (previously) matched node. It accepts a node path.
+In this case, it returns the value of matched node, but does not change the current
+node. Suitable when you want to match a node and then navigate through
+node children:
+
+ $som->match('/Envelope/Body/[1]'); # match method
+ $som->valueof('[1]'); # result
+ $som->valueof('[2]'); # first out parameter (if present)
+
+The returned value depends on the context. In a scalar context it will return
+the first element from matched nodeset. In an array context it will return
+all matched elements.
+
+=item dataof()
+
+Same as C<valueof()>, but it returns a L</"SOAP::Data"> object, so you can get
+access to the name, the type and attributes of an element.
+
+=item headerof()
+
+Same as C<dataof()>, but it returns L</"SOAP::Header"> object, so you can get
+access to the name, the type and attributes of an element. Can be used for
+modifying headers (if you want to see updated header inside Header element,
+it's better to use this method instead of C<dataof()> method).
+
+=item namespaceuriof()
+
+Returns the uri associated with the matched element. This uri can also be
+inherited, for example, if you have
+
+ <a xmlns='http://my.namespace'>
+ <b>
+ value
+ </b>
+ </a>
+
+this method will return same value for 'b' element as for 'a'.
+
+=back
+
+SOAP::SOM also provides methods for direct access to the envelope, the body,
+methods and parameters (both in and out). All these methods return real
+values (in most cases it will be a hash reference), if called as object
+method. Returned values also depend on context: in an array context it will
+return an array of values and in scalar context it will return the first
+element. So, if you want to access the first output parameter, you can call
+C<< $param = $som->paramsout >>;
+and you will get it regardless of the actual number of output parameters.
+If you call it as class function (for example, SOAP::SOM::method)
+it returns an XPath string that matches the current element
+('/Envelope/Body/[1]' in case of 'method'). The method will return C<undef>
+if not present OR if you try to access an undefined element. To distinguish
+between these two cases you can first access the C<match()> method that
+will return true/false in a boolean context and then get the real value:
+
+ if ($som->match('//myparameter')) {
+ $value = $som->valueof; # can be undef too
+ } else {
+ # doesn't exist
+ }
+
+=over 4
+
+=item root()
+
+Returns the value (as hash) of the root element. Do exactly the same as
+C<< $som->valueof('/') >> does.
+
+=item envelope()
+
+Returns the value (as hash) of the C<Envelope> element. Keys in this hash will be
+'Header' (if present), 'Body' and any other (optional) elements. Values will
+be the deserialized header, body, and elements, respectively.
+If called as function (C<SOAP::SOM::envelope>) it will return a Xpath string
+that matches the envelope content. Useful when you want just match it and
+then iterate over the content by yourself. Example:
+
+ if ($som->match(SOAP::SOM::envelope)) {
+ $som->valueof('Header'); # should give access to header if present
+ $som->valueof('Body'); # should give access to body
+ } else {
+ # hm, are we doing SOAP or what?
+ }
+
+=item header()
+
+Returns the value (as hash) of the C<Header> element. If you want to access all
+attributes in the header use:
+
+ # get element as SOAP::Data object
+ $transaction = $som->match(join '/', SOAP::SOM::header, 'transaction')->dataof;
+ # then you can access all attributes of 'transaction' element
+ $transaction->attr;
+
+=item headers()
+
+Returns a node set of values with deserialized headers. The difference between
+the C<header()> and C<headers()> methods is that the first gives you access
+to the whole header and second to the headers inside the 'Header' tag:
+
+ $som->headerof(join '/', SOAP::SOM::header, '[1]');
+ # gives you first header as SOAP::Header object
+
+ ($som->headers)[0];
+ # gives you value of the first header, same as
+ $som->valueof(join '/', SOAP::SOM::header, '[1]');
+
+ $som->header->{name_of_your_header_here}
+ # gives you value of name_of_your_header_here
+
+=item body()
+
+Returns the value (as hash) of the C<Body> element.
+
+=item fault()
+
+Returns the value (as hash) of C<Fault> element: C<faultcode>, C<faultstring> and
+C<detail>. If C<Fault> element is present, C<result()>, C<paramsin()>,
+C<paramsout()> and C<method()> will return an undef.
+
+=item faultcode()
+
+Returns the value of the C<faultcode> element if present and undef otherwise.
+
+=item faultstring()
+
+Returns the value of the C<faultstring> element if present and undef otherwise.
+
+=item faultactor()
+
+Returns the value of the C<faultactor> element if present and undef otherwise.
+
+=item faultdetail()
+
+Returns the value of the C<detail> element if present and undef otherwise.
+
+=item method()
+
+Returns the value of the method element (all input parameters if you call it on
+a deserialized request envelope, and result/output parameters if you call it
+on a deserialized response envelope). Returns undef if the 'Fault' element is
+present.
+
+=item result()
+
+Returns the value of the C<result> of the method call. In fact, it will return
+the first child element (in document order) of the method element.
+
+=item paramsin()
+
+Returns the value(s) of all passed parameters.
+
+=item paramsout()
+
+Returns value(s) of the output parameters.
+
+=item paramsall()
+
+Returns value(s) of the result AND output parameters as one array.
+
+=item parts()
+
+Return an array of MIME::Entities if the current payload contains attachments, or returns undefined if payload is not MIME multipart.
+
+=item is_multipart()
+
+Returns true if payload is MIME multipart, false otherwise.
+
+=back
+
+=head2 SOAP::Schema
+
+SOAP::Schema gives you ability to load schemas and create stubs according
+to these schemas. Different syntaxes are provided:
+
+=over 4
+
+=item *
+
+ use SOAP::Lite
+ service => 'http://www.xmethods.net/sd/StockQuoteService.wsdl',
+ # service => 'file:/your/local/path/StockQuoteService.wsdl',
+ # service => 'file:./StockQuoteService.wsdl',
+ ;
+ print getQuote('MSFT'), "\n";
+
+=item *
+
+ use SOAP::Lite;
+ print SOAP::Lite
+ -> service('http://www.xmethods.net/sd/StockQuoteService.wsdl')
+ -> getQuote('MSFT'), "\n";
+
+=item *
+
+ use SOAP::Lite;
+ my $service = SOAP::Lite
+ -> service('http://www.xmethods.net/sd/StockQuoteService.wsdl');
+ print $service->getQuote('MSFT'), "\n";
+
+=back
+
+You can create stub with B<stubmaker> script:
+
+ perl stubmaker.pl http://www.xmethods.net/sd/StockQuoteService.wsdl
+
+and you'll be able to access SOAP services in one line:
+
+ perl "-MStockQuoteService qw(:all)" -le "print getQuote('MSFT')"
+
+or dynamically:
+
+ perl "-MSOAP::Lite service=>'file:./quote.wsdl'" -le "print getQuote('MSFT')"
+
+Other supported syntaxes with stub(s) are:
+
+=over 4
+
+=item *
+
+ use StockQuoteService ':all';
+ print getQuote('MSFT'), "\n";
+
+=item *
+
+ use StockQuoteService;
+ print StockQuoteService->getQuote('MSFT'), "\n";
+
+=item *
+
+ use StockQuoteService;
+ my $service = StockQuoteService->new;
+ print $service->getQuote('MSFT'), "\n";
+
+=back
+
+Support for schemas is limited for now. Though module was tested with dozen
+different schemas it won't understand complex objects and will work only
+with WSDL.
+
+=head2 SOAP::Trace
+
+SOAP::Trace provides you with a trace/debug facility for the SOAP::Lite
+library. To activate it you need to specify a list of traceable
+events/parts of SOAP::Lite:
+
+ use SOAP::Lite +trace =>
+ [qw(list of available traces here)];
+
+Available events are:
+
+ transport -- (client) access to request/response for transport layer
+ dispatch -- (server) shows full name of dispatched call
+ result -- (server) result of method call
+ parameters -- (server) parameters for method call
+ headers -- (server) headers of received message
+ objects -- (both) new/DESTROY calls
+ method -- (both) parameters for '->envelope(method =>' call
+ fault -- (both) parameters for '->envelope(fault =>' call
+ freeform -- (both) parameters for '->envelope(freeform =>' call
+ trace -- (both) trace enters into some important functions
+ debug -- (both) details about transport
+
+For example:
+
+ use SOAP::Lite +trace =>
+ [qw(method fault)];
+
+lets you output the parameter values for all your fault/normal envelopes onto STDERR.
+If you want to log it you can either redirect STDERR to some file
+
+ BEGIN { open(STDERR, '>>....'); }
+
+or (preferably) define your own function for a particular event:
+
+ use SOAP::Lite +trace =>
+ [ method => sub {'log messages here'}, fault => \&log_faults ];
+
+You can share the same function for several events:
+
+ use SOAP::Lite +trace =>
+ [method, fault => \&log_methods_and_faults];
+
+Also you can use 'all' to get all available tracing and use '-' in front of an event to disable particular event:
+
+ use SOAP::Lite +trace =>
+ [ all, -transport ]; # to get all logging without transport messages
+
+Finally,
+
+ use SOAP::Lite +trace;
+
+will switch all debugging on.
+
+You can use 'debug' instead of 'trace'. I prefer 'trace', others 'debug'.
+Also C<on_debug> is available for backward compatibility, as in
+
+ use SOAP::Lite;
+
+ my $s = SOAP::Lite
+ -> uri('http://tempuri.org/')
+ -> proxy('http://beta.search.microsoft.com/search/MSComSearchService.asmx')
+ -> on_debug(sub{print at _}) # show you request/response with headers
+ ;
+ print $s->GetVocabulary(SOAP::Data->name(Query => 'something')->uri('http://tempuri.org/'))
+ ->valueof('//FOUND');
+
+or switch it on individually, with
+
+ use SOAP::Lite +trace => debug;
+
+or
+
+ use SOAP::Lite +trace => [debug => sub {'do_what_I_want_here'}];
+
+Compare this with:
+
+ use SOAP::Lite +trace => transport;
+
+which gives you access to B<actual> request/response objects, so you can even
+set/read cookies or do whatever you want there.
+
+The difference between C<debug> and C<transport> is that C<transport> will get
+a HTTP::Request/HTTP::Response object and C<debug> will get a stringified request
+(NOT OBJECT!). It can also be called in other places too.
+
+=head2 SOAP::Transport
+
+Supports the SOAP Transport architecture. All transports must extend this
+class.
+
+=head2 SOAP::Fault
+
+This class gives you access to Fault generated on server side. To make a
+Fault message you might simply die on server side and SOAP processor will
+wrap you message as faultstring element and will transfer Fault on client
+side. But in some cases you need to have more control over this process and
+SOAP::Fault class gives it to you. To use it, simply die with SOAP::Fault
+object as a parameter:
+
+ die SOAP::Fault->faultcode('Server.Custom') # will be qualified
+ ->faultstring('Died in server method')
+ ->faultdetail(bless {code => 1} => 'BadError')
+ ->faultactor('http://www.soaplite.com/custom');
+
+faultdetail() and faultactor() methods are optional and since faultcode and
+faultstring are required to represent fault message SOAP::Lite will use
+default values ('Server' and 'Application error') if not specified.
+
+=head2 SOAP::Utils
+
+This class gives you access to a number of subroutines to assist in data
+formating, encoding, etc. Many of the subroutines are private, and are not
+documented here, but a few are made public. They are:
+
+=over 4
+
+=item format_datetime
+
+ Returns a valid xsd:datetime string given a time object returned by
+ Perl's localtime function. Usage:
+
+ print SOAP::Utils::format_datetime(localtime);
+
+=back
+
+=head2 SOAP::Constants
+
+This class gives you access to number of options that may affect behavior of
+SOAP::Lite objects. They are not true contstants, aren't they?
+
+=over
+
+=item $PATCH_HTTP_KEEPALIVE
+
+SOAP::Lite's HTTP Transport module attempts to provide a simple patch to
+LWP::Protocol to enable HTTP Keep Alive. By default, this patch is turned
+off, if however you would like to turn on the experimental patch change the
+constant like so:
+
+ $SOAP::Constants::PATCH_HTTP_KEEPALIVE = 1;
+
+=item $DO_NOT_USE_XML_PARSER
+
+By default SOAP::Lite tries to load XML::Parser and if it fails, then to
+load XML::Parser::Lite. You may skip the first step and use XML::Parser::Lite
+even if XML::Parser is presented in your system if assign true value like this:
+
+ $SOAP::Constants::DO_NOT_USE_XML_PARSER = 1;
+
+=item $DO_NOT_USE_CHARSET
+
+By default SOAP::Lite specifies charset in content-type. Since not every
+toolkit likes it you have an option to switch it off if you set
+C<$DO_NOT_USE_CHARSET> to true.
+
+=item $DO_NOT_CHECK_CONTENT_TYPE
+
+By default SOAP::Lite verifies that content-type in successful response has
+value 'multipart/related' or 'multipart/form-data' for MIME-encoded messages
+and 'text/xml' for all other ocassions. SOAP::Lite will raise exception for
+all other values. C<$DO_NOT_CHECK_CONTENT_TYPE> when set to true will allow
+you to accept those values as valid.
+
+=back
+
+=head1 FEATURES AND OPTIONS
+
+=head2 DEFAULT SETTINGS
+
+Though this feature looks similar to L<autodispatch|/"AUTODISPATCHING AND SOAP:: PREFIX"> they have (almost)
+nothing in common. It lets you create default object and all objects
+created after that will be cloned from default object and hence get its
+properties. If you want to provide common proxy() or uri() settings for
+all SOAP::Lite objects in your application you may do:
+
+ use SOAP::Lite
+ proxy => 'http://localhost/cgi-bin/soap.cgi',
+ uri => 'http://my.own.com/My/Examples'
+ ;
+
+ my $soap1 = new SOAP::Lite; # will get the same proxy()/uri() as above
+ print $soap1->getStateName(1)->result;
+
+ my $soap2 = SOAP::Lite->new; # same thing as above
+ print $soap2->getStateName(2)->result;
+
+ # or you may override any settings you want
+ my $soap3 = SOAP::Lite->proxy('http://localhost/');
+ print $soap3->getStateName(1)->result;
+
+B<Any> SOAP::Lite properties can be propagated this way. Changes in object
+copies will not affect global settings and you may still change global
+settings with C<< SOAP::Lite->self >> call which returns reference to
+global object. Provided parameter will update this object and you can
+even set it to C<undef>:
+
+ SOAP::Lite->self(undef);
+
+The C<use SOAP::Lite> syntax also lets you specify default event handlers
+for your code. If you have different SOAP objects and want to share the
+same C<on_action()> (or C<on_fault()> for that matter) handler. You can
+specify C<on_action()> during initialization for every object, but
+you may also do:
+
+ use SOAP::Lite
+ on_action => sub {sprintf '%s#%s', @_}
+ ;
+
+and this handler will be the default handler for all your SOAP objects.
+You can override it if you specify a handler for a particular object.
+See F<t/*.t> for example of on_fault() handler.
+
+Be warned, that since C<use ...> is executed at compile time B<all> C<use>
+statements will be executed B<before> script execution that can make
+unexpected results. Consider code:
+
+ use SOAP::Lite proxy => 'http://localhost/';
+
+ print SOAP::Lite->getStateName(1)->result;
+
+ use SOAP::Lite proxy => 'http://localhost/cgi-bin/soap.cgi';
+
+ print SOAP::Lite->getStateName(1)->result;
+
+B<BOTH> SOAP calls will go to C<'http://localhost/cgi-bin/soap.cgi'>. If
+you want to execute C<use> at run-time, put it in C<eval>:
+
+ eval "use SOAP::Lite proxy => 'http://localhost/cgi-bin/soap.cgi'; 1" or die;
+
+or use
+
+ SOAP::Lite->self->proxy('http://localhost/cgi-bin/soap.cgi');
+
+=head2 IN/OUT, OUT PARAMETERS AND AUTOBINDING
+
+SOAP::Lite gives you access to all parameters (both in/out and out) and
+also does some additional work for you. Lets consider following example:
+
+ <mehodResponse>
+ <res1>name1</res1>
+ <res2>name2</res2>
+ <res3>name3</res3>
+ </mehodResponse>
+
+In that case:
+
+ $result = $r->result; # gives you 'name1'
+ $paramout1 = $r->paramsout; # gives you 'name2', because of scalar context
+ $paramout1 = ($r->paramsout)[0]; # gives you 'name2' also
+ $paramout2 = ($r->paramsout)[1]; # gives you 'name3'
+
+or
+
+ @paramsout = $r->paramsout; # gives you ARRAY of out parameters
+ $paramout1 = $paramsout[0]; # gives you 'res2', same as ($r->paramsout)[0]
+ $paramout2 = $paramsout[1]; # gives you 'res3', same as ($r->paramsout)[1]
+
+Generally, if server returns C<return (1,2,3)> you will get C<1> as the result
+and C<2> and C<3> as out parameters.
+
+If the server returns C<return [1,2,3]> you will get an ARRAY from C<result()> and
+C<undef> from C<paramsout()> .
+Results can be arbitrary complex: they can be an array of something, they can
+be objects, they can be anything and still be returned by C<result()> . If only
+one parameter is returned, C<paramsout()> will return C<undef>.
+
+But there is more.
+If you have in your output parameters a parameter with the same
+signature (name+type) as in the input parameters this parameter will be mapped
+into your input automatically. Example:
+
+B<server>:
+
+ sub mymethod {
+ shift; # object/class reference
+ my $param1 = shift;
+ my $param2 = SOAP::Data->name('myparam' => shift() * 2);
+ return $param1, $param2;
+ }
+
+B<client>:
+
+ $a = 10;
+ $b = SOAP::Data->name('myparam' => 12);
+ $result = $soap->mymethod($a, $b);
+
+After that, C<< $result == 10 and $b->value == 24 >>! Magic? Sort of.
+Autobinding gives it to you. That will work with objects also with
+one difference: you do not need to worry about the name and the type of
+object parameter. Consider the C<PingPong> example (F<examples/My/PingPong.pm> and
+F<examples/pingpong.pl>):
+
+B<server>:
+
+ package My::PingPong;
+
+ sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ bless {_num=>shift} => $class;
+ }
+
+ sub next {
+ my $self = shift;
+ $self->{_num}++;
+ }
+
+B<client>:
+
+ use SOAP::Lite +autodispatch =>
+ uri => 'urn:',
+ proxy => 'http://localhost/'
+ ;
+
+ my $p = My::PingPong->new(10); # $p->{_num} is 10 now, real object returned
+ print $p->next, "\n"; # $p->{_num} is 11 now!, object autobinded
+
+=head2 AUTODISPATCHING AND SOAP:: PREFIX
+
+B<WARNING>: C<autodispatch> feature can have side effects for your application
+and can affect functionality of other modules/libraries because of overloading
+UNIVERSAL::AUTOLOAD. All unresolved calls will be dispatched as SOAP calls,
+however it could be not what you want in some cases. If so, consider using
+object interface (see C<implementation of OO interface>).
+
+SOAP::Lite provides an autodispatching feature that lets you create
+code which looks the same for local and remote access.
+
+For example:
+
+ use SOAP::Lite +autodispatch =>
+ uri => 'urn:/My/Examples',
+ proxy => 'http://localhost/'
+ ;
+
+tells SOAP to 'autodispatch' all calls to the 'http://localhost/' endpoint with
+the 'urn:/My/Examples' uri. All consequent method calls can look like:
+
+ print getStateName(1), "\n";
+ print getStateNames(12,24,26,13), "\n";
+ print getStateList([11,12,13,42])->[0], "\n";
+ print getStateStruct({item1 => 10, item2 => 4})->{item2}, "\n";
+
+As you can see, there is no SOAP specific coding at all.
+
+The same logic will work for objects as well:
+
+ print "Session iterator\n";
+ my $p = My::SessionIterator->new(10);
+ print $p->next, "\n";
+ print $p->next, "\n";
+
+This will access the remote My::SessionIterator module, gets an object, and then
+calls remote methods again. The object will be transferred to the server, the
+method is executed there and the result (and the modified object!) will be
+transferred back to the client.
+
+Autodispatch will work B<only> if you do not have the same method in your
+code. For example, if you have C<use My::SessionIterator> somewhere in your
+code of our previous example, all methods will be resolved locally and no
+SOAP calls will be done. If you want to get access to remote objects/methods
+even in that case, use C<SOAP::> prefix to your methods, like:
+
+ print $p->SOAP::next, "\n";
+
+See C<pingpong.pl> for example of a script, that works with the same object
+locally and remotely.
+
+C<SOAP::> prefix also gives you ability to access methods that have the same
+name as methods of SOAP::Lite itself. For example, you want to call method
+new() for your class C<My::PingPong> through OO interface.
+First attempt could be:
+
+ my $s = SOAP::Lite
+ -> uri('http://www.soaplite.com/My/PingPong')
+ -> proxy('http://localhost/cgi-bin/soap.cgi')
+ ;
+ my $obj = $s->new(10);
+
+but it won't work, because SOAP::Lite has method new() itself. To provide
+a hint, you should use C<SOAP::> prefix and call will be dispatched remotely:
+
+ my $obj = $s->SOAP::new(10);
+
+You can mix autodispatch and usual SOAP calls in the same code if
+you need it. Keep in mind, that calls with SOAP:: prefix should always be a
+method call, so if you want to call functions, use C<< SOAP->myfunction() >>
+instead of C<SOAP::myfunction()>.
+
+Be warned though Perl has very flexible syntax some versions will complain
+
+ Bareword "autodispatch" not allowed while "strict subs" in use ...
+
+if you try to put 'autodispatch' and '=>' on separate lines. So, keep them
+on the same line, or put 'autodispatch' in quotes:
+
+ use SOAP::Lite 'autodispatch' # DON'T use plus in this case
+ => ....
+ ;
+
+=head2 ACCESSING HEADERS AND ENVELOPE ON SERVER SIDE
+
+SOAP::Lite gives you direct access to all headers and the whole envelope on
+the server side. Consider the following code from My::Parameters.pm:
+
+ sub byname {
+ my($a, $b, $c) = @{pop->method}{qw(a b c)};
+ return "a=$a, b=$b, c=$c";
+ }
+
+You will get this functionality ONLY if you inherit your class from
+the SOAP::Server::Parameters class. This should keep existing code working and
+provides this feature only when you need it.
+
+Every method on server side will be called as class/object method, so it will
+get an B<object reference> or a B<class name> as the first parameter, then the
+method parameters, and then an envelope as SOAP::SOM object. Shortly:
+
+ $self [, @parameters] , $envelope
+
+If you have a fixed number of parameters, you can do:
+
+ my $self = shift;
+ my($param1, $param2) = @_;
+
+and ignore the envelope. If you need access to the envelope you can do:
+
+ my $envelope = pop;
+
+since the envelope is always the last element in the parameters list.
+The C<byname()> method C<< pop->method >> will return a hash with
+parameter names as hash keys and parameter values as hash values:
+
+ my($a, $b, $c) = @{pop->method}{qw(a b c)};
+
+gives you by-name access to your parameters.
+
+=head2 SERVICE DEPLOYMENT. STATIC AND DYNAMIC
+
+Let us scrutinize the deployment process. When designing your SOAP server you
+can consider two kind of deployment: B<static> and B<dynamic>.
+For both, static and dynamic, you should specify C<MODULE>,
+C<MODULE::method>, C<method> or C<PATH/> when creating C<use>ing the
+SOAP::Lite module. The difference between static and dynamic deployment is
+that in case of 'dynamic', any module which is not present will be loaded on
+demand. See the L</"SECURITY"> section for detailed description.
+
+Example for B<static> deployment:
+
+ use SOAP::Transport::HTTP;
+ use My::Examples; # module is preloaded
+
+ SOAP::Transport::HTTP::CGI
+ # deployed module should be present here or client will get 'access denied'
+ -> dispatch_to('My::Examples')
+ -> handle;
+
+Example for B<dynamic> deployment:
+
+ use SOAP::Transport::HTTP;
+ # name is unknown, module will be loaded on demand
+
+ SOAP::Transport::HTTP::CGI
+ # deployed module should be present here or client will get 'access denied'
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'My::Examples')
+ -> handle;
+
+For static deployment you should specify the MODULE name directly.
+For dynamic deployment you can specify the name either directly (in that
+case it will be C<require>d without any restriction) or indirectly, with a PATH
+In that case, the ONLY path that will be available will be the PATH given
+to the dispatch_to() method). For information how to handle this situation
+see L</"SECURITY"> section.
+
+You should also use static binding when you have several different classes
+in one file and want to make them available for SOAP calls.
+
+B<SUMMARY>:
+
+ dispatch_to(
+ # dynamic dispatch that allows access to ALL modules in specified directory
+ PATH/TO/MODULES
+ # 1. specifies directory
+ # -- AND --
+ # 2. gives access to ALL modules in this directory without limits
+
+ # static dispatch that allows access to ALL methods in particular MODULE
+ MODULE
+ # 1. gives access to particular module (all available methods)
+ # PREREQUISITES:
+ # module should be loaded manually (for example with 'use ...')
+ # -- OR --
+ # you can still specify it in PATH/TO/MODULES
+
+ # static dispatch that allows access to particular method ONLY
+ MODULE::method
+ # same as MODULE, but gives access to ONLY particular method,
+ # so there is not much sense to use both MODULE and MODULE::method
+ # for the same MODULE
+ )
+
+In addition to this SOAP::Lite also supports experimental syntax that
+allows you bind specific URL or SOAPAction to CLASS/MODULE or object:
+
+ dispatch_with({
+ URI => MODULE, # 'http://www.soaplite.com/' => 'My::Class',
+ SOAPAction => MODULE, # 'http://www.soaplite.com/method' => 'Another::Class',
+ URI => object, # 'http://www.soaplite.com/obj' => My::Class->new,
+ })
+
+URI is checked before SOAPAction. You may use both C<dispatch_to()> and
+C<dispatch_with()> syntax and C<dispatch_with()> has more priority, so
+first checked URI, then SOAPAction and only then will be checked
+C<dispatch_to()>. See F<t/03-server.t> for more information and examples.
+
+=head2 SECURITY
+
+Due to security reasons, the current path for perl modules (C<@INC>) will be disabled
+once you have chosen dynamic deployment and specified your own C<PATH/>.
+If you want to access other modules in your included package you have
+several options:
+
+=over 4
+
+=item 1
+
+Switch to static linking:
+
+ use MODULE;
+ $server->dispatch_to('MODULE');
+
+It can be useful also when you want to import something specific
+from the deployed modules:
+
+ use MODULE qw(import_list);
+
+=item 2
+
+Change C<use> to C<require>. The path is unavailable only during
+the initialization part, and it is available again during execution.
+So, if you do C<require> somewhere in your package, it will work.
+
+=item 3
+
+Same thing, but you can do:
+
+ eval 'use MODULE qw(import_list)'; die if $@;
+
+=item 4
+
+Assign a C<@INC> directory in your package and then make C<use>.
+Don't forget to put C<@INC> in C<BEGIN{}> block or it won't work:
+
+ BEGIN { @INC = qw(my_directory); use MODULE }
+
+=back
+
+=head2 COMPRESSION
+
+SOAP::Lite provides you option for enabling compression on wire (for HTTP
+transport only). Both server and client should support this capability,
+but this logic should be absolutely transparent for your application.
+
+Compression can be enabled by specifying threshold for compression on client
+or server side:
+
+=over 4
+
+=item Client
+
+ print SOAP::Lite
+ -> uri('http://localhost/My/Parameters')
+ -> proxy('http://localhost/', options => {compress_threshold => 10000})
+ -> echo(1 x 10000)
+ -> result
+ ;
+
+=item Server
+
+ my $server = SOAP::Transport::HTTP::CGI
+ -> dispatch_to('My::Parameters')
+ -> options({compress_threshold => 10000})
+ -> handle;
+
+=back
+
+For more information see L<COMPRESSION section|SOAP::Transport::HTTP/"COMPRESSION">
+in HTTP transport documentation.
+
+=head2 OBJECTS-BY-REFERENCE
+
+SOAP::Lite implements an experimental (yet functional) support for
+objects-by-reference. You should not see any difference on the client side
+when using this. On the server side you should specify the names of the
+classes you want to be returned by reference (instead of by value) in the
+C<objects_by_reference()> method for your server implementation (see
+soap.pop3, soap.daemon and Apache.pm).
+
+Garbage collection is done on the server side (not earlier than after 600
+seconds of inactivity time), and you can overload the default behavior with
+specific functions for any particular class.
+
+Binding does not have any special syntax and is implemented on server side
+(see the differences between My::SessionIterator and My::PersistentIterator).
+On the client side, objects will have same type/class as before
+(C<< My::SessionIterator->new() >> will return an object of class
+My::SessionIterator). However, this object is just a stub with an object ID
+inside.
+
+=head2 INTEROPERABILITY
+
+=over 4
+
+=item Microsoft's .NET
+
+To use .NET client and SOAP::Lite server
+
+=over 4
+
+=item qualify all elements
+
+use fully qualified names for your return values, e.g.:
+
+ return SOAP::Data->name('myname')
+ ->type('string')
+ ->uri('http://tempuri.org/')
+ ->value($output);
+
+Use namespace that you specify for URI instead of 'http://tempuri.org/'.
+
+In addition see comment about default incoding in .NET Web Services below.
+
+=back
+
+To use SOAP::Lite client and .NET server
+
+=over 4
+
+=item declare proper soapAction (uri/method) in your call
+
+For example, use C<on_action(sub{join '', @_})>.
+
+=item disable charset in content-type
+
+Specify C<$SOAP::Constants::DO_NOT_USE_CHARSET = 1> somewhere in your code
+after C<use SOAP::Lite> if you are getting error:
+
+ Server found request content type to be 'text/xml; charset=utf-8',
+ but expected 'text/xml'
+
+=item qualify all elements
+
+Any of following actions should work:
+
+=over 4
+
+=item use fully qualified name for method parameters
+
+Use C<< SOAP::Data->name(Query => 'biztalk')->uri('http://tempuri.org/') >> instead of
+C<< SOAP::Data->name('Query' => 'biztalk') >>.
+
+Example of SOAPsh call (all parameters should be in one line):
+
+ > perl SOAPsh.pl
+ "http://beta.search.microsoft.com/search/mscomsearchservice.asmx"
+ "http://tempuri.org/"
+ "on_action(sub{join '', @_})"
+ "GetVocabulary(SOAP::Data->name(Query => 'biztalk')->uri('http://tempuri.org/'))"
+
+=item make method in default namespace
+
+instead of
+
+ my @rc = $soap->call(add => @parms)->result;
+ # -- OR --
+ my @rc = $soap->add(@parms)->result;
+
+use
+
+ my $method = SOAP::Data->name('add')
+ ->attr({xmlns => 'http://tempuri.org/'});
+ my @rc = $soap->call($method => @parms)->result;
+
+=item modify .NET server if you are in charge for that
+
+Stefan Pharies <stefanph at microsoft.com>:
+
+SOAP::Lite uses the SOAP encoding (section 5 of the soap 1.1 spec), and
+the default for .NET Web Services is to use a literal encoding. So
+elements in the request are unqualified, but your service expects them to
+be qualified. .Net Web Services has a way for you to change the expected
+message format, which should allow you to get your interop working.
+At the top of your class in the asmx, add this attribute (for Beta 1):
+
+ [SoapService(Style=SoapServiceStyle.RPC)]
+
+Another source said it might be this attribute (for Beta 2):
+
+ [SoapRpcService]
+
+Full Web Service text may look like:
+
+ <%@ WebService Language="C#" Class="Test" %>
+ using System;
+ using System.Web.Services;
+ using System.Xml.Serialization;
+
+ [SoapService(Style=SoapServiceStyle.RPC)]
+ public class Test : WebService {
+ [WebMethod]
+ public int add(int a, int b) {
+ return a + b;
+ }
+ }
+
+Another example from Kirill Gavrylyuk <kirillg at microsoft.com>:
+
+"You can insert [SoapRpcService()] attribute either on your class or on
+operation level".
+
+ <%@ WebService Language=CS class="DataType.StringTest"%>
+
+ namespace DataType {
+
+ using System;
+ using System.Web.Services;
+ using System.Web.Services.Protocols;
+ using System.Web.Services.Description;
+
+ [SoapRpcService()]
+ public class StringTest: WebService {
+ [WebMethod]
+ [SoapRpcMethod()]
+ public string RetString(string x) {
+ return(x);
+ }
+ }
+ }
+
+Example from Yann Christensen <yannc at microsoft.com>:
+
+ using System;
+ using System.Web.Services;
+ using System.Web.Services.Protocols;
+
+ namespace Currency {
+ [WebService(Namespace="http://www.yourdomain.com/example")]
+ [SoapRpcService]
+ public class Exchange {
+ [WebMethod]
+ public double getRate(String country, String country2) {
+ return 122.69;
+ }
+ }
+ }
+
+=back
+
+=back
+
+Thanks to
+ Petr Janata <petr.janata at i.cz>,
+ Stefan Pharies <stefanph at microsoft.com>,
+ Brian Jepson <bjepson at jepstone.net>, and others
+for description and examples.
+
+=back
+
+=head2 TROUBLESHOOTING
+
+=over 4
+
+=item +autodispatch doesn't work in Perl 5.8
+
+There is a bug in Perl 5.8's UNIVERSAL::AUTOLOAD functionality that prevents
+the +autodispatch functionality from working properly. The workaround is to
+use dispatch_from instead. Where you might normally do something like this:
+
+ use Some::Module;
+ use SOAP::Lite +autodispatch =>
+ uri => 'urn:Foo'
+ proxy => 'http://...';
+
+You would do something like this:
+
+ use SOAP::Lite dispatch_from(Some::Module) =>
+ uri => 'urn:Foo'
+ proxy => 'http://...';
+
+=item HTTP transport
+
+See L<TROUBLESHOOTING|SOAP::Transport::HTTP/"TROUBLESHOOTING"> section in
+documentation for HTTP transport.
+
+=item COM interface
+
+=over 4
+
+=item Can't call method "server" on undefined value
+
+Probably you didn't register Lite.dll with 'regsvr32 Lite.dll'
+
+=item Failed to load PerlCtrl runtime
+
+Probably you have two Perl installations in different places and
+ActiveState's Perl isn't the first Perl specified in PATH. Rename the
+directory with another Perl (at least during the DLL's startup) or put
+ActiveState's Perl on the first place in PATH.
+
+=back
+
+=item XML Parsers
+
+=over 4
+
+=item SAX parsers
+
+SAX 2.0 has a known bug in org.xml.sax.helpers.ParserAdapter
+ rejects Namespace prefix used before declaration
+
+(http://www.megginson.com/SAX/index.html).
+
+That means that in some cases SOAP messages created by SOAP::Lite may not
+be parsed properly by SAX2/Java parser, because Envelope
+element contains namespace declarations and attributes that depends on this
+declarations. According to XML specification order of these attributes is
+not significant. SOAP::Lite does NOT have a problem parsing such messages.
+
+Thanks to Steve Alpert (Steve_Alpert at idx.com) for pointing on it.
+
+=back
+
+=back
+
+=head2 PERFORMANCE
+
+=over 4
+
+=item Processing of XML encoded fragments
+
+SOAP::Lite is based on XML::Parser which is basically wrapper around James
+Clark's expat parser. Expat's behavior for parsing XML encoded string can
+affect processing messages that have lot of encoded entities, like XML
+fragments, encoded as strings. Providing low-level details, parser will call
+char() callback for every portion of processed stream, but individually for
+every processed entity or newline. It can lead to lot of calls and additional
+memory manager expenses even for small messages. By contrast, XML messages
+which are encoded as base64, don't have this problem and difference in
+processing time can be significant. For XML encoded string that has about 20
+lines and 30 tags, number of call could be about 100 instead of one for
+the same string encoded as base64.
+
+Since it is parser's feature there is NO fix for this behavior (let me know
+if you find one), especially because you need to parse message you already
+got (and you cannot control content of this message), however, if your are
+in charge for both ends of processing you can switch encoding to base64 on
+sender's side. It will definitely work with SOAP::Lite and it B<may> work with
+other toolkits/implementations also, but obviously I cannot guarantee that.
+
+If you want to encode specific string as base64, just do
+C<< SOAP::Data->type(base64 => $string) >> either on client or on server
+side. If you want change behavior for specific instance of SOAP::Lite, you
+may subclass C<SOAP::Serializer>, override C<as_string()> method that is
+responsible for string encoding (take a look into C<as_base64()>) and
+specify B<new> serializer class for your SOAP::Lite object with:
+
+ my $soap = new SOAP::Lite
+ serializer => My::Serializer->new,
+ ..... other parameters
+
+or on server side:
+
+ my $server = new SOAP::Transport::HTTP::Daemon # or any other server
+ serializer => My::Serializer->new,
+ ..... other parameters
+
+If you want to change this behavior for B<all> instances of SOAP::Lite, just
+substitute C<as_string()> method with C<as_base64()> somewhere in your
+code B<after> C<use SOAP::Lite> and B<before> actual processing/sending:
+
+ *SOAP::Serializer::as_string = \&SOAP::Serializer::as_base64;
+
+Be warned that last two methods will affect B<all> strings and convert them
+into base64 encoded. It doesn't make any difference for SOAP::Lite, but it
+B<may> make a difference for other toolkits.
+
+=back
+
+=head2 WEBHOSTING INSTALLATION
+
+As soon as you have telnet access to the box and XML::Parser is already
+installed there (or you have Perl 5.6 and can use XML::Parser::Lite) you
+may install your own copy of SOAP::Lite even if hosting provider doesn't
+want to do it.
+
+Setup C<PERL5LIB> environment variable. Depending on your shell it may
+look like:
+
+ PERL5LIB=/you/home/directory/lib; export PERL5LIB
+
+C<lib> here is the name of directory where all libraries will be installed
+under your home directory.
+
+Run CPAN module with
+
+ perl -MCPAN -e shell
+
+and run three commands from CPAN shell
+
+ > o conf make_arg -I~/lib
+ > o conf make_install_arg -I~/lib
+ > o conf makepl_arg LIB=~/lib PREFIX=~ INSTALLMAN1DIR=~/man/man1 INSTALLMAN3DIR=~/man/man3
+
+C<LIB> will specify directory where all libraries will reside.
+
+C<PREFIX> will specify prefix for all directories (like F<lib>, F<bin>, F<man>,
+though it doesn't work in all cases for some reason).
+
+C<INSTALLMAN1DIR> and C<INSTALLMAN3DIR> specify directories for manuals
+(if you don't specify them, install will fail because it'll try to setup
+it in default directory and you don't have permissions for that).
+
+Then run:
+
+ > install SOAP::Lite
+
+Now in your scripts you need to specify:
+
+ use lib '/your/home/directory/lib';
+
+somewhere before C<'use SOAP::Lite;'>
+
+=head1 BUGS AND LIMITATIONS
+
+=over 4
+
+=item *
+
+No support for multidimensional, partially transmitted and sparse arrays
+(however arrays of arrays are supported, as well as any other data
+structures, and you can add your own implementation with SOAP::Data).
+
+=item *
+
+Limited support for WSDL schema.
+
+=item *
+
+XML::Parser::Lite relies on Unicode support in Perl and doesn't do
+entity decoding.
+
+=item *
+
+Limited support for mustUnderstand and Actor attributes.
+
+=back
+
+=head1 PLATFORMS
+
+=over 4
+
+=item MacOS
+
+Information about XML::Parser for MacPerl could be found here:
+http://bumppo.net/lists/macperl-modules/1999/07/msg00047.html
+
+Compiled XML::Parser for MacOS could be found here:
+http://www.perl.com/CPAN-local/authors/id/A/AS/ASANDSTRM/XML-Parser-2.27-bin-1-MacOS.tgz
+
+=back
+
+=head1 AVAILABILITY
+
+You can download the latest version SOAP::Lite for Unix or SOAP::Lite for Win32 from the following sources:
+
+* SOAP::Lite Homepage: http://soaplite.com/
+* CPAN: http://search.cpan.org/search?dist=SOAP-Lite
+* Sourceforge: http://sourceforge.net/projects/soaplite/
+
+You are welcome to send e-mail to the maintainers of SOAP::Lite with your
+with your comments, suggestions, bug reports and complaints.
+
+=head1 SEE ALSO
+
+L<SOAP> SOAP/Perl library from Keith Brown ( http://www.develop.com/soap/ ) or
+( http://search.cpan.org/search?dist=SOAP )
+
+=head1 ACKNOWLEDGMENTS
+
+A lot of thanks to
+ Tony Hong <thong at xmethods.net>,
+ Petr Janata <petr.janata at i.cz>,
+ Murray Nesbitt <murray at ActiveState.com>,
+ Robert Barta <rho at bigpond.net.au>,
+ Gisle Aas <gisle at ActiveState.com>,
+ Carl K. Cunningham <cc at roberts.de>,
+ Graham Glass <graham-glass at mindspring.com>,
+ Chris Radcliff <chris at velocigen.com>,
+ Arun Kumar <u_arunkumar at yahoo.com>,
+ and many many others
+
+for providing help, feedback, support, patches and comments.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/FTP.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/FTP.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/FTP.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,30 @@
+__END__
+
+=head1 NAME
+
+SOAP::Transport::FTP - Client side FTP support for SOAP::Lite
+
+=head1 SYNOPSIS
+
+ use SOAP::Lite
+ uri => 'http://my.own.site.com/My/Examples',
+ proxy => 'ftp://login:password@ftp.somewhere.com/relative/path/to/file.xml', # ftp server
+ # proxy => 'ftp://login:password@ftp.somewhere.com//absolute/path/to/file.xml', # ftp server
+ ;
+
+ print getStateName(1);
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/HTTP.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/HTTP.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/HTTP.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,402 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: HTTP.pm,v 1.1 2004/10/16 17:45:17 byrnereese Exp $
+#
+# ======================================================================
+
+__END__
+
+=head1 NAME
+
+SOAP::Transport::HTTP - Server/Client side HTTP support for SOAP::Lite
+
+=head1 SYNOPSIS
+
+=over 4
+
+=item Client
+
+ use SOAP::Lite
+ uri => 'http://my.own.site.com/My/Examples',
+ proxy => 'http://localhost/',
+ # proxy => 'http://localhost/cgi-bin/soap.cgi', # local CGI server
+ # proxy => 'http://localhost/', # local daemon server
+ # proxy => 'http://localhost/soap', # local mod_perl server
+ # proxy => 'https://localhost/soap', # local mod_perl SECURE server
+ # proxy => 'http://login:password@localhost/cgi-bin/soap.cgi', # local CGI server with authentication
+ ;
+
+ print getStateName(1);
+
+=item CGI server
+
+ use SOAP::Transport::HTTP;
+
+ SOAP::Transport::HTTP::CGI
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ -> handle
+ ;
+
+=item Daemon server
+
+ use SOAP::Transport::HTTP;
+
+ # change LocalPort to 81 if you want to test it with soapmark.pl
+
+ my $daemon = SOAP::Transport::HTTP::Daemon
+ -> new (LocalAddr => 'localhost', LocalPort => 80)
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ;
+ print "Contact to SOAP server at ", $daemon->url, "\n";
+ $daemon->handle;
+
+=item Apache mod_perl server
+
+See F<examples/server/Apache.pm> and L</"EXAMPLES"> section for more information.
+
+=item mod_soap server (.htaccess, directory-based access)
+
+ SetHandler perl-script
+ PerlHandler Apache::SOAP
+ PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
+ PerlSetVar options "compress_threshold => 10000"
+
+See L<Apache::SOAP> for more information.
+
+=back
+
+=head1 DESCRIPTION
+
+This class encapsulates all HTTP related logic for a SOAP server,
+independent of what web server it's attached to.
+If you want to use this class you should follow simple guideline
+mentioned above.
+
+Following methods are available:
+
+=over 4
+
+=item on_action()
+
+on_action method lets you specify SOAPAction understanding. It accepts
+reference to subroutine that takes three parameters:
+
+ SOAPAction, method_uri and method_name.
+
+C<SOAPAction> is taken from HTTP header and method_uri and method_name are
+extracted from request's body. Default behavior is match C<SOAPAction> if
+present and ignore it otherwise. You can specify you own, for example
+die if C<SOAPAction> doesn't match with following code:
+
+ $server->on_action(sub {
+ (my $action = shift) =~ s/^("?)(.+)\1$/$2/;
+ die "SOAPAction shall match 'uri#method'\n" if $action ne join '#', @_;
+ });
+
+=item dispatch_to()
+
+dispatch_to lets you specify where you want to dispatch your services
+to. More precisely, you can specify C<PATH>, C<MODULE>, C<method> or
+combination C<MODULE::method>. Example:
+
+ dispatch_to(
+ 'PATH/', # dynamic: load anything from there, any module, any method
+ 'MODULE', # static: any method from this module
+ 'MODULE::method', # static: specified method from this module
+ 'method', # static: specified method from main::
+ );
+
+If you specify C<PATH/> name of module/classes will be taken from uri as
+path component and converted to Perl module name with substitution
+'::' for '/'. Example:
+
+ urn:My/Examples => My::Examples
+ urn://localhost/My/Examples => My::Examples
+ http://localhost/My/Examples => My::Examples
+
+For consistency first '/' in the path will be ignored.
+
+According to this scheme to deploy new class you should put this
+class in one of the specified directories and enjoy its services.
+Easy, eh?
+
+=item handle()
+
+handle method will handle your request. You should provide parameters
+with request() method, call handle() and get it back with response() .
+
+=item request()
+
+request method gives you access to HTTP::Request object which you
+can provide for Server component to handle request.
+
+=item response()
+
+response method gives you access to HTTP::Response object which
+you can access to get results from Server component after request was
+handled.
+
+=back
+
+=head2 PROXY SETTINGS
+
+You can use any proxy setting you use with LWP::UserAgent modules:
+
+ SOAP::Lite->proxy('http://endpoint.server/',
+ proxy => ['http' => 'http://my.proxy.server']);
+
+or
+
+ $soap->transport->proxy('http' => 'http://my.proxy.server');
+
+should specify proxy server for you. And if you use C<HTTP_proxy_user>
+and C<HTTP_proxy_pass> for proxy authorization SOAP::Lite should know
+how to handle it properly.
+
+=head2 COOKIE-BASED AUTHENTICATION
+
+ use HTTP::Cookies;
+
+ my $cookies = HTTP::Cookies->new(ignore_discard => 1);
+ # you may also add 'file' if you want to keep them between sessions
+
+ my $soap = SOAP::Lite->proxy('http://localhost/');
+ $soap->transport->cookie_jar($cookies);
+
+Cookies will be taken from response and provided for request. You may
+always add another cookie (or extract what you need after response)
+with HTTP::Cookies interface.
+
+You may also do it in one line:
+
+ $soap->proxy('http://localhost/',
+ cookie_jar => HTTP::Cookies->new(ignore_discard => 1));
+
+=head2 SSL CERTIFICATE AUTHENTICATION
+
+To get certificate authentication working you need to specify three
+environment variables: C<HTTPS_CERT_FILE>, C<HTTPS_KEY_FILE>, and
+(optionally) C<HTTPS_CERT_PASS>:
+
+ $ENV{HTTPS_CERT_FILE} = 'client-cert.pem';
+ $ENV{HTTPS_KEY_FILE} = 'client-key.pem';
+
+Crypt::SSLeay (which is used for https support) will take care about
+everything else. Other options (like CA peer verification) can be specified
+in a similar way. See Crypt::SSLeay documentation for more details.
+
+Those who would like to use encrypted keys may check
+http://groups.yahoo.com/group/soaplite/message/729 for details.
+
+=head2 COMPRESSION
+
+SOAP::Lite provides you with the option for enabling compression on the
+wire (for HTTP transport only). Both server and client should support
+this capability, but this should be absolutely transparent to your
+application. The Server will respond with an encoded message only if
+the client can accept it (indicated by client sending an Accept-Encoding
+header with 'deflate' or '*' values) and client has fallback logic,
+so if server doesn't understand specified encoding
+(Content-Encoding: deflate) and returns proper error code
+(415 NOT ACCEPTABLE) client will repeat the same request without encoding
+and will store this server in a per-session cache, so all other requests
+will go there without encoding.
+
+Having options on client and server side that let you specify threshold
+for compression you can safely enable this feature on both client and
+server side.
+
+=over 4
+
+=item Client
+
+ print SOAP::Lite
+ -> uri('http://localhost/My/Parameters')
+ -> proxy('http://localhost/', options => {compress_threshold => 10000})
+ -> echo(1 x 10000)
+ -> result
+ ;
+
+=item Server
+
+ my $server = SOAP::Transport::HTTP::CGI
+ -> dispatch_to('My::Parameters')
+ -> options({compress_threshold => 10000})
+ -> handle;
+
+=back
+
+Compression will be enabled on the client side
+B<if> the threshold is specified
+B<and> the size of current message is bigger than the threshold
+B<and> the module Compress::Zlib is available.
+
+The Client will send the header 'Accept-Encoding' with value 'deflate'
+B<if> the threshold is specified
+B<and> the module Compress::Zlib is available.
+
+Server will accept the compressed message if the module Compress::Zlib
+is available, and will respond with the compressed message
+B<only if> the threshold is specified
+B<and> the size of the current message is bigger than the threshold
+B<and> the module Compress::Zlib is available
+B<and> the header 'Accept-Encoding' is presented in the request.
+
+=head1 EXAMPLES
+
+Consider following examples of SOAP servers:
+
+=over 4
+
+=item CGI:
+
+ use SOAP::Transport::HTTP;
+
+ SOAP::Transport::HTTP::CGI
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ -> handle
+ ;
+
+=item daemon:
+
+ use SOAP::Transport::HTTP;
+
+ my $daemon = SOAP::Transport::HTTP::Daemon
+ -> new (LocalAddr => 'localhost', LocalPort => 80)
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ;
+ print "Contact to SOAP server at ", $daemon->url, "\n";
+ $daemon->handle;
+
+=item mod_perl:
+
+httpd.conf:
+
+ <Location /soap>
+ SetHandler perl-script
+ PerlHandler SOAP::Apache
+ </Location>
+
+Apache.pm:
+
+ package SOAP::Apache;
+
+ use SOAP::Transport::HTTP;
+
+ my $server = SOAP::Transport::HTTP::Apache
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method');
+
+ sub handler { $server->handler(@_) }
+
+ 1;
+
+=item Apache::Registry:
+
+httpd.conf:
+
+ Alias /mod_perl/ "/Apache/mod_perl/"
+ <Location /mod_perl>
+ SetHandler perl-script
+ PerlHandler Apache::Registry
+ PerlSendHeader On
+ Options +ExecCGI
+ </Location>
+
+soap.mod_cgi (put it in /Apache/mod_perl/ directory mentioned above)
+
+ use SOAP::Transport::HTTP;
+
+ SOAP::Transport::HTTP::CGI
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ -> handle
+ ;
+
+=back
+
+WARNING: dynamic deployment with Apache::Registry will fail, because
+module will be loaded dynamically only for the first time. After that
+it is already in the memory, that will bypass dynamic deployment and
+produces error about denied access. Specify both PATH/ and MODULE name
+in dispatch_to() and module will be loaded dynamically and then will work
+as under static deployment. See examples/server/soap.mod_cgi for example.
+
+=head1 TROUBLESHOOTING
+
+=over 4
+
+=item Dynamic libraries are not found
+
+If you see in webserver's log file something like this:
+
+Can't load '/usr/local/lib/perl5/site_perl/.../XML/Parser/Expat/Expat.so'
+for module XML::Parser::Expat: dynamic linker: /usr/local/bin/perl:
+ libexpat.so.0 is NEEDED, but object does not exist at
+/usr/local/lib/perl5/.../DynaLoader.pm line 200.
+
+and you are using Apache web server, try to put into your httpd.conf
+
+ <IfModule mod_env.c>
+ PassEnv LD_LIBRARY_PATH
+ </IfModule>
+
+=item Apache is crashing with segfaults (it may looks like "500 unexpected EOF before status line seen" on client side)
+
+If using SOAP::Lite (or XML::Parser::Expat) in combination with mod_perl
+causes random segmentation faults in httpd processes try to configure
+Apache with:
+
+ RULE_EXPAT=no
+
+-- OR (for Apache 1.3.20 and later) --
+
+ ./configure --disable-rule=EXPAT
+
+See http://archive.covalent.net/modperl/2000/04/0185.xml for more
+details and lot of thanks to Robert Barta <rho at bigpond.net.au> for
+explaining this weird behavior.
+
+If it doesn't help, you may also try -Uusemymalloc
+(or something like that) to get perl to use the system's own malloc.
+Thanks to Tim Bunce <Tim.Bunce at pobox.com>.
+
+=item CGI scripts are not running under Microsoft Internet Information Server (IIS)
+
+CGI scripts may not work under IIS unless scripts are .pl, not .cgi.
+
+=back
+
+=head1 DEPENDENCIES
+
+ Crypt::SSLeay for HTTPS/SSL
+ SOAP::Lite, URI for SOAP::Transport::HTTP::Server
+ LWP::UserAgent, URI for SOAP::Transport::HTTP::Client
+ HTTP::Daemon for SOAP::Transport::HTTP::Daemon
+ Apache, Apache::Constants for SOAP::Transport::HTTP::Apache
+
+=head1 SEE ALSO
+
+ See ::CGI, ::Daemon and ::Apache for implementation details.
+ See examples/server/soap.cgi as SOAP::Transport::HTTP::CGI example.
+ See examples/server/soap.daemon as SOAP::Transport::HTTP::Daemon example.
+ See examples/My/Apache.pm as SOAP::Transport::HTTP::Apache example.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/IO.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/IO.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/IO.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,56 @@
+__END__
+
+=head1 NAME
+
+SOAP::Transport::IO - Server side IO support for SOAP::Lite
+
+=head1 SYNOPSIS
+
+ use SOAP::Transport::IO;
+
+ SOAP::Transport::IO::Server
+
+ # you may specify as parameters for new():
+ # -> new( in => 'in_file_name' [, out => 'out_file_name'] )
+ # -> new( in => IN_HANDLE [, out => OUT_HANDLE] )
+ # -> new( in => *IN_HANDLE [, out => *OUT_HANDLE] )
+ # -> new( in => \*IN_HANDLE [, out => \*OUT_HANDLE] )
+
+ # -- OR --
+ # any combinations
+ # -> new( in => *STDIN, out => 'out_file_name' )
+ # -> new( in => 'in_file_name', => \*OUT_HANDLE )
+
+ # -- OR --
+ # use in() and/or out() methods
+ # -> in( *STDIN ) -> out( *STDOUT )
+
+ # -- OR --
+ # use default (when nothing specified):
+ # in => *STDIN, out => *STDOUT
+
+ # don't forget, if you want to accept parameters from command line
+ # \*HANDLER will be understood literally, so this syntax won't work
+ # and server will complain
+
+ -> new(@ARGV)
+
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ -> handle
+ ;
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/JABBER.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/JABBER.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/JABBER.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,61 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: JABBER.pm,v 1.1 2004/10/16 17:45:17 byrnereese Exp $
+#
+# ======================================================================
+
+__END__
+
+=head1 NAME
+
+SOAP::Transport::JABBER - Server/Client side JABBER support for SOAP::Lite
+
+=head1 SYNOPSIS
+
+=over 4
+
+=item Client
+
+ use SOAP::Lite
+ uri => 'http://my.own.site.com/My/Examples',
+ proxy => 'jabber://username:password@jabber.org:5222/soaplite_server@jabber.org/',
+ # proto username passwd server port destination resource (optional)
+ ;
+
+ print getStateName(1);
+
+=item Server
+
+ use SOAP::Transport::JABBER;
+
+ my $server = SOAP::Transport::JABBER::Server
+ -> new('jabber://username:password@jabber.org:5222')
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ;
+
+ print "Contact to SOAP server\n";
+ do { $server->handle } while sleep 10;
+
+=back
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/LOCAL.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/LOCAL.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/LOCAL.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,32 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: LOCAL.pm,v 1.1 2004/10/16 17:45:17 byrnereese Exp $
+#
+# ======================================================================
+
+__END__
+
+=head1 NAME
+
+SOAP::Transport::LOCAL - Client side no-transport support for SOAP::Lite
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/MAILTO.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/MAILTO.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/MAILTO.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,50 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: MAILTO.pm,v 1.1 2004/10/16 17:45:17 byrnereese Exp $
+#
+# ======================================================================
+
+__END__
+
+=head1 NAME
+
+SOAP::Transport::MAILTO - Client side SMTP/sendmail support for SOAP::Lite
+
+=head1 SYNOPSIS
+
+ use SOAP::Lite;
+
+ SOAP::Lite
+ -> uri('http://soaplite.com/My/Examples')
+ -> proxy('mailto:destination.email at address', smtp => 'smtp.server', From => 'your.email', Subject => 'SOAP message')
+
+ # or
+ # -> proxy('mailto:destination.email at address?From=your.email&Subject=SOAP%20message', smtp => 'smtp.server')
+
+ # or if you want to send with sendmail
+ # -> proxy('mailto:destination.email at address?From=your.email&Subject=SOAP%20message')
+
+ # or if your sendmail is in undiscoverable place
+ # -> proxy('mailto:destination.email at address?From=your.email&Subject=SOAP%20message', sendmail => 'command to run your sendmail')
+
+ -> getStateName(12)
+ ;
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/MQ.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/MQ.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/MQ.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,60 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: MQ.pm,v 1.1 2004/10/16 17:45:17 byrnereese Exp $
+#
+# ======================================================================
+
+__END__
+
+=head1 NAME
+
+SOAP::Transport::MQ - Server/Client side MQ support for SOAP::Lite
+
+=head1 SYNOPSIS
+
+=over 4
+
+=item Client
+
+ use SOAP::Lite
+ uri => 'http://my.own.site.com/My/Examples',
+ proxy => 'mq://server:port?Channel=CHAN1;QueueManager=QM_SOAP;RequestQueue=SOAPREQ1;ReplyQueue=SOAPRESP1',
+ ;
+
+ print getStateName(1);
+
+=item Server
+
+ use SOAP::Transport::MQ;
+
+ my $server = SOAP::Transport::MQ::Server
+ ->new('mq://server:port?Channel=CHAN1;QueueManager=QM_SOAP;RequestQueue=SOAPREQ1;ReplyQueue=SOAPRESP1')
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ;
+
+ print "Contact to SOAP server\n";
+ do { $server->handle } while sleep 1;
+
+=back
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/POP3.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/POP3.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/POP3.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,54 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: POP3.pm,v 1.1 2004/10/16 17:45:17 byrnereese Exp $
+#
+# ======================================================================
+
+__END__
+
+=head1 NAME
+
+SOAP::Transport::POP3 - Server side POP3 support for SOAP::Lite
+
+=head1 SYNOPSIS
+
+ use SOAP::Transport::POP3;
+
+ my $server = SOAP::Transport::POP3::Server
+ -> new('pop://pop.mail.server')
+ # if you want to have all in one place
+ # -> new('pop://user:password@pop.mail.server')
+ # or, if you have server that supports MD5 protected passwords
+ # -> new('pop://user:password;AUTH=+APOP@pop.mail.server')
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ;
+ # you don't need to use next line if you specified your password in new()
+ $server->login('user' => 'password') or die "Can't authenticate to POP3 server\n";
+
+ # handle will return number of processed mails
+ # you can organize loop if you want
+ do { $server->handle } while sleep 10;
+
+ # you may also call $server->quit explicitly to purge deleted messages
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/TCP.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/TCP.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/OldDocs/SOAP/Transport/TCP.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,42 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: TCP.pm,v 1.1 2004/10/16 17:45:17 byrnereese Exp $
+#
+# ======================================================================
+
+__END__
+
+=head1 NAME
+
+SOAP::Transport::TCP - Server/Client side TCP support for SOAP::Lite
+
+=head1 SYNOPSIS
+
+ use SOAP::Transport::TCP;
+
+ my $daemon = SOAP::Transport::TCP::Server
+ -> new (LocalAddr => 'localhost', LocalPort => 82, Listen => 5, Reuse => 1)
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ;
+ print "Contact to SOAP server at ", join(':', $daemon->sockhost, $daemon->sockport), "\n";
+ $daemon->handle;
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Client.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Client.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Client.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,77 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+#
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Client.pm,v 1.1 2004/10/12 18:47:55 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Client - exists purely as a superclass for client classes declared by the various SOAP::Lite transport modules.
+
+=head1 DESCRIPTION
+
+The SOAP::Client class exists purely as a superclass for client classes declared by the various SOAP::Lite transport modules. The methods it provides are all simple accessors; they return the current value when called with no arguments or set the attribute value and return the object reference when called with an argument. These attributes include:
+
+=head1 METHODS
+
+=over
+
+=item code, message, status
+
+Stores the response code, message, and status from the most-recent send attempt. For some protocols, such as FTP, the same value is used for all three because of the lack of finer-grained detail (the default is to ensure that all three attributes contain data, even if redundant). Other protocols (such as HTTP) have distinct values in each.
+
+=item endpoint
+
+Identifies the current endpoint to which messages are being sent. This should match the value of the transport method from the L<SOAP::Transport> class, but setting this doesn't propagate to the transport object. It is better to use the transport object (or the shortcut via the SOAP::Lite object itself) when setting this.
+
+=item is_success
+
+The success or failure of the most-recent transmission is noted here as a boolean value.
+
+=item options
+
+The options attribute keeps a hash-table reference of additional options and their values. At present, only one option is used by any of the transport modules:
+
+=over
+
+=item compress_threshold
+
+The value of this option should be a numerical value. If set, and if the Compress::Zlib library is available, messages whose size in bytes exceeds this value will be compressed before sending. Both ends of the conversation must have it enabled.
+
+=back
+
+Other options may be defined using this mechanism. Note that setting the options using this accessor requires a full hash reference be passed. To set just one or a few values, consider retrieving the current reference value and using it to set the key(s).
+
+=back
+
+=head1 SEE ALSO
+
+L<SOAP::Server>
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Constants.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Constants.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Constants.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,64 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+#
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Constants.pm,v 1.1 2004/10/12 18:47:55 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Constants - SOAP::Lite provides several variables to allows programmers and users to modify the behavior of SOAP::Lite in specific ways.
+
+=head1 DESCRIPTION
+
+A number of "constant" values are provided by means of this namespace. The values aren't constants in the strictest sense; the purpose of the values detailed here is to allow the application to change them if it desires to alter the specific behavior governed.
+
+=head1 CONSTANTS
+
+=head2 $DO_NOT_USE_XML_PARSER
+
+The SOAP::Lite package attempts to locate and use the L<XML::Parser> package, falling back on an internal, pure-Perl parser in its absence. This package is a fast parser, based on the Expat parser developed by James Clark. If the application sets this value to 1, there will be no attempt to locate or use XML::Parser. There are several reasons you might choose to do this. If the package will never be made available, there is no reason to perform the test. Setting this parameter is less time-consuming than the test for the package would be. Also, the XML::Parser code links against the Expat libraries for the C language. In some environments, this could cause a problem when mixed with other applications that may be linked against a different version of the same libraries. This was once the case with certain combinations of Apache, mod_perl and XML::Parser.
+
+=head2 $DO_NOT_USE_CHARSET
+
+Unless this parameter is set to 1, outgoing Content-Type headers will include specification of the character set used in encoding the message itself. Not all endpoints (client or server) may be able to properly deal with that data on the content header, however. If dealing with an endpoint that expects to do a more literal examination of the header as whole (as opposed to fully parsing it), this parameter may prove useful.
+
+=head2 $DO_NOT_CHECK_CONTENT_TYPE
+
+The content-type itself for a SOAP message is rather clearly defined, and in most cases, an application would have no reason to disable the testing of that header. This having been said, the content-type for SOAP 1.2 is still only a recommended draft, and badly coded endpoints might send valid messages with invalid Content-Type headers. While the "right" thing to do would be to reject such messages, that isn't always an option. Setting this parameter to 1 allows the toolkit to skip the content-type test.
+
+=head2 $PATCH_HTTP_KEEPALIVE
+
+SOAP::Lite's HTTP Transport module attempts to provide a simple patch to
+LWP::Protocol to enable HTTP Keep Alive. By default, this patch is turned
+off, if however you would like to turn on the experimental patch change the
+constant like so:
+
+ $SOAP::Constants::PATCH_HTTP_KEEPALIVE = 1;
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Data.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Data.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Data.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,239 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2003 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Data.pm,v 1.3 2004/11/14 19:30:49 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Data - this class provides the means by which to explicitly manipulate and control all aspects of the way in which Perl data gets expressed as SOAP data entities.
+
+=head1 DESCRIPTION
+
+The SOAP::Data class provides the means by which to explicitly manipulate and control all aspects of the way in which Perl data gets expressed as SOAP data entities. Most of the methods are accessors, which like those in SOAP::Lite are designed to return the current value if no new one is passed, while returning the object reference otherwise (allowing for chained method calls). Note that most accessors (except value) accept a new value for the data object as a second argument.
+
+=head1 METHODS
+
+=over
+
+=item new(optional key/value pairs)
+
+ $obj = SOAP::Data->new(name => 'idx', value => 5);
+
+This is the class constructor. Almost all of the attributes related to the class may be passed to the constructor as key/value pairs. This method isn't often used directly because SOAP::Data objects are generally created for temporary use. It is available for those situations that require it.
+
+=item name(new name, optional value)
+
+ $obj->name('index');
+
+Gets or sets the current value of the name, as the object regards it. The name is what the serializer will use for the tag when generating the XML for this object. It is what will become the accessor for the data element. Optionally, the object's value may be updated if passed as a second argument.
+
+=item type(new type, optional value)
+
+ $obj->type('int');
+
+Gets or sets the type associated with the current value in the object. This is useful for those cases where the SOAP::Data object is used to explicitly specify the type of data that would otherwise be interpreted as a different type completely (such as perceiving the string 123 as an integer, instead). Allows the setting of the object's value, if passed as a second argument to the method.
+
+=item uri(new uri, optional value)
+
+ $obj->uri('http://www.perl.com/SOAP');
+
+Gets or sets the URI that will be used as the namespace for the resulting XML entity, if one is desired. This doesn't set the label for the namespace. If one isn't provided by means of the prefix method, one is generated automatically when needed. Also allows the setting of the object's value, if passed as a second argument to the method.
+
+=item prefix(new prefix, optional value)
+
+ $obj->prefix('perl');
+
+Provides the prefix, or label, for use when associating the data object with a specific namespace. Also allows the setting of the object's value, if passed as a second argument to the method.
+
+=item attr(hash reference of attributes, optional value)
+
+ $obj->attr({ attr1 => 'value' });
+
+Allows for the setting of arbitrary attributes on the data object. Keep in mind the requirement that any attributes not natively known to SOAP must be namespace-qualified. Also allows the setting of the object's value, if passed as a second argument to the method.
+
+=item value(new value)
+
+ $obj->value(10);
+
+Fetches the current value encapsulated by the object, or explicitly sets it.
+
+=back
+
+The last four methods are convenience shortcuts for the attributes that SOAP itself supports. Each also permits inclusion of a new value, as an optional second argument.
+
+=over
+
+=item actor(new actor, optional value)
+
+ $obj->actor($new_actor_name);
+
+Gets or sets the value of the actor attribute; useful only when the object generates an entity for the message header.
+
+=item mustUnderstand(boolean, optional value)
+
+ $obj->mustUnderstand(0);
+
+Manipulates the mustUnderstand attribute, which tells the SOAP processor whether it is required to understand the entity in question.
+
+=item encodingStyle(new encoding URN, optional value)
+
+ $obj->encodingStyle($soap_11_encoding);
+
+This method is most likely to be used in places outside the header creation. Sets encodingStyle, which specifies an encoding that differs from the one that would otherwise be defaulted to.
+
+=item root(boolean, optional value)
+
+ $obj->root(1);
+
+When the application must explicitly specify which data element is to be regarded as the root element for the sake of generating the object model, this method provides the access to the root attribute.
+
+=back
+
+=head1 TYPE DETECTION
+
+SOAP::Lite's serializer will detect the type of any scalar passed in as a SOAP::Data object's value. Because Perl is loosely typed, the serializer is only able to detect types based upon a predetermined set of regular expressions. Therefore, type detection is not always 100% accurate. In such a case you may need to explicitly set the type of the element being encoded. For example, by default the following code will be serialized as an integer:
+
+ $elem = SOAP::Data->name('idx')->value(5);
+
+If, however, you need to serialize this into a long, then the following code will do so:
+
+ $elem = SOAP::Data->name('idx')->value(5)->type('long');
+
+=head1 EXAMPLES
+
+=head2 SIMPLE TYPES
+
+The following example will all produce the same XML:
+
+ $elem1 = SOAP::Data->new(name => 'idx', value => 5);
+ $elem2 = SOAP::Data->name('idx' => 5);
+ $elem3 = SOAP::Data->name('idx')->value(5);
+
+=head2 COMPLEX TYPES
+
+A common question is how to do you created nested XML elements using SOAP::Lite. The following example demonstrates how:
+
+ SOAP::Data->name('foo' => \SOAP::Data->value(
+ SOAP::Data->name('bar' => '123')));
+
+The above code will produce the following XML:
+
+ <foo>
+ <bar>123</bar>
+ </foo>
+
+=head2 ARRAYS
+
+The following code:
+
+ $elem1 = SOAP::Data->name('item' => 123)->type('SomeObject');
+ $elem2 = SOAP::Data->name('item' => 456)->type('SomeObject');
+ push(@array,$elem1);
+ push(@array,$elem2);
+
+ my $client = SOAP::Lite
+ ->readable(1)
+ ->uri($NS)
+ ->proxy($HOST);
+
+ $temp_elements = SOAP::Data
+ ->name("CallDetails" => \SOAP::Data->value(
+ SOAP::Data->name("elem1" => 'foo'),
+ SOAP::Data->name("elem2" => 'baz'),
+ SOAP::Data->name("someArray" => \SOAP::Data->value(
+ SOAP::Data->name("someArrayItem" => @array)
+ ->type("SomeObject"))
+ )->type("ArrayOf_SomeObject") ))
+
+ ->type("SomeObject");
+
+ $response = $client->someMethod($temp_elements);
+
+Will produce the following XML:
+
+ <?xml version="1.0" encoding="UTF-8"?>
+ <SOAP-ENV:Envelope
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:xsd="http://www.w3.org/2001/XMLSchema"
+ xmlns:namesp2="http://namespaces.soaplite.com/perl"
+ SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+ <SOAP-ENV:Body>
+ <namesp1:someMethod xmlns:namesp1="urn:TemperatureService">
+ <CallDetails xsi:type="namesp2:SomeObject">
+ <elem1 xsi:type="xsd:string">foo</elem1>
+ <elem2 xsi:type="xsd:string">baz</elem2>
+ <someArray xsi:type="namesp2:ArrayOf_SomeObject">
+ <item xsi:type="namesp2:SomeObject">123</bar>
+ <item xsi:type="namesp2:SomeObject">456</bar>
+ </someArray>
+ </CallDetails>
+ </namesp1:test>
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+In the code above, the @array variable can be an array of anything. If you pass
+in an array of numbers, then SOAP::Lite will properly serialize that into such.
+If however you need to encode an array of complex types, then simply pass in an
+array of other SOAP::Data objects and you are all set.
+
+=head2 COMPOSING MESSAGES USING RAW XML
+
+In some circumstances you may need to encode a message using raw unserialized
+XML text. To instantiate a SOAP::Data object using raw XML, do the following:
+
+ $xml_content = "<foo><bar>123</bar></foo>";
+ $elem = SOAP::Data->type('xml' => $xml_content);
+
+SOAP::Lite's serializer simple takes whatever text is passed to it, and inserts
+into the encoded SOAP::Data element I<verbatim>. The text input is NOT validated to
+ensure it is valid XML, nor is the resulting SOAP::Data element validated to
+ensure that it will produce valid XML. Therefore, it is incumbent upon the
+developer to ensure that any XML data used in this fashion is valid and will
+result in a valid XML document.
+
+=head2 MULTIPLE NAMESPACES
+
+When working with complex types it may be necessary to declare multiple namespaces. The following code demonstrates how to do so:
+
+ $elem = SOAP::Data->name("myElement" => "myValue")
+ ->attr( { 'xmlns:foo2' => 'urn:Foo2',
+ 'xmlns:foo3' => 'urn:Foo3' } );
+
+This will produce the following XML:
+
+ <myElement xmlns:foo2="urn:Foo2" xmlns:foo3="urn:Foo3">myValue</myElement>
+
+=head1 SEE ALSO
+
+L<SOAP::Header>, L<SOAP::SOM>, L<SOAP::Serializer>
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
+
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Deserializer.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Deserializer.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Deserializer.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,65 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Deserializer.pm,v 1.3 2004/10/17 19:59:04 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Deserializer - the means by which the toolkit manages the conversion of XML into an object managable by a developer
+
+=head1 DESCRIPTION
+
+SOAP::Deserializer provides the means by which incoming XML is decoded into a Perl data structure.
+
+=head1 METHODS
+
+=over
+
+=item context
+
+This provides access to the calling context of C<SOAP::Deserializer>. In a client side context the often means a reference to an instance of SOAP::Lite. In a server side context this means a reference to a SOAP::Server instance.
+
+=back
+
+=head1 EXAMPLES
+
+=head2 DESERIALIZING RAW XML INTO A SOAP::SOM OBJECT
+
+A useful utility for SOAP::Deserializer is for parsing raw XML documents or fragments into a SOAP::SOM object. SOAP::Lite developers use this technique to write unit tests for the SOAP::Lite module itself. It is a lot more efficient for testing aspects of the toolkit than generating client calls over the network. This is a perfect way for developers to write unit tests for their custom data types for example.
+
+Here is an example of how raw XML content can be parsed into a SOAP::SOM object by using SOAP::Deserializer:
+
+ $xml = <<END_XML;
+ <foo>
+ <person>
+ <foo>123</foo>
+ <foo>456</foo>
+ </person>
+ <person>
+ <foo>789</foo>
+ <foo>012</foo>
+ </person>
+ </foo>
+ END_XML
+
+ my $som = SOAP::Deserializer->deserialize($xml);
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Fault.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Fault.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Fault.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,91 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2003 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Fault.pm,v 1.1 2004/10/12 18:47:55 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Fault - encapsulates SOAP faults prior to their serialization or after their deserialization
+
+=head1 DESCRIPTION
+
+This class encapsulates SOAP faults prior to their serialization or after their deserialization. The methods available are a constructor and four accessors. Each accessor creates an object on demand, just as the other classes do, when called as a static method. Like other accessors in the SOAP::Lite package, they return the object itself when setting the attribute.
+
+=head1 GENERATING A SOAP FAULT
+
+To generate a SOAP Fault simply issue a Perl die command on the server side as you might normally. The SOAP processor will intercept the die command and return a SOAP Fault, using the string passed to the die command as the faultstring, to the client making the call. If you require having more control over the SOAP Fault returned to the client, then simply pass a SOAP::Fault object to the die command and the SOAP processor will behave accordingly. For example:
+
+ die SOAP::Fault->faultcode('Server.Custom') # will be qualified
+ ->faultstring('Died in server method')
+ ->faultdetail(bless {code => 1} => 'BadError')
+ ->faultactor('http://www.soaplite.com/custom');
+
+=head1 METHODS
+
+=over
+
+=item new(optional data)
+
+ $fault = SOAP::Fault->new(faultcode => 'Server');
+
+Explicitly creates a new SOAP::Fault object. Any of the four attributes represented next by accessor methods may be passed in the argument list with values immediately following their attribute name.
+
+=item faultcode(optional value)
+
+ $fault->faultcode('MethodUnknown');
+
+Returns the current fault code or sets it if a value is given.
+
+=item faultstring(optional value)
+
+ $fault->faultstring("There is no $method here");
+
+Returns or sets the fault string.
+
+=item faultactor(optional value)
+
+ $fault->faultcode($header->actor);
+
+Returns or sets the fault-actor element. Note that the actor isn't always required in a SOAP fault.
+
+=item faultdetail(optional value)
+
+ $fault->faultcode(bless { proxy => $ip }, 'Err');
+
+Returns or sets the fault's detail element. Like the actor, this isn't always a required element. Note that fault detail content in a message is represented as tag blocks. Thus, the values passed to this accessor when setting the value are either SOAP::Data objects, or more general blessed hash references.
+
+=back
+
+In addition to these methods, the SOAP::Fault package also provides detail as an alias for faultdetail. The former is the actual name of the element with SOAP faults, but the latter name is less ambiguous when regarded with the rest of the SOAP::Lite package. Objects of this class also have a special stringification enabled. If an object is printed or otherwise stringified, the value produced is faultcode: faultstring, with the attribute values of the object.
+
+=head1 SEE ALSO
+
+L<SOAP::Data>, L<SOAP::Header>, L<SOAP::SOM>
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Header.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Header.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Header.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,45 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2003 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Header.pm,v 1.1 2004/10/12 18:47:55 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Header - similar to SOAP::Data elements, a SOAP::Header object simply is encoded in the SOAP Header block
+
+=head1 DESCRIPTION
+
+Objects instantiated from the SOAP::Header class are functionally the same as SOAP::Data objects, and as such share all the methods from that class. The distinction may be cosmetic, but it is present so that applications may more easily distinguish header blocks from more generic data elements.
+
+=head1 SEE ALSO
+
+L<SOAP::Data>
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
+
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Lite.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Lite.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Lite.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,4576 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2005 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Lite.pm,v 1.37 2005/12/25 07:52:18 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Lite;
+
+use 5.004;
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/)
+# or warn "warning: unspecified/non-released version of ", __PACKAGE__, "\n";
+$VERSION = '0.66';
+
+# ======================================================================
+
+package SOAP::XMLSchemaSOAP1_1::Deserializer;
+
+sub anyTypeValue { 'ur-type' }
+
+sub as_boolean { shift; my $value = shift; $value eq '1' || $value eq 'true' ? 1 : $value eq '0' || $value eq 'false' ? 0 : die "Wrong boolean value '$value'\n" }
+sub as_base64 { shift; require MIME::Base64; MIME::Base64::decode_base64(shift) }
+sub as_ur_type { $_[1] }
+
+BEGIN {
+ no strict 'refs';
+ for my $method (qw(
+ string float double decimal timeDuration recurringDuration uriReference
+ integer nonPositiveInteger negativeInteger long int short byte
+ nonNegativeInteger unsignedLong unsignedInt unsignedShort unsignedByte
+ positiveInteger timeInstant time timePeriod date month year century
+ recurringDate recurringDay language
+ )) { my $name = 'as_' . $method; *$name = sub { $_[1] } }
+}
+
+# ----------------------------------------------------------------------
+
+package SOAP::XMLSchemaSOAP1_2::Deserializer;
+
+sub anyTypeValue { 'anyType' }
+
+sub as_boolean; *as_boolean = \&SOAP::XMLSchemaSOAP1_1::Deserializer::as_boolean;
+sub as_base64 { shift; require MIME::Base64; MIME::Base64::decode_base64(shift) }
+sub as_anyType { $_[1] }
+
+BEGIN {
+ no strict 'refs';
+ for my $method (qw(
+ string float double decimal dateTime timePeriod gMonth gYearMonth gYear
+ century gMonthDay gDay duration recurringDuration anyURI
+ language integer nonPositiveInteger negativeInteger long int short byte
+ nonNegativeInteger unsignedLong unsignedInt unsignedShort unsignedByte
+ positiveInteger date time dateTime
+ )) { my $name = 'as_' . $method; *$name = sub { $_[1] } }
+}
+
+# ----------------------------------------------------------------------
+
+package SOAP::XMLSchemaApacheSOAP::Deserializer;
+
+sub as_map {
+ my $self = shift;
+ +{ map { my $hash = ($self->decode_object($_))[1]; ($hash->{key} => $hash->{value}) } @{$_[3] || []} };
+}
+sub as_Map; *as_Map = \&as_map;
+
+# Thank to Kenneth Draper for this contribution
+sub as_vector {
+ my $self = shift;
+ [ map { scalar(($self->decode_object($_))[1]) } @{$_[3] || []} ];
+}
+sub as_Vector; *as_Vector = \&as_vector;
+
+# ----------------------------------------------------------------------
+
+package SOAP::XMLSchema::Serializer;
+
+use vars qw(@ISA);
+
+sub xmlschemaclass {
+ my $self = shift;
+ return $ISA[0] unless @_;
+ @ISA = (shift);
+ return $self;
+}
+
+# ----------------------------------------------------------------------
+
+package SOAP::XMLSchema1999::Serializer;
+
+use vars qw(@EXPORT $AUTOLOAD);
+
+sub AUTOLOAD {
+ local($1,$2);
+ my($package, $method) = $AUTOLOAD =~ m/(?:(.+)::)([^:]+)$/;
+ return if $method eq 'DESTROY';
+ no strict 'refs';
+ die "Type '$method' can't be found in a schema class '$package'\n"
+ unless $method =~ s/^as_// && grep {$_ eq $method} @{"$package\::EXPORT"};
+
+ $method =~ s/_/-/; # fix ur-type
+
+ *$AUTOLOAD = sub {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'xsi:type' => "xsd:$method", %$attr}, $value];
+ };
+ goto &$AUTOLOAD;
+}
+
+BEGIN {
+ @EXPORT = qw(ur_type
+ float double decimal timeDuration recurringDuration uriReference
+ integer nonPositiveInteger negativeInteger long int short byte
+ nonNegativeInteger unsignedLong unsignedInt unsignedShort unsignedByte
+ positiveInteger timeInstant time timePeriod date month year century
+ recurringDate recurringDay language
+ base64 hex string boolean
+ );
+ # predeclare subs, so ->can check will be positive
+ foreach (@EXPORT) { eval "sub as_$_" }
+}
+
+sub nilValue { 'null' }
+sub anyTypeValue { 'ur-type' }
+
+sub as_base64 {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ require MIME::Base64;
+ return [$name, {'xsi:type' => SOAP::Utils::qualify($self->encprefix => 'base64'), %$attr}, MIME::Base64::encode_base64($value,'')];
+}
+
+sub as_hex {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'xsi:type' => 'xsd:hex', %$attr}, join '', map {uc sprintf "%02x", ord} split '', $value];
+}
+
+sub as_long {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'xsi:type' => 'xsd:long', %$attr}, $value];
+}
+
+sub as_dateTime {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'xsi:type' => 'xsd:dateTime', %$attr}, $value];
+}
+
+sub as_string {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ die "String value expected instead of @{[ref $value]} reference\n" if ref $value;
+ return [$name, {'xsi:type' => 'xsd:string', %$attr}, SOAP::Utils::encode_data($value)];
+}
+
+sub as_undef { $_[1] ? '1' : '0' }
+
+sub as_boolean {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'xsi:type' => 'xsd:boolean', %$attr}, $value ? '1' : '0'];
+}
+
+sub as_float {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'xsi:type' => 'xsd:float', %$attr}, $value ];
+}
+
+# ----------------------------------------------------------------------
+
+package SOAP::XMLSchema1999::Deserializer;
+
+sub anyTypeValue { 'ur-type' }
+
+sub as_string; *as_string = \&SOAP::XMLSchemaSOAP1_1::Deserializer::as_string;
+sub as_boolean; *as_boolean = \&SOAP::XMLSchemaSOAP1_1::Deserializer::as_boolean;
+sub as_hex { shift; my $value = shift; $value =~ s/([a-zA-Z0-9]{2})/chr oct '0x'.$1/ge; $value }
+sub as_ur_type { $_[1] }
+sub as_undef { shift; my $value = shift; $value eq '1' || $value eq 'true' ? 1 : $value eq '0' || $value eq 'false' ? 0 : die "Wrong null/nil value '$value'\n" }
+
+BEGIN {
+ no strict 'refs';
+ for my $method (qw(
+ float double decimal timeDuration recurringDuration uriReference
+ integer nonPositiveInteger negativeInteger long int short byte
+ nonNegativeInteger unsignedLong unsignedInt unsignedShort unsignedByte
+ positiveInteger timeInstant time timePeriod date month year century
+ recurringDate recurringDay language
+ )) { my $name = 'as_' . $method; *$name = sub { $_[1] } }
+}
+
+# ----------------------------------------------------------------------
+
+package SOAP::XMLSchema2001::Serializer;
+
+use vars qw(@EXPORT);
+
+# no more warnings about "used only once"
+*AUTOLOAD if 0;
+
+*AUTOLOAD = \&SOAP::XMLSchema1999::Serializer::AUTOLOAD;
+
+BEGIN {
+ @EXPORT = qw(anyType anySimpleType float double decimal dateTime
+ timePeriod gMonth gYearMonth gYear century
+ gMonthDay gDay duration recurringDuration anyURI
+ language integer nonPositiveInteger negativeInteger
+ long int short byte nonNegativeInteger unsignedLong
+ unsignedInt unsignedShort unsignedByte positiveInteger
+ date time string hex base64 boolean
+ QName
+ );
+ # Add QName to @EXPORT
+ # predeclare subs, so ->can check will be positive
+ foreach (@EXPORT) { eval "sub as_$_" }
+}
+
+sub nilValue { 'nil' }
+sub anyTypeValue { 'anyType' }
+
+sub as_long; *as_long = \&SOAP::XMLSchema1999::Serializer::as_long;
+sub as_float; *as_float = \&SOAP::XMLSchema1999::Serializer::as_float;
+sub as_string; *as_string = \&SOAP::XMLSchema1999::Serializer::as_string;
+# TODO - QNames still don't work for 2001 schema!
+sub as_QName; *as_QName = \&SOAP::XMLSchema1999::Serializer::as_string;
+sub as_hex; *as_hex = \&as_hexBinary;
+sub as_base64; *as_base64 = \&as_base64Binary;
+sub as_timeInstant; *as_timeInstant = \&as_dateTime;
+sub as_undef { $_[1] ? 'true' : 'false' }
+
+sub as_hexBinary {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'xsi:type' => 'xsd:hexBinary', %$attr}, join '', map {uc sprintf "%02x", ord} split '', $value];
+}
+
+sub as_base64Binary {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ require MIME::Base64;
+ return [$name, {'xsi:type' => 'xsd:base64Binary', %$attr}, MIME::Base64::encode_base64($value,'')];
+}
+
+sub as_boolean {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'xsi:type' => 'xsd:boolean', %$attr}, $value ? 'true' : 'false'];
+}
+
+# ----------------------------------------------------------------------
+
+package SOAP::XMLSchema2001::Deserializer;
+
+sub anyTypeValue { 'anyType' }
+
+sub as_string; *as_string = \&SOAP::XMLSchema1999::Deserializer::as_string;
+sub as_boolean; *as_boolean = \&SOAP::XMLSchemaSOAP1_2::Deserializer::as_boolean;
+sub as_base64Binary; *as_base64Binary = \&SOAP::XMLSchemaSOAP1_2::Deserializer::as_base64;
+sub as_hexBinary; *as_hexBinary = \&SOAP::XMLSchema1999::Deserializer::as_hex;
+sub as_undef; *as_undef = \&SOAP::XMLSchema1999::Deserializer::as_undef;
+
+BEGIN {
+ no strict 'refs';
+ for my $method (qw(
+ anyType anySimpleType
+ float double decimal dateTime timePeriod gMonth gYearMonth gYear century
+ gMonthDay gDay duration recurringDuration anyURI
+ language integer nonPositiveInteger negativeInteger long int short byte
+ nonNegativeInteger unsignedLong unsignedInt unsignedShort unsignedByte
+ positiveInteger date time dateTime
+ QName
+ )) { my $name = 'as_' . $method; *$name = sub { $_[1] } }
+ # put QName in @EXPORT
+}
+
+# ======================================================================
+
+package SOAP::Constants;
+
+BEGIN {
+
+ use constant URI_1999_SCHEMA_XSD => "http://www.w3.org/1999/XMLSchema";
+ use constant URI_1999_SCHEMA_XSI => "http://www.w3.org/1999/XMLSchema-instance";
+ use constant URI_2000_SCHEMA_XSD => "http://www.w3.org/2000/10/XMLSchema";
+ use constant URI_2000_SCHEMA_XSI => "http://www.w3.org/2000/10/XMLSchema-instance";
+ use constant URI_2001_SCHEMA_XSD => "http://www.w3.org/2001/XMLSchema";
+ use constant URI_2001_SCHEMA_XSI => "http://www.w3.org/2001/XMLSchema-instance";
+
+ use constant URI_LITERAL_ENC => "";
+ use constant URI_SOAP11_ENC => "http://schemas.xmlsoap.org/soap/encoding/";
+ use constant URI_SOAP11_ENV => "http://schemas.xmlsoap.org/soap/envelope/";
+ use constant URI_SOAP11_NEXT_ACTOR => "http://schemas.xmlsoap.org/soap/actor/next";
+ use constant URI_SOAP12_ENC => "http://www.w3.org/2003/05/soap-encoding";
+ use constant URI_SOAP12_ENV => "http://www.w3.org/2003/05/soap-envelope";
+ use constant URI_SOAP12_NOENC => "http://www.w3.org/2003/05/soap-envelope/encoding/none";
+ use constant URI_SOAP12_NEXT_ACTOR => "http://www.w3.org/2003/05/soap-envelope/role/next";
+
+ # These URIs are not the *current* 1.2 URIs
+ #use constant URI_SOAP12_ENC => "http://www.w3.org/2001/06/*";
+ #use constant URI_SOAP12_ENC => "http://www.w3.org/2001/09/*";
+ #use constant URI_SOAP12_ENC => "http://www.w3.org/2001/12/*";
+ #use constant URI_SOAP12_ENC => "http://www.w3.org/2002/06/*";
+ #use constant URI_SOAP12_ENC => "http://www.w3.org/2002/12/*";
+
+ use vars qw($NSMASK $ELMASK);
+
+ $NSMASK = '[a-zA-Z_:][\w.\-:]*';
+ $ELMASK = '^(?![xX][mM][lL])[a-zA-Z_][\w.\-]*$';
+
+ use vars qw($NEXT_ACTOR $NS_ENV $NS_ENC $NS_APS
+ $FAULT_CLIENT $FAULT_SERVER $FAULT_VERSION_MISMATCH
+ $HTTP_ON_FAULT_CODE $HTTP_ON_SUCCESS_CODE $FAULT_MUST_UNDERSTAND
+ $NS_XSI_ALL $NS_XSI_NILS %XML_SCHEMAS $DEFAULT_XML_SCHEMA
+ $DEFAULT_HTTP_CONTENT_TYPE
+ $SOAP_VERSION %SOAP_VERSIONS $WRONG_VERSION
+ $NS_SL_HEADER $NS_SL_PERLTYPE $PREFIX_ENV $PREFIX_ENC
+ $DO_NOT_USE_XML_PARSER $DO_NOT_CHECK_MUSTUNDERSTAND
+ $DO_NOT_USE_CHARSET $DO_NOT_PROCESS_XML_IN_MIME
+ $DO_NOT_USE_LWP_LENGTH_HACK $DO_NOT_CHECK_CONTENT_TYPE
+ $MAX_CONTENT_SIZE $PATCH_HTTP_KEEPALIVE $DEFAULT_PACKAGER
+ @SUPPORTED_ENCODING_STYLES $OBJS_BY_REF_KEEPALIVE
+ $DEFAULT_CACHE_TTL
+ );
+
+ $FAULT_CLIENT = 'Client';
+ $FAULT_SERVER = 'Server';
+ $FAULT_VERSION_MISMATCH = 'VersionMismatch';
+ $FAULT_MUST_UNDERSTAND = 'MustUnderstand';
+
+ $HTTP_ON_SUCCESS_CODE = 200; # OK
+ $HTTP_ON_FAULT_CODE = 500; # INTERNAL_SERVER_ERROR
+
+ @SUPPORTED_ENCODING_STYLES = ( URI_LITERAL_ENC,URI_SOAP11_ENC,URI_SOAP12_ENC,URI_SOAP12_NOENC );
+
+ $WRONG_VERSION = 'Wrong SOAP version specified.';
+
+ %SOAP_VERSIONS = (
+ ($SOAP_VERSION = 1.1) => {
+ NEXT_ACTOR => URI_SOAP11_NEXT_ACTOR,
+ NS_ENV => URI_SOAP11_ENV,
+ NS_ENC => URI_SOAP11_ENC,
+ DEFAULT_XML_SCHEMA => URI_2001_SCHEMA_XSD,
+ DEFAULT_HTTP_CONTENT_TYPE => 'text/xml',
+ },
+ 1.2 => {
+ NEXT_ACTOR => URI_SOAP12_NEXT_ACTOR,
+ NS_ENV => URI_SOAP12_ENV,
+ NS_ENC => URI_SOAP12_ENC,
+ DEFAULT_XML_SCHEMA => URI_2001_SCHEMA_XSD,
+ DEFAULT_HTTP_CONTENT_TYPE => 'application/soap',
+ },
+ );
+
+ # schema namespaces
+ %XML_SCHEMAS = ( # The '()' is necessary to put constants in SCALAR form
+ URI_1999_SCHEMA_XSD() => 'SOAP::XMLSchema1999',
+ URI_2001_SCHEMA_XSD() => 'SOAP::XMLSchema2001',
+ URI_SOAP11_ENC() => 'SOAP::XMLSchemaSOAP1_1',
+ URI_SOAP12_ENC() => 'SOAP::XMLSchemaSOAP1_2',
+ );
+
+ $NS_XSI_ALL = join join('|', map {"$_-instance"} grep {/XMLSchema/} keys %XML_SCHEMAS), '(?:', ')';
+ $NS_XSI_NILS = join join('|', map { my $class = $XML_SCHEMAS{$_} . '::Serializer'; "\{($_)-instance\}" . $class->nilValue
+ } grep {/XMLSchema/} keys %XML_SCHEMAS),
+ '(?:', ')';
+
+ # ApacheSOAP namespaces
+ $NS_APS = 'http://xml.apache.org/xml-soap';
+
+ # SOAP::Lite namespace
+ $NS_SL_HEADER = 'http://namespaces.soaplite.com/header';
+ $NS_SL_PERLTYPE = 'http://namespaces.soaplite.com/perl';
+
+ # default prefixes
+ # $PREFIX_ENV = 'SOAP-ENV';
+ # $PREFIX_ENC = 'SOAP-ENC';
+ $PREFIX_ENV = 'soap';
+ $PREFIX_ENC = 'soapenc';
+
+ # others
+ $DO_NOT_USE_XML_PARSER = 0;
+ $DO_NOT_CHECK_MUSTUNDERSTAND = 0;
+ $DO_NOT_USE_CHARSET = 0;
+ $DO_NOT_PROCESS_XML_IN_MIME = 0;
+ $DO_NOT_USE_LWP_LENGTH_HACK = 0;
+ $DO_NOT_CHECK_CONTENT_TYPE = 0;
+ $PATCH_HTTP_KEEPALIVE = 1;
+ $OBJS_BY_REF_KEEPALIVE = 600; # seconds
+ # TODO - use default packager constant somewhere
+ $DEFAULT_PACKAGER = "SOAP::Packager::MIME";
+ $DEFAULT_CACHE_TTL = 0;
+}
+
+# ======================================================================
+
+package SOAP::Utils;
+
+sub qualify { $_[1] ? $_[1] =~ /:/ ? $_[1] : join(':', $_[0] || (), $_[1]) : defined $_[1] ? $_[0] : '' }
+sub overqualify (&$) { for ($_[1]) { &{$_[0]}; s/^:|:$//g } }
+sub disqualify {
+ (my $qname = shift) =~ s/^($SOAP::Constants::NSMASK?)://;
+ $qname;
+}
+sub splitqname { local($1,$2); $_[0] =~ /^(?:([^:]+):)?(.+)$/ ; return ($1,$2) }
+sub longname { defined $_[0] ? sprintf('{%s}%s', $_[0], $_[1]) : $_[1] }
+sub splitlongname { local($1,$2); $_[0] =~ /^(?:\{(.*)\})?(.+)$/; return ($1,$2) }
+
+# Q: why only '&' and '<' are encoded, but not '>'?
+# A: because it is not required according to XML spec.
+#
+# [http://www.w3.org/TR/REC-xml#syntax]
+# The ampersand character (&) and the left angle bracket (<) may appear in
+# their literal form only when used as markup delimiters, or within a comment,
+# a processing instruction, or a CDATA section. If they are needed elsewhere,
+# they must be escaped using either numeric character references or the
+# strings "&" and "<" respectively. The right angle bracket (>) may be
+# represented using the string ">", and must, for compatibility, be
+# escaped using ">" or a character reference when it appears in the
+# string "]]>" in content, when that string is not marking the end of a
+# CDATA section.
+
+my %encode_attribute = ('&' => '&', '>' => '>', '<' => '<', '"' => '"');
+sub encode_attribute { (my $e = $_[0]) =~ s/([&<>\"])/$encode_attribute{$1}/g; $e }
+
+my %encode_data = ('&' => '&', '>' => '>', '<' => '<', "\xd" => '
');
+sub encode_data { my $e = $_[0]; if ($e) { $e =~ s/([&<>\015])/$encode_data{$1}/g; $e =~ s/\]\]>/\]\]>/g; } $e }
+
+# methods for internal tree (SOAP::Deserializer, SOAP::SOM and SOAP::Serializer)
+
+sub o_qname { $_[0]->[0] }
+sub o_attr { $_[0]->[1] }
+sub o_child { ref $_[0]->[2] ? $_[0]->[2] : undef }
+sub o_chars { ref $_[0]->[2] ? undef : $_[0]->[2] }
+ # $_[0]->[3] is not used. Serializer stores object ID there
+sub o_value { $_[0]->[4] }
+sub o_lname { $_[0]->[5] }
+sub o_lattr { $_[0]->[6] }
+
+sub format_datetime {
+ my ($s,$m,$h,$D,$M,$Y) = (@_)[0,1,2,3,4,5];
+ my $time = sprintf("%04d-%02d-%02dT%02d:%02d:%02d",($Y+1900),($M+1),$D,$h,$m,$s);
+ return $time;
+}
+
+# make bytelength that calculates length in bytes regardless of utf/byte settings
+# either we can do 'use bytes' or length will count bytes already
+BEGIN {
+ sub bytelength;
+ eval ( eval('use bytes; 1') # 5.6.0 and later?
+ ? 'sub bytelength { use bytes; length(@_ ? $_[0] : $_) }; 1'
+ : 'sub bytelength { length(@_ ? $_[0] : $_) }; 1'
+ ) or die;
+}
+
+# ======================================================================
+
+package SOAP::Cloneable;
+
+sub clone {
+ my $self = shift;
+ return unless ref $self && UNIVERSAL::isa($self => __PACKAGE__);
+ my $clone = bless {} => ref($self) || $self;
+ foreach (keys %$self) {
+ my $value = $self->{$_};
+ $clone->{$_} = ref $value && UNIVERSAL::isa($value => __PACKAGE__) ? $value->clone : $value;
+ }
+ $clone;
+}
+
+# ======================================================================
+
+package SOAP::Transport;
+
+use vars qw($AUTOLOAD @ISA);
+
+ at ISA = qw(SOAP::Cloneable);
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+ return $self if ref $self;
+ my $class = ref($self) || $self;
+
+ SOAP::Trace::objects('()');
+ return bless {} => $class;
+}
+
+sub proxy {
+ my $self = shift->new;
+# my $self = shift;
+ my $class = ref $self;
+ return $self->{_proxy} unless @_;
+ $_[0] =~ /^(\w+):/ or die "proxy: transport protocol not specified\n";
+ my $protocol = uc "$1"; # untainted now
+ # https: should be done through Transport::HTTP.pm
+ for ($protocol) { s/^HTTPS$/HTTP/ }
+
+ (my $protocol_class = "${class}::$protocol") =~ s/-/_/g;
+ no strict 'refs';
+ unless (defined %{"$protocol_class\::Client::"} && UNIVERSAL::can("$protocol_class\::Client" => 'new')) {
+ eval "require $protocol_class";
+ die "Unsupported protocol '$protocol'\n" if $@ =~ m!^Can\'t locate SOAP/Transport/!;
+ die if $@;
+ }
+ $protocol_class .= "::Client";
+ return $self->{_proxy} = $protocol_class->new(endpoint => shift, @_);
+}
+
+sub AUTOLOAD {
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+ return if $method eq 'DESTROY';
+
+ no strict 'refs';
+ *$AUTOLOAD = sub { shift->proxy->$method(@_) };
+ goto &$AUTOLOAD;
+}
+
+# ======================================================================
+
+package SOAP::Fault;
+
+use Carp ();
+
+use overload fallback => 1, '""' => "stringify";
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ $self = bless {} => $class;
+ SOAP::Trace::objects('()');
+ }
+
+ Carp::carp "Odd (wrong?) number of parameters in new()" if $^W && (@_ & 1);
+ while (@_) { my $method = shift; $self->$method(shift) if $self->can($method) }
+
+ return $self;
+}
+
+sub stringify {
+ my $self = shift;
+ return join ': ', $self->faultcode, $self->faultstring;
+}
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(faultcode faultstring faultactor faultdetail)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ if (@_) { $self->{$field} = shift; return $self }
+ return $self->{$field};
+ }
+ }
+ *detail = \&faultdetail;
+}
+
+# ======================================================================
+
+package SOAP::Data;
+
+use vars qw(@ISA @EXPORT_OK);
+use Exporter;
+use Carp ();
+
+ at ISA = qw(Exporter);
+ at EXPORT_OK = qw(name type attr value uri);
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ $self = bless {_attr => {}, _value => [], _signature => []} => $class;
+ SOAP::Trace::objects('()');
+ }
+
+ Carp::carp "Odd (wrong?) number of parameters in new()" if $^W && (@_ & 1);
+ while (@_) { my $method = shift; $self->$method(shift) if $self->can($method) }
+
+ return $self;
+}
+
+sub name {
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ if (@_) {
+ my($name, $uri, $prefix) = shift;
+ if ($name) {
+ ($uri, $name) = SOAP::Utils::splitlongname($name);
+ unless (defined $uri) {
+ ($prefix, $name) = SOAP::Utils::splitqname($name);
+ $self->prefix($prefix) if defined $prefix;
+ } else {
+ $self->uri($uri);
+ }
+ }
+ $self->{_name} = $name;
+
+ $self->value(@_) if @_;
+ return $self;
+ }
+ return $self->{_name};
+}
+
+sub attr {
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ if (@_) { $self->{_attr} = shift; $self->value(@_) if @_; return $self }
+ return $self->{_attr};
+}
+
+sub type {
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ if (@_) {
+ $self->{_type} = shift;
+ $self->value(@_) if @_;
+ return $self;
+ }
+ if (!defined $self->{_type} && (my @types = grep {/^\{$SOAP::Constants::NS_XSI_ALL}type$/o} keys %{$self->{_attr}})) {
+ $self->{_type} = (SOAP::Utils::splitlongname(delete $self->{_attr}->{shift(@types)}))[1];
+ }
+ return $self->{_type};
+}
+
+BEGIN {
+ no strict 'refs';
+ for my $method (qw(root mustUnderstand)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $attr = $method eq 'root' ? "{$SOAP::Constants::NS_ENC}$method" : "{$SOAP::Constants::NS_ENV}$method";
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ if (@_) {
+ $self->{_attr}->{$attr} = $self->{$field} = shift() ? 1 : 0;
+ $self->value(@_) if @_;
+ return $self;
+ }
+ $self->{$field} = SOAP::XMLSchemaSOAP1_2::Deserializer->as_boolean($self->{_attr}->{$attr})
+ if !defined $self->{$field} && defined $self->{_attr}->{$attr};
+ return $self->{$field};
+ }
+ }
+ for my $method (qw(actor encodingStyle)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $attr = "{$SOAP::Constants::NS_ENV}$method";
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ if (@_) {
+ $self->{_attr}->{$attr} = $self->{$field} = shift;
+ $self->value(@_) if @_;
+ return $self;
+ }
+ $self->{$field} = $self->{_attr}->{$attr}
+ if !defined $self->{$field} && defined $self->{_attr}->{$attr};
+ return $self->{$field};
+ }
+ }
+}
+
+sub prefix {
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ return $self->{_prefix} unless @_;
+ $self->{_prefix} = shift;
+ $self->value(@_) if @_;
+ return $self;
+}
+
+sub uri {
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ return $self->{_uri} unless @_;
+ my $uri = $self->{_uri} = shift;
+ warn "Usage of '::' in URI ($uri) deprecated. Use '/' instead\n"
+ if defined $uri && $^W && $uri =~ /::/;
+ $self->value(@_) if @_;
+ return $self;
+}
+
+sub set_value {
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ $self->{_value} = [@_];
+ return $self;
+}
+
+sub value {
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ @_ ? ($self->set_value(@_), return $self)
+ : wantarray ? return @{$self->{_value}} : return $self->{_value}->[0];
+}
+
+sub signature {
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) ? shift->new : __PACKAGE__->new;
+ @_ ? ($self->{_signature} = shift, return $self) : (return $self->{_signature});
+}
+
+# ======================================================================
+
+package SOAP::Header;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Data);
+
+# ======================================================================
+
+package SOAP::Serializer;
+
+use Carp ();
+use vars qw(@ISA);
+
+ at ISA = qw(SOAP::Cloneable SOAP::XMLSchema::Serializer);
+
+BEGIN {
+ # namespaces and anonymous data structures
+ my $ns = 0;
+ my $name = 0;
+ my $prefix = 'c-';
+ sub gen_ns { 'namesp' . ++$ns }
+ sub gen_name { join '', $prefix, 'gensym', ++$name }
+ sub prefix { $prefix =~ s/^[^\-]+-/$_[1]-/; $_[0]; }
+}
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(readable level seen autotype typelookup attr maptype
+ namespaces multirefinplace encoding signature
+ on_nonserialized context
+ ns_uri ns_prefix use_default_ns)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+ }
+ }
+ for my $method (qw(method fault freeform)) { # aliases for envelope
+ *$method = sub { shift->envelope($method => @_) }
+ }
+ # Is this necessary? Seems like work for nothing when a user could just use
+ # SOAP::Utils directly.
+ # for my $method (qw(qualify overqualify disqualify)) { # import from SOAP::Utils
+ # *$method = \&{'SOAP::Utils::'.$method};
+ # }
+}
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+ return $self if ref $self;
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ $self = bless {
+ _level => 0,
+ _autotype => 1,
+ _readable => 0,
+ _ns_uri => '',
+ _ns_prefix => '',
+ _use_default_ns => 1,
+ _multirefinplace => 0,
+ _seen => {},
+ _typelookup => {
+ 'base64Binary' =>
+ [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64Binary'],
+ 'int' =>
+ [20, sub {$_[0] =~ /^[+-]?(\d+)$/ && $1 <= 2147483648 && $1 >= -2147483648; }, 'as_int'],
+ 'long' =>
+ [25, sub {$_[0] =~ /^[+-]?(\d+)$/ && $1 <= 9223372036854775807;}, 'as_long'],
+ 'float' =>
+ [30, sub {$_[0] =~ /^(-?(?:\d+(?:\.\d*)?|\.\d+|NaN|INF)|([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)$/}, 'as_float'],
+ 'gMonth' =>
+ [35, sub { $_[0] =~ /^--\d\d--(-\d\d:\d\d)?$/; }, 'as_gMonth'],
+ 'gDay' =>
+ [40, sub { $_[0] =~ /^---\d\d(-\d\d:\d\d)?$/; }, 'as_gDay'],
+ 'gYear' =>
+ [45, sub { $_[0] =~ /^-?\d\d\d\d(-\d\d:\d\d)?$/; }, 'as_gYear'],
+ 'gMonthDay' =>
+ [50, sub { $_[0] =~ /^-\d\d-\d\d(-\d\d:\d\d)?$/; }, 'as_gMonthDay'],
+ 'gYearMonth' =>
+ [55, sub { $_[0] =~ /^-?\d\d\d\d-\d\d(Z|([+-]\d\d:\d\d))?$/; }, 'as_gYearMonth'],
+ 'date' =>
+ [60, sub { $_[0] =~ /^-?\d\d\d\d-\d\d-\d\d(Z|([+-]\d\d:\d\d))?$/; }, 'as_date'],
+ 'time' =>
+ [70, sub { $_[0] =~ /^\d\d:\d\d:\d\d(\.\d\d\d)?(Z|([+-]\d\d:\d\d))?$/; }, 'as_time'],
+ 'dateTime' =>
+ [75, sub { $_[0] =~ /^\d\d\d\d-\d\d-\d\dT\d\d:\d\d:\d\d(\.\d\d\d)?(Z|([+-]\d\d:\d\d))?$/; }, 'as_dateTime'],
+ 'duration' =>
+ [80, sub { $_[0] =~ /^-?P(\d+Y)?(\d+M)?(\dD)?(T(\d+H)?(\d+M)?(\d+S)?)?$/; }, 'as_duration'],
+ 'boolean' =>
+ [90, sub { $_[0] =~ /^(true|false)$/i; }, 'as_boolean'],
+ 'anyURI' =>
+ [95, sub { $_[0] =~ /^(urn:)|(http:\/\/)/i; }, 'as_anyURI'],
+ 'string' =>
+ [100, sub {1}, 'as_string'],
+ },
+ _encoding => 'UTF-8',
+ _objectstack => {},
+ _signature => [],
+ _maptype => {},
+ _on_nonserialized => sub {Carp::carp "Cannot marshall @{[ref shift]} reference" if $^W; return},
+ _encodingStyle => $SOAP::Constants::NS_ENC,
+ _attr => {
+ "{$SOAP::Constants::NS_ENV}encodingStyle" => $SOAP::Constants::NS_ENC,
+ },
+ _namespaces => {
+ $SOAP::Constants::NS_ENC => $SOAP::Constants::PREFIX_ENC,
+ $SOAP::Constants::PREFIX_ENV ? ($SOAP::Constants::NS_ENV => $SOAP::Constants::PREFIX_ENV) : (),
+ },
+ _soapversion => SOAP::Lite->soapversion,
+ } => $class;
+ $self->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA);
+ SOAP::Trace::objects('()');
+ }
+
+ Carp::carp "Odd (wrong?) number of parameters in new()" if $^W && (@_ & 1);
+ while (@_) { my $method = shift; $self->$method(shift) if $self->can($method) }
+
+ return $self;
+}
+
+sub ns {
+ my $self = shift->new;
+ if (@_) {
+ my ($u,$p) = @_;
+ $self->register_ns($u);
+ $self->{'_ns_uri'} = $u;
+ $self->{'_ns_prefix'} = $p ? $p : $self->gen_ns;
+ $self->{'_use_default_ns'} = 0;
+ return $self;
+ }
+ return $self->{'_ns_uri'};
+}
+
+sub default_ns {
+ my $self = shift->new;
+ if (@_) {
+ my ($u) = @_;
+ $self->{'_ns_uri'} = $u;
+ $self->{'_ns_prefix'} = '';
+ $self->{'_use_default_ns'} = 1;
+ return $self;
+ }
+ return $self->{'_ns_uri'};
+}
+
+sub use_prefix {
+ my $self = shift->new;
+ warn 'use_prefix has been deprecated. if you wish to turn off or on the use of a default namespace, then please use either ns(uri) or default_ns(uri)';
+ if (@_) {
+ my $use = shift;
+ $self->{'_use_default_ns'} = !$use;
+ return $self;
+ } else {
+ return $self->{'_use_default_ns'};
+ }
+}
+
+# old
+# sub uri {
+# my $self = shift->new;
+# if (@_) {
+# $self->{'_uri'} = shift;
+# $self->register_ns($self->{'_uri'}) if (!$self->use_prefix);
+# return $self;
+# }
+# return $self->{'_uri'};
+# }
+
+sub uri {
+ my $self = shift->new;
+# warn 'uri has been deprecated. if you wish to set the namespace for the request, then please use either ns(uri) or default_ns(uri)';
+ if (@_) {
+ $self->{'_ns_uri'} = shift;
+ $self->register_ns($self->{'_ns_uri'}) if (!$self->use_prefix);
+ return $self;
+ }
+ return $self->{'_ns_uri'};
+}
+
+sub encodingStyle {
+ my $self = shift;
+ return $self->{'_encodingStyle'} unless @_;
+ my $cur_style = $self->{'_encodingStyle'};
+ delete($self->{'_namespaces'}->{$cur_style});
+ my $new_style = shift;
+ if ($new_style eq "") {
+ delete($self->{'_attr'}->{"{$SOAP::Constants::NS_ENV}encodingStyle"});
+ } else {
+ $self->{'_attr'}->{"{$SOAP::Constants::NS_ENV}encodingStyle"} = $new_style;
+ $self->{'_namespaces'}->{$new_style} = $SOAP::Constants::PREFIX_ENC;
+ }
+}
+
+# TODO - changing SOAP version can affect previously set encodingStyle
+sub soapversion {
+ my $self = shift;
+ return $self->{_soapversion} unless @_;
+ return $self if $self->{_soapversion} eq SOAP::Lite->soapversion;
+ $self->{_soapversion} = shift;
+
+ $self->attr({
+ "{$SOAP::Constants::NS_ENV}encodingStyle" => $SOAP::Constants::NS_ENC,
+ });
+ $self->namespaces({
+ $SOAP::Constants::NS_ENC => $SOAP::Constants::PREFIX_ENC,
+ $SOAP::Constants::PREFIX_ENV ? ($SOAP::Constants::NS_ENV => $SOAP::Constants::PREFIX_ENV) : (),
+ });
+ $self->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA);
+
+ $self;
+}
+
+sub xmlschema {
+ my $self = shift->new;
+ return $self->{_xmlschema} unless @_;
+
+ my @schema;
+ if ($_[0]) {
+ @schema = grep {/XMLSchema/ && /$_[0]/} keys %SOAP::Constants::XML_SCHEMAS;
+ Carp::croak "More than one schema match parameter '$_[0]': @{[join ', ', @schema]}" if @schema > 1;
+ Carp::croak "No schema match parameter '$_[0]'" if @schema != 1;
+ }
+
+ # do nothing if current schema is the same as new
+ return $self if $self->{_xmlschema} && $self->{_xmlschema} eq $schema[0];
+
+ my $ns = $self->namespaces;
+
+ # delete current schema from namespaces
+ if (my $schema = $self->{_xmlschema}) {
+ delete $ns->{$schema};
+ delete $ns->{"$schema-instance"};
+ }
+
+ # add new schema into namespaces
+ if (my $schema = $self->{_xmlschema} = shift @schema) {
+ $ns->{$schema} = 'xsd';
+ $ns->{"$schema-instance"} = 'xsi';
+ }
+
+ # and here is the class serializer should work with
+ my $class = exists $SOAP::Constants::XML_SCHEMAS{$self->{_xmlschema}} ?
+ $SOAP::Constants::XML_SCHEMAS{$self->{_xmlschema}} . '::Serializer' : $self;
+
+ $self->xmlschemaclass($class);
+
+ return $self;
+}
+
+sub envprefix {
+ my $self = shift->new;
+ return $self->namespaces->{$SOAP::Constants::NS_ENV} unless @_;
+ $self->namespaces->{$SOAP::Constants::NS_ENV} = shift;
+ return $self;
+}
+
+sub encprefix {
+ my $self = shift->new;
+ return $self->namespaces->{$SOAP::Constants::NS_ENC} unless @_;
+ $self->namespaces->{$SOAP::Constants::NS_ENC} = shift;
+ return $self;
+}
+
+sub gen_id { sprintf "%U", $_[1] }
+
+sub multiref_object {
+ my $self = shift;
+ my $object = shift;
+ my $id = $self->gen_id($object);
+ my $seen = $self->seen;
+ $seen->{$id}->{count}++;
+ $seen->{$id}->{multiref} ||= $seen->{$id}->{count} > 1;
+ $seen->{$id}->{value} = $object;
+ $seen->{$id}->{recursive} ||= 0;
+ return $id;
+}
+
+sub recursive_object {
+ my $self = shift;
+ $self->seen->{$self->gen_id(shift)}->{recursive} = 1;
+}
+
+sub is_href {
+ my $self = shift;
+ my $seen = $self->seen->{shift || return} or return;
+ return 1 if $seen->{id};
+ return $seen->{multiref} &&
+ !($seen->{id} = (shift ||
+ $seen->{recursive} ||
+ $seen->{multiref} && $self->multirefinplace));
+}
+
+sub multiref_anchor {
+ my $seen = shift->seen->{my $id = shift || return undef};
+ return $seen->{multiref} ? "ref-$id" : undef;
+}
+
+sub encode_multirefs {
+ my $self = shift;
+ return if $self->multirefinplace;
+
+ my $seen = $self->seen;
+ map { $_->[1]->{_id} = 1; $_
+ } map { $self->encode_object($seen->{$_}->{value})
+ } grep { $seen->{$_}->{multiref} && !$seen->{$_}->{recursive}
+ } keys %$seen;
+}
+
+sub maptypetouri {
+ my($self, $type, $simple) = @_;
+
+ return $type unless defined $type;
+ my($prefix, $name) = SOAP::Utils::splitqname($type);
+
+ unless (defined $prefix) {
+ $name =~ s/__|\./::/g;
+ $self->maptype->{$name} = $simple
+ ? die "Schema/namespace for type '$type' is not specified\n"
+ : $SOAP::Constants::NS_SL_PERLTYPE
+ unless exists $self->maptype->{$name};
+ $type = $self->maptype->{$name}
+ ? SOAP::Utils::qualify($self->namespaces->{$self->maptype->{$name}} ||= gen_ns, $type)
+ : undef;
+ }
+ return $type;
+}
+
+sub encode_object {
+ my($self, $object, $name, $type, $attr) = @_;
+
+ $attr ||= {};
+
+ return $self->encode_scalar($object, $name, $type, $attr) unless ref $object;
+
+ my $id = $self->multiref_object($object);
+
+ use vars '%objectstack'; # we'll play with symbol table
+ local %objectstack = %objectstack; # want to see objects ONLY in the current tree
+ # did we see this object in current tree? Seems to be recursive refs
+ $self->recursive_object($object) if ++$objectstack{$id} > 1;
+ # return if we already saw it twice. It should be already properly serialized
+ return if $objectstack{$id} > 2;
+
+ if (UNIVERSAL::isa($object => 'SOAP::Data')) {
+ # use $object->SOAP::Data:: to enable overriding name() and others in inherited classes
+ $object->SOAP::Data::name($name) unless defined $object->SOAP::Data::name;
+
+ # apply ->uri() and ->prefix() which can modify name and attributes of
+ # element, but do not modify SOAP::Data itself
+ my($name, $attr) = $self->fixattrs($object);
+ $attr = $self->attrstoqname($attr);
+
+ my @realvalues = $object->SOAP::Data::value;
+ return [$name || gen_name, $attr] unless @realvalues;
+
+ my $method = "as_" . ($object->SOAP::Data::type || '-'); # dummy type if not defined
+ # try to call method specified for this type
+ my @values = map {
+ # store null/nil attribute if value is undef
+ local $attr->{SOAP::Utils::qualify(xsi => $self->xmlschemaclass->nilValue)} = $self->xmlschemaclass->as_undef(1)
+ unless defined;
+ $self->can($method) && $self->$method($_, $name || gen_name, $object->SOAP::Data::type, $attr)
+ || $self->typecast($_, $name || gen_name, $object->SOAP::Data::type, $attr)
+ || $self->encode_object($_, $name, $object->SOAP::Data::type, $attr)
+ } @realvalues;
+ $object->SOAP::Data::signature([map {join $;, $_->[0], SOAP::Utils::disqualify($_->[1]->{'xsi:type'} || '')} @values]) if @values;
+ return wantarray ? @values : $values[0];
+ }
+
+ my $class = ref $object;
+
+ if ($class !~ /^(?:SCALAR|ARRAY|HASH|REF)$/o) {
+ # we could also check for CODE|GLOB|LVALUE, but we cannot serialize
+ # them anyway, so they'll be cought by check below
+ $class =~ s/::/__/g;
+
+ $name = $class if !defined $name;
+ $type = $class if !defined $type && $self->autotype;
+
+ my $method = 'as_' . $class;
+ if ($self->can($method)) {
+ my $encoded = $self->$method($object, $name, $type, $attr);
+ return $encoded if ref $encoded;
+ # return only if handled, otherwise handle with default handlers
+ }
+ }
+
+ if (UNIVERSAL::isa($object => 'REF') || UNIVERSAL::isa($object => 'SCALAR')) {
+ return $self->encode_scalar($object, $name, $type, $attr);
+ } elsif (UNIVERSAL::isa($object => 'ARRAY')) {
+ # Added in SOAP::Lite 0.65_6 to fix an XMLRPC bug
+ return $self->encodingStyle eq "" || ref $self eq 'XMLRPC::Serializer' ?
+ $self->encode_array($object, $name, $type, $attr) :
+ $self->encode_literal_array($object, $name, $type, $attr);
+ } elsif (UNIVERSAL::isa($object => 'HASH')) {
+ return $self->encode_hash($object, $name, $type, $attr);
+ } else {
+ return $self->on_nonserialized->($object);
+ }
+}
+
+sub encode_scalar {
+ my($self, $value, $name, $type, $attr) = @_;
+ $name ||= gen_name;
+
+ my $schemaclass = $self->xmlschemaclass;
+
+ # null reference
+ return [$name, {%$attr, SOAP::Utils::qualify(xsi => $schemaclass->nilValue) => $schemaclass->as_undef(1)}] unless defined $value;
+
+ # object reference
+ return [$name, {'xsi:type' => $self->maptypetouri($type), %$attr}, [$self->encode_object($$value)], $self->gen_id($value)] if ref $value;
+
+ # autodefined type
+ if ($self->autotype) {
+ my $lookup = $self->typelookup;
+ for (sort {$lookup->{$a}->[0] <=> $lookup->{$b}->[0]} keys %$lookup) {
+ my $method = $lookup->{$_}->[2];
+ return $self->can($method) && $self->$method($value, $name, $type, $attr)
+ || $method->($value, $name, $type, $attr)
+ if $lookup->{$_}->[1]->($value);
+ }
+ }
+
+ # invariant
+ return [$name, $attr, $value];
+}
+
+sub encode_array {
+ my($self, $array, $name, $type, $attr) = @_;
+ my $items = 'item';
+
+ # TODO: add support for multidimensional, partially transmitted and sparse arrays
+ my @items = map {$self->encode_object($_, $items)} @$array;
+ my $num = @items;
+ my($arraytype, %types) = '-';
+ for (@items) { $arraytype = $_->[1]->{'xsi:type'} || '-'; $types{$arraytype}++ }
+ $arraytype = sprintf "%s\[$num]", keys %types > 1 || $arraytype eq '-' ? SOAP::Utils::qualify(xsd => $self->xmlschemaclass->anyTypeValue) : $arraytype;
+
+ $type = SOAP::Utils::qualify($self->encprefix => 'Array') if $self->autotype && !defined $type;
+
+ return [$name || SOAP::Utils::qualify($self->encprefix => 'Array'),
+ {SOAP::Utils::qualify($self->encprefix => 'arrayType') => $arraytype, 'xsi:type' => $self->maptypetouri($type), %$attr},
+ [@items],
+ $self->gen_id($array)
+ ];
+}
+
+# Will encode arrays using doc-literal style
+sub encode_literal_array {
+ my($self, $array, $name, $type, $attr) = @_;
+
+ # If typing is disabled, just serialize each of the array items
+ # with no type information, each using the specified name,
+ # and do not crete a wrapper array tag.
+ if (!$self->autotype) {
+ $name ||= gen_name;
+ return map {$self->encode_object($_, $name)} @$array;
+ }
+
+ my $items = 'item';
+
+ # TODO: add support for multidimensional, partially transmitted and sparse arrays
+ my @items = map {$self->encode_object($_, $items)} @$array;
+ my $num = @items;
+ my($arraytype, %types) = '-';
+ for (@items) { $arraytype = $_->[1]->{'xsi:type'} || '-'; $types{$arraytype}++ }
+ $arraytype = sprintf "%s\[$num]", keys %types > 1 || $arraytype eq '-' ? SOAP::Utils::qualify(xsd => $self->xmlschemaclass->anyTypeValue) : $arraytype;
+ $type = SOAP::Utils::qualify($self->encprefix => 'Array') if !defined $type;
+ return [$name || SOAP::Utils::qualify($self->encprefix => 'Array'),
+ {SOAP::Utils::qualify($self->encprefix => 'arrayType') => $arraytype, 'xsi:type' => $self->maptypetouri($type), %$attr},
+ [@items],
+ $self->gen_id($array)
+ ];
+}
+
+sub encode_hash_old {
+#sub encode_hash {
+ my($self, $hash, $name, $type, $attr) = @_;
+
+ if ($self->autotype && grep {!/$SOAP::Constants::ELMASK/o} keys %$hash) {
+ warn qq!Cannot encode @{[$name ? "'$name'" : 'unnamed']} element as 'hash'. Will be encoded as 'map' instead\n! if $^W;
+ return $self->as_map($hash, $name || gen_name, $type, $attr);
+ }
+
+ $type = 'SOAPStruct'
+ if $self->autotype && !defined($type) && exists $self->maptype->{SOAPStruct};
+ return [$name || gen_name,
+ {'xsi:type' => $self->maptypetouri($type), %$attr},
+ [map {$self->encode_object($hash->{$_}, $_)} keys %$hash],
+ $self->gen_id($hash)
+ ];
+}
+
+#sub encode_hash_lexi_patch {
+sub encode_hash {
+ my($self, $hash, $name, $type, $attr) = @_;
+
+ if ($self->autotype && grep {!/$SOAP::Constants::ELMASK/o} keys %$hash) {
+ warn qq!Cannot encode @{[$name ? "'$name'" : 'unnamed']} element as 'hash'. Will be encoded as 'map' instead\n! if $^W;
+ return $self->as_map($hash, $name || gen_name, $type, $attr);
+ }
+
+ $type = 'SOAPStruct'
+ if $self->autotype && !defined($type) && exists $self->maptype->{SOAPStruct};
+ return [$name || gen_name,
+ $self->autotype ? {'xsi:type' => $self->maptypetouri($type), %$attr} : { %$attr },
+ [map {$self->encode_object($hash->{$_}, $_)} keys %$hash],
+ $self->gen_id($hash)
+ ];
+}
+
+sub as_ordered_hash {
+ my $self = shift;
+ my ($value, $name, $type, $attr) = @_;
+ die "Not an ARRAY reference for 'ordered_hash' type" unless UNIVERSAL::isa($value => 'ARRAY');
+ return [ $name, $attr,
+ [map{$self->encode_object(@{$value}[2*$_+1,2*$_])} 0..$#$value/2 ],
+ $self->gen_id($value)
+ ];
+}
+
+sub as_map {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ die "Not a HASH reference for 'map' type" unless UNIVERSAL::isa($value => 'HASH');
+ my $prefix = ($self->namespaces->{$SOAP::Constants::NS_APS} ||= 'apachens');
+ my @items = map {$self->encode_object(SOAP::Data->type(ordered_hash => [key => $_, value => $value->{$_}]), 'item', '')} keys %$value;
+ return [$name, {'xsi:type' => "$prefix:Map", %$attr}, [@items], $self->gen_id($value)];
+}
+
+sub as_xml {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'_xml' => 1}, $value];
+}
+
+sub typecast {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return if ref $value; # skip complex object, caller knows how to deal with it
+ return if $self->autotype && !defined $type; # we don't know, autotype knows
+ return [$name,
+ {(defined $type && $type gt '' ? ('xsi:type' => $self->maptypetouri($type, 'simple type')) : ()), %$attr},
+ $value
+ ];
+}
+
+sub register_ns {
+ my $self = shift->new;
+# my $self = shift;
+ my ($ns,$prefix) = @_;
+ $prefix = gen_ns if !$prefix;
+ $self->{'_namespaces'}->{$ns} = $prefix if $ns;
+}
+
+sub find_prefix {
+ my $self = shift;
+ my ($ns) = @_;
+ foreach my $this_ns (keys %{$self->{'_namespaces'}}) {
+ return $self->{'_namespaces'}->{$this_ns} if ($ns eq $this_ns);
+ }
+}
+
+sub fixattrs {
+ my $self = shift;
+ my $data = shift;
+ my($name, $attr) = ($data->SOAP::Data::name, {%{$data->SOAP::Data::attr}});
+ my($xmlns, $prefix) = ($data->uri, $data->prefix);
+ unless (defined($xmlns) || defined($prefix)) {
+ $self->register_ns($xmlns,$prefix) unless ($self->use_default_ns);
+ return ($name, $attr);
+ }
+ $name ||= gen_name; # local name
+ $prefix = gen_ns if !defined $prefix && $xmlns gt '';
+ $prefix = '' if defined $xmlns && $xmlns eq '' ||
+ defined $prefix && $prefix eq '';
+
+ $attr->{join ':', xmlns => $prefix || ()} = $xmlns if defined $xmlns;
+ $name = join ':', $prefix, $name if $prefix;
+ $self->register_ns($xmlns,$prefix) unless ($self->use_default_ns);
+ return ($name, $attr);
+}
+
+sub toqname {
+ my $self = shift;
+ my $long = shift;
+
+ return $long unless $long =~ /^\{(.*)\}(.+)$/;
+ return SOAP::Utils::qualify $self->namespaces->{$1} ||= gen_ns, $2;
+}
+
+sub attrstoqname {
+ my $self = shift;
+ my $attrs = shift;
+
+ return {
+ map { /^\{(.*)\}(.+)$/
+ ? ($self->toqname($_) => $2 eq 'type' || $2 eq 'arrayType' ? $self->toqname($attrs->{$_}) : $attrs->{$_})
+ : ($_ => $attrs->{$_})
+ } keys %$attrs
+ };
+}
+
+sub tag {
+ my $self = shift;
+ my($tag, $attrs, @values) = @_;
+ my $value = join '', @values;
+ my $level = $self->level;
+ my $indent = $self->readable ? ' ' x (($level-1)*2) : '';
+
+ # check for special attribute
+ return "$indent$value" if exists $attrs->{_xml} && delete $attrs->{_xml};
+
+ die "Element '$tag' can't be allowed in valid XML message. Died."
+ if $tag !~ /^(?![xX][mM][lL])$SOAP::Constants::NSMASK$/o;
+
+ my $prolog = $self->readable ? "\n" : "";
+ my $epilog = $self->readable ? "\n" : "";
+ my $tagjoiner = " ";
+ if ($level == 1) {
+ my $namespaces = $self->namespaces;
+ foreach (keys %$namespaces) { $attrs->{SOAP::Utils::qualify(xmlns => $namespaces->{$_})} = $_ }
+ $prolog = qq!<?xml version="1.0" encoding="@{[$self->encoding]}"?>!
+ if defined $self->encoding;
+ $prolog .= "\n" if $self->readable;
+ $tagjoiner = " \n".(' ' x (($level+1) * 2)) if $self->readable;
+ }
+ my $tagattrs = join($tagjoiner, '', map { sprintf '%s="%s"', $_, SOAP::Utils::encode_attribute($attrs->{$_}) }
+ grep { $_ && defined $attrs->{$_} && ($_ ne 'xsi:type' || $attrs->{$_} ne '')
+ } keys %$attrs);
+
+ if ($value gt '') {
+ return sprintf("$prolog$indent<%s%s>%s%s</%s>$epilog",$tag,$tagattrs,$value,($value =~ /^\s*</ ? $indent : ""),$tag);
+ } else {
+ return sprintf("$prolog$indent<%s%s />$epilog$indent",$tag,$tagattrs);
+ }
+}
+
+sub xmlize {
+ my $self = shift;
+ my($name, $attrs, $values, $id) = @{+shift};
+ $attrs ||= {};
+
+ local $self->{_level} = $self->{_level} + 1;
+ return $self->tag($name, $attrs)
+ unless defined $values;
+ return $self->tag($name, $attrs, $values)
+ unless UNIVERSAL::isa($values => 'ARRAY');
+ return $self->tag($name, {%$attrs, href => '#'.$self->multiref_anchor($id)})
+ if $self->is_href($id, delete($attrs->{_id}));
+ return $self->tag($name,
+ {%$attrs, id => $self->multiref_anchor($id)},
+ map {$self->xmlize($_)} @$values);
+}
+
+sub uriformethod {
+ my $self = shift;
+
+ my $method_is_data = ref $_[0] && UNIVERSAL::isa($_[0] => 'SOAP::Data');
+
+ # drop prefrix from method that could be string or SOAP::Data object
+ my($prefix, $method) = $method_is_data
+ ? ($_[0]->prefix, $_[0]->name)
+ : SOAP::Utils::splitqname($_[0]);
+
+ my $attr = {reverse %{$self->namespaces}};
+ # try to define namespace that could be stored as
+ # a) method is SOAP::Data
+ # ? attribute in method's element as xmlns= or xmlns:${prefix}=
+ # : uri
+ # b) attribute in Envelope element as xmlns= or xmlns:${prefix}=
+ # c) no prefix or prefix equal serializer->envprefix
+ # ? '', but see coment below
+ # : die with error message
+ my $uri = $method_is_data
+ ? ref $_[0]->attr && ($_[0]->attr->{$prefix ? "xmlns:$prefix" : 'xmlns'} || $_[0]->uri)
+ : $self->uri;
+
+ defined $uri or $uri = $attr->{$prefix || ''};
+
+ defined $uri or $uri = !$prefix || $prefix eq $self->envprefix
+ # still in doubts what should namespace be in this case
+ # but will keep it like this for now and be compatible with our server
+ ? ( $method_is_data && $^W && warn("URI is not provided as an attribute for method ($method)\n"),
+ ''
+ )
+ : die "Can't find namespace for method ($prefix:$method)\n";
+
+ return ($uri, $method);
+}
+
+sub serialize { SOAP::Trace::trace('()');
+ my $self = shift->new;
+ @_ == 1 or Carp::croak "serialize() method accepts one parameter";
+
+ $self->seen({}); # reinitialize multiref table
+ my($encoded) = $self->encode_object($_[0]);
+
+ # now encode multirefs if any
+ # v -------------- subelements of Envelope
+ push(@{$encoded->[2]}, $self->encode_multirefs) if ref $encoded->[2];
+ return $self->xmlize($encoded);
+}
+
+sub envelope {
+ SOAP::Trace::trace('()');
+ my $self = shift->new;
+ my $type = shift;
+ my(@parameters, @header);
+ for (@_) {
+ # Find all the SOAP Headers
+ if (defined($_) && ref($_) && UNIVERSAL::isa($_ => 'SOAP::Header')) {
+ push(@header, $_);
+
+ # Find all the SOAP Message Parts (attachments)
+ } elsif (defined($_) && ref($_) &&
+ $self->context && $self->context->packager->is_supported_part($_)) {
+ $self->context->packager->push_part($_);
+
+ # Find all the SOAP Body elements
+ } else {
+ push(@parameters, $_);
+ }
+ }
+ my $header = @header ? SOAP::Data->set_value(@header) : undef;
+ my($body,$parameters);
+ if ($type eq 'method' || $type eq 'response') {
+ SOAP::Trace::method(@parameters);
+
+ my $method = shift(@parameters);
+# or die "Unspecified method for SOAP call\n";
+
+ $parameters = @parameters ? SOAP::Data->set_value(@parameters) : undef;
+ if (!defined($method)) {
+ } elsif (UNIVERSAL::isa($method => 'SOAP::Data')) {
+ $body = $method;
+ } elsif (!$self->use_default_ns) {
+ $body = SOAP::Data->name($method)->uri($self->{'_ns_uri'});
+ $body = $body->prefix($self->{'_ns_prefix'}) if ($self->{'_ns_prefix'});
+ } else {
+ if ($self->{'_ns_uri'}) {
+ $body = SOAP::Data->name($method)->attr( {
+ 'xmlns' => $self->{'_ns_uri'},
+ } );
+ } else {
+ $body = SOAP::Data->name($method);
+ }
+ }
+ # This is breaking a unit test right now...
+ $body->set_value(SOAP::Utils::encode_data($parameters ? \$parameters : ()))
+ if $body;
+ } elsif ($type eq 'fault') {
+ SOAP::Trace::fault(@parameters);
+ $body = SOAP::Data
+ -> name(SOAP::Utils::qualify($self->envprefix => 'Fault'))
+ # parameters[1] needs to be escaped - thanks to aka_hct at gmx dot de
+ # commented on 2001/03/28 because of failing in ApacheSOAP
+ # need to find out more about it
+ # -> attr({'xmlns' => ''})
+ -> value(\SOAP::Data->set_value(
+ SOAP::Data->name(faultcode => SOAP::Utils::qualify($self->envprefix => $parameters[0]))->type(""),
+ SOAP::Data->name(faultstring => SOAP::Utils::encode_data($parameters[1]))->type(""),
+ defined($parameters[2]) ? SOAP::Data->name(detail => do{my $detail = $parameters[2]; ref $detail ? \$detail : $detail}) : (),
+ defined($parameters[3]) ? SOAP::Data->name(faultactor => $parameters[3])->type("") : (),
+ ));
+ } elsif ($type eq 'freeform') {
+ SOAP::Trace::freeform(@parameters);
+ $body = SOAP::Data->set_value(@parameters);
+ } elsif (!defined($type)) {
+ # This occurs when the Body is intended to be null. When no method has been
+ # passed in of any kind.
+ } else {
+ die "Wrong type of envelope ($type) for SOAP call\n";
+ }
+
+ $self->seen({}); # reinitialize multiref table
+ # Build the envelope
+ # Right now it is possible for $body to be a SOAP::Data element that has not
+ # XML escaped any values. How do you remedy this?
+ my($encoded) = $self->encode_object(
+ SOAP::Data->name(SOAP::Utils::qualify($self->envprefix => 'Envelope') => \SOAP::Data->value(
+ ($header ? SOAP::Data->name(SOAP::Utils::qualify($self->envprefix => 'Header') => \$header) : ()),
+ ($body ? SOAP::Data->name(SOAP::Utils::qualify($self->envprefix => 'Body') => \$body) :
+ SOAP::Data->name(SOAP::Utils::qualify($self->envprefix => 'Body')) ),
+ ))->attr($self->attr)
+ );
+ $self->signature($parameters->signature) if ref $parameters;
+
+ # IMHO multirefs should be encoded after Body, but only some
+ # toolkits understand this encoding, so we'll keep them for now (04/15/2001)
+ # as the last element inside the Body
+ # v -------------- subelements of Envelope
+ # vv -------- last of them (Body)
+ # v --- subelements
+ push(@{$encoded->[2]->[-1]->[2]}, $self->encode_multirefs) if ref $encoded->[2]->[-1]->[2];
+
+ # Sometimes SOAP::Serializer is invoked statically when there is no context.
+ # So first check to see if a context exists.
+ # TODO - a context needs to be initialized by a constructor?
+ if ($self->context && $self->context->packager->parts) {
+ # TODO - this needs to be called! Calling it though wraps the payload twice!
+ # return $self->context->packager->package($self->xmlize($encoded));
+ }
+ return $self->xmlize($encoded);
+}
+
+# ======================================================================
+
+package SOAP::Parser;
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub xmlparser {
+ my $self = shift;
+ return eval { $SOAP::Constants::DO_NOT_USE_XML_PARSER ? undef : do {
+ require XML::Parser; XML::Parser->new }} ||
+ eval { require XML::Parser::Lite; XML::Parser::Lite->new } ||
+ die "XML::Parser is not @{[$SOAP::Constants::DO_NOT_USE_XML_PARSER ? 'used' : 'available']} and ", $@;
+}
+
+sub parser {
+ my $self = shift->new;
+# my $self = shift;
+ @_ ? ($self->{'_parser'} = shift, return $self) : return ($self->{'_parser'} ||= $self->xmlparser);
+}
+
+sub new {
+ my $self = shift;
+ return $self if ref $self;
+ my $class = ref($self) || $self;
+ SOAP::Trace::objects('()');
+ return bless {_parser => shift} => $class;
+}
+
+sub decode { SOAP::Trace::trace('()');
+ my $self = shift;
+
+ $self->parser->setHandlers(
+ Final => sub { shift; $self->final(@_) },
+ Start => sub { shift; $self->start(@_) },
+ End => sub { shift; $self->end(@_) },
+ Char => sub { shift; $self->char(@_) },
+ ExternEnt => sub { shift; die "External entity (pointing to '$_[1]') is not allowed" },
+ );
+ # my $parsed = $self->parser->parse($_[0]);
+ # return $parsed;
+ #
+ my $ret = undef;
+ eval {
+ $ret = $self->parser->parse($_[0]);
+ };
+ if ($@) {
+ $self->final; # Clean up in the event of an error
+ die $@; # Pass back the error
+ }
+ return $ret;
+}
+
+sub final {
+ my $self = shift;
+
+ # clean handlers, otherwise SOAP::Parser won't be deleted:
+ # it refers to XML::Parser which refers to subs from SOAP::Parser
+ # Thanks to Ryan Adams <iceman at mit.edu>
+ # and Craig Johnston <craig.johnston at pressplay.com>
+ # checked by number of tests in t/02-payload.t
+
+ undef $self->{_values};
+ $self->parser->setHandlers(
+ Final => undef, Start => undef, End => undef, Char => undef, ExternEnt => undef,
+ );
+ $self->{_done};
+}
+
+sub start { push @{shift->{_values}}, [shift, {@_}] }
+
+# string concatenation changed to arrays which should improve performance
+# for strings with many entity-encoded elements.
+# Thanks to Mathieu Longtin <mrdamnfrenchy at yahoo.com>
+sub char { push @{shift->{_values}->[-1]->[3]}, shift }
+
+sub end {
+ my $self = shift;
+ my $done = pop @{$self->{_values}};
+ $done->[2] = defined $done->[3] ? join('',@{$done->[3]}) : '' unless ref $done->[2];
+ undef $done->[3];
+ @{$self->{_values}} ? (push @{$self->{_values}->[-1]->[2]}, $done)
+ : ($self->{_done} = $done);
+}
+
+# ======================================================================
+
+package SOAP::SOM;
+
+use Carp ();
+
+sub BEGIN {
+ no strict 'refs';
+ my %path = (
+ root => '/',
+ envelope => '/Envelope',
+ body => '/Envelope/Body',
+ header => '/Envelope/Header',
+ headers => '/Envelope/Header/[>0]',
+ fault => '/Envelope/Body/Fault',
+ faultcode => '/Envelope/Body/Fault/faultcode',
+ faultstring => '/Envelope/Body/Fault/faultstring',
+ faultactor => '/Envelope/Body/Fault/faultactor',
+ faultdetail => '/Envelope/Body/Fault/detail',
+ );
+ for my $method (keys %path) {
+ *$method = sub {
+ my $self = shift;
+ ref $self or return $path{$method};
+ Carp::croak "Method '$method' is readonly and doesn't accept any parameters" if @_;
+ return $self->valueof($path{$method});
+ };
+ }
+ my %results = (
+ method => '/Envelope/Body/[1]',
+ result => '/Envelope/Body/[1]/[1]',
+ freeform => '/Envelope/Body/[>0]',
+ paramsin => '/Envelope/Body/[1]/[>0]',
+ paramsall => '/Envelope/Body/[1]/[>0]',
+ paramsout => '/Envelope/Body/[1]/[>1]'
+ );
+ for my $method (keys %results) {
+ *$method = sub {
+ my $self = shift;
+ ref $self or return $results{$method};
+ Carp::croak "Method '$method' is readonly and doesn't accept any parameters" if @_;
+ defined $self->fault ? return : return $self->valueof($results{$method});
+ };
+ }
+ for my $method (qw(context)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+ }
+ }
+ for my $method (qw(o_child o_value o_lname o_lattr o_qname)) { # import from SOAP::Utils
+ *$method = \&{'SOAP::Utils::'.$method};
+ }
+}
+
+# use object in boolean context return true/false on last match
+# Ex.: $som->match('//Fault') ? 'SOAP call failed' : 'success';
+use overload fallback => 1, 'bool' => sub { @{shift->{_current}} > 0 };
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ my $content = shift;
+ SOAP::Trace::objects('()');
+ return bless { _content => $content, _current => [$content] } => $class;
+}
+
+sub parts {
+ my $self = shift;
+ if (@_) {
+ $self->context->packager->parts(@_);
+ return $self;
+ } else {
+ return $self->context->packager->parts;
+ }
+}
+
+sub is_multipart {
+ my $self = shift;
+ return defined($self->parts);
+}
+
+sub current {
+ my $self = shift;
+ $self->{_current} = [@_], return $self if @_;
+ return wantarray ? @{$self->{_current}} : $self->{_current}->[0];
+}
+
+sub valueof {
+ my $self = shift;
+ local $self->{_current} = $self->{_current};
+ $self->match(shift) if @_;
+ return wantarray ? map {o_value($_)} @{$self->{_current}}
+ : @{$self->{_current}} ? o_value($self->{_current}->[0]) : undef;
+}
+
+sub headerof { # SOAP::Header is the same as SOAP::Data, so just rebless it
+ wantarray
+ ? map { bless $_ => 'SOAP::Header' } shift->dataof(@_)
+ : do { # header returned by ->dataof can be undef in scalar context
+ my $header = shift->dataof(@_);
+ ref $header ? bless($header => 'SOAP::Header') : undef;
+ };
+}
+
+sub dataof {
+ my $self = shift;
+ local $self->{_current} = $self->{_current};
+ $self->match(shift) if @_;
+ return wantarray ? map {$self->_as_data($_)} @{$self->{_current}}
+ : @{$self->{_current}} ? $self->_as_data($self->{_current}->[0]) : undef;
+}
+
+sub namespaceuriof {
+ my $self = shift;
+ local $self->{_current} = $self->{_current};
+ $self->match(shift) if @_;
+ return wantarray ? map {(SOAP::Utils::splitlongname(o_lname($_)))[0]} @{$self->{_current}}
+ : @{$self->{_current}} ? (SOAP::Utils::splitlongname(o_lname($self->{_current}->[0])))[0] : undef;
+}
+
+sub _as_data {
+ my $self = shift;
+ my $pointer = shift;
+
+ SOAP::Data
+ -> new(prefix => '', name => o_qname($pointer), name => o_lname($pointer), attr => o_lattr($pointer))
+ -> set_value(o_value($pointer));
+}
+
+sub match {
+ my $self = shift;
+ my $path = shift;
+ $self->{_current} = [
+ $path =~ s!^/!! || !@{$self->{_current}}
+ ? $self->_traverse($self->{_content}, 1 => split '/' => $path)
+ : map {$self->_traverse_tree(o_child($_), split '/' => $path)} @{$self->{_current}}
+ ];
+ return $self;
+}
+
+sub _traverse {
+ my $self = shift;
+ my($pointer, $itself, $path, @path) = @_;
+
+ die "Incorrect parameter" unless $itself =~ /^\d*$/;
+
+ if ($path && substr($path, 0, 1) eq '{') {
+ $path = join '/', $path, shift @path while @path && $path !~ /}/;
+ }
+
+ my($op, $num) = $path =~ /^\[(<=|<|>=|>|=|!=?)?(\d+)\]$/ if defined $path;
+
+ return $pointer unless defined $path;
+
+ $op = '==' unless $op; $op .= '=' if $op eq '=' || $op eq '!';
+ my $numok = defined $num && eval "$itself $op $num";
+ my $nameok = (o_lname($pointer) || '') =~ /(?:^|\})$path$/ if defined $path; # name can be with namespace
+
+ my $anynode = $path eq '';
+ unless ($anynode) {
+ if (@path) {
+ return if defined $num && !$numok || !defined $num && !$nameok;
+ } else {
+ return $pointer if defined $num && $numok || !defined $num && $nameok;
+ return;
+ }
+ }
+
+ my @walk;
+ push @walk, $self->_traverse_tree([$pointer], @path) if $anynode;
+ push @walk, $self->_traverse_tree(o_child($pointer), $anynode ? ($path, @path) : @path);
+ return @walk;
+}
+
+sub _traverse_tree {
+ my $self = shift;
+ my($pointer, @path) = @_;
+
+ # can be list of children or value itself. Traverse only children
+ return unless ref $pointer eq 'ARRAY';
+
+ my $itself = 1;
+
+ grep {defined}
+ map {$self->_traverse($_, $itself++, @path)}
+ grep {!ref o_lattr($_) ||
+ !exists o_lattr($_)->{"{$SOAP::Constants::NS_ENC}root"} ||
+ o_lattr($_)->{"{$SOAP::Constants::NS_ENC}root"} ne '0'}
+ @$pointer;
+}
+
+# ======================================================================
+
+package SOAP::Deserializer;
+
+use vars qw(@ISA);
+
+ at ISA = qw(SOAP::Cloneable);
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(ids hrefs parts parser base xmlschemas xmlschema context)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+
+ }
+ }
+}
+
+sub new {
+ my $self = shift;
+ return $self if ref $self;
+ my $class = ref($self) || $self;
+ SOAP::Trace::objects('()');
+ return bless {
+ '_ids' => {},
+ '_hrefs' => {},
+ '_parser' => SOAP::Parser->new,
+ '_xmlschemas' => {
+ $SOAP::Constants::NS_APS => 'SOAP::XMLSchemaApacheSOAP::Deserializer',
+ map { $_ => $SOAP::Constants::XML_SCHEMAS{$_} . '::Deserializer'
+ } keys %SOAP::Constants::XML_SCHEMAS
+ },
+ } => $class;
+}
+
+sub is_xml {
+ # Added check for envelope delivery. Fairly standard with MMDF and sendmail
+ # Thanks to Chris Davies <Chris.Davies at ManheimEurope.com>
+ $_[1] =~ /^\s*</ || $_[1] !~ /^(?:[\w-]+:|From )/;
+}
+
+sub baselocation {
+ my $self = shift;
+ my $location = shift;
+ if ($location) {
+ my $uri = URI->new($location);
+ # make absolute location if relative
+ $location = $uri->abs($self->base || 'thismessage:/')->as_string unless $uri->scheme;
+ }
+ return $location;
+}
+
+# Returns the envelope and populates SOAP::Packager with parts
+sub decode_parts {
+ my $self = shift;
+ my $env = $self->context->packager->unpackage($_[0],$self->context);
+ my $body = $self->parser->decode($env);
+ # TODO - This shouldn't be here! This is packager specific!
+ # However this does need to pull out all the cid's
+ # to populate ids hash with.
+ foreach (@{$self->context->packager->parts}) {
+ my $data = $_->bodyhandle->as_string;
+ my $type = $_->head->mime_attr('Content-Type');
+ my $location = $_->head->mime_attr('Content-Location');
+ my $id = $_->head->mime_attr('Content-Id');
+ $location = $self->baselocation($location);
+ my $part = lc($type) eq 'text/xml' && !$SOAP::Constants::DO_NOT_PROCESS_XML_IN_MIME ?
+ $self->parser->decode($data)
+ : ['mimepart', {}, $data];
+ # This below looks like unnecessary bloat!!!
+ # I should probably dereference the mimepart, provide a callback to get the string data
+ $id =~ s/^<([^>]*)>$/$1/; # string any leading and trailing brackets
+ $self->ids->{$id} = $part if $id;
+ $self->ids->{$location} = $part if $location;
+ }
+ return $body;
+}
+
+# decode returns a parsed body in the form of an ARRAY
+# each element of the ARRAY is a HASH, ARRAY or SCALAR
+sub decode {
+ my $self = shift->new; # this actually is important
+ return $self->is_xml($_[0])
+ ? $self->parser->decode($_[0])
+ : $self->decode_parts($_[0]);
+}
+
+# deserialize returns a SOAP::SOM object and parses straight
+# text as input
+sub deserialize {
+ SOAP::Trace::trace('()');
+ my $self = shift->new;
+
+ # initialize
+ $self->hrefs({});
+ $self->ids({});
+
+ # If the document is XML, then ids will be empty
+ # If the document is MIME, then ids will hold a list of cids
+ my $parsed = $self->decode($_[0]);
+
+ # Having this code here makes multirefs in the Body work, but multirefs
+ # that reference XML fragments in a MIME part do not work.
+ if (keys %{$self->ids()}) {
+ $self->traverse_ids($parsed);
+ } else {
+ # delay - set ids to be traversed later in decode_object, they only get
+ # traversed if an href is found that is referencing an id.
+ $self->ids($parsed);
+ }
+ $self->decode_object($parsed);
+ my $som = SOAP::SOM->new($parsed);
+ $som->context($self->context); # TODO - try removing this and see if it works!
+ return $som;
+}
+
+sub traverse_ids {
+ my $self = shift;
+ my $ref = shift;
+ my($undef, $attrs, $children) = @$ref;
+ # ^^^^^^ to fix nasty error on Mac platform (Carl K. Cunningham)
+ $self->ids->{$attrs->{'id'}} = $ref if exists $attrs->{'id'};
+ return unless ref $children;
+ for (@$children) {$self->traverse_ids($_)};
+}
+
+sub decode_object {
+ my $self = shift;
+ my $ref = shift;
+ my($name, $attrs, $children, $value) = @$ref;
+
+ $ref->[6] = $attrs = {%$attrs}; # make a copy for long attributes
+
+ use vars qw(%uris);
+ local %uris = (%uris, map {
+ do { (my $ns = $_) =~ s/^xmlns:?//; $ns } => delete $attrs->{$_}
+ } grep {/^xmlns(:|$)/} keys %$attrs);
+
+ foreach (keys %$attrs) {
+ next unless m/^($SOAP::Constants::NSMASK?):($SOAP::Constants::NSMASK)$/;
+
+ $1 =~ /^[xX][mM][lL]/ ||
+ $uris{$1} &&
+ do {
+ $attrs->{SOAP::Utils::longname($uris{$1}, $2)} = do {
+ my $value = $attrs->{$_};
+ $2 ne 'type' && $2 ne 'arrayType'
+ ? $value
+ : SOAP::Utils::longname($value =~ m/^($SOAP::Constants::NSMASK?):(${SOAP::Constants::NSMASK}(?:\[[\d,]*\])*)/
+ ? ($uris{$1} || die("Unresolved prefix '$1' for attribute value '$value'\n"), $2)
+ : ($uris{''} || die("Unspecified namespace for type '$value'\n"), $value)
+ );
+ };
+ 1;
+ } ||
+ die "Unresolved prefix '$1' for attribute '$_'\n";
+ }
+
+ # and now check the element
+ my $ns = ($name =~ s/^($SOAP::Constants::NSMASK?):// ? $1 : '');
+ $ref->[5] = SOAP::Utils::longname(
+ $ns ? ($uris{$ns} || die "Unresolved prefix '$ns' for element '$name'\n")
+ : (defined $uris{''} ? $uris{''} : undef),
+ $name
+ );
+
+ ($children, $value) = (undef, $children) unless ref $children;
+
+ return $name => ($ref->[4] = $self->decode_value(
+ [$ref->[5], $attrs, $children, $value]
+ ));
+}
+
+sub decode_value {
+ my $self = shift;
+ my $ref = shift;
+ my($name, $attrs, $children, $value) = @$ref;
+
+ # check SOAP version if applicable
+ use vars '$level'; local $level = $level || 0;
+ if (++$level == 1) {
+ my($namespace, $envelope) = SOAP::Utils::splitlongname($name);
+ SOAP::Lite->soapversion($namespace) if $envelope eq 'Envelope' && $namespace;
+ }
+
+ # check encodingStyle
+ # future versions may bind deserializer to encodingStyle
+ my $encodingStyle = $attrs->{"{$SOAP::Constants::NS_ENV}encodingStyle"} || "";
+ my (%union,%isect);
+ # TODO - SOAP 1.2 and 1.1 have different rules about valid encodingStyle values
+ # For example, in 1.1 - any http://schemas.xmlsoap.org/soap/encoding/*
+ # value is valid
+ # Find intersection of declared and supported encoding styles
+ foreach my $e (@SOAP::Constants::SUPPORTED_ENCODING_STYLES, split(/ +/,$encodingStyle)) {
+ $union{$e}++ && $isect{$e}++;
+ }
+ die "Unrecognized/unsupported value of encodingStyle attribute '$encodingStyle'"
+ if defined($encodingStyle) && length($encodingStyle) > 0 && !%isect &&
+ !(SOAP::Lite->soapversion == 1.1 && $encodingStyle =~ /(?:^|\b)$SOAP::Constants::NS_ENC/);
+
+ # removed to provide literal support in 0.65
+ #$encodingStyle !~ /(?:^|\b)$SOAP::Constants::NS_ENC/;
+ # # ^^^^^^^^ \b causing problems (!?) on some systems
+ # # as reported by David Dyck <dcd at tc.fluke.com>
+ # # so use (?:^|\b) instead
+
+ use vars '$arraytype'; # type of Array element specified on Array itself
+ # either specified with xsi:type, or <enc:name/> or array element
+ my ($type) = grep {defined}
+ map($attrs->{$_}, sort grep {/^\{$SOAP::Constants::NS_XSI_ALL\}type$/o} keys %$attrs),
+ $name =~ /^\{$SOAP::Constants::NS_ENC\}/ ? $name : $arraytype;
+ local $arraytype; # it's used only for one level, we don't need it anymore
+
+ # $name is not used here since type should be encoded as type, not as name
+ my ($schema, $class) = SOAP::Utils::splitlongname($type) if $type;
+ my $schemaclass = defined($schema) && $self->xmlschemas->{$schema}
+ || $self;
+ # store schema that is used in parsed message
+ $self->xmlschema($schema) if $schema && $schema =~ /XMLSchema/;
+
+ # don't use class/type if anyType/ur-type is specified on wire
+ undef $class if $schemaclass->can('anyTypeValue') && $schemaclass->anyTypeValue eq $class;
+
+ my $method = 'as_' . ($class || '-'); # dummy type if not defined
+ $class =~ s/__|\./::/g if $class;
+
+ my $id = $attrs->{id};
+ if (defined $id && exists $self->hrefs->{$id}) {
+ return $self->hrefs->{$id};
+ } elsif (exists $attrs->{href}) {
+ (my $id = delete $attrs->{href}) =~ s/^(#|cid:|uuid:)?//;
+ # convert to absolute if not internal '#' or 'cid:'
+ $id = $self->baselocation($id) unless $1;
+ return $self->hrefs->{$id} if exists $self->hrefs->{$id};
+ # First time optimization. we don't traverse IDs unless asked for it.
+ # This is where traversing id's is delayed from before
+ # - the first time through - ids should contain a copy of the parsed XML
+ # structure! seems silly to make so many copies
+ my $ids = $self->ids;
+ if (ref($ids) ne 'HASH') {
+ $self->ids({}); # reset list of ids first time through
+ $self->traverse_ids($ids);
+ }
+ if (exists($self->ids->{$id})) {
+ my $obj = ($self->decode_object(delete($self->ids->{$id})))[1];
+ return $self->hrefs->{$id} = $obj;
+ } else {
+ die "Unresolved (wrong?) href ($id) in element '$name'\n";
+ }
+ }
+
+ return undef if grep {
+ /^$SOAP::Constants::NS_XSI_NILS$/ &&
+ $self->xmlschemas->{$1 || $2}->as_undef($attrs->{$_})
+ } keys %$attrs;
+ # try to handle with typecasting
+ my $res = $self->typecast($value, $name, $attrs, $children, $type);
+ return $res if defined $res;
+
+ # ok, continue with others
+ if (exists $attrs->{"{$SOAP::Constants::NS_ENC}arrayType"}) {
+ my $res = [];
+ $self->hrefs->{$id} = $res if defined $id;
+
+ # check for arrayType which could be [1], [,2][5] or []
+ # [,][1] will NOT be allowed right now (multidimensional sparse array)
+ my($type, $multisize) = $attrs->{"{$SOAP::Constants::NS_ENC}arrayType"}
+ =~ /^(.+)\[(\d*(?:,\d+)*)\](?:\[(?:\d+(?:,\d+)*)\])*$/
+ or die qq!Unrecognized/unsupported format of arrayType attribute '@{[$attrs->{"{$SOAP::Constants::NS_ENC}arrayType"}]}'\n!;
+
+ my @dimensions = map { $_ || undef } split /,/, $multisize;
+ my $size = 1; foreach (@dimensions) { $size *= $_ || 0 }
+
+ local $arraytype = $type;
+
+ # multidimensional
+ if ($multisize =~ /,/) {
+ @$res = splitarray(
+ [@dimensions],
+ [map { scalar(($self->decode_object($_))[1]) } @{$children || []}]
+ );
+
+ # normal
+ } else {
+ @$res = map { scalar(($self->decode_object($_))[1]) } @{$children || []};
+ }
+
+ # sparse (position)
+ if (ref $children && exists SOAP::Utils::o_lattr($children->[0])->{"{$SOAP::Constants::NS_ENC}position"}) {
+ my @new;
+ for (my $pos = 0; $pos < @$children; $pos++) {
+ # TBD implement position in multidimensional array
+ my($position) = SOAP::Utils::o_lattr($children->[$pos])->{"{$SOAP::Constants::NS_ENC}position"} =~ /^\[(\d+)\]$/
+ or die "Position must be specified for all elements of sparse array\n";
+ $new[$position] = $res->[$pos];
+ }
+ @$res = @new;
+ }
+
+ # partially transmitted (offset)
+ # TBD implement offset in multidimensional array
+ my($offset) = $attrs->{"{$SOAP::Constants::NS_ENC}offset"} =~ /^\[(\d+)\]$/
+ if exists $attrs->{"{$SOAP::Constants::NS_ENC}offset"};
+ unshift(@$res, (undef) x $offset) if $offset;
+
+ die "Too many elements in array. @{[scalar@$res]} instead of claimed $multisize ($size)\n"
+ if $multisize && $size < @$res;
+
+ # extend the array if number of elements is specified
+ $#$res = $dimensions[0]-1 if defined $dimensions[0] && @$res < $dimensions[0];
+
+ return defined $class && $class ne 'Array' ? bless($res => $class) : $res;
+
+ } elsif ($name =~ /^\{$SOAP::Constants::NS_ENC\}Struct$/ ||
+ !$schemaclass->can($method) &&
+ (ref $children || defined $class && $value =~ /^\s*$/)) {
+ my $res = {};
+ $self->hrefs->{$id} = $res if defined $id;
+ # Patch code introduced in 0.65 - deserializes array properly
+ # %$res = map {$self->decode_object($_)} @{$children || []}; # removed in patch
+ # Decode each element of the struct.
+ foreach my $child (@{$children || []}) {
+ my ($child_name, $child_value) = $self->decode_object($child);
+ # Store the decoded element in the struct. If the element name is
+ # repeated, replace the previous scalar value with a new array
+ # containing both values.
+ my $prev = $res->{$child_name};
+ if (not defined $prev) {
+ # first time to see this value: use scalar
+ $res->{$child_name} = $child_value;
+ } elsif (ref $prev ne "ARRAY") {
+ # second time to see this value: convert scalar to array
+ $res->{$child_name} = [ $prev, $child_value ];
+ } else {
+ # already have an array: append to it
+ push @{$res->{$child_name}}, $child_value;
+ }
+ }
+ # End patch code
+ return defined $class && $class ne 'SOAPStruct' ? bless($res => $class) : $res;
+ } else {
+ my $res;
+ if ($schemaclass->can($method)) {
+ $method = "$schemaclass\::$method" unless ref $schemaclass;
+ $res = $self->$method($value, $name, $attrs, $children, $type);
+ } else {
+ $res = $self->typecast($value, $name, $attrs, $children, $type);
+ $res = $class ? die "Unrecognized type '$type'\n" : $value
+ unless defined $res;
+ }
+ $self->hrefs->{$id} = $res if defined $id;
+ return $res;
+ }
+}
+
+sub splitarray {
+ my @sizes = @{+shift};
+ my $size = shift @sizes;
+ my $array = shift;
+
+ return splice(@$array, 0, $size) unless @sizes;
+ my @array = ();
+ push @array, [splitarray([@sizes], $array)] while @$array && (!defined $size || $size--);
+ return @array;
+}
+
+sub typecast { } # typecast is called for both objects AND scalar types
+ # check ref of the second parameter (first is the object)
+ # return undef if you don't want to handle it
+
+# ======================================================================
+
+package SOAP::Client;
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(endpoint code message is_success status options)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+# my $self = shift;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+ }
+ }
+}
+
+# ======================================================================
+
+package SOAP::Server::Object;
+
+sub gen_id; *gen_id = \&SOAP::Serializer::gen_id;
+
+my %alive;
+my %objects;
+
+sub objects_by_reference {
+ shift;
+ while (@_) { @alive{shift()} = ref $_[0] ? shift : sub { $_[1]-$_[$_[5] ? 5 : 4] > $SOAP::Constants::OBJS_BY_REF_KEEPALIVE } }
+ keys %alive;
+}
+
+sub reference {
+ my $self = shift;
+ my $stamp = time;
+ my $object = shift;
+ my $id = $stamp . $self->gen_id($object);
+
+ # this is code for garbage collection
+ my $time = time;
+ my $type = ref $object;
+ my @objects = grep { $objects{$_}->[1] eq $type } keys %objects;
+ for (grep { $alive{$type}->(scalar @objects, $time, @{$objects{$_}}) } @objects) {
+ delete $objects{$_};
+ }
+
+ $objects{$id} = [$object, $type, $stamp];
+ bless { id => $id } => ref $object;
+}
+
+sub references {
+ my $self = shift;
+ return @_ unless %alive; # small optimization
+ map { ref($_) && exists $alive{ref $_} ? $self->reference($_) : $_ } @_;
+}
+
+sub object {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ my $object = shift;
+ return $object unless ref($object) && $alive{ref $object} && exists $object->{id};
+ my $reference = $objects{$object->{id}};
+ die "Object with specified id couldn't be found\n" unless ref $reference->[0];
+ $reference->[3] = time; # last access time
+ return $reference->[0]; # reference to actual object
+}
+
+sub objects {
+ my $self = shift;
+ return @_ unless %alive; # small optimization
+ map { ref($_) && exists $alive{ref $_} && exists $_->{id} ? $self->object($_) : $_ } @_;
+}
+
+# ======================================================================
+
+package SOAP::Server::Parameters;
+
+sub byNameOrOrder {
+ unless (UNIVERSAL::isa($_[-1] => 'SOAP::SOM')) {
+ warn "Last parameter is expected to be envelope\n" if $^W;
+ pop;
+ return @_;
+ }
+ my $params = pop->method;
+ my @mandatory = ref $_[0] eq 'ARRAY' ? @{shift()} : die "list of parameters expected as the first parameter for byName";
+ my $byname = 0;
+ my @res = map { $byname += exists $params->{$_}; $params->{$_} } @mandatory;
+ return $byname ? @res : @_;
+}
+
+sub byName {
+ unless (UNIVERSAL::isa($_[-1] => 'SOAP::SOM')) {
+ warn "Last parameter is expected to be envelope\n" if $^W;
+ pop;
+ return @_;
+ }
+ return @{pop->method}{ref $_[0] eq 'ARRAY' ? @{shift()} : die "list of parameters expected as the first parameter for byName"};
+}
+
+# ======================================================================
+
+package SOAP::Server;
+
+use Carp ();
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub initialize {
+ return (
+ packager => SOAP::Packager::MIME->new,
+ transport => SOAP::Transport->new,
+ serializer => SOAP::Serializer->new,
+ deserializer => SOAP::Deserializer->new,
+ on_action => sub { ; },
+ on_dispatch => sub { return; },
+ );
+}
+
+sub new {
+ my $self = shift;
+ return $self if ref $self;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my(@params, @methods);
+
+ while (@_) { my($method, $params) = splice(@_,0,2);
+ $class->can($method) ? push(@methods, $method, $params)
+ : $^W && Carp::carp "Unrecognized parameter '$method' in new()";
+ }
+ $self = bless {
+ _dispatch_to => [],
+ _dispatch_with => {},
+ _dispatched => [],
+ _action => '',
+ _options => {},
+ } => $class;
+ unshift(@methods, $self->initialize);
+ while (@methods) { my($method, $params) = splice(@methods,0,2);
+ $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ }
+ SOAP::Trace::objects('()');
+ }
+
+ Carp::carp "Odd (wrong?) number of parameters in new()" if $^W && (@_ & 1);
+ while (@_) { my($method, $params) = splice(@_,0,2);
+ $self->can($method)
+ ? $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ : $^W && Carp::carp "Unrecognized parameter '$method' in new()"
+ }
+
+ return $self;
+}
+
+sub init_context {
+ my $self = shift;
+ $self->{'_deserializer'}->{'_context'} = $self;
+ $self->{'_serializer'}->{'_context'} = $self;
+}
+
+sub destroy_context {
+ my $self = shift;
+ delete($self->{'_deserializer'}->{'_context'});
+ delete($self->{'_serializer'}->{'_context'})
+}
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(serializer deserializer transport)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ if (@_) {
+ my $context = $self->{$field}->{'_context'}; # save the old context
+ $self->{$field} = shift;
+ $self->{$field}->{'_context'} = $context; # restore the old context
+ return $self;
+ } else {
+ return $self->{$field};
+ }
+ }
+ }
+ for my $method (qw(action myuri options dispatch_with packager)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+# my $self = shift;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+ }
+ }
+ for my $method (qw(on_action on_dispatch)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+# my $self = shift;
+ return $self->{$field} unless @_;
+ local $@;
+ # commented out because that 'eval' was unsecure
+ # > ref $_[0] eq 'CODE' ? shift : eval shift;
+ # Am I paranoid enough?
+ $self->{$field} = shift;
+ Carp::croak $@ if $@;
+ Carp::croak "$method() expects subroutine (CODE) or string that evaluates into subroutine (CODE)"
+ unless ref $self->{$field} eq 'CODE';
+ return $self;
+ }
+ }
+ for my $method (qw(dispatch_to)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+# my $self = shift;
+ @_ ? ($self->{$field} = [@_], return $self)
+ : return @{$self->{$field}};
+ }
+ }
+}
+
+sub objects_by_reference {
+ my $self = shift->new;
+# my $self = shift;
+ @_ ? (SOAP::Server::Object->objects_by_reference(@_), return $self)
+ : SOAP::Server::Object->objects_by_reference;
+}
+
+sub dispatched {
+ my $self = shift->new;
+# my $self = shift;
+ @_ ? (push(@{$self->{_dispatched}}, @_), return $self)
+ : return @{$self->{_dispatched}};
+}
+
+sub find_target {
+ my $self = shift;
+ my $request = shift;
+
+ # try to find URI/method from on_dispatch call first
+ my($method_uri, $method_name) = $self->on_dispatch->($request);
+
+ # if nothing there, then get it from envelope itself
+ $request->match((ref $request)->method);
+ ($method_uri, $method_name) = ($request->namespaceuriof || '', $request->dataof->name)
+ unless $method_name;
+
+ $self->on_action->(my $action = $self->action, $method_uri, $method_name);
+
+ # check to avoid security vulnerability: Protected->Unprotected::method(@parameters)
+ # see for more details: http://www.phrack.org/phrack/58/p58-0x09
+ die "Denied access to method ($method_name)\n" unless $method_name =~ /^\w+$/;
+
+ my($class, $static);
+ # try to bind directly
+ if (defined($class = $self->dispatch_with->{$method_uri}
+ || $self->dispatch_with->{$action || ''}
+ || ($action =~ /^"(.+)"$/ ? $self->dispatch_with->{$1} : undef))) {
+ # return object, nothing else to do here
+ return ($class, $method_uri, $method_name) if ref $class;
+ $static = 1;
+ } else {
+ die "URI path shall map to class" unless defined ($class = URI->new($method_uri)->path);
+
+ for ($class) { s!^/|/$!!g; s!/!::!g; s/^$/main/; }
+ die "Failed to access class ($class)" unless $class =~ /^(\w[\w:]*)$/;
+
+ my $fullname = "$class\::$method_name";
+ foreach ($self->dispatch_to) {
+ return ($_, $method_uri, $method_name) if ref eq $class; # $OBJECT
+ next if ref; # skip other objects
+ # will ignore errors, because it may complain on
+ # d:\foo\bar, which is PATH and not regexp
+ eval {
+ $static ||=
+ $class =~ /^$_$/ || # MODULE
+ $fullname =~ /^$_$/ || # MODULE::method
+ $method_name =~ /^$_$/ && ($class eq 'main') # method ('main' assumed)
+ ;
+ };
+ }
+ }
+
+ no strict 'refs';
+
+# TODO - sort this mess out:
+# SOAP::Lite 0.60:
+# unless (defined %{"${class}::"}) {
+# Patch to SOAP::Lite 0.60:
+# The following patch does not work for packages defined within a BEGIN block
+# unless (exists($INC{join '/', split /::/, $class.'.pm'})) {
+# Combination of 0.60 and patch:
+ unless (defined(%{"${class}::"}) || exists($INC{join '/', split /::/, $class.'.pm'})) {
+ # allow all for static and only specified path for dynamic bindings
+ local @INC = (($static ? @INC : ()), grep {!ref && m![/\\.]!} $self->dispatch_to);
+ eval 'local $^W; ' . "require $class";
+ die "Failed to access class ($class): $@" if $@;
+ $self->dispatched($class) unless $static;
+ }
+
+ die "Denied access to method ($method_name) in class ($class)"
+ unless $static || grep {/^$class$/} $self->dispatched;
+
+ return ($class, $method_uri, $method_name);
+}
+
+sub handle {
+ SOAP::Trace::trace('()');
+ my $self = shift;
+ $self = $self->new if !ref $self; # inits the server when called in a static context
+ $self->init_context();
+ # we want to restore it when we are done
+ local $SOAP::Constants::DEFAULT_XML_SCHEMA
+ = $SOAP::Constants::DEFAULT_XML_SCHEMA;
+
+ # SOAP version WILL NOT be restored when we are done.
+ # is it problem?
+
+ my $result = eval {
+ local $SIG{__DIE__};
+ # why is this here:
+ $self->serializer->soapversion(1.1);
+ my $request = eval { $self->deserializer->deserialize($_[0]) };
+ die SOAP::Fault
+ ->faultcode($SOAP::Constants::FAULT_VERSION_MISMATCH)
+ ->faultstring($@)
+ if $@ && $@ =~ /^$SOAP::Constants::WRONG_VERSION/;
+ die "Application failed during request deserialization: $@" if $@;
+ my $som = ref $request;
+ die "Can't find root element in the message"
+ unless $request->match($som->envelope);
+ $self->serializer->soapversion(SOAP::Lite->soapversion);
+ $self->serializer->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA
+ = $self->deserializer->xmlschema)
+ if $self->deserializer->xmlschema;
+
+ die SOAP::Fault
+ ->faultcode($SOAP::Constants::FAULT_MUST_UNDERSTAND)
+ ->faultstring("Unrecognized header has mustUnderstand attribute set to 'true'")
+ if !$SOAP::Constants::DO_NOT_CHECK_MUSTUNDERSTAND &&
+ grep { $_->mustUnderstand &&
+ (!$_->actor || $_->actor eq $SOAP::Constants::NEXT_ACTOR)
+ } $request->dataof($som->headers);
+
+ die "Can't find method element in the message"
+ unless $request->match($som->method);
+ # TODO - SOAP::Dispatcher plugs in here
+ # my $handler = $self->dispatcher->find_handler($request);
+ my($class, $method_uri, $method_name) = $self->find_target($request);
+ my @results = eval {
+ local $^W;
+ my @parameters = $request->paramsin;
+
+ # SOAP::Trace::dispatch($fullname);
+ SOAP::Trace::parameters(@parameters);
+
+ push @parameters, $request
+ if UNIVERSAL::isa($class => 'SOAP::Server::Parameters');
+
+ SOAP::Server::Object->references(
+ defined $parameters[0] && ref $parameters[0] &&
+ UNIVERSAL::isa($parameters[0] => $class) ? do {
+ my $object = shift @parameters;
+ SOAP::Server::Object->object(ref $class ? $class : $object)
+ ->$method_name(SOAP::Server::Object->objects(@parameters)),
+ # send object back as a header
+ # preserve name, specify URI
+ SOAP::Header
+ ->uri($SOAP::Constants::NS_SL_HEADER => $object)
+ ->name($request->dataof($som->method.'/[1]')->name)
+ } # end do block
+ # SOAP::Dispatcher will plug-in here as well
+ # $handler->dispatch(SOAP::Server::Object->objects(@parameters)
+ : $class->$method_name(SOAP::Server::Object->objects(@parameters)) );
+ }; # end eval block
+ SOAP::Trace::result(@results);
+
+ # let application errors pass through with 'Server' code
+ die ref $@ ?
+ $@ : $@ =~ /^Can\'t locate object method "$method_name"/ ?
+ "Failed to locate method ($method_name) in class ($class)" :
+ SOAP::Fault->faultcode($SOAP::Constants::FAULT_SERVER)->faultstring($@)
+ if $@;
+
+ my $result = $self->serializer
+ ->prefix('s') # distinguish generated element names between client and server
+ ->uri($method_uri)
+ ->envelope(response => $method_name . 'Response', @results);
+ $self->destroy_context();
+ return $result;
+ };
+
+ $self->destroy_context();
+ # void context
+ return unless defined wantarray;
+
+ # normal result
+ return $result unless $@;
+
+ # check fails, something wrong with message
+ return $self->make_fault($SOAP::Constants::FAULT_CLIENT, $@) unless ref $@;
+
+ # died with SOAP::Fault
+ return $self->make_fault($@->faultcode || $SOAP::Constants::FAULT_SERVER,
+ $@->faultstring || 'Application error',
+ $@->faultdetail, $@->faultactor)
+ if UNIVERSAL::isa($@ => 'SOAP::Fault');
+
+ # died with complex detail
+ return $self->make_fault($SOAP::Constants::FAULT_SERVER, 'Application error' => $@);
+
+} # end of handle()
+
+sub make_fault {
+ my $self = shift;
+ my($code, $string, $detail, $actor) = @_;
+ $self->serializer->fault($code, $string, $detail, $actor || $self->myuri);
+}
+
+# ======================================================================
+
+package SOAP::Trace;
+
+use Carp ();
+
+my @list = qw(transport dispatch result parameters headers objects method fault freeform trace debug);
+{ no strict 'refs'; for (@list) { *$_ = sub {} } }
+
+sub defaultlog {
+ my $caller = (caller(1))[3]; # the 4th element returned by caller is the subroutine namea
+ $caller = (caller(2))[3] if $caller =~ /eval/;
+ chomp(my $msg = join ' ', @_);
+ printf STDERR "%s: %s\n", $caller, $msg;
+}
+
+sub import { no strict 'refs'; local $^W;
+ my $pack = shift;
+ my(@notrace, @symbols);
+ for (@_) {
+ if (ref eq 'CODE') {
+ my $call = $_;
+ foreach (@symbols) { *$_ = sub { $call->(@_) } }
+ @symbols = ();
+ } else {
+ local $_ = $_;
+ my $minus = s/^-//;
+ my $all = $_ eq 'all';
+ Carp::carp "Illegal symbol for tracing ($_)" unless $all || $pack->can($_);
+ $minus ? push(@notrace, $all ? @list : $_) : push(@symbols, $all ? @list : $_);
+ }
+ }
+ # TODO - I am getting a warning here about redefining a subroutine
+ foreach (@symbols) { *$_ = \&defaultlog }
+ foreach (@notrace) { *$_ = sub {} }
+}
+
+# ======================================================================
+
+package SOAP::Custom::XML::Data;
+
+use vars qw(@ISA $AUTOLOAD);
+ at ISA = qw(SOAP::Data);
+
+use overload fallback => 1, '""' => sub { shift->value };
+
+sub _compileit {
+ no strict 'refs';
+ my $method = shift;
+ *$method = sub {
+ return __PACKAGE__->SUPER::name($method => $_[0]->attr->{$method})
+ if exists $_[0]->attr->{$method};
+ my @elems = grep {
+ ref $_ && UNIVERSAL::isa($_ => __PACKAGE__) && $_->SUPER::name =~ /(^|:)$method$/
+ } $_[0]->value;
+ return wantarray? @elems : $elems[0];
+ }
+}
+
+sub BEGIN { foreach (qw(name type import)) { _compileit($_) } }
+
+sub AUTOLOAD {
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+ return if $method eq 'DESTROY';
+
+ _compileit($method);
+ goto &$AUTOLOAD;
+}
+
+# ======================================================================
+
+package SOAP::Custom::XML::Deserializer;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Deserializer);
+
+sub decode_value {
+ my $self = shift;
+ my $ref = shift;
+ my($name, $attrs, $children, $value) = @$ref;
+ # base class knows what to do with it
+ return $self->SUPER::decode_value($ref) if exists $attrs->{href};
+
+ SOAP::Custom::XML::Data
+ -> SOAP::Data::name($name)
+ -> attr($attrs)
+ -> set_value(ref $children && @$children ? map(scalar(($self->decode_object($_))[1]), @$children) : $value);
+}
+
+# ======================================================================
+
+package SOAP::Schema::Deserializer;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Custom::XML::Deserializer);
+
+# ======================================================================
+
+package SOAP::Schema::WSDL;
+
+use vars qw(%imported @ISA);
+ at ISA = qw(SOAP::Schema);
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ $self = $class->SUPER::new(@_);
+# $self = bless {} => $class;
+ }
+ return $self;
+}
+
+sub base {
+ my $self = shift->new;
+ @_ ? ($self->{_base} = shift, return $self) : return $self->{_base};
+}
+
+sub import {
+ my $self = shift->new;
+ my $s = shift;
+ my $base = shift || $self->base || die "Missing base argument for ", __PACKAGE__, "\n";
+
+# my $schema;
+ my @a = $s->import;
+ local %imported = %imported;
+ foreach (@a) {
+ next unless $_->location;
+ my $location = URI->new_abs($_->location->value, $base)->as_string;
+ if ($imported{$location}++) {
+ warn "Recursion loop detected in service description from '$location'. Ignored\n" if $^W;
+ return $s;
+ }
+# $schema ||= SOAP::Schema->new;
+# my $root = $self->import($schema->deserializer->deserialize($schema->access($location))->root, $location);
+ my $root = $self->import($self->deserializer->deserialize($self->access($location))->root, $location);
+ $root->SOAP::Data::name eq 'definitions' ? $s->set_value($s->value, $root->value) :
+ $root->SOAP::Data::name eq 'schema' ? do { # add <types> element if there is no one
+ $s->set_value($s->value, $self->deserializer->deserialize('<types></types>')->root) unless $s->types;
+ $s->types->set_value($s->types->value, $root) } :
+ die "Don't know what to do with '@{[$root->SOAP::Data::name]}' in schema imported from '$location'\n";
+ }
+ # return the parsed WSDL file
+ $s;
+}
+
+# TODO - This is woefully incomplete!
+sub parse_schema_element {
+ my $element = shift;
+ # Current element is a complex type
+ if (defined($element->complexType)) {
+ if (defined($element->complexType->sequence)) {
+ my @elements;
+ foreach my $e ($element->complexType->sequence->element) {
+ push @elements,parse_schema_element($e);
+ }
+ return @elements;
+ }
+ } elsif ($element->simpleType) {
+ } else {
+ return $element;
+ }
+}
+
+sub parse {
+ my $self = shift->new;
+ my($s, $service, $port) = @_;
+ my @result;
+
+ # handle imports
+ $self->import($s);
+
+ # handle descriptions without <service>, aka tModel-type descriptions
+ my @services = $s->service;
+ my $tns = $s->{'_attr'}->{'targetNamespace'};
+ # if there is no <service> element we'll provide it
+ @services = $self->deserializer->deserialize(<<"FAKE")->root->service unless @services;
+<definitions>
+ <service name="@{[$service || 'FakeService']}">
+ <port name="@{[$port || 'FakePort']}" binding="@{[$s->binding->name]}"/>
+ </service>
+</definitions>
+FAKE
+
+ my $has_warned = 0;
+ foreach (@services) {
+ my $name = $_->name;
+ next if $service && $service ne $name;
+ my %services;
+ foreach ($_->port) {
+ next if $port && $port ne $_->name;
+ my $binding = SOAP::Utils::disqualify($_->binding);
+ my $endpoint = ref $_->address ? $_->address->location : undef;
+ foreach ($s->binding) {
+ # is this a SOAP binding?
+ next unless grep { $_->uri eq 'http://schemas.xmlsoap.org/wsdl/soap/' } $_->binding;
+ next unless $_->name eq $binding;
+ my $default_style = $_->binding->style;
+ my $porttype = SOAP::Utils::disqualify($_->type);
+ foreach ($_->operation) {
+ my $opername = $_->name;
+ $services{$opername} = {}; # should be initialized in 5.7 and after
+ my $soapaction = $_->operation->soapAction;
+ my $invocationStyle = $_->operation->style || $default_style || "rpc";
+ my $encodingStyle = $_->input->body->use || "encoded";
+ my $namespace = $_->input->body->namespace || $tns;
+ my @parts;
+ foreach ($s->portType) {
+ next unless $_->name eq $porttype;
+ foreach ($_->operation) {
+ next unless $_->name eq $opername;
+ my $inputmessage = SOAP::Utils::disqualify($_->input->message);
+ foreach my $msg ($s->message) {
+ next unless $msg->name eq $inputmessage;
+ if ($invocationStyle eq "document" && $encodingStyle eq "literal") {
+ warn "document/literal support is EXPERIMENTAL in SOAP::Lite"
+ if !$has_warned && ($has_warned = 1);
+ my ($input_ns,$input_name) = SOAP::Utils::splitqname($msg->part->element);
+ foreach my $schema ($s->types->schema) {
+ foreach my $element ($schema->element) {
+ next unless $element->name eq $input_name;
+ push @parts,parse_schema_element($element);
+ }
+ $services{$opername}->{parameters} = [ @parts ];
+ }
+ } else {
+ # TODO - support all combinations of doc|rpc/lit|enc.
+ #warn "$invocationStyle/$encodingStyle is not supported in this version of SOAP::Lite";
+ @parts = $msg->part;
+ $services{$opername}->{parameters} = [ @parts ];
+ }
+ }
+ }
+
+ for ($services{$opername}) {
+ $_->{endpoint} = $endpoint;
+ $_->{soapaction} = $soapaction;
+ $_->{uri} = $namespace;
+# $_->{parameters} = [@parts];
+ }
+
+ }
+ }
+ }
+ }
+ # fix nonallowed characters in package name, and add 's' if started with digit
+ for ($name) { s/\W+/_/g; s/^(\d)/s$1/ }
+ push @result, $name => \%services;
+ }
+ return @result;
+}
+
+# ======================================================================
+
+# Naming? SOAP::Service::Schema?
+package SOAP::Schema;
+
+use Carp ();
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+ return $self if ref $self;
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ require LWP::UserAgent;
+ $self = bless {
+ '_deserializer' => SOAP::Schema::Deserializer->new,
+ '_useragent' => LWP::UserAgent->new,
+ } => $class;
+
+ SOAP::Trace::objects('()');
+ }
+
+ Carp::carp "Odd (wrong?) number of parameters in new()" if $^W && (@_ & 1);
+ while (@_) { my $method = shift; $self->$method(shift) if $self->can($method) }
+
+ return $self;
+}
+
+sub schema {
+ warn "SOAP::Schema->schema has been deprecated. Please use SOAP::Schema->schema_url instead.";
+ return shift->schema_url(@_);
+}
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(deserializer schema_url services useragent stub cache_dir cache_ttl)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+ }
+ }
+}
+
+sub parse {
+ my $self = shift;
+ my $s = $self->deserializer->deserialize($self->access)->root;
+ # here should be something that defines what schema description we want to use
+ $self->services({SOAP::Schema::WSDL->base($self->schema_url)->parse($s, @_)});
+}
+
+sub refresh_cache {
+ my $self = shift;
+ my ($filename,$contents) = @_;
+ open CACHE,">$filename" or Carp::croak "Could not open cache file for writing: $!";
+ print CACHE $contents;
+ close CACHE;
+}
+
+sub load {
+ my $self = shift->new;
+ local $^W; # supress warnings about redefining
+ foreach (keys %{$self->services || Carp::croak 'Nothing to load. Schema is not specified'}) {
+ # TODO - check age of cached file, and delete if older than configured amount
+ if ($self->cache_dir) {
+ my $cached_file = File::Spec->catfile($self->cache_dir,$_.".pm");
+ my $ttl = $self->cache_ttl || $SOAP::Constants::DEFAULT_CACHE_TTL;
+ open (CACHE, "<$cached_file");
+ my @stat = stat($cached_file) unless eof(CACHE);
+ close CACHE;
+ if (@stat) {
+ # Cache exists
+ my $cache_lived = time() - $stat[9];
+ if ($ttl > 0 && $cache_lived > $ttl) {
+ $self->refresh_cache($cached_file,$self->generate_stub($_));
+ }
+ } else {
+ # Cache doesn't exist
+ $self->refresh_cache($cached_file,$self->generate_stub($_));
+ }
+ push @INC,$self->cache_dir;
+ eval "require $_" or Carp::croak "Could not load cached file: $@";
+ } else {
+ eval $self->generate_stub($_) or Carp::croak "Bad stub: $@";
+ }
+ }
+ $self;
+}
+
+sub access {
+ my $self = shift->new;
+ my $url = shift || $self->schema_url || Carp::croak 'Nothing to access. URL is not specified';
+ $self->useragent->env_proxy if $ENV{'HTTP_proxy'};
+
+ my $req = HTTP::Request->new(GET => $url);
+ $req->proxy_authorization_basic($ENV{'HTTP_proxy_user'}, $ENV{'HTTP_proxy_pass'})
+ if ($ENV{'HTTP_proxy_user'} && $ENV{'HTTP_proxy_pass'});
+
+ my $resp = $self->useragent->request($req);
+ $resp->is_success ? $resp->content : die "Service description '$url' can't be loaded: ", $resp->status_line, "\n";
+}
+
+sub generate_stub {
+ my $self = shift->new;
+ my $package = shift;
+ my $services = $self->services->{$package};
+ my $schema_url = $self->schema_url;
+
+ $self->{'_stub'} = <<"EOP";
+package $package;
+# Generated by SOAP::Lite (v$SOAP::Lite::VERSION) for Perl -- soaplite.com
+# Copyright (C) 2000-2004 Paul Kulchenko
+# -- generated at [@{[scalar localtime]}]
+EOP
+ $self->{'_stub'} .= "# -- generated from $schema_url\n" if $schema_url;
+ $self->{'_stub'} .= 'my %methods = ('."\n";
+ foreach my $service (keys %$services) {
+ $self->{'_stub'} .= "$service => {\n";
+ foreach (qw(endpoint soapaction uri)) {
+ $self->{'_stub'} .= " $_ => '".$services->{$service}{$_}."',\n";
+ }
+ $self->{'_stub'} .= " parameters => [\n";
+ foreach (@{$services->{$service}{parameters}}) {
+# next unless $_;
+ $self->{'_stub'} .= " SOAP::Data->new(name => '".$_->name."', type => '".$_->type."', attr => {";
+ $self->{'_stub'} .= do { my %attr = %{$_->attr};
+ join(', ', map {"'$_' => '$attr{$_}'"}
+ grep {/^xmlns:(?!-)/}
+ keys %attr)
+ };
+ $self->{'_stub'} .= "}),\n";
+ }
+ $self->{'_stub'} .= " ], # end parameters\n";
+ $self->{'_stub'} .= " }, # end $service\n";
+ }
+ $self->{'_stub'} .= "); # end my %methods\n";
+ $self->{'_stub'} .= <<'EOP';
+
+use SOAP::Lite;
+use Exporter;
+use Carp ();
+
+use vars qw(@ISA $AUTOLOAD @EXPORT_OK %EXPORT_TAGS);
+ at ISA = qw(Exporter SOAP::Lite);
+ at EXPORT_OK = (keys %methods);
+%EXPORT_TAGS = ('all' => [@EXPORT_OK]);
+
+sub _call {
+ my ($self, $method) = (shift, shift);
+ my $name = UNIVERSAL::isa($method => 'SOAP::Data') ? $method->name : $method;
+ my %method = %{$methods{$name}};
+ $self->proxy($method{endpoint} || Carp::croak "No server address (proxy) specified")
+ unless $self->proxy;
+ my @templates = @{$method{parameters}};
+ my @parameters = ();
+ foreach my $param (@_) {
+ if (@templates) {
+ my $template = shift @templates;
+ my ($prefix,$typename) = SOAP::Utils::splitqname($template->type);
+ my $method = 'as_'.$typename;
+ # TODO - if can('as_'.$typename) {...}
+ my $result = $self->serializer->$method($param, $template->name, $template->type, $template->attr);
+ push(@parameters, $template->value($result->[2]));
+ } else {
+ push(@parameters, $param);
+ }
+ }
+ $self->endpoint($method{endpoint})
+ ->uri($method{uri})
+ ->on_action(sub{qq!"$method{soapaction}"!});
+EOP
+ my $namespaces = $self->deserializer->ids->[1];
+ foreach my $key (keys %{$namespaces}) {
+ my ($ns,$prefix) = SOAP::Utils::splitqname($key);
+ $self->{'_stub'} .= ' $self->serializer->register_ns("'.$namespaces->{$key}.'","'.$prefix.'");'."\n"
+ if ($ns eq "xmlns");
+ }
+ $self->{'_stub'} .= <<'EOP';
+ my $som = $self->SUPER::call($method => @parameters);
+ if ($self->want_som) {
+ return $som;
+ }
+ UNIVERSAL::isa($som => 'SOAP::SOM') ? wantarray ? $som->paramsall : $som->result : $som;
+}
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(want_som)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+ }
+ }
+}
+no strict 'refs';
+for my $method (@EXPORT_OK) {
+ my %method = %{$methods{$method}};
+ *$method = sub {
+ my $self = UNIVERSAL::isa($_[0] => __PACKAGE__)
+ ? ref $_[0] ? shift # OBJECT
+ # CLASS, either get self or create new and assign to self
+ : (shift->self || __PACKAGE__->self(__PACKAGE__->new))
+ # function call, either get self or create new and assign to self
+ : (__PACKAGE__->self || __PACKAGE__->self(__PACKAGE__->new));
+ $self->_call($method, @_);
+ }
+}
+
+sub AUTOLOAD {
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+ return if $method eq 'DESTROY' || $method eq 'want_som';
+ die "Unrecognized method '$method'. List of available method(s): @EXPORT_OK\n";
+}
+
+1;
+EOP
+ return $self->stub;
+}
+
+# ======================================================================
+
+package SOAP;
+
+use vars qw($AUTOLOAD);
+require URI;
+
+my $soap; # shared between SOAP and SOAP::Lite packages
+
+{ no strict 'refs';
+ *AUTOLOAD = sub {
+ local($1,$2);
+ my($package, $method) = $AUTOLOAD =~ m/(?:(.+)::)([^:]+)$/;
+ return if $method eq 'DESTROY';
+
+ my $soap = ref $_[0] && UNIVERSAL::isa($_[0] => 'SOAP::Lite') ? $_[0] : $soap || die "SOAP:: prefix shall only be used in combination with +autodispatch option\n";
+
+ my $uri = URI->new($soap->uri);
+ my $currenturi = $uri->path;
+ $package =
+ ref $_[0] && UNIVERSAL::isa($_[0] => 'SOAP::Lite') ? $currenturi :
+ $package eq 'SOAP' ? ref $_[0] || ($_[0] eq 'SOAP'
+ ? $currenturi || Carp::croak "URI is not specified for method call" : $_[0]) :
+ $package eq 'main' ? $currenturi || $package
+ : $package;
+
+ # drop first parameter if it's a class name
+ {
+ my $pack = $package;
+ for ($pack) { s!^/!!; s!/!::!g; }
+ shift @_ if @_ && !ref $_[0] && ($_[0] eq $pack || $_[0] eq 'SOAP') ||
+ ref $_[0] && UNIVERSAL::isa($_[0] => 'SOAP::Lite');
+ }
+
+ for ($package) { s!::!/!g; s!^/?!/!; }
+ $uri->path($package);
+
+ my $som = $soap->uri($uri->as_string)->call($method => @_);
+ UNIVERSAL::isa($som => 'SOAP::SOM') ? wantarray ? $som->paramsall : $som->result
+ : $som;
+ };
+}
+
+# ======================================================================
+
+package SOAP::Lite;
+
+use vars qw($AUTOLOAD @ISA);
+use Carp ();
+
+use SOAP::Packager;
+
+ at ISA = qw(SOAP::Cloneable);
+
+# provide access to global/autodispatched object
+sub self { @_ > 1 ? $soap = $_[1] : $soap }
+
+# no more warnings about "used only once"
+*UNIVERSAL::AUTOLOAD if 0;
+
+sub autodispatched { \&{*UNIVERSAL::AUTOLOAD} eq \&{*SOAP::AUTOLOAD} };
+
+sub soapversion {
+ my $self = shift;
+ my $version = shift or return $SOAP::Constants::SOAP_VERSION;
+
+ ($version) = grep { $SOAP::Constants::SOAP_VERSIONS{$_}->{NS_ENV} eq $version
+ } keys %SOAP::Constants::SOAP_VERSIONS
+ unless exists $SOAP::Constants::SOAP_VERSIONS{$version};
+
+ die qq!$SOAP::Constants::WRONG_VERSION Supported versions:\n@{[
+ join "\n", map {" $_ ($SOAP::Constants::SOAP_VERSIONS{$_}->{NS_ENV})"} keys %SOAP::Constants::SOAP_VERSIONS
+ ]}\n!
+ unless defined($version) && defined(my $def = $SOAP::Constants::SOAP_VERSIONS{$version});
+
+ foreach (keys %$def) {
+ eval "\$SOAP::Constants::$_ = '$SOAP::Constants::SOAP_VERSIONS{$version}->{$_}'";
+ }
+
+ $SOAP::Constants::SOAP_VERSION = $version;
+ $self;
+}
+
+BEGIN { SOAP::Lite->soapversion(1.1) }
+
+sub import {
+ my $pkg = shift;
+ my $caller = caller;
+ no strict 'refs';
+ # emulate 'use SOAP::Lite 0.99' behavior
+ $pkg->require_version(shift) if defined $_[0] && $_[0] =~ /^\d/;
+
+ while (@_) {
+ my $command = shift;
+
+ my @parameters = UNIVERSAL::isa($_[0] => 'ARRAY') ? @{shift()} : shift
+ if @_ && $command ne 'autodispatch';
+ if ($command eq 'autodispatch' || $command eq 'dispatch_from') {
+ $soap = ($soap||$pkg)->new;
+ no strict 'refs';
+ foreach ($command eq 'autodispatch' ? 'UNIVERSAL' : @parameters) {
+ my $sub = "${_}::AUTOLOAD";
+ defined &{*$sub}
+ ? (\&{*$sub} eq \&{*SOAP::AUTOLOAD} ? () : Carp::croak "$sub already assigned and won't work with DISPATCH. Died")
+ : (*$sub = *SOAP::AUTOLOAD);
+ }
+ } elsif ($command eq 'service') {
+ foreach (keys %{SOAP::Schema->schema_url(shift(@parameters))->parse(@parameters)->load->services}) {
+ $_->export_to_level(1, undef, ':all');
+ }
+ } elsif ($command eq 'debug' || $command eq 'trace') {
+ SOAP::Trace->import(@parameters ? @parameters : 'all');
+ } elsif ($command eq 'import') {
+ local $^W; # supress warnings about redefining
+ my $package = shift(@parameters);
+ $package->export_to_level(1, undef, @parameters ? @parameters : ':all') if $package;
+ } else {
+ Carp::carp "Odd (wrong?) number of parameters in import(), still continue" if $^W && !(@parameters & 1);
+ $soap = ($soap||$pkg)->$command(@parameters);
+ }
+ }
+}
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+ return $self if ref $self;
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ # Check whether we can clone. Only the SAME class allowed, no inheritance
+ $self = ref($soap) eq $class ? $soap->clone : {
+ _transport => SOAP::Transport->new,
+ _serializer => SOAP::Serializer->new,
+ _deserializer => SOAP::Deserializer->new,
+ _packager => SOAP::Packager::MIME->new,
+ _schema => undef,
+ _autoresult => 0,
+ _on_action => sub { sprintf '"%s#%s"', shift || '', shift },
+ _on_fault => sub {ref $_[1] ? return $_[1] : Carp::croak $_[0]->transport->is_success ? $_[1] : $_[0]->transport->status},
+ };
+ bless $self => $class;
+ $self->on_nonserialized($self->on_nonserialized || $self->serializer->on_nonserialized);
+ SOAP::Trace::objects('()');
+ }
+
+ Carp::carp "Odd (wrong?) number of parameters in new()" if $^W && (@_ & 1);
+ while (@_) { my($method, $params) = splice(@_,0,2);
+ $self->can($method)
+ ? $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ : $^W && Carp::carp "Unrecognized parameter '$method' in new()"
+ }
+
+ return $self;
+}
+
+sub init_context {
+ my $self = shift->new;
+ $self->{'_deserializer'}->{'_context'} = $self;
+ $self->{'_serializer'}->{'_context'} = $self;
+}
+
+sub destroy_context {
+ my $self = shift;
+ delete($self->{'_deserializer'}->{'_context'});
+ delete($self->{'_serializer'}->{'_context'})
+}
+
+# Naming? wsdl_parser
+sub schema {
+ my $self = shift;
+ if (@_) {
+ $self->{'_schema'} = shift;
+ return $self;
+ } else {
+ if (!defined $self->{'_schema'}) { $self->{'_schema'} = SOAP::Schema->new; }
+ return $self->{'_schema'};
+ }
+}
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(serializer deserializer)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ if (@_) {
+ my $context = $self->{$field}->{'_context'}; # save the old context
+ $self->{$field} = shift;
+ $self->{$field}->{'_context'} = $context; # restore the old context
+ return $self;
+ } else {
+ return $self->{$field};
+ }
+ }
+ }
+ for my $method (qw(endpoint transport outputxml autoresult packager)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+ }
+ }
+ for my $method (qw(on_action on_fault on_nonserialized)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ return $self->{$field} unless @_;
+ local $@;
+ # commented out because that 'eval' was unsecure
+ # > ref $_[0] eq 'CODE' ? shift : eval shift;
+ # Am I paranoid enough?
+ $self->{$field} = shift;
+ Carp::croak $@ if $@;
+ Carp::croak "$method() expects subroutine (CODE) or string that evaluates into subroutine (CODE)"
+ unless ref $self->{$field} eq 'CODE';
+ return $self;
+ }
+ }
+ # SOAP::Transport Shortcuts
+ # TODO - deprecate proxy() in favor of new language endpoint_url()
+ for my $method (qw(proxy)) {
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->transport->$method(@_), return $self) : return $self->transport->$method();
+ }
+ }
+
+ # SOAP::Seriailizer Shortcuts
+ for my $method (qw(autotype readable envprefix encodingStyle
+ encprefix multirefinplace encoding
+ typelookup header maptype xmlschema
+ uri ns_prefix ns_uri use_prefix use_default_ns
+ ns default_ns)) {
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->serializer->$method(@_), return $self) : return $self->serializer->$method();
+ }
+ }
+ # SOAP::Schema Shortcuts
+ for my $method (qw(cache_dir cache_ttl)) {
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->schema->$method(@_), return $self) : return $self->schema->$method();
+ }
+ }
+}
+
+sub parts {
+ my $self = shift;
+ $self->packager->parts(@_);
+ return $self;
+}
+
+# Naming? wsdl
+sub service {
+ my $self = shift->new;
+ return $self->{'_service'} unless @_;
+ $self->schema->schema_url($self->{'_service'} = shift);
+ my %services = %{$self->schema->parse(@_)->load->services};
+
+ Carp::croak "More than one service in service description. Service and port names have to be specified\n"
+ if keys %services > 1;
+ my $service = (keys %services)[0]->new;
+ return $service;
+}
+
+sub AUTOLOAD {
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+ return if $method eq 'DESTROY';
+
+ ref $_[0] or Carp::croak qq!Can\'t locate class method "$method" via package \"! . __PACKAGE__ .'\"';
+
+ no strict 'refs';
+ *$AUTOLOAD = sub {
+ my $self = shift;
+ my $som = $self->call($method => @_);
+ return $self->autoresult && UNIVERSAL::isa($som => 'SOAP::SOM')
+ ? wantarray ? $som->paramsall : $som->result
+ : $som;
+ };
+ goto &$AUTOLOAD;
+}
+
+sub call {
+ SOAP::Trace::trace('()');
+ my $self = shift;
+ # Why is this here? Can't call be null? Indicating that there are no input arguments?
+ #return $self->{_call} unless @_;
+ die "A service address has not been specified either by using SOAP::Lite->proxy() or a service description)\n"
+ unless defined $self->proxy && UNIVERSAL::isa($self->proxy => 'SOAP::Client');
+
+ $self->init_context();
+ my $serializer = $self->serializer;
+ $serializer->on_nonserialized($self->on_nonserialized);
+ my $response = $self->transport->send_receive(
+ context => $self, # this is provided for context
+ endpoint => $self->endpoint,
+ action => scalar($self->on_action->($serializer->uriformethod($_[0]))),
+ # leave only parameters so we can later update them if required
+ envelope => $serializer->envelope(method => shift, @_),
+# envelope => $serializer->envelope(method => shift, @_),
+ encoding => $serializer->encoding,
+ parts => @{$self->packager->parts} ? $self->packager->parts : undef,
+ );
+
+ return $response if $self->outputxml;
+
+ # deserialize and store result
+ my $result = $self->{'_call'} = eval { $self->deserializer->deserialize($response) } if $response;
+
+ if (!$self->transport->is_success || # transport fault
+ $@ || # not deserializible
+ # fault message even if transport OK
+ # or no transport error (for example, fo TCP, POP3, IO implementations)
+ UNIVERSAL::isa($result => 'SOAP::SOM') && $result->fault) {
+ return $self->{'_call'} = ($self->on_fault->($self, $@ ? $@ . ($response || '') : $result) || $result);
+ }
+
+ return unless $response; # nothing to do for one-ways
+
+ # little bit tricky part that binds in/out parameters
+ if (UNIVERSAL::isa($result => 'SOAPSOM') &&
+ ($result->paramsout || $result->headers) &&
+ $serializer->signature) {
+ my $num = 0;
+ my %signatures = map {$_ => $num++} @{$serializer->signature};
+ for ($result->dataof(SOAP::SOM::paramsout), $result->dataof(SOAP::SOM::headers)) {
+ my $signature = join $;, $_->name, $_->type || '';
+ if (exists $signatures{$signature}) {
+ my $param = $signatures{$signature};
+ my($value) = $_->value; # take first value
+ UNIVERSAL::isa($_[$param] => 'SOAP::Data') ? $_[$param]->SOAP::Data::value($value) :
+ UNIVERSAL::isa($_[$param] => 'ARRAY') ? (@{$_[$param]} = @$value) :
+ UNIVERSAL::isa($_[$param] => 'HASH') ? (%{$_[$param]} = %$value) :
+ UNIVERSAL::isa($_[$param] => 'SCALAR') ? (${$_[$param]} = $$value) :
+ ($_[$param] = $value)
+ }
+ }
+ }
+ $self->destroy_context();
+ return $result;
+} # end of call()
+
+# ======================================================================
+
+package SOAP::Lite::COM;
+
+require SOAP::Lite;
+
+sub required {
+ foreach (qw(
+ URI::_foreign URI::http URI::https
+ LWP::Protocol::http LWP::Protocol::https LWP::Authen::Basic LWP::Authen::Digest
+ HTTP::Daemon Compress::Zlib SOAP::Transport::HTTP
+ XMLRPC::Lite XMLRPC::Transport::HTTP
+ )) {
+ eval join ';', 'local $SIG{__DIE__}', "require $_";
+ }
+}
+
+sub new { required; SOAP::Lite->new(@_) }
+
+sub create; *create = \&new; # make alias. Somewhere 'new' is registered keyword
+
+sub soap; *soap = \&new; # also alias. Just to be consistent with .xmlrpc call
+
+sub xmlrpc { required; XMLRPC::Lite->new(@_) }
+
+sub server { required; shift->new(@_) }
+
+sub data { SOAP::Data->new(@_) }
+
+sub header { SOAP::Header->new(@_) }
+
+sub hash { +{@_} }
+
+sub instanceof {
+ my $class = shift;
+ die "Incorrect class name" unless $class =~ /^(\w[\w:]*)$/;
+ eval "require $class";
+ $class->new(@_);
+}
+
+# ======================================================================
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+SOAP::Lite - Perl's Web Services Toolkit
+
+=head1 DESCRIPTION
+
+SOAP::Lite is a collection of Perl modules which provides a simple and lightweight interface to the Simple Object Access Protocol (SOAP) both on client and server side.
+
+=head1 OVERVIEW OF CLASSES AND PACKAGES
+
+=over
+
+=item F<lib/SOAP/Lite.pm>
+
+L<SOAP::Lite> - Main class provides all logic
+
+L<SOAP::Transport> - Supports transport architecture
+
+L<SOAP::Data> - Provides extensions for serialization architecture
+
+L<SOAP::Header> - Provides extensions for header serialization
+
+SOAP::Parser - Parses XML file into object tree
+
+L<SOAP::Serializer> - Serializes data structures to SOAP package
+
+SOAP::Deserializer - Deserializes results of SOAP::Parser into objects
+
+L<SOAP::SOM> - Provides access to deserialized object tree
+
+L<SOAP::Constants> - Provides access to common constants
+
+L<SOAP::Trace> - Provides tracing facilities
+
+L<SOAP::Schema> - Provides access and stub(s) for schema(s)
+
+L<SOAP::Schema::WSDL|SOAP::Schema/SOAP::Schema::WSDL> - WSDL implementation for SOAP::Schema
+
+L<SOAP::Server> - Handles requests on server side
+
+SOAP::Server::Object - Handles objects-by-reference
+
+L<SOAP::Fault> - Provides support for Faults on server side
+
+L<SOAP::Utils> - A set of private and public utility subroutines
+
+=item F<lib/SOAP/Packager.pm>
+
+L<SOAP::Packager> - Provides an abstract class for implementing custom packagers.
+
+L<SOAP::Packager::MIME|SOAP::Packager/SOAP::Packager::MIME> - Provides MIME support to SOAP::Lite
+
+L<SOAP::Packager::DIME|SOAP::Packager/SOAP::Packager::DIME> - Provides DIME support to SOAP::Lite
+
+=item F<lib/SOAP/Transport/HTTP.pm>
+
+L<SOAP::Transport::HTTP::Client|SOAP::Transport/SOAP::Transport::HTTP::Client> - Client interface to HTTP transport
+
+L<SOAP::Transport::HTTP::Server|SOAP::Transport/SOAP::Transport::HTTP::Server> - Server interface to HTTP transport
+
+L<SOAP::Transport::HTTP::CGI|SOAP::Transport/SOAP::Transport::HTTP::CGI> - CGI implementation of server interface
+
+L<SOAP::Transport::HTTP::Daemon|SOAP::Transport/SOAP::Transport::HTTP::Daemon> - Daemon implementation of server interface
+
+L<SOAP::Transport::HTTP::Apache|SOAP::Transport/SOAP::Transport::HTTP::Apache> - mod_perl implementation of server interface
+
+=item F<lib/SOAP/Transport/POP3.pm>
+
+L<SOAP::Transport::POP3::Server|SOAP::Transport/SOAP::Transport::POP3::Server> - Server interface to POP3 protocol
+
+=item F<lib/SOAP/Transport/MAILTO.pm>
+
+L<SOAP::Transport::MAILTO::Client|SOAP::Transport/SOAP::Transport::MAILTO::Client> - Client interface to SMTP/sendmail
+
+=item F<lib/SOAP/Transport/LOCAL.pm>
+
+L<SOAP::Transport::LOCAL::Client|SOAP::Transport/SOAP::Transport::LOCAL::Client> - Client interface to local transport
+
+=item F<lib/SOAP/Transport/TCP.pm>
+
+L<SOAP::Transport::TCP::Server|SOAP::Transport/SOAP::Transport::TCP::Server> - Server interface to TCP protocol
+
+L<SOAP::Transport::TCP::Client|SOAP::Transport/SOAP::Transport::TCP::Client> - Client interface to TCP protocol
+
+=item F<lib/SOAP/Transport/IO.pm>
+
+L<SOAP::Transport::IO::Server|SOAP::Transport/SOAP::Transport::IO::Server> - Server interface to IO transport
+
+=back
+
+=head1 METHODS
+
+The first group of methods presented are the constructor and the accessor methods. All accessor methods share the trait of returning the current appropriate value when called with no arguments, while returning the object reference itself when called with a new value for the field in question. This allows the set-attribute calls to be chained together.
+
+=over
+
+=item new(optional key/value pairs)
+
+ $client = SOAP::Lite->new(proxy => $endpoint)
+
+This is the constructor of the class. Many of the accessor methods defined here may be initialized at creation by providing their name as a key, followed by the desired value. The example provides the value for the proxy element of the client.
+
+=item transport(optional transport object)
+
+ $transp = $client->transport( );
+
+Provides access to the transport object that the client has allocated to manage the communication layer operations. You can set this by passing a new object that derives from C<SOAP::Transport>, but this is generally not needed or recommended. Several of the following methods are shortcuts to this object's accessors.
+
+=item serializer(optional serializer object)
+
+ $serial = $client->serializer( )
+
+Provides access to the C<SOAP::Serializer> object that the client uses to transform the elements and data of a request into an XML document for the sake of transport. As with transport, this may be set by providing a new object reference, but it is generally not needed.
+
+=item packager(optional packager object)
+
+ $packager = $client->packager( )
+
+Provides access to the C<SOAP::Packager> object that the client uses to manage the use of attachments. The default packager is a MIME packager, but unless you specify parts to send, no MIME formatting will be done.
+
+See also: L<SOAP::Packager>.
+
+=item proxy(endpoint, optional extra arguments)
+
+ $client->proxy('http://soap.xml.info/ endPoint');
+
+The proxy is the server or endpoint to which the client is going to connect. It shouldn't be confused with the uri method discussed later, which refers to a different element of the conversation. This method allows the setting of the endpoint, along with any extra information that the transport object may need when communicating the request. Indeed, this method is actually an alias to the proxy method of L<SOAP::Transport>. It is the same as typing:
+
+ $client->transport( )->proxy(...arguments);
+
+When extra information is needed, it is also passed in the call to this method. Connecting to a server that uses browser cookies for authentication can be done by creating an instance of the HTTP::Cookies class (from the LWP package) and passing it as the value following a key of cookie_jar. The value for sockettime-outs may also be set this way. The full range of options vary by transport method. One common theme is that the endpoint string is always the first argument, with all additional arguments following it.
+
+The following is a list of optional arguments that may be passed to C<proxy()>:
+
+=over
+
+=item options( HASH )
+
+This is for SOAP::Lite specific options. Currently the only option one is allowed to set is the C<compress_threshold> option. See L<COMPRESSION|SOAP::Transport/"COMPRESSION"> in L<HTTP::Transport>.
+
+=item All initialization options from LWP::UserAgent
+
+=back
+
+For example, if you wish to set the HTTP timeout for a SOAP::Lite client to 5 seconds, use the following code:
+
+ my $soap = SOAP::Lite
+ ->uri($uri)
+ ->proxy($proxyUrl, timeout => 5 );
+
+See L<LWP::UserAgent>.
+
+=item endpoint(optional new endpoint address)
+
+ $client->endpoint('http://soap.xml.info/ newPoint')
+
+It may be preferable to set a new endpoint without the additional work of examining the new address for protocol information and checking to ensure the support code is loaded and available. This method allows the caller to change the endpoint that the client is currently set to connect to, without reloading the relevant transport code. Note that the proxy method must have already been called before this method is used.
+
+=item service(service URL)
+
+ $client->service('http://svc.perl.org/Svc.wsdl');
+
+C<SOAP::Lite> offers some support for creating method stubs from service descriptions. At present, only WSDL support is in place. This method loads the specified WSDL schema and uses it as the basis for generating stubs.
+
+=item outputxml(boolean)
+
+ $client->outputxml('true');
+
+Controls whether the returned information from a remote method call is the raw XML from the server. The default is to process the data from the server and present it to the caller as an object of the L<SOAP::SOM> class. If the application prefers to use a different parser or do something else entirely with the results, this method may be used to inhibit the parsing of the returned information.
+
+=item autotype(boolean)
+
+ $client->autotype(0);
+
+This method is a shortcut for:
+
+ $client->serializer->autotype(boolean);
+
+By default, the serializer tries to automatically deduce types for the data being sent in a message. Setting a false value with this method disables the behavior.
+
+=item readable(boolean)
+
+ $client->readable(1);
+
+This method is a shortcut for:
+
+ $client->serializer->readable(boolean);
+
+When this is used to set a true value for this property, the generated XML sent to the endpoint has extra characters (spaces and new lines) added in to make the XML itself more readable to human eyes (presumably for debugging). The default is to not send any additional characters.
+
+=item default_ns($uri)
+
+Sets the default namespace for the request to the specified uri. This overrides any previous namespace declaration that may have been set using a previous call to C<ns()> or C<default_ns()>. Setting the default namespace causes elements to be serialized without a namespace prefix, like so:
+
+ <soap:Envelope>
+ <soap:Body>
+ <myMethod xmlns="http://www.someuri.com">
+ <foo />
+ </myMethod>
+ </soap:Body>
+ </soap:Envelope>
+
+=item ns($uri,$prefix=undef)
+
+Sets the namespace uri and optionally the namespace prefix for the request to the specified values. This overrides any previous namespace declaration that may have been set using a previous call to C<ns()> or C<default_ns()>. If a prefix is not specified, one will be generated for you automatically. Setting the namespace causes elements to be serialized with a declared namespace prefix, like so:
+
+ <soap:Envelope>
+ <soap:Body>
+ <my:myMethod xmlns:my="http://www.someuri.com">
+ <my:foo />
+ </my:myMethod>
+ </soap:Body>
+ </soap:Envelope>
+
+=item use_prefix(boolean)
+
+Deprecated - the C<use_prefix()> subroutine has been deprecated in order to provide a more intuitive naming scheme for subroutines that set namespaces. C<use_prefix()> was originally added to allow users to turn on or off the use of a default namespace. This functionality is being replaced by C<ns()> and C<default_ns()>.
+
+Shortcut for C<< serializer->use_prefix() >>. This lets you turn on/off the use of a namespace prefix for the children of the /Envelope/Body element. Default is 'true'. (This was introduced in 0.61 for better .NET compatibility)
+
+When use_prefix is set to 'true', serialized XML will look like this:
+
+ <SOAP-ENV:Envelope ...attributes skipped>
+ <SOAP-ENV:Body>
+ <namesp1:mymethod xmlns:namesp1="urn:MyURI" />
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+When use_prefix is set to 'true', serialized XML will look like this:
+
+ <SOAP-ENV:Envelope ...attributes skipped>
+ <SOAP-ENV:Body>
+ <mymethod xmlns="urn:MyURI" />
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+=item soapversion(optional value)
+
+ $client->soapversion('1.2');
+
+If no parameter is given, returns the current version of SOAP that is being used by the client object to encode requests. If a parameter is given, the method attempts to set that as the version of SOAP being used. The value should be either 1.1 or 1.2.
+
+=item envprefix(QName)
+
+ $client->envprefix('env');
+
+This method is a shortcut for:
+
+ $client->serializer->envprefix(QName);
+
+The namespace label used for the main SOAP namespace elements (such as Envelope, Body, and the attributes) defaults to SOAP-ENV. As has been discussed in earlier chapters, the label itself isn't important. But applications that wish to explicitly choose a different one (such as env to denote a SOAP 1.2 message) may do so with this method.
+
+=item encprefix(QName)
+
+ $client->encprefix('enc');
+
+This method is a shortcut for:
+
+ $client->serializer->encprefix(QName);
+
+As with the envprefix method, this gets or sets the label used for the namespace of the encoding rules. The default value is SOAP-ENC, as is generally used in SOAP 1.1 messages, though the label itself has no actual meaning.
+
+=back
+
+While it may seem to be an unnecessary operation to set a value that isn't relevant to the message, such as the namespace labels for the envelope and encoding URNs, the ability to set these labels explicitly can prove to be a great aid in distinguishing and debugging messages on the server side of operations.
+
+=over
+
+=item encoding(encoding URN)
+
+ $client->encoding($soap_12_encoding_URN);
+
+This method is a shortcut for:
+
+ $client->serializer->encoding(args);
+
+Where the earlier method dealt with the label used for the attributes related to the SOAP encoding scheme, this method actually sets the URN to be specified as the encoding scheme for the message. The default is to specify the encoding for SOAP 1.1, so this is handy for applications that need to encode according to SOAP 1.2 rules.
+
+=item typelookup
+
+ $client->typelookup;
+
+This method is a shortcut for:
+
+ $client->serializer->typelookup;
+
+Gives the application access to the type-lookup table from the serializer object. See the section on L<SOAP::Serializer>.
+
+=item uri(service specifier)
+
+Deprecated - the C<uri> subroutine has been deprecated in order to provide a more intuitive naming scheme for subroutines that set namespaces. In the future, you will be required to use either the C<ns()> or C<default_ns()> subroutines in lieu of C<uri()>.
+
+ $client->uri($service_uri);
+
+This method is a shortcut for:
+
+ $client->serializer->uri(service);
+
+The URI associated with this accessor on a client object is the service-specifier for the request, often encoded for HTTP-based requests as the SOAPAction header. While the names may seem confusing, this method doesn't specify the endpoint itself. In most circumstances, the C<uri> refers to the namespace used for the request.
+
+Often times, the value may look like a valid URL. Despite this, it doesn't have to point to an existing resource (and often doesn't). This method sets and retrieves this value from the object. Note that no transport code is triggered by this because it has no direct effect on the transport of the object.
+
+=item multirefinplace(boolean)
+
+ $client->multirefinplace(1);
+
+This method is a shortcut for:
+
+ $client->serializer->multirefinplace(boolean);
+
+Controls how the serializer handles values that have multiple references to them. Recall from previous SOAP chapters that a value may be tagged with an identifier, then referred to in several places. When this is the case for a value, the serializer defaults to putting the data element towards the top of the message, right after the opening tag of the method-specification. It is serialized as a standalone entity with an ID that is then referenced at the relevant places later on. If this method is used to set a true value, the behavior is different. When the multirefinplace attribute is true, the data is serialized at the first place that references it, rather than as a separate element higher up in the body. This is more compact but may be harder to read or trace in a debugging environment.
+
+=item parts( ARRAY )
+
+Used to specify an array of L<MIME::Entity>'s to be attached to the transmitted SOAP message. Attachments that are returned in a response can be accessed by C<SOAP::SOM::parts()>.
+
+=item self
+
+ $ref = SOAP::Lite->self;
+
+Returns an object reference to the default global object the C<SOAP::Lite> package maintains. This is the object that processes many of the arguments when provided on the use line.
+
+=back
+
+The following method isn't an accessor style of method but neither does it fit with the group that immediately follows it:
+
+=over
+
+=item call(arguments)
+
+ $client->call($method => @arguments);
+
+As has been illustrated in previous chapters, the C<SOAP::Lite> client objects can manage remote calls with auto-dispatching using some of Perl's more elaborate features. call is used when the application wants a greater degree of control over the details of the call itself. The method may be built up from a L<SOAP::Data> object, so as to allow full control over the namespace associated with the tag, as well as other attributes like encoding. This is also important for calling methods that contain characters not allowable in Perl function names, such as A.B.C.
+
+=back
+
+The next four methods used in the C<SOAP::Lite> class are geared towards handling the types of events than can occur during the message lifecycle. Each of these sets up a callback for the event in question:
+
+=over
+
+=item on_action(callback)
+
+ $client->on_action(sub { qq("$_[0]") });
+
+Triggered when the transport object sets up the SOAPAction header for an HTTP-based call. The default is to set the header to the string, uri#method, in which URI is the value set by the uri method described earlier, and method is the name of the method being called. When called, the routine referenced (or the closure, if specified as in the example) is given two arguments, uri and method, in that order.
+
+=item on_fault(callback)
+
+ $client->on_fault(sub { popup_dialog($_[1]) });
+
+Triggered when a method call results in a fault response from the server. When it is called, the argument list is first the client object itself, followed by the object that encapsulates the fault. In the example, the fault object is passed (without the client object) to a hypothetical GUI function that presents an error dialog with the text of fault extracted from the object (which is covered shortly under the L<SOAP::SOM> methods).
+
+=item on_nonserialized(callback)
+
+ $client->on_nonserialized(sub { die "$_[0]?!?" });
+
+Occasionally, the serializer may be given data it can't turn into SOAP-savvy XML; for example, if a program bug results in a code reference or something similar being passed in as a parameter to method call. When that happens, this callback is activated, with one argument. That argument is the data item that could not be understood. It will be the only argument. If the routine returns, the return value is pasted into the message as the serialization. Generally, an error is in order, and this callback allows for control over signaling that error.
+
+=item on_debug(callback)
+
+ $client->on_debug(sub { print @_ });
+
+This is kept for backwards-compatibility with earlier versions of the toolkit. Each method has a trace step built in, which is called at routine entry. This specifies a callback to be used when these trace statements are reached. Because this is deprecated, it is recommended that applications use the +debug and +trace facilities described later under L<SOAP::Trace>. Note also that debugging isn't handled on a per-object basis; if this method is used on a given object, it sets debugging behavior for all objects of the class.
+
+=back
+
+=head1 WRITING A SOAP CLIENT
+
+TODO - soap client example
+
+=head1 WRITING A SOAP SERVER
+
+See L<SOAP::Server>, or L<SOAP::Transport>.
+
+=head1 FEATURES
+
+=head2 ATTACHMENTS
+
+C<SOAP::Lite> features support for the SOAP with Attachments specification.
+Currently, SOAP::Lite only supports MIME based attachments. DIME based attachments
+are yet to be fully functional.
+
+=head3 EXAMPLES
+
+=head4 Client sending an attachment
+
+C<SOAP::Lite> clients can specify attachments to be sent along with a request by using the C<SOAP::Lite::parts()> method, which takes as an argument an ARRAY of C<MIME::Entity>'s.
+
+ use SOAP::Lite;
+ use MIME::Entity;
+ my $ent = build MIME::Entity
+ Type => "image/gif",
+ Encoding => "base64",
+ Path => "somefile.gif",
+ Filename => "saveme.gif",
+ Disposition => "attachment";
+ my $som = SOAP::Lite
+ ->uri($SOME_NAMESPACE)
+ ->parts([ $ent ])
+ ->proxy($SOME_HOST)
+ ->some_method(SOAP::Data->name("foo" => "bar"));
+
+=head4 Client retrieving an attachment
+
+A client accessing attachments that were returned in a response by using the C<SOAP::SOM::parts()> accessor.
+
+ use SOAP::Lite;
+ use MIME::Entity;
+ my $soap = SOAP::Lite
+ ->uri($NS)
+ ->proxy($HOST);
+ my $som = $soap->foo();
+ foreach my $part (${$som->parts}) {
+ print $part->stringify;
+ }
+
+=head4 Server receiving an attachment
+
+Servers, like clients, use the S<SOAP::SOM> module to access attachments trasmitted to it.
+
+ package Attachment;
+ use SOAP::Lite;
+ use MIME::Entity;
+ use strict;
+ use vars qw(@ISA);
+ @ISA = qw(SOAP::Server::Parameters);
+ sub someMethod {
+ my $self = shift;
+ my $envelope = pop;
+ foreach my $part (@{$envelope->parts}) {
+ print "AttachmentService: attachment found! (".ref($part).")\n";
+ }
+ # do something
+ }
+
+=head4 Server responding with an attachment
+
+Servers wishing to return an attachment to the calling client need only return C<MIME::Entity> objects along with SOAP::Data elements, or any other data intended for the response.
+
+ package Attachment;
+ use SOAP::Lite;
+ use MIME::Entity;
+ use strict;
+ use vars qw(@ISA);
+ @ISA = qw(SOAP::Server::Parameters);
+ sub someMethod {
+ my $self = shift;
+ my $envelope = pop;
+ my $ent = build MIME::Entity
+ 'Id' => "<1234>",
+ 'Type' => "text/xml",
+ 'Path' => "some.xml",
+ 'Filename' => "some.xml",
+ 'Disposition' => "attachment";
+ return SOAP::Data->name("foo" => "blah blah blah"),$ent;
+ }
+
+=head2 DEFAULT SETTINGS
+
+Though this feature looks similar to L<autodispatch|/"IN/OUT, OUT PARAMETERS AND AUTOBINDING"> they have (almost) nothing in common. This capability allows you specify default settings so that all objects created after that will be initialized with the proper default settings.
+
+If you wish to provide common C<proxy()> or C<uri()> settings for all C<SOAP::Lite> objects in your application you may do:
+
+ use SOAP::Lite
+ proxy => 'http://localhost/cgi-bin/soap.cgi',
+ uri => 'http://my.own.com/My/Examples';
+
+ my $soap1 = new SOAP::Lite; # will get the same proxy()/uri() as above
+ print $soap1->getStateName(1)->result;
+
+ my $soap2 = SOAP::Lite->new; # same thing as above
+ print $soap2->getStateName(2)->result;
+
+ # or you may override any settings you want
+ my $soap3 = SOAP::Lite->proxy('http://localhost/');
+ print $soap3->getStateName(1)->result;
+
+B<Any> C<SOAP::Lite> properties can be propagated this way. Changes in object copies will not affect global settings and you may still change global settings with C<< SOAP::Lite->self >> call which returns reference to global object. Provided parameter will update this object and you can even set it to C<undef>:
+
+ SOAP::Lite->self(undef);
+
+The C<use SOAP::Lite> syntax also lets you specify default event handlers for your code. If you have different SOAP objects and want to share the same C<on_action()> (or C<on_fault()> for that matter) handler. You can specify C<on_action()> during initialization for every object, but you may also do:
+
+ use SOAP::Lite
+ on_action => sub {sprintf '%s#%s', @_};
+
+and this handler will be the default handler for all your SOAP objects. You can override it if you specify a handler for a particular object. See F<t/*.t> for example of on_fault() handler.
+
+Be warned, that since C<use ...> is executed at compile time B<all> C<use> statements will be executed B<before> script execution that can make unexpected results. Consider code:
+
+ use SOAP::Lite proxy => 'http://localhost/';
+ print SOAP::Lite->getStateName(1)->result;
+
+ use SOAP::Lite proxy => 'http://localhost/cgi-bin/soap.cgi';
+ print SOAP::Lite->getStateName(1)->result;
+
+B<Both> SOAP calls will go to C<'http://localhost/cgi-bin/soap.cgi'>. If you want to execute C<use> at run-time, put it in C<eval>:
+
+ eval "use SOAP::Lite proxy => 'http://localhost/cgi-bin/soap.cgi'; 1" or die;
+
+Or alternatively,
+
+ SOAP::Lite->self->proxy('http://localhost/cgi-bin/soap.cgi');
+
+=head2 SETTING MAXIMUM MESSAGE SIZE
+
+One feature of C<SOAP::Lite> is the ability to control the maximum size of a message a SOAP::Lite server will be allowed to process. To control this feature simply define C<$SOAP::Constants::MAX_CONTENT_SIZE> in your code like so:
+
+ use SOAP::Transport::HTTP;
+ use MIME::Entity;
+ $SOAP::Constants::MAX_CONTENT_SIZE = 10000;
+ SOAP::Transport::HTTP::CGI
+ ->dispatch_to('TemperatureService')
+ ->handle;
+
+=head2 IN/OUT, OUT PARAMETERS AND AUTOBINDING
+
+C<SOAP::Lite> gives you access to all parameters (both in/out and out) and also does some additional work for you. Lets consider following example:
+
+ <mehodResponse>
+ <res1>name1</res1>
+ <res2>name2</res2>
+ <res3>name3</res3>
+ </mehodResponse>
+
+In that case:
+
+ $result = $r->result; # gives you 'name1'
+ $paramout1 = $r->paramsout; # gives you 'name2', because of scalar context
+ $paramout1 = ($r->paramsout)[0]; # gives you 'name2' also
+ $paramout2 = ($r->paramsout)[1]; # gives you 'name3'
+
+or
+
+ @paramsout = $r->paramsout; # gives you ARRAY of out parameters
+ $paramout1 = $paramsout[0]; # gives you 'res2', same as ($r->paramsout)[0]
+ $paramout2 = $paramsout[1]; # gives you 'res3', same as ($r->paramsout)[1]
+
+Generally, if server returns C<return (1,2,3)> you will get C<1> as the result and C<2> and C<3> as out parameters.
+
+If the server returns C<return [1,2,3]> you will get an ARRAY from C<result()> and C<undef> from C<paramsout()>.
+
+Results can be arbitrary complex: they can be an array, they can be objects, they can be anything and still be returned by C<result()> . If only one parameter is returned, C<paramsout()> will return C<undef>.
+
+Furthermore, if you have in your output parameters a parameter with the same signature (name+type) as in the input parameters this parameter will be mapped into your input automatically. For example:
+
+B<Server Code>:
+
+ sub mymethod {
+ shift; # object/class reference
+ my $param1 = shift;
+ my $param2 = SOAP::Data->name('myparam' => shift() * 2);
+ return $param1, $param2;
+ }
+
+B<Client Code>:
+
+ $a = 10;
+ $b = SOAP::Data->name('myparam' => 12);
+ $result = $soap->mymethod($a, $b);
+
+After that, C<< $result == 10 and $b->value == 24 >>! Magic? Sort of.
+Autobinding gives it to you. That will work with objects also with one difference: you do not need to worry about the name and the type of object parameter. Consider the C<PingPong> example (F<examples/My/PingPong.pm> and F<examples/pingpong.pl>):
+
+B<Server Code>:
+
+ package My::PingPong;
+
+ sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ bless {_num=>shift} => $class;
+ }
+
+ sub next {
+ my $self = shift;
+ $self->{_num}++;
+ }
+
+B<Client Code>:
+
+ use SOAP::Lite +autodispatch =>
+ uri => 'urn:',
+ proxy => 'http://localhost/';
+
+ my $p = My::PingPong->new(10); # $p->{_num} is 10 now, real object returned
+ print $p->next, "\n"; # $p->{_num} is 11 now!, object autobinded
+
+=head2 STATIC AND DYNAMIC SERVICE DEPLOYMENT
+
+Let us scrutinize the deployment process. When designing your SOAP server you can consider two kind of deployment: B<static> and B<dynamic>. For both, static and dynamic, you should specify C<MODULE>, C<MODULE::method>, C<method> or C<PATH/> when creating C<use>ing the SOAP::Lite module. The difference between static and dynamic deployment is that in case of 'dynamic', any module which is not present will be loaded on demand. See the L</"SECURITY"> section for detailed description.
+
+=head3 STATIC DEPLOYMENT EXAMPLE
+
+ use SOAP::Transport::HTTP;
+ use My::Examples; # module is preloaded
+
+ SOAP::Transport::HTTP::CGI
+ # deployed module should be present here or client will get 'access denied'
+ -> dispatch_to('My::Examples')
+ -> handle;
+
+For static deployment you should specify the MODULE name directly.
+
+You should also use static binding when you have several different classes in one file and want to make them available for SOAP calls.
+
+=head3 DYNAMIC DEPLOYMENT EXAMPLE
+
+ use SOAP::Transport::HTTP;
+ # name is unknown, module will be loaded on demand
+
+ SOAP::Transport::HTTP::CGI
+ # deployed module should be present here or client will get 'access denied'
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'My::Examples')
+ -> handle;
+
+For dynamic deployment you can specify the name either directly (in that case it will be C<require>d without any restriction) or indirectly, with a PATH. In that case, the ONLY path that will be available will be the PATH given to the dispatch_to() method). For information how to handle this situation see L</"SECURITY"> section.
+
+=head3 SUMMARY
+
+ dispatch_to(
+ # dynamic dispatch that allows access to ALL modules in specified directory
+ PATH/TO/MODULES
+ # 1. specifies directory
+ # -- AND --
+ # 2. gives access to ALL modules in this directory without limits
+
+ # static dispatch that allows access to ALL methods in particular MODULE
+ MODULE
+ # 1. gives access to particular module (all available methods)
+ # PREREQUISITES:
+ # module should be loaded manually (for example with 'use ...')
+ # -- OR --
+ # you can still specify it in PATH/TO/MODULES
+
+ # static dispatch that allows access to particular method ONLY
+ MODULE::method
+ # same as MODULE, but gives access to ONLY particular method,
+ # so there is not much sense to use both MODULE and MODULE::method
+ # for the same MODULE
+ )
+
+In addition to this C<SOAP::Lite> also supports an experimental syntax that allows you to bind a specific URL or SOAPAction to a CLASS/MODULE or object. For example:
+
+ dispatch_with({
+ URI => MODULE, # 'http://www.soaplite.com/' => 'My::Class',
+ SOAPAction => MODULE, # 'http://www.soaplite.com/method' => 'Another::Class',
+ URI => object, # 'http://www.soaplite.com/obj' => My::Class->new,
+ })
+
+C<URI> is checked before C<SOAPAction>. You may use both the C<dispatch_to()> and C<dispatch_with()> methods in the same server, but note that C<dispatch_with()> has a higher order of precedence. C<dispatch_to()> will be checked only after C<URI> and C<SOAPAction> has been checked. See F<t/03-server.t> for more information and examples.
+
+See also: L<EXAMPLE APACHE::REGISTRY USAGE|SOAP::Transport/"EXAMPLE APACHE::REGISTRY USAGE">, L</"SECURITY">
+
+=head2 COMPRESSION
+
+C<SOAP::Lite> provides you option to enable transparent compression over the wire. Compression can be enabled by specifying a threshold value (in the form of kilobytes) for compression on both the client and server sides:
+
+I<Note: Compression currently only works for HTTP based servers and clients.>
+
+B<Client Code>
+
+ print SOAP::Lite
+ ->uri('http://localhost/My/Parameters')
+ ->proxy('http://localhost/', options => {compress_threshold => 10000})
+ ->echo(1 x 10000)
+ ->result;
+
+B<Server Code>
+
+ my $server = SOAP::Transport::HTTP::CGI
+ ->dispatch_to('My::Parameters')
+ ->options({compress_threshold => 10000})
+ ->handle;
+
+For more information see L<COMPRESSION|SOAP::Transport/"COMPRESSION"> in L<HTTP::Transport>.
+
+=head1 SECURITY
+
+For security reasons, the exisiting path for Perl modules (C<@INC>) will be disabled once you have chosen dynamic deployment and specified your own C<PATH/>. If you wish to access other modules in your included package you have several options:
+
+=over 4
+
+=item 1
+
+Switch to static linking:
+
+ use MODULE;
+ $server->dispatch_to('MODULE');
+
+Which can also be useful when you want to import something specific from the deployed modules:
+
+ use MODULE qw(import_list);
+
+=item 2
+
+Change C<use> to C<require>. The path is only unavailable during the initialization phase. It is available once more during execution. Therefore, if you utilize C<require> somewhere in your package, it will work.
+
+=item 3
+
+Wrap C<use> in an C<eval> block:
+
+ eval 'use MODULE qw(import_list)'; die if $@;
+
+=item 4
+
+Set your include path in your package and then specify C<use>. Don't forget to put C<@INC> in a C<BEGIN{}> block or it won't work. For example,
+
+ BEGIN { @INC = qw(my_directory); use MODULE }
+
+=back
+
+=head1 INTEROPERABILITY
+
+=head2 Microsoft .NET client with SOAP::Lite Server
+
+In order to use a .NET client with a SOAP::Lite server, be sure you use fully qualified names for your return values. For example:
+
+ return SOAP::Data->name('myname')
+ ->type('string')
+ ->uri($MY_NAMESPACE)
+ ->value($output);
+
+In addition see comment about default incoding in .NET Web Services below.
+
+=head2 SOAP::Lite client with a .NET server
+
+If experiencing problems when using a SOAP::Lite client to call a .NET Web service, it is recommended you check, or adhere to all of the following recommendations:
+
+=over 4
+
+=item Declare a proper soapAction in your call
+
+For example, use C<on_action( sub { 'http://www.myuri.com/WebService.aspx#someMethod'; } )>.
+
+=item Disable charset definition in Content-type header
+
+Some users have said that Microsoft .NET prefers the value of the Content-type header to be a mimetype exclusively, but SOAP::Lite specifies a character set in addition to the mimetype. This results in an error similar to:
+
+ Server found request content type to be 'text/xml; charset=utf-8',
+ but expected 'text/xml'
+
+To turn off this behavior specify use the following code:
+
+ use SOAP::Lite;
+ $SOAP::Constants::DO_NOT_USE_CHARSET = 1;
+ # The rest of your code
+
+=item Use fully qualified name for method parameters
+
+For example, the following code is preferred:
+
+ SOAP::Data->name(Query => 'biztalk')
+ ->uri('http://tempuri.org/')
+
+As opposed to:
+
+ SOAP::Data->name('Query' => 'biztalk')
+
+=item Place method in default namespace
+
+For example, the following code is preferred:
+
+ my $method = SOAP::Data->name('add')
+ ->attr({xmlns => 'http://tempuri.org/'});
+ my @rc = $soap->call($method => @parms)->result;
+
+As opposed to:
+
+ my @rc = $soap->call(add => @parms)->result;
+ # -- OR --
+ my @rc = $soap->add(@parms)->result;
+
+=item Disable use of explicit namespace prefixes
+
+Some user's have reported that .NET will simply not parse messages that use namespace prefixes on anything but SOAP elements themselves. For example, the following XML would not be parsed:
+
+ <SOAP-ENV:Envelope ...attributes skipped>
+ <SOAP-ENV:Body>
+ <namesp1:mymethod xmlns:namesp1="urn:MyURI" />
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+SOAP::Lite allows users to disable the use of explicit namespaces through the C<use_prefix()> method. For example, the following code:
+
+ $som = SOAP::Lite->uri('urn:MyURI')
+ ->proxy($HOST)
+ ->use_prefix(0)
+ ->myMethod();
+
+Will result in the following XML, which is more pallatable by .NET:
+
+ <SOAP-ENV:Envelope ...attributes skipped>
+ <SOAP-ENV:Body>
+ <mymethod xmlns="urn:MyURI" />
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+=item Modify your .NET server, if possible
+
+Stefan Pharies <stefanph at microsoft.com>:
+
+SOAP::Lite uses the SOAP encoding (section 5 of the soap 1.1 spec), and
+the default for .NET Web Services is to use a literal encoding. So
+elements in the request are unqualified, but your service expects them to
+be qualified. .Net Web Services has a way for you to change the expected
+message format, which should allow you to get your interop working.
+At the top of your class in the asmx, add this attribute (for Beta 1):
+
+ [SoapService(Style=SoapServiceStyle.RPC)]
+
+Another source said it might be this attribute (for Beta 2):
+
+ [SoapRpcService]
+
+Full Web Service text may look like:
+
+ <%@ WebService Language="C#" Class="Test" %>
+ using System;
+ using System.Web.Services;
+ using System.Xml.Serialization;
+
+ [SoapService(Style=SoapServiceStyle.RPC)]
+ public class Test : WebService {
+ [WebMethod]
+ public int add(int a, int b) {
+ return a + b;
+ }
+ }
+
+Another example from Kirill Gavrylyuk <kirillg at microsoft.com>:
+
+"You can insert [SoapRpcService()] attribute either on your class or on
+operation level".
+
+ <%@ WebService Language=CS class="DataType.StringTest"%>
+
+ namespace DataType {
+
+ using System;
+ using System.Web.Services;
+ using System.Web.Services.Protocols;
+ using System.Web.Services.Description;
+
+ [SoapRpcService()]
+ public class StringTest: WebService {
+ [WebMethod]
+ [SoapRpcMethod()]
+ public string RetString(string x) {
+ return(x);
+ }
+ }
+ }
+
+Example from Yann Christensen <yannc at microsoft.com>:
+
+ using System;
+ using System.Web.Services;
+ using System.Web.Services.Protocols;
+
+ namespace Currency {
+ [WebService(Namespace="http://www.yourdomain.com/example")]
+ [SoapRpcService]
+ public class Exchange {
+ [WebMethod]
+ public double getRate(String country, String country2) {
+ return 122.69;
+ }
+ }
+ }
+
+=back
+
+Special thanks goes to the following people for providing the above description and details on .NET interoperability issues:
+
+Petr Janata <petr.janata at i.cz>,
+
+Stefan Pharies <stefanph at microsoft.com>,
+
+Brian Jepson <bjepson at jepstone.net>, and others
+
+=head1 TROUBLESHOOTING
+
+=over 4
+
+=item SOAP::Lite serializes "18373" as an integer, but I want it to be a string!
+
+Because Perl is loosely typed, there is no 100% reliable way to predict what the *intended* type of a variable is. So SOAP::Lite has a system of guessing what a type is. But it is not 100% reliable. You do however, have the control to override this autotyping behavior with your own.
+
+Suppose you wanted to case every element of an array as a string. Then the following code will change the precedence of SOAP::Seriailizer's is-a-string test to be the first test run. Because the is-a-string test always returns C<true> every element will be determined to be a string.
+
+ my @list = qw(-1 45 foo bar 3838);
+ my $proxy = SOAP::Lite->uri($uri)->proxy($proxyUrl);
+ $proxy->serializer->typelookup->{string}->[0] = 0;
+ $proxy->myMethod(\@list);
+
+Alternatively, you can build the XML data structure manually...
+
+See L<SOAP::Serializer|SOAP::Serializer/AUTOTYPING>.
+
+=item C<+autodispatch> doesn't work in Perl 5.8
+
+There is a bug in Perl 5.8's C<UNIVERSAL::AUTOLOAD> functionality that prevents the C<+autodispatch> functionality from working properly. The workaround is to use C<dispatch_from> instead. Where you might normally do something like this:
+
+ use Some::Module;
+ use SOAP::Lite +autodispatch =>
+ uri => 'urn:Foo'
+ proxy => 'http://...';
+
+You would do something like this:
+
+ use SOAP::Lite dispatch_from(Some::Module) =>
+ uri => 'urn:Foo'
+ proxy => 'http://...';
+
+=item Problems using SOAP::Lite's COM Interface
+
+=over
+
+=item Can't call method "server" on undefined value
+
+You probably did not register F<Lite.dll> using C<regsvr32 Lite.dll>
+
+=item Failed to load PerlCtrl Runtime
+
+It is likely that you have install Perl in two different locations and the location of ActiveState's Perl is not the first instance of Perl specified in your PATH. To rectify, rename the directory in which the non-ActiveState Perl is installed, or be sure the path to ActiveState's Perl is specified prior to any other instance of Perl in your PATH.
+
+=back
+
+=item Dynamic libraries are not found
+
+If you are using the Apache web server, and you are seeing something like the following in your webserver log file:
+
+ Can't load '/usr/local/lib/perl5/site_perl/.../XML/Parser/Expat/Expat.so'
+ for module XML::Parser::Expat: dynamic linker: /usr/local/bin/perl:
+ libexpat.so.0 is NEEDED, but object does not exist at
+ /usr/local/lib/perl5/.../DynaLoader.pm line 200.
+
+Then try placing the following into your F<httpd.conf> file and see if it fixes your problem.
+
+ <IfModule mod_env.c>
+ PassEnv LD_LIBRARY_PATH
+ </IfModule>
+
+=item SOAP client reports "500 unexpected EOF before status line seen
+
+See L</"Apache is crashing with segfaults">
+
+=item Apache is crashing with segfaults
+
+Using C<SOAP::Lite> (or L<XML::Parser::Expat>) in combination with mod_perl causes random segmentation faults in httpd processes. To fix, try configuring Apache with the following:
+
+ RULE_EXPAT=no
+
+If you are using Apache 1.3.20 and later, try configuring Apache with the following option:
+
+ ./configure --disable-rule=EXPAT
+
+See http://archive.covalent.net/modperl/2000/04/0185.xml for more details and lot of thanks to Robert Barta <rho at bigpond.net.au> for explaining this weird behavior.
+
+If this doesn't address the problem, you may wish to try C<-Uusemymalloc>, or a similar option in order to instruct Perl to use the system's own C<malloc>.
+
+Thanks to Tim Bunce <Tim.Bunce at pobox.com>.
+
+=item CGI scripts do not work under Microsoft Internet Information Server (IIS)
+
+CGI scripts may not work under IIS unless scripts use the C<.pl> extension, opposed to C<.cgi>.
+
+=item Java SAX parser unable to parse message composed by SOAP::Lite
+
+In some cases SOAP messages created by C<SOAP::Lite> may not be parsed properly by a SAX2/Java XML parser. This is due to a known bug in C<org.xml.sax.helpers.ParserAdapter>. This bug manifests itself when an attribute in an XML element occurs prior to the XML namespace declaration on which it depends. However, according to the XML specification, the order of these attributes is not significant.
+
+http://www.megginson.com/SAX/index.html
+
+Thanks to Steve Alpert (Steve_Alpert at idx.com) for pointing on it.
+
+=back
+
+=head1 PERFORMANCE
+
+=over 4
+
+=item Processing of XML encoded fragments
+
+C<SOAP::Lite> is based on L<XML::Parser> which is basically wrapper around James
+Clark's expat parser. Expat's behavior for parsing XML encoded string can
+affect processing messages that have lot of encoded entities, like XML
+fragments, encoded as strings. Providing low-level details, parser will call
+char() callback for every portion of processed stream, but individually for
+every processed entity or newline. It can lead to lot of calls and additional
+memory manager expenses even for small messages. By contrast, XML messages
+which are encoded as base64Binary, don't have this problem and difference in
+processing time can be significant. For XML encoded string that has about 20
+lines and 30 tags, number of call could be about 100 instead of one for
+the same string encoded as base64Binary.
+
+Since it is parser's feature there is NO fix for this behavior (let me know
+if you find one), especially because you need to parse message you already
+got (and you cannot control content of this message), however, if your are
+in charge for both ends of processing you can switch encoding to base64 on
+sender's side. It will definitely work with SOAP::Lite and it B<may> work with
+other toolkits/implementations also, but obviously I cannot guarantee that.
+
+If you want to encode specific string as base64, just do
+C<< SOAP::Data->type(base64 => $string) >> either on client or on server
+side. If you want change behavior for specific instance of SOAP::Lite, you
+may subclass C<SOAP::Serializer>, override C<as_string()> method that is
+responsible for string encoding (take a look into C<as_base64Binary()>) and
+specify B<new> serializer class for your SOAP::Lite object with:
+
+ my $soap = new SOAP::Lite
+ serializer => My::Serializer->new,
+ ..... other parameters
+
+or on server side:
+
+ my $server = new SOAP::Transport::HTTP::Daemon # or any other server
+ serializer => My::Serializer->new,
+ ..... other parameters
+
+If you want to change this behavior for B<all> instances of SOAP::Lite, just
+substitute C<as_string()> method with C<as_base64Binary()> somewhere in your
+code B<after> C<use SOAP::Lite> and B<before> actual processing/sending:
+
+ *SOAP::Serializer::as_string = \&SOAP::Serializer::as_base64Binary;
+
+Be warned that last two methods will affect B<all> strings and convert them
+into base64 encoded. It doesn't make any difference for SOAP::Lite, but it
+B<may> make a difference for other toolkits.
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+=over 4
+
+=item *
+
+No support for multidimensional, partially transmitted and sparse arrays (however arrays of arrays are supported, as well as any other data structures, and you can add your own implementation with SOAP::Data).
+
+=item *
+
+Limited support for WSDL schema.
+
+=item *
+
+XML::Parser::Lite relies on Unicode support in Perl and doesn't do entity decoding.
+
+=item *
+
+Limited support for mustUnderstand and Actor attributes.
+
+=back
+
+=head1 PLATFORM SPECIFICS
+
+=over 4
+
+=item MacOS
+
+Information about XML::Parser for MacPerl could be found here:
+
+http://bumppo.net/lists/macperl-modules/1999/07/msg00047.html
+
+Compiled XML::Parser for MacOS could be found here:
+
+http://www.perl.com/CPAN-local/authors/id/A/AS/ASANDSTRM/XML-Parser-2.27-bin-1-MacOS.tgz
+
+=back
+
+=head1 AVAILABILITY
+
+You can download the latest version SOAP::Lite for Unix or SOAP::Lite for Win32 from the following sources:
+
+ * SOAP::Lite Homepage: http://soaplite.com/
+ * CPAN: http://search.cpan.org/search?dist=SOAP-Lite
+ * Sourceforge: http://sourceforge.net/projects/soaplite/
+
+You are welcome to send e-mail to the maintainers of SOAP::Lite with your
+with your comments, suggestions, bug reports and complaints.
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to Randy J. Ray, author of I<Programming Web Services with Perl>,
+who has contributed greatly to the documentation effort of SOAP::Lite.
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite
+to republish and redistribute the SOAP::Lite reference manual found in Appendix B
+of I<Programming Web Services with Perl>.
+
+And special gratitude to all the developers who have contributed patches, ideas,
+time, energy, and help in a million different forms to the development of this
+software.
+
+=head1 REPORTING BUGS
+
+Please report all suspected SOAP::Lite bugs using Sourceforge. This ensures
+proper tracking of the issue and allows you the reporter to know when something
+gets fixed.
+
+http://sourceforge.net/tracker/?group_id=66000&atid=513017
+
+If under dire circumstances you need immediate assistance with the resolution of
+an issue, you are welcome to contact Byrne Reese at <byrne at majordojo dot com>.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2005 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+This text and all associated documentation for this library is made available
+under the Creative Commons Attribution-NoDerivs 2.0 license.
+http://creativecommons.org/licenses/by-nd/2.0/
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Packager.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Packager.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Packager.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,539 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Packager.pm,v 1.4 2004/10/26 15:26:49 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Packager;
+
+use strict;
+use vars;
+
+use vars qw($SUPPORTED_TYPES);
+$SUPPORTED_TYPES = { };
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method ( qw(parser headers_http persist_parts) ) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift;
+ if (@_) { $self->{$field} = shift; return $self }
+ return $self->{$field};
+ }
+ }
+}
+
+sub new {
+ my($class) = shift;
+ my(%params) = @_;
+ bless {
+ "_parts" => [ ],
+ "_parser" => undef,
+ "_persist_parts" => 0,
+ }, $class;
+}
+
+sub is_supported_part {
+ my $self = shift;
+ return $SUPPORTED_TYPES->{ref $_[0]};
+}
+
+sub parts {
+ my $self = shift;
+ if (@_) {
+ $self->{'_parts'} = shift;
+ }
+ return $self->{'_parts'};
+}
+
+# This is a static method that helps find the right Packager
+sub find_packager {
+ # TODO - Input:
+ # * the mimetype of the data to be decoded raw data that needs
+ # * the data to be decoded
+ # Returns:
+ # * the proper SOAP::Packager instance
+}
+
+sub push_part {
+ my $self = shift;
+ my ($part) = @_;
+ push @{$self->{'_parts'}}, $part;
+}
+
+sub package {
+ # do nothing
+ die "SOAP::Packager::package() must be implemented";
+}
+
+sub unpackage {
+ my $self = shift;
+ $self->{'_parts'} = [] if !$self->persist_parts; # experimental
+}
+
+# ======================================================================
+
+package SOAP::Packager::MIME;
+
+use strict;
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Packager);
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method ( qw(transfer_encoding env_id env_location) ) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift;
+ if (@_) { $self->{$field} = shift; return $self }
+ return $self->{$field};
+ }
+ }
+}
+
+sub new {
+ my ($classname) = @_;
+ my $self = SOAP::Packager::new(@_);
+ $self->{'_content_encoding'} = '8bit';
+ $self->{'_env_id'} = '<main_envelope>';
+ $self->{'_env_location'} = '/main_envelope';
+ bless $self, $classname;
+ $SOAP::Packager::SUPPORTED_TYPES->{"MIME::Entity"} = 1;
+ return $self;
+}
+
+sub initialize_parser {
+ my $self = shift;
+ eval "require MIME::Parser;";
+ die "Could not find MIME::Parser - is MIME::Tools installed? Aborting." if $@;
+ $self->{'_parser'} = MIME::Parser->new;
+ $self->{'_parser'}->output_to_core('ALL');
+ $self->{'_parser'}->tmp_to_core(1);
+ $self->{'_parser'}->ignore_errors(1);
+}
+
+sub generate_random_string {
+ my ($self,$len) = @_;
+ my @chars=('a'..'z','A'..'Z','0'..'9','_');
+ my $random_string;
+ foreach (1..$len) {
+ $random_string .= $chars[rand @chars];
+ }
+ return $random_string;
+}
+
+sub get_multipart_id {
+ my ($id) = shift;
+ ($id || '') =~ /^<?([^>]+)>?$/; $1 || '';
+}
+
+sub package {
+ my $self = shift;
+ my ($envelope,$context) = @_;
+ return $envelope if (!$self->parts); # if there are no parts,
+ # then there is nothing to do
+ require MIME::Entity;
+ local $MIME::Entity::BOUNDARY_DELIMITER = "\r\n";
+ my $top = MIME::Entity->build('Type' => "Multipart/Related");
+ $top->attach('Type' => $context->soapversion == 1.1 ? "text/xml" : "application/soap+xml",
+ 'Content-Transfer-Encoding' => $self->transfer_encoding(),
+ 'Content-Location' => $self->env_location(),
+ 'Content-ID' => $self->env_id(),
+ 'Data' => $envelope );
+ # consume the attachments that come in as input by 'shift'ing
+ no strict 'refs';
+ while (my $part = shift(@{$self->parts})) {
+ $top->add_part($part);
+ }
+ # determine MIME boundary
+ my $boundary = $top->head->multipart_boundary;
+ $self->headers_http({ 'Content-Type' => 'Multipart/Related; type="text/xml"; start="<main_envelope>"; boundary="'.$boundary.'"'});
+ return $top->stringify_body;
+}
+
+sub unpackage {
+ my $self = shift;
+ my ($raw_input,$context) = @_;
+ $self->SUPER::unpackage();
+
+ # Parse the raw input into a MIME::Entity structure.
+ # - fail if the raw_input is not MIME formatted
+ $self->initialize_parser() if !defined($self->parser);
+ my $entity = eval { $self->parser->parse_data($raw_input) }
+ or die "Something wrong with MIME message: @{[$@ || $self->parser->last_error]}\n";
+
+ my $env = undef;
+ # major memory bloat below! TODO - fix!
+ if (lc($entity->head->mime_type) eq 'multipart/form-data') {
+ $env = $self->process_form_data($entity);
+ } elsif (lc($entity->head->mime_type) eq 'multipart/related') {
+ $env = $self->process_related($entity);
+ } elsif (lc($entity->head->mime_type) eq 'text/xml') {
+ # I don't think this ever gets called.
+ # warn "I am somewhere in the SOAP::Packager::MIME code I didn't know I would be in!";
+ $env = $entity->bodyhandle->as_string;
+ } else {
+ die "Can't handle MIME messsage with specified type (@{[$entity->head->mime_type]})\n";
+ }
+
+ # return the envelope
+ if ($env) {
+ return $env;
+ } elsif ($entity->bodyhandle->as_string) {
+ return $entity->bodyhandle->as_string;
+ } else {
+ die "No content in MIME message\n";
+ }
+}
+
+sub process_form_data {
+ my ($self, $entity) = @_;
+ my $env = undef;
+ foreach my $part ($entity->parts) {
+ my $name = $part->head->mime_attr('content-disposition.name');
+ $name eq 'payload' ?
+ $env = $part->bodyhandle->as_string
+ : $self->push_part($part);
+ }
+ return $env;
+}
+
+sub process_related {
+ my $self = shift;
+ my ($entity) = @_;
+ die "Multipart MIME messages MUST declare Multipart/Related content-type"
+ if ($entity->head->mime_attr('content-type') !~ /^multipart\/related/i);
+ my $start = get_multipart_id($entity->head->mime_attr('content-type.start'))
+ || get_multipart_id($entity->parts(0)->head->mime_attr('content-id'));
+ my $location = $entity->head->mime_attr('content-location') ||
+ 'thismessage:/';
+ my $env;
+ foreach my $part ($entity->parts) {
+ next if !UNIVERSAL::isa($part => "MIME::Entity");
+
+ # Weird, the following use of head->get(SCALAR[,INDEX]) doesn't work as
+ # expected. Work around is to eliminate the INDEX.
+ my $pid = get_multipart_id($part->head->mime_attr('content-id'));
+
+ # If Content-ID is not supplied, then generate a random one (HACK - because
+ # MIME::Entity does not do this as it should... content-id is required
+ # according to MIME specification)
+ $pid = $self->generate_random_string(10) if $pid eq '';
+ my $type = $part->head->mime_type;
+
+ # If a Content-Location header cannot be found, this will look for an
+ # alternative in the following MIME Header attributes
+ my $plocation = $part->head->get('content-location') ||
+ $part->head->mime_attr('Content-Disposition.filename') ||
+ $part->head->mime_attr('Content-Type.name');
+ if ($start && $pid eq $start) {
+ $env = $part->bodyhandle->as_string;
+ } else {
+ $self->push_part($part) if (defined($part->bodyhandle));
+ }
+ }
+ die "Can't find 'start' parameter in multipart MIME message\n"
+ if @{$self->parts} > 1 && !$start;
+ return $env;
+}
+
+# ======================================================================
+
+package SOAP::Packager::DIME;
+
+use strict;
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Packager);
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method ( qw(foo) ) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift;
+ if (@_) { $self->{$field} = shift; return $self }
+ return $self->{$field};
+ }
+ }
+}
+
+sub new {
+ my ($classname) = @_;
+ my $self = SOAP::Packager::new(@_);
+ bless $self, $classname;
+ $SOAP::Packager::SUPPORTED_TYPES->{"DIME::Payload"} = 1;
+ return $self;
+}
+
+sub initialize_parser {
+ my $self = shift;
+ print STDERR "Initializing parser\n";
+ eval "require DIME::Parser;";
+ die "Could not find DIME::Parser - is DIME::Tools installed? Aborting." if $@;
+ $self->{'_parser'} = DIME::Parser->new;
+}
+
+sub package {
+ my $self = shift;
+ my ($envelope,$context) = @_;
+ return $envelope if (!$self->parts); # if there are no parts,
+ # then there is nothing to do
+ require DIME::Message;
+ require DIME::Payload;
+ my $message = DIME::Message->new;
+ my $top = DIME::Payload->new;
+ $top->attach('MIMEType' => $context->soapversion == 1.1 ?
+ "http://schemas.xmlsoap.org/soap/envelope/" : "application/soap+xml",
+ 'Data' => $envelope );
+ $message->add_payload($top);
+ # consume the attachments that come in as input by 'shift'ing
+ no strict 'refs';
+ while (my $part = shift(@{$self->parts})) {
+ die "You are only allowed to add parts of type DIME::Payload to a DIME::Message"
+ if (!$part->isa('DIME::Payload'));
+# print STDERR "Adding payload to DIME message: ".ref($part)."\n";
+ $message->add_payload($part);
+# print STDERR "Payload's payload is: ".${$part->print_content_data}."\n";
+ }
+ $self->headers_http({ 'Content-Type' => 'application/dime' });
+ return $message->print_data;
+}
+
+sub unpackage {
+ my $self = shift;
+ my ($raw_input,$context) = @_;
+ $self->SUPER::unpackage();
+
+ # Parse the raw input into a DIME::Message structure.
+ # - fail if the raw_input is not DIME formatted
+ print STDERR "raw_data: $raw_input\n";
+ $self->initialize_parser() if !defined($self->parser);
+ my $message = eval { $self->parser->parse_data(\$raw_input) }
+ or die "Something wrong with DIME message: @{[$@]}\n";
+
+ # The first payload is always the SOAP Message
+ # TODO - Error check
+ my @payloads = @{$message->{'_PAYLOADS'}};
+ my $env = shift(@payloads);
+ my $env_str = $env->print_content_data;
+ print STDERR "Received this envelope: ".$env_str."\n";
+ while (my $p = shift(@payloads)) {
+ print STDERR "Adding part to Packager\n";
+ $self->push_part($p);
+ }
+ return $env_str;
+}
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+SOAP::Packager - this class is an abstract class which allows for multiple types of packaging agents such as MIME and DIME.
+
+=head1 DESCRIPTION
+
+The SOAP::Packager class is responsible for managing a set of "parts." Parts are
+additional pieces of information, additional documents, or virtually anything that
+needs to be associated with the SOAP Envelope/payload. The packager then will take
+these parts and encode/decode or "package"/"unpackage" them as they come and go
+over the wire.
+
+=head1 METHODS
+
+=over
+
+=item new
+
+Instantiates a new instance of a SOAP::Packager.
+
+=item parts
+
+Contains an array of parts. The contents of this array and their types are completely
+dependant upon the Packager being used. For example, when using MIME, the content
+of this array is MIME::Entity's.
+
+=item push_part
+
+Adds a part to set of parts managed by the current instance of SOAP::Packager.
+
+=item parser
+
+Returns the parser used to parse attachments out of a data stream.
+
+=item headers_http
+
+This is a hook into the HTTP layer. It provides a way for a packager to add and/or modify
+HTTP headers in a request/response. For example, most packaging layers will need to
+override the Content-Type (e.g. multipart/related, or application/dime).
+
+=back
+
+=head1 ABSTRACT METHODS
+
+If you wish to implement your own SOAP::Packager, then the methods below must be
+implemented by you according to the prescribed input and output requirements.
+
+=over
+
+=item package()
+
+The C<package> subroutine takes as input the SOAP envelope in string/SCALAR form.
+This will serve as the content of the root part. The packager then encapsulates the
+envelope with the parts contained within C<parts> and returns the properly
+encapsulated envelope in string/SCALAR form.
+
+=item unpackage()
+
+The C<unpackage> subroutines takes as input raw data that needs to be parsed into
+a set of parts. It is responsible for extracting the envelope from the input, and
+populating C<parts> with an ARRAY of parts extracted from the input. It then returns
+the SOAP Envelope in string/SCALAR form so that SOAP::Lite can parse it.
+
+=back
+
+=head1 SUPPORTED PACKAGING FORMATS
+
+=head2 SOAP::Packager::MIME
+
+C<SOAP::Packager::MIME> utilizes L<MIME::Tools> to provides the ability to send
+and receive Multipart/Related and Multipart/Form-Data formatted requests and
+responses.
+
+=head3 MIME METHODS
+
+The following methods are used when composing a MIME formatted message.
+
+=over
+
+=item transfer_encoding
+
+The value of the root part's Content-Transfer-Encoding MIME Header. Default is: 8bit.
+
+=item env_id
+
+The value of the root part's Content-Id MIME Header. Default is: <main_envelope>.
+
+=item env_location
+
+The value of the root part's Content-Location MIME Header. Default is: /main_envelope.
+
+=item env_type
+
+The value of the root part's Content-Type MIME Header. Default is: text/xml.
+
+=back
+
+=head3 OPTIMIZING THE MIME PARSER
+
+The use of attachments can often result in a heavy drain on system resources depending
+upon how your MIME parser is configured. For example, you can instruct the parser to
+store attachments in memory, or to use temp files. Using one of the other can affect
+performance, disk utilization, and/or reliability. Therefore you should consult the
+following URL for optimization techniques and trade-offs:
+
+http://search.cpan.org/dist/MIME-tools/lib/MIME/Parser.pm#OPTIMIZING_YOUR_PARSER
+
+To modify the parser's configuration options consult the following code sample,
+which incidentally shows how to minimize memory utilization:
+
+ my $packager = SOAP::Packager::MIME->new;
+ # $packager->parser->decode_headers(1); # no difference
+ # $packager->parser->extract_nested_messages(1); # no difference
+ $packager->parser->output_to_core(0); # much less memory
+ $packager->parser->tmp_to_core(0); # much less memory
+ $packager->parser->tmp_recycling(0); # promotes faster garbage collection
+ $packager->parser->use_inner_files(1); # no difference
+ my $client = SOAP::Lite->uri($NS)->proxy($URL)->packager($packager);
+ $client->someMethod();
+
+=head3 CLIENT SIDE EXAMPLE
+
+The following code sample shows how to use attachments within the context of a
+SOAP::Lite client.
+
+ #!/usr/bin/perl
+ use SOAP::Lite;
+ use MIME::Entity;
+ my $ent = build MIME::Entity
+ Type => "text/plain",
+ Path => "attachment.txt",
+ Filename => "attachment.txt",
+ Disposition => "attachment";
+ $NS = "urn:Majordojo:TemperatureService";
+ $HOST = "http://localhost/cgi-bin/soaplite.cgi";
+ my $client = SOAP::Lite
+ ->packager(SOAP::Packager::MIME->new)
+ ->parts([ $ent ])
+ ->uri($NS)
+ ->proxy($HOST);
+ $response = $client->c2f(SOAP::Data->name("temperature" => '100'));
+ print $response->valueof('//c2fResponse/foo');
+
+=head3 SERVER SIDE EXAMPLE
+
+The following code shows how to use attachments within the context of a CGI
+script. It shows how to read incoming attachments, and to return attachments to
+the client.
+
+ #!/usr/bin/perl -w
+ use SOAP::Transport::HTTP;
+ use MIME::Entity;
+ SOAP::Transport::HTTP::CGI
+ ->packager(SOAP::Packager::MIME->new)
+ ->dispatch_with({'urn:Majordojo:TemperatureService' => 'TemperatureService'})
+ ->handle;
+
+ BEGIN {
+ package TemperatureService;
+ use vars qw(@ISA);
+ @ISA = qw(Exporter SOAP::Server::Parameters);
+ use SOAP::Lite;
+ sub c2f {
+ my $self = shift;
+ my $envelope = pop;
+ my $temp = $envelope->dataof("//c2f/temperature");
+ use MIME::Entity;
+ my $ent = build MIME::Entity
+ Type => "text/plain",
+ Path => "printenv",
+ Filename => "printenv",
+ Disposition => "attachment";
+ # read attachments
+ foreach my $part (@{$envelope->parts}) {
+ print STDERR "soaplite.cgi: attachment found! (".ref($part).")\n";
+ print STDERR "soaplite.cgi: contents => ".$part->stringify."\n";
+ }
+ # send attachments
+ return SOAP::Data->name('convertedTemp' => (((9/5)*($temp->value)) + 32)),
+ $ent;
+ }
+ }
+
+=head2 SOAP::Packager::DIME
+
+TODO
+
+=head1 SEE ALSO
+
+L<MIME::Tools>, L<DIME::Tools>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/SOM.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/SOM.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/SOM.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,315 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2003 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: SOM.pm,v 1.1 2004/10/12 18:47:55 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::SOM - provides access to the values contained in SOAP Response
+
+=head1 DESCRIPTION
+
+Objects from the SOAP::SOM class aren't generally instantiated directly by an application. Rather, they are handed back by the deserialization of a message. In other words, developers will almost never do this:
+
+ $som = SOAP::SOM->new;
+
+SOAP::SOM objects are returned by a SOAP::Lite call in a client context. For example:
+
+ my $client = SOAP::Lite
+ ->readable(1)
+ ->uri($NS)
+ ->proxy($HOST)
+ $som = $client->someMethod();
+
+=head1 METHODS
+
+=over
+
+=item new(message)
+
+ $som = SOAP::SOM->new($message_as_xml);
+
+As said, the need to actually create an object of this class should be very rare. However, if the need arises, the syntax must be followed. The single argument to new must be a valid XML document the parser will understand as a SOAP response.
+
+=back
+
+The following group of methods provide general data retrieval from the SOAP::SOM object. The model for this is an abbreviated form of XPath. Following this group are methods that are geared towards specific retrieval of commonly requested elements.
+
+=over
+
+=item match(path)
+
+ $som->match('/Envelope/Body/[1]');
+
+This method sets the internal pointers within the data structure so that the retrieval methods that follow will have access to the desired data. In the example path, the match is being made against the method entity, which is the first child tag of the body in a SOAP response. The enumeration of container children starts at 1 in this syntax, not 0. The returned value is dependent on the context of the call. If the call is made in a boolean context (such as C<< if ($som->match($path)) >>), the return value is a boolean indicating whether the requested path matched at all. Otherwise, an object reference is returned. The returned object is also a SOAP::SOM instance but is smaller, containing the subset of the document tree matched by the expression.
+
+=item valueof(node)
+
+ $res = $som->valueof('[1]');
+
+When the SOAP::SOM object has matched a path internally with the match method, this method allows retrieval of the data within any of the matched nodes. The data comes back as native Perl data, not a class instance (see dataof). In a scalar context, this method returns just the first element from a matched node set. In an array context, all elements are returned. Assuming that the earlier call happens after the earlier call to match, it retrieves the result entity from the method response that is contained in C<$som>, as this is the first child element in a method-response tag.
+
+=item dataof(node)
+
+ $resobj = $som->dataof('[1]');
+
+Performs the same operation as the earlier valueof method, except that the data is left in its L<SOAP::Data> form, rather than being deserialized. This allows full access to all the attributes that were serialized along with the data, such as namespace and encoding.
+
+=item headerof(node)
+
+ $resobj = $som->headerof('[1]');
+
+Acts much like dataof, except that it returns an object of the L<SOAP::Header> class (covered later in this chapter), rather than SOAP::Data. This is the preferred interface for manipulating the header entities in a message.
+
+=item namespaceuriof(node)
+
+ $ns = $som->namespaceof('[1]');
+
+Retrieves the namespace URI that governs the requested node. Note that namespaces are inherited, so this method will return the relevant value, even if it derives from a parent or other ancestor node.
+
+=back
+
+The following methods provide more direct access to the message envelope. All these methods return some form of a Perl value, most often a hash reference, when called. Context is also relevant: in a scalar context only the first matching node is returned, while in an array context, all matching nodes are. When called as a static method or as a regular function (such as C<SOAP::SOM::envelope>), any of the following methods returns the XPath string that is used with the match method to retrieve the data.
+
+=over
+
+=item root
+
+ $root = $som->root;
+
+Returns the value of the root element as a hash reference. It behaves exactly as C<$som->valueof('/')> does.
+
+=item envelope
+
+ $envelope = $som->envelope;
+
+Retrieves the "Envelope" element of the message, returning it and its data as a hash reference. Keys in the hash will be Header and Body (plus any optional elements that may be present in a SOAP 1.1 envelope), whose values will be the serialized header and body, respectively.
+
+=item header
+
+ $header = $som->header;
+
+Retrieves the header portion of the envelope as a hash reference. All data within it will have been deserialized. If the attributes of the header are desired, the static form of the method can be combined with match to fetch the header as a SOAP::Data object:
+
+ $header = $som->match(SOAP::SOM::header)->dataof;
+
+=item headers
+
+ @hdrs = $som->headers;
+
+Retrieves the node set of values with deserialized headers from within the Header container. This is different from the earlier header method in that it returns the whole header as a single structure, and this returns the child elements as an array. In other words, the following expressions yield the same data structure:
+
+ $header = ($som->headers)[0];
+ $header = $som->valueof(SOAP::SOM::header.'/[1]');
+
+=item body
+
+ $body = $som->body;
+
+Retrieves the message body as a hash reference. The entity tags act as keys, with their deserialized content providing the values.
+
+=item fault
+
+ if ($som->fault) { die $som->fault->faultstring }
+
+Acts both as a boolean test whether a fault occurred, and as a way to retrieve the Fault entity itself from the message body as a hash reference. If the message contains a fault, the next four methods (faultcode, faultstring, faultactor, and faultdetail) may be used to retrieve the respective parts of the fault (which are also available on the hash reference as keys). If fault in a boolean context is true, the C<result>, C<paramsin>, C<paramsout>, and C<method> methods all return C<undef>.
+
+=item faultcode
+
+ $code = $som->faultcode;
+
+Returns the faultcode element of the fault if there is a fault; undef otherwise.
+
+=item faultstring
+
+ $string = $som->faultstring;
+
+Returns the faultstring element of the fault if there is a fault; undef otherwise.
+
+=item faultactor
+
+ $actor = $som->faultactor;
+
+Returns the faultactor element of the fault, if there is a fault and if the actor was specified within it. The faultactor element is optional in the serialization of a fault, so it may not always be present. This element is usually a string.
+
+=item faultdetail
+
+ $detail = $som->faultdetail;
+
+Returns the content of the detail element of the fault, if there is a fault and if the detail element was provided. Note that the name of the element isn't the same as the method, due to the possibility for confusion had the method been called simply, detail. As with the faultactor element, this isn't always a required component of a fault, so it isn't guaranteed to be present. The specification for the detail portion of a fault calls for it to contain a series of element tags, so the application may expect a hash reference as a return value when detail information is available (and undef otherwise).
+
+=item method
+
+ $method = $som->method
+
+Retrieves the "method" element of the message, as a hash reference. This includes all input parameters when called on a request message or all result/output parameters when called on a response message. If there is a fault present in the message, it returns undef.
+
+=item result
+
+ $value = $som->result;
+
+Returns the value that is the result of a SOAP response. The value will be already deserialized into a native Perl datatype.
+
+=item paramsin
+
+ @list = $som->paramsin;
+
+Retrieves the parameters being passed in on a SOAP request. If called in a scalar context, the first parameter is returned. When called in a list context, the full list of all parameters is returned. Each parameter is a hash reference, following the established structure for such return values.
+
+=item paramsout
+
+ @list = $som->paramsout;
+
+Returns the output parameters from a SOAP response. These are the named parameters that are returned in addition to the explicit response entity itself. It shares the same scalar/list context behavior as the paramsin method.
+
+=item paramsall
+
+ @list = $som->paramsall;
+
+Returns all parameters from a SOAP response, including the result entity itself, as one array.
+
+=item parts()
+
+Return an array of C<MIME::Entity>'s if the current payload contains attachments, or returns undefined if payload is not MIME multipart.
+
+=item is_multipart()
+
+Returns true if payload is MIME multipart, false otherwise.
+
+=back
+
+=head1 EXAMPLES
+
+=head2 ACCESSING ELEMENT VALUES
+
+Suppose for the following SOAP Envelope:
+
+ <Envelope>
+ <Body>
+ <fooResponse>
+ <bar>abcd</bar>
+ </fooResponse>
+ </Body>
+ </Envelope>
+
+And suppose you wanted to access the value of the bar element, then use the following code:
+
+ my $soap = SOAP::Lite
+ ->uri($SOME_NS)
+ ->proxy($SOME_HOST);
+ my $som = $soap->foo();
+ print $som->valueof('//fooResponse/bar');
+
+=head2 ACCESSING ATTRIBUTE VALUES
+
+Suppose the following SOAP Envelope:
+
+ <Envelope>
+ <Body>
+ <c2fResponse>
+ <convertedTemp test="foo">98.6</convertedTemp>
+ </c2fResponse>
+ </Body>
+ </Envelope>
+
+Then to print the attribute 'test' use the following code:
+
+ print "The attribute is: " .
+ $som->dataof('//c2fResponse/convertedTemp')->attr->{'test'};
+
+=head2 ITERATING OVER AN ARRAY
+
+Suppose for the following SOAP Envelope:
+
+ <Envelope>
+ <Body>
+ <catalog>
+ <product>
+ <title>Programming Web Service with Perl</title>
+ <price>$29.95</price>
+ </product>
+ <product>
+ <title>Perl Cookbook</title>
+ <price>$49.95</price>
+ </product>
+ </catalog>
+ </Body>
+ </Envelope>
+
+If the SOAP Envelope returned contained an array, use the following code to iterate over the array:
+
+ for my $t ($som->valueof('//catalog/product')) {
+ print $t->{title} . " - " . $t->{price} . "\n";
+ }
+
+=head2 DETECTING A SOAP FAULT
+
+A SOAP::SOM object is returned by a SOAP::Lite client regardless of whether the call succeeded or not. Therefore, a SOAP Client is responsible for determining if the returned value is a fault or not. To do so, use the fault() method which returns 1 if the SOAP::SOM object is a fault and 0 otherwise.
+
+ my $som = $client->someMethod(@parameters);
+
+ if ($som->fault) {
+ print $som->faultdetail;
+ } else {
+ # do something
+ }
+
+=head2 PARSING ARRAYS OF ARRAYS
+
+The most efficient way To parse and to extract data out of an array containing another array encoded in a SOAP::SOM object is the following:
+
+ $xml = <<END_XML;
+ <foo>
+ <person>
+ <foo>123</foo>
+ <foo>456</foo>
+ </person>
+ <person>
+ <foo>789</foo>
+ <foo>012</foo>
+ </person>
+ </foo>
+ END_XML
+
+ my $som = SOAP::Deserializer->deserialize($xml);
+ my $i = 0;
+ foreach my $a ($som->dataof("//person/*")) {
+ $i++;
+ my $j = 0;
+ foreach my $b ($som->dataof("//person/[$i]/*")) {
+ $j++;
+ # do something
+ }
+ }
+
+=head1 SEE ALSO
+
+L<SOAP::Data>, L<SOAP::Serializer>
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Schema.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Schema.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Schema.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,134 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2003 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Schema.pm,v 1.5 2004/11/14 19:30:49 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Schema - provides an umbrella for the way in which SOAP::Lite manages service description schemas
+
+=head1 DESCRIPTION
+
+This class provides an umbrella for the way in which SOAP::Lite manages service description schemas. Currently, the only support present is for the Web Services Description Language (WSDL). This is another of the classes not generally designed to be directly instantiated by an application, though it can be if so desired.
+
+=head1 METHODS
+
+=over
+
+=item new(optional key/value pairs)
+
+ $schema = SOAP::Schema->new(parse => $schema_uri);
+
+This is the class constructor. With no arguments, it creates a blank object of the class. Any arguments that are passed are treated as key/value pairs in which the key represents one of the methods described here, and the value is what gets passed when the method itself gets invoked.
+
+=item parse(service description URI)
+
+ $schema->parse('http://schemas.w3.org/soap.wsdl');
+
+Parses the internal representation of the service description prior to the generation of stub routines to provide method-like access to the remote services.
+
+=item access(service description URI)
+
+ $schema->access('http://soap.org/service.wsdl');
+
+Loads the specified service description from the given URL, using the current value of the schema accessor if none is provided. The full content of the URL is returned on success, or an exception is thrown (via C<die>) on error.
+
+=item load
+
+ $schema->load;
+
+Takes the internal representation of the service and generates code stubs for the remote methods, allowing them to be called as local object methods. Stubs are generated for all the functions declared in the WSDL description with this call because it's enough of a class framework to allow for basic object creation for use as handles.
+
+=item schema
+
+ $current_schema = $schema->schema;
+
+Gets (or sets) the current schema representation to be used by this object. The value to be passed when setting this is just the URI of the schema. This gets passed to other methods such as access for loading the actual content.
+
+=item services
+
+ $hashref = $schema->services;
+
+Gets or sets the services currently stored on the object. The services are kept as a hash reference, whose keys and values are the list of returned values from the WSDL parser. Keys represent the names of the services themselves (names have been normalized into Perl-compatible identifiers), with values that are also hash references to the internal representation of the service itself.
+
+=item stub
+
+Returns the autogenerated Perl code as a string. This code is generated from the WSDL provided by the C<service> method call. The code contains a package definition for the service being called.
+
+ my $client = SOAP::Lite->new;
+ my $code = $client->service($WSDL_URL)->stub;
+ open FILE,">ServicePackage.pm";
+ print FILE $code;
+ close FILE;
+
+=item cache_dir
+
+Sets/retrieves the value of the directory where generated stubs will be cached. If C<cache_dir> is null, then no caching will be performed.
+
+ my $client = SOAP::Lite->new;
+ my $code = $client->cache_dir("/tmp")->service($WSDL_URL)->stub;
+
+If C<cache_dir> is undefined, no caching will take place.
+
+=item cache_ttl
+
+Sets/retrieves the value of the time to live (in seconds) for cached files. This is only relevant when used in conjunction with C<cache_dir>.
+
+If C<cache_ttl> is set to 0, the cache will never expire. Files will have to be removed manually in order for the cache to be refreshed.
+
+ my $client = SOAP::Lite->new;
+ my $code = $client->cache_ttl(3600)->cache_dir("/tmp")->service($WSDL_URL)->stub;
+
+The default time to live is 0.
+
+=item useragent(LWP::UserAgent)
+
+ my $client = SOAP::Lite->new;
+ $ua = $client->schema->useragent;
+ $ua->agent("Fubar! 0.1");
+ my $response = $client->service("http://localhost/some.wsdl")
+ ->someMethod("Foo");
+
+Gets or sets the classes UserAgent used for retrieving schemas over the web.
+This allows users to have direct access to the UserAgent so that they may control
+the credentials passed to a remote server, or the specific configuration of their
+HTTP agent.
+
+=back
+
+=head1 SOAP::Schema::WSDL
+
+At present, the SOAP::Lite toolkit supports only loading of service descriptions in the WSDL syntax. This class manages the parsing and storing of these service specifications. As a general rule, this class should be even less likely to be used directly by an application because its presence should be completely abstracted by the previous class (SOAP::Schema). None of the methods are defined here; the class is only mentioned for sake of reference.
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
+
+
+
+
+
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Serializer.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Serializer.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Serializer.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,270 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Serializer.pm,v 1.2 2004/10/17 05:18:18 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Serializer - the means by which the toolkit manages the expression of data as XML
+
+=head1 DESCRIPTION
+
+The SOAP::Serializer class is the means by which the toolkit manages the expression of data as XML. The object that a SOAP::Lite instance uses by default is generally enough for the task, with no need for the application to create its own. The main purpose of this class is to provide a place for applications to extend the serializer by defining additional methods for handling new datatypes.
+
+=head1 METHODS
+
+=over
+
+=item new(optional key/value pairs)
+
+ $serialize = SOAP::Serializer->new( );
+
+This is the constructor method for the class. In addition to creating a basic object and initializing it with default values, the constructor can also take names and values for most of the accessor methods that the class supports.
+
+=item envelope(method, data arguments)
+
+ $serialize->envelope(fault => $fault_obj);
+
+Provides the core purpose for the SOAP::Serializer class. It creates the full SOAP envelope based on the input passed in to it. The data arguments passed in the list of parameters to the method are divided into two sublists: any parameters that are L<SOAP::Header> objects or derivatives of go into one list, while the remainder go into the other. The nonheader objects are used as the content for the message body, with the body itself being largely dependent on the value of the first argument in the list. This argument is expected to be a string and should be one of the following:
+
+=item context
+
+ $serialize->context->packager();
+
+This provides access to the calling context of C<SOAP::Serializer>. In a client side context the often means a reference to an instance of SOAP::Lite. In a server side context this means a reference to a SOAP::Server instance.
+
+=over
+
+=item method
+
+The envelope is being created to encapsulate a RPC-style method call.
+
+=item response
+
+The message being created is that of a response stemming from a RPC-style method call.
+
+=item fault
+
+For this specifier, the envelope being created is to transmit a fault.
+
+=item freeform
+
+This identifier is used as a general-case encoding style for messages that don't fit into any of the previous cases. The arguments are encoded into the envelope's Body tag without any sort of context sensitivity. Any value other than these four results in an error.
+
+=back
+
+=item envprefix(optional value)
+
+ $serialize->envprefix('env');
+
+Gets or sets the prefix that labels the SOAP envelope namespace. This defaults to SOAP-ENV.
+
+=item encprefix(optional value)
+
+ $serialize->envprefix('enc');
+
+Gets or sets the prefix that labels the SOAP encoding namespace. Defaults to SOAP-ENC.
+
+=item soapversion(optional value)
+
+ $serial->soapversion('1.2');
+
+If no parameter is given, returns the current version of SOAP that is being used as the basis for serializing messages. If a parameter is given, attempts to set that as the version of SOAP being used. The value should be either 1.1 or 1.2. When the SOAP version is being set, the package selects new URNs for envelope and encoding spaces and also calls the xmlschema method to set the appropriate schema definition.
+
+=item xmlschema(optional value)
+
+ $serial->xmlschema($xml_schema_1999);
+
+Gets or sets the URN for the schema being used to express the structure of the XML generated by the serializer. If setting the value, the input must be the full URN for the new schema and is checked against the list of known SOAP schemas.
+
+=item register_ns
+
+The register_ns subroutine allows users to register a global namespace
+with the SOAP Envelope. The first parameter is the namespace, the second
+parameter to this subroutine is an optional prefix. If a prefix is not
+provided, one will be generated automatically for you. All namespaces
+registered with the serializer get declared in the <soap:Envelope />
+element.
+
+=item find_prefix
+
+The find_prefix subroutine takes a namespace as a parameter and returns
+the assigned prefix to that namespace. This eliminates the need to declare
+and redeclare namespaces within an envelope. This subroutine is especially
+helpful in determining the proper prefix when assigning a type to a
+SOAP::Data element. A good example of how this might be used is as follows:
+
+ SOAP::Data->name("foo" => $inputParams{'foo'})
+ ->type($client->serializer->find_prefix('urn:Foo').':Foo');
+
+=back
+
+=head1 CUSTOM DATA TYPES
+
+When serializing an object, or blessed hash reference, into XML, C<SOAP::Serializer> first checks to see if a subroutine has been defined for the corresponding class name. For example, in the code below, C<SOAP::Serializer> will check to see if a subroutine called C<as_MyModule__MyPackage> has been defined. If so, then it will pass C<$foo> to that subroutine along with other data known about the C<SOAP::Data> element being encoded.
+
+ $foo = MyModule::MyPackage->new;
+ my $client = SOAP::Lite
+ ->uri($NS)
+ ->proxy($HOST);
+ $som = $client->someMethod(SOAP::Data->name("foo" => $foo));
+
+=head1 as_TypeName SUBROUTINE REQUIREMENTS
+
+=over
+
+=item Naming Convention
+
+The subroutine should always be prepended with C<as_> followed by the type's name. The type's name must have all colons (':') substituded with an underscore ('_').
+
+=item Input
+
+The input to C<as_TypeName> will have at least one parameter, and at most four parameters. The first parameter will always be the value or the object to be encoded. The following three parameters depend upon the context of the value/object being encoded.
+
+If the value/object being encoded was part of a C<SOAP::Data> object (as in the above example), then the second, third and fourth parameter will be the C<SOAP::Data> element's name, type, and attribute set respectively. If on the other hand, the value/object being encoded is I<not> part of a C<SOAP::Data> object, as in the code below:
+
+ $foo = MyModule::MyPackage->new;
+ my $client = SOAP::Lite
+ ->uri($NS)
+ ->proxy($HOST);
+ $som = $client->someMethod($foo);
+
+Then the second and third parameters will be the class name of the value/object being encoded (e.g. "MyModule::MyPackage" in the example above), and the fourth parameter will be an empty hash.
+
+=item Output
+
+The encoding subroutine must return an array containing three elements: 1) the name of the XML element, 2) a hash containing the attributes to be placed into the element, and 3) the value of the element.
+
+=back
+
+=head1 AUTOTYPING
+
+When the type of an element has not been declared explicitly, SOAP::Lite must "guess" at the object's type. That is due to the fact that the only form of introspection that Perl provides (through the use of the C<ref> subroutine) does not provide enough information to C<SOAP::Serializer> to allow SOAP::Lite to determine the exact type of an element being serialized.
+
+To work around this limitation, the C<SOAP::Serializer::typelookup> hash was created. This hash is populated with all the data types that the current C<SOAP::Serializer> can auto detect. Users and developers are free to modify the contents of this hash allowing them to register new data types with the system.
+
+When C<SOAP::Serializer> is asked to encode an object into XML, it goes through the following steps. First, C<SOAP::Serializer> checks to see if a type has been explicitly stated for the current object. If a type has been provided C<SOAP::Serializer> checks to see if an C<as_TypeName> subroutine as been defined for that type. If such a subroutine exists, then C<SOAP::Serializer> passes the object to it to be encoded. If the subroutine does not exist, or the type has not been provided, then C<SOAP::Serializer> must attempt to "guess" the type of the object being serialized.
+
+To do so, C<SOAP::Serializer> runs in sequence a set of tests stored in the C<SOAP::Serializer::typelookup> hash. C<SOAP::Serializer> continues to run each test until one of the tests returns true, indicating that the type of the object has been detected. When the type of the object has been detected, then C<SOAP::Serializer> passes the object to the encoding subroutine that corresponds with the test that was passed. If all the tests fail, and the type was not determined, then C<SOAP::Serializer> will as a last resort encode the object based on one of the four basic data types known to Perl: REF, SCALAR, ARRAY and HASH.
+
+The following table contains the set of data types detectable by C<SOAP::Lite> by default and the order in which their corresponding test subroutine will be run, according to their precedence value.
+
+ Table 1 - Autotyping Precedence
+
+ TYPENAME PRECEDENCE VALUE
+ ----------------------------
+ base64 10
+ int 20
+ long 25
+ float 30
+ gMonth 35
+ gDay 40
+ gYear 45
+ gMonthDay 50
+ gYearMonth 55
+ date 60
+ time 70
+ dateTime 75
+ duration 80
+ boolean 90
+ anyURI 95
+ string 100
+
+
+=head2 REGISTERING A NEW DATA TYPE
+
+To register a new data type that can be automatically detected by C<SOAP::Lite> and then serialized into XML, the developer must provide the following four things:
+
+=over
+
+=item *
+
+The name of the new data type.
+
+=item *
+
+A subroutine that is capable of detecting whether a value passed to it is of the corresponding data type.
+
+=item *
+
+A number representing the test subroutine's precedence relative to all the other types' test subroutinestypes. See I<Table 1 - Autotyping Precedence>.
+
+=item *
+
+A subroutine that is capable of providing C<SOAP::Serializer> with the information necessary to serialize an object of the corresponding data type into XML.
+
+=back
+
+=head3 EXAMPLE 1
+
+If, for example, you wish to create a new datatype called C<uriReference> for which you would like Perl values to be automatically detected and serialized into, then you follow these steps.
+
+B<Step 1: Write a Test Subroutine>
+
+The test subroutine will have passed to it by C<SOAP::Serializer> a value to be tested. The test subroutine must return 1 if the value passed to it is of the corresponding type, or else it must return 0.
+
+ sub SOAP::Serializer::uriReferenceTest {
+ my ($value) = @_;
+ return 1 if ($value =~ m!^http://!);
+ return 0;
+ }
+
+B<Step 2: Write an Encoding Subroutine>
+
+The encoding subroutine provides C<SOAP::Serializer> with the data necessary to encode the value passed to it into XML. The encoding subroutine name's should be of the following format: C<as_><Type Name>.
+
+The encoding subroutine will have passed to it by C<SOAP::Serializer> four parameters: the value to be encoded, the name of the element being encoded, the assumed type of the element being encoded, and a reference to a hash containing the attributes of the element being encoded. The encoding subroutine must return an array representing the encoded datatype. C<SOAP::Serializer> will use the contents of this array to generate the corresponding XML of the value being encoded, or serialized. This array contains the following 3 elements: the name of the XML element, a hash containing the attributes to be placed into the element, and the value of the element.
+
+ sub SOAP::Serializer::as_uriReference {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {'xsi:type' => 'xsd:uriReference', %$attr}, $value];
+ }
+
+B<Step 3: Register the New Data Type>
+
+To register the new data type, simply add the type to the C<SOAP::Serializer::typelookup> hash using the type name as the key, and an array containing the precedence value, the test subroutine, and the encoding subroutine.
+
+ $s->typelookup->{uriReference}
+ = [11, \&uriReferenceTest, 'as_uriReference'];
+
+I<Tip: As a short hand, you could just as easily use an anonymous test subroutine when registering the new datatype in place of the C<urlReferenceTest> subroutine above. For example:>
+
+ $s->typelookup->{uriReference}
+ = [11, sub { $_[0] =~ m!^http://! }, 'as_uriReference'];
+
+Once complete, C<SOAP::Serializer> will be able to serialize the following C<SOAP::Data> object into XML:
+
+ $elem = SOAP::Data->name("someUri" => 'http://yahoo.com')->type('uriReference');
+
+C<SOAP::Serializer> will also be able to automatically determine and serialize the following untyped C<SOAP::Data> object into XML:
+
+ $elem = SOAP::Data->name("someUri" => 'http://yahoo.com');
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Server.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Server.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Server.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,264 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2003 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Server.pm,v 1.3 2004/10/22 22:24:26 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Server - provides the basic framework for the transport-specific server classes to build upon
+
+=head1 DESCRIPTION
+
+The SOAP::Server class provides the basic framework for the transport-specific server classes to build upon. Note that in none of the code examples provided with SOAP::Lite is this class used directly. Instead, it is designed to be a superclass within more specific implementation classes. The methods provided by SOAP::Server itself are:
+
+=head1 METHODS
+
+=over
+
+=item new(optional key/value pairs)
+
+ $server = SOAP::Server->new(%options);
+
+Creates a new object of the class. Various default instance values are set up, and like many of the constructors in this module, most of the class methods described here may be passed in the construction call by giving the name followed by the parameter (or an array reference if there are multiple parameters).
+
+=item action(optional new value)
+
+ $action = $server->action
+
+Retrieves or sets the value of the action attribute on the server object. This attribute is used when mapping the request to an appropriate namespace or routine. For example, the HTTP library sets the attribute to the value of the SOAPAction header when processing of the request begins, so that the find_target method described later may retrieve the value to match it against the server's configuration. Returns the object itself when setting the attribute.
+
+=item myuri(optional new value)
+
+ $server->myuri("http://localhost:9000/SOAP");
+
+Gets or sets the myuri attribute. This specifies the specific URI that the server is answering requests to (which may be different from the value specified in action or in the SOAPAction header).
+
+=item serializer(optional new value)
+
+=item deserializer(optional new value)
+
+ $serializer = $server->serializer;
+ $server->deserializer($new_deser_obj);
+
+As with the client objects, these methods provide direct access to the serialization and deserialization objects the server object uses to transform input and output from and to XML. There is generally little or no need to explicitly set these to new values.
+
+=item options(optional new value)
+
+ $server->options({compress_threshold => 10000});
+
+Sets (or retrieves) the current server options as a hash-table reference. At present, only one option is used within the SOAP::Lite libraries themselves:
+
+=over
+
+=item compress_threshold
+
+The value of this option is expected to be a numerical value. If set, and if the Compress::Zlib library is available to use, messages whose size in bytes exceeds this value are compressed for transmission. Both
+ends of the conversation have to support this and have it enabled.
+
+=back
+
+Other options may be defined and passed around using this mechanism. Note that setting the options using this accessor requires a full hash reference be passed. To set just one or a few values, retrieve the current reference value and use it to set the key(s).
+
+=item dispatch_with(optional new value)
+
+ $server->dispatch_with($new_table);
+
+Represents one of two ways in which a SOAP::Server (or derived) object may specify mappings of incoming requests to server-side subroutines or namespaces. The value of the attribute is a hash-table reference. To set the attribute, you must pass a new hash reference. The hash table's keys are URI strings (literal URIs or the potential values of the SOAPAction header), and the corresponding values are one of a class name or an object reference. Requests that come in for a URI found in the table are routed to the specified class or through the specified object.
+
+=item dispatch_to(optional list of new values)
+
+ $server->dispatch_to($dir, 'Module', 'Mod::meth');
+
+This is the more traditional way to specify modules and packages for routing requests. This is also an accessor, but it returns a list of values when called with no arguments (rather than a single one). Each item in the list of values passed to this method is expected to be one of four things:
+
+=over
+
+=item I<Directory path>
+
+If the value is a directory path, all modules located in that path are available for remote use.
+
+=item I<Package name>
+
+When the value is a package name (without including a specific method name), all routines within the package are available remotely.
+
+=item I<Fully qualified method name>
+
+Alternately, when the value is a package-qualified name of a subroutine or method, that specific routine is made available. This allows the server to make selected methods available without opening the entire package.
+
+=item I<Object reference>
+
+If the value is an object reference, the object itself routes the request.
+
+The list of values held by the dispatch_to table are compared only after the URI mapping table from the dispatch_with attribute has been consulted. If the request's URI or SOAPAction header don't map to a specific configuration, the path specified by the action header (or in absence, the URI) is converted to a package name and compared against this set of values.
+
+=back
+
+=item objects_by_reference(optional list of new values)
+
+ $server->objects_by_reference(qw(My:: Class));
+
+This also returns a list of values when retrieving the current attribute value,
+as opposed to a single value.
+
+This method doesn't directly specify classes for request routing so much as it
+modifies the behavior of the routing for the specified classes. The classes that
+are given as arguments to this method are marked to be treated as producing
+persistent objects. The client is given an object representation that contains
+just a handle on a local object with a default persistence of 600 idle seconds.
+Each operation on the object resets the idle timer to zero. This facility is
+considered experimental in the current version of SOAP::Lite.
+
+A global variable/"constant" allows developers to specify the amount of time
+an object will be persisted. The default value is 600 idle seconds. This value
+can be changed using the following code:
+
+ $SOAP::Constants::OBJS_BY_REF_KEEPALIVE = 1000;
+
+=item on_action(optional new value)
+
+ $server->on_action(sub { ...new code });
+
+Gets or sets the reference to a subroutine that is used for executing the on_action hook. Where the client code uses this hook to construct the action-request data (such as for a SOAPAction header), the server uses the on_action hook to do any last-minute tests on the request itself, before it gets routed to a final destination. When called, the hook routine is passed three arguments:
+
+=over
+
+=item action
+
+The action URI itself, retrieved from the action method described earlier.
+
+=item method_uri
+
+The URI of the XML namespace the method name is labeled with.
+
+=item method_name
+
+The name of the method being called by the request.
+
+=back
+
+=item on_dispatch(optional new value)
+
+ ($uri, $name) = $server->on_dispatch->($request);
+
+Gets or sets the subroutine reference used for the on_dispatch hook. This hook is called at the start of the request-routing phase and is given a single argument when called:
+
+=over
+
+=item request
+
+An object of the L<SOAP::SOM> class, containing the deserialized request from the client.
+
+=back
+
+=item find_target
+
+ ($class, $uri, $name) = $server->find_target($req)
+
+Taking as its argument an object of the SOAP::SOM class that contains the deserialized request, this method returns a three-element list describing the method that is to be called. The elements are:
+
+=over
+
+=item class
+
+The class into which the method call should be made. This may come back as either a string or an objectreference, if the dispatching is configured using an object instance.
+
+=item uri
+
+The URN associated with the request method. This is the value that was used when configuring the method routing on the server object.
+
+=item name
+
+The name of the method to call.
+
+=back
+
+=item handle
+
+ $server->handle($request_text);
+
+Implements the main functionality of the serving process, in which the server takes an incoming request and dispatches it to the correct server-side subroutine. The parameter taken as input is either plain XML or MIME-encoded content (if MIME-encoding support is enabled).
+
+=item make_fault
+
+ return $server->makefault($code, $message);
+
+Creates a SOAP::Fault object from the data passed in. The order of arguments is: code, message, detail, actor. The first two are required (because they must be present in all faults), but the last two may be omitted unless needed.
+
+=back
+
+=head2 SOAP::Server::Parameters
+
+This class provides two methods, but the primary purpose from the developer's point of view is to allow classes that a SOAP server exposes to inherit from it. When a class inherits from the SOAP::Server::Parameters class, the list of parameters passed to a called method includes the deserialized request in the form of a L<SOAP::SOM> object. This parameter is passed at the end of the arguments list, giving methods the option of ignoring it unless it is needed.
+
+The class provides two subroutines (not methods), for retrieving parameters from the L<SOAP::SOM> object. These are designed to be called without an object reference in the parameter list, but with an array reference instead (as the first parameter). The remainder of the arguments list is expected to be the list from the method-call itself, including the SOAP::SOM object at the end of the list. The routines may be useful to understand if an application wishes to subclass SOAP::Server::Parameters and inherit from the new class instead.
+
+=over
+
+=item byNameOrOrder(order, parameter list, envelope)
+
+ @args = SOAP::Server::Parameters::byNameOrOrder ([qw(a b)], @_);
+
+Using the list of argument names passed in the initial argument as an array reference, this routine returns a list of the parameter values for the parameters matching those names, in that order. If none of the names given in the initial array-reference exist in the parameter list, the values are returned in the order in which they already appear within the list of parameters. In this case, the number of returned values may differ from the length of the requested-parameters list.
+
+=item byName(order, parameter list, envelope)
+
+ @args = SOAP::Server::Parameters::byName ([qw(a b c)], @_);
+
+Acts in a similar manner to the previous, with the difference that it always returns as many values as requested, even if some (or all) don't exist. Parameters that don't exist in the parameter list are returned as undef values.
+
+=back
+
+=head3 EXAMPLE
+
+The following is an example CGI based Web Service that utilizes a Perl module that inherits from the C<SOAP::Server::Parameters> class. This allows the methods of that class to access its input by name.
+
+ #!/usr/bin/perl
+ use SOAP::Transport::HTTP;
+ SOAP::Transport::HTTP::CGI
+ ->dispatch_to('C2FService')
+ ->handle;
+ BEGIN {
+ package C2FService;
+ use vars qw(@ISA);
+ @ISA = qw(Exporter SOAP::Server::Parameters);
+ use SOAP::Lite;
+ sub c2f {
+ my $self = shift;
+ my $envelope = pop;
+ my $temp = $envelope->dataof("//c2f/temperature");
+ return SOAP::Data->name('convertedTemp' => (((9/5)*($temp->value)) + 32));
+ }
+ }
+
+=head1 SEE ALSO
+
+L<SOAP::SOM>, L<SOAP::Transport::HTTP>
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
+
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Test.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Test.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Test.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,408 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Test.pm,v 1.3 2003/08/11 05:50:47 paulclinger Exp $
+#
+# ======================================================================
+
+package SOAP::Test;
+
+use 5.004;
+use vars qw($VERSION $TIMEOUT);
+$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+
+$TIMEOUT = 5;
+
+# ======================================================================
+
+package My::PingPong; # we'll use this package in our tests
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ bless {_num=>shift} => $class;
+}
+
+sub next {
+ my $self = shift;
+ $self->{_num}++;
+}
+
+sub value {
+ my $self = shift;
+ $self->{_num};
+}
+
+# ======================================================================
+
+package SOAP::Test::Server;
+
+use strict;
+use Test;
+use SOAP::Lite;
+
+sub run_for {
+ my $proxy = shift or die "Proxy/endpoint is not specified";
+
+ # ------------------------------------------------------
+ my $s = SOAP::Lite->uri('http://something/somewhere')->proxy($proxy)->on_fault(sub{});
+ eval { $s->transport->timeout($SOAP::Test::TIMEOUT) };
+ my $r = $s->test_connection;
+
+ unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+ }
+ # ------------------------------------------------------
+
+ plan tests => 53;
+
+ eval q!use SOAP::Lite on_fault => sub{ref $_[1] ? $_[1] : new SOAP::SOM}; 1! or die;
+
+ print STDERR "Perl SOAP server test(s)...\n";
+
+ $s = SOAP::Lite
+ -> uri('urn:/My/Examples')
+ -> proxy($proxy);
+
+ ok($s->getStateName(1)->result eq 'Alabama');
+ ok($s->getStateNames(1,4,6,13)->result =~ /^Alabama\s+Arkansas\s+Colorado\s+Illinois\s*$/);
+
+ $r = $s->getStateList([1,2,3,4])->result;
+ ok(ref $r && $r->[0] eq 'Alabama');
+
+ $r = $s->getStateStruct({item1 => 1, item2 => 4})->result;
+ ok(ref $r && $r->{item2} eq 'Arkansas');
+
+ {
+ my $autoresult = $s->autoresult;
+ $s->autoresult(1);
+ ok($s->getStateName(1) eq 'Alabama');
+ $s->autoresult($autoresult);
+ }
+
+ print STDERR "Autobinding of output parameters test(s)...\n";
+
+ $s->uri('urn:/My/Parameters');
+ my $param1 = 10;
+ my $param2 = SOAP::Data->name('myparam' => 12);
+ my $result = $s->autobind($param1, $param2)->result;
+ ok($result == $param1 && $param2->value == 24);
+
+ print STDERR "Header manipulation test(s)...\n";
+ $a = $s->addheader(2, SOAP::Header->name(my => 123));
+ ok(ref $a->header && $a->header->{my} eq '123123');
+ ok($a->headers eq '123123');
+
+ print STDERR "Echo untyped data test(s)...\n";
+ $a = $s->echotwo(11, 12);
+ ok($a->result == 11);
+
+ print STDERR "mustUnderstand test(s)...\n";
+ $s->echo(SOAP::Header->name(somethingelse => 123)
+ ->mustUnderstand(1));
+ ok($s->call->faultstring =~ /[Hh]eader has mustUnderstand attribute/);
+
+ if ($proxy =~ /^http/) {
+ ok($s->transport->status =~ /^500/);
+ } else {
+ skip('No Status checks for non http protocols on server side' => undef);
+ }
+
+ $s->echo(SOAP::Header->name(somethingelse => 123)
+ ->mustUnderstand(1)
+ ->actor('http://notme/'));
+ ok(!defined $s->call->fault);
+
+ print STDERR "dispatch_from test(s)...\n";
+ eval "use SOAP::Lite
+ uri => 'http://my.own.site.com/My/Examples',
+ dispatch_from => ['A', 'B'],
+ proxy => '$proxy',
+ ; 1" or die;
+
+ eval { C->c };
+ ok($@ =~ /Can't locate object method "c"/);
+
+ eval { A->a };
+ ok(!$@ && SOAP::Lite->self->call->faultstring =~ /Failed to access class \(A\)/);
+
+ eval "use SOAP::Lite
+ dispatch_from => 'A',
+ uri => 'http://my.own.site.com/My/Examples',
+ proxy => '$proxy',
+ ; 1" or die;
+
+ eval { A->a };
+ ok(!$@ && SOAP::Lite->self->call->faultstring =~ /Failed to access class \(A\)/);
+
+ print STDERR "Object autobinding and SOAP:: prefix test(s)...\n";
+
+ eval "use SOAP::Lite +autodispatch =>
+ uri => 'urn:', proxy => '$proxy'; 1" or die;
+
+ ok(SOAP::Lite->autodispatched);
+
+ eval { SOAP->new(1) };
+ ok($@ =~ /^URI is not specified/);
+
+ eval "use SOAP::Lite +autodispatch =>
+ uri => 'urn:/A/B', proxy => '$proxy'; 1" or die;
+
+ # should call My::PingPong, not A::B
+ my $p = My::PingPong->SOAP::new(10);
+ ok(ref $p && $p->SOAP::next+1 == $p->value);
+
+ # forget everything
+ SOAP::Lite->self(undef);
+
+ $s = SOAP::Lite
+ -> uri('urn:/My/PingPong')
+ -> proxy($proxy)
+ ;
+
+ # should return object EXACTLY as after My::PingPong->SOAP::new(10)
+ $p = $s->SOAP::new(10);
+ ok(ref $p && $s->SOAP::next($p)+1 == $p->value);
+
+ print STDERR "VersionMismatch test(s)...\n";
+
+ {
+ local $SOAP::Constants::NS_ENV = 'http://schemas.xmlsoap.org/new/envelope/';
+ my $s = SOAP::Lite
+ -> uri('http://my.own.site.com/My/Examples')
+ -> proxy($proxy)
+ -> on_fault(sub{})
+ ;
+ $r = $s->dosomething;
+ ok(ref $r && $r->faultcode =~ /:VersionMismatch/);
+ }
+
+ print STDERR "Objects-by-reference test(s)...\n";
+
+ eval "use SOAP::Lite +autodispatch =>
+ uri => 'urn:', proxy => '$proxy'; 1" or die;
+
+ print STDERR "Session iterator\n";
+ $r = My::SessionIterator->new(10);
+ if (!ref $r || exists $r->{id}) {
+ ok(ref $r && $r->next && $r->next == 11);
+ } else {
+ skip('No persistent objects (o-b-r) supported on server side' => undef);
+ }
+
+ print STDERR "Persistent iterator\n";
+ $r = My::PersistentIterator->new(10);
+ if (!ref $r || exists $r->{id}) {
+ my $first = ($r->next, $r->next) if ref $r;
+
+ $r = My::PersistentIterator->new(10);
+ ok(ref $r && $r->next && $r->next == $first+2);
+ } else {
+ skip('No persistent objects (o-b-r) supported on server side' => undef);
+ }
+
+ { local $^W; # disable warnings about deprecated AUTOLOADing for nonmethods
+ print STDERR "Parameters-by-name test(s)...\n";
+ print STDERR "You can see warning about AUTOLOAD for non-method...\n" if $^W;
+
+ eval "use SOAP::Lite +autodispatch =>
+ uri => 'http://my.own.site.com/My/Parameters', proxy => '$proxy'; 1" or die;
+
+ my @parameters = (
+ SOAP::Data->name(b => 222),
+ SOAP::Data->name(c => 333),
+ SOAP::Data->name(a => 111)
+ );
+
+ # switch to 'main' package, because nonqualified methods should be there
+ ok(main::byname(@parameters) eq "a=111, b=222, c=333");
+
+ ok(main::bynameororder(@parameters) eq "a=111, b=222, c=333");
+
+ ok(main::bynameororder(111, 222, 333) eq "a=111, b=222, c=333");
+
+ print STDERR "Function call test(s)...\n";
+ print STDERR "You can see warning about AUTOLOAD for non-method...\n" if $^W;
+ ok(main::echo(11) == 11);
+ }
+
+ print STDERR "SOAPAction test(s)...\n";
+ if ($proxy =~ /^tcp:/) {
+ for (1..2) {skip('No SOAPAction checks for tcp: protocol on server side' => undef)}
+ } else {
+ my $s = SOAP::Lite
+ -> uri('http://my.own.site.com/My/Examples')
+ -> proxy($proxy)
+ -> on_action(sub{'""'})
+ ;
+ ok($s->getStateName(1)->result eq 'Alabama');
+
+ $s->on_action(sub{'"wrong_SOAPAction_here"'});
+ ok($s->getStateName(1)->faultstring =~ /SOAPAction shall match/);
+ }
+
+ print STDERR "UTF8 test(s)...\n";
+ if (!eval "pack('U*', 0)") {
+ for (1) {skip('No UTF8 test. No support for pack("U*") modifier' => undef)}
+ } else {
+ $s = SOAP::Lite
+ -> uri('http://my.own.site.com/My/Parameters')
+ -> proxy($proxy);
+
+ my $latin1 = '¯à¨¢¥â';
+ my $utf8 = pack('U*', unpack('C*', $latin1));
+ my $result = $s->echo(SOAP::Data->type(string => $utf8))->result;
+
+ ok(pack('U*', unpack('C*', $result)) eq $utf8 # should work where XML::Parser marks resulting strings as UTF-8
+ || join('', unpack('C*', $result)) eq join('', unpack('C*', $utf8)) # should work where it doesn't
+ );
+ }
+
+ {
+ my $on_fault_was_called = 0;
+ print STDERR "Die in server method test(s)...\n";
+ my $s = SOAP::Lite
+ -> uri('http://my.own.site.com/My/Parameters')
+ -> proxy($proxy)
+ -> on_fault(sub{$on_fault_was_called++;return})
+ ;
+ ok($s->die_simply()->faultstring =~ /Something bad/);
+ ok($on_fault_was_called > 0);
+ my $detail = $s->die_with_object()->dataof(SOAP::SOM::faultdetail . '/[1]');
+ ok($on_fault_was_called > 1);
+ ok(ref $detail && $detail->name =~ /(^|:)something$/);
+
+ # get Fault as hash of subelements
+ my $fault = $s->die_with_fault()->fault;
+ ok($fault->{faultcode} =~ ':Server.Custom');
+ ok($fault->{faultstring} eq 'Died in server method');
+ ok(ref $fault->{detail}->{BadError} eq 'BadError');
+ ok($fault->{faultactor} eq 'http://www.soaplite.com/custom');
+ }
+
+ print STDERR "Method with attributes test(s)...\n";
+
+ $s = SOAP::Lite
+ -> uri('urn:/My/Examples')
+ -> proxy($proxy)
+ ;
+
+ ok($s->call(SOAP::Data->name('getStateName')->attr({xmlns => 'urn:/My/Examples'}), 1)->result eq 'Alabama');
+
+ print STDERR "Call with empty uri test(s)...\n";
+ $s = SOAP::Lite
+ -> uri('')
+ -> proxy($proxy)
+ ;
+
+ ok($s->getStateName(1)->faultstring =~ /Denied access to method \(getStateName\) in class \(main\)/);
+
+ ok($s->call('a:getStateName' => 1)->faultstring =~ /Denied access to method \(getStateName\) in class \(main\)/);
+
+ print STDERR "Number of parameters test(s)...\n";
+
+ $s = SOAP::Lite
+ -> uri('http://my.own.site.com/My/Parameters')
+ -> proxy($proxy)
+ ;
+ { my @all = $s->echo->paramsall; ok(@all == 0) }
+ { my @all = $s->echo(1)->paramsall; ok(@all == 1) }
+ { my @all = $s->echo((1) x 10)->paramsall; ok(@all == 10) }
+
+ print STDERR "Memory refresh test(s)...\n";
+
+ # Funny test.
+ # Let's forget about ALL settings we did before with 'use SOAP::Lite...'
+ SOAP::Lite->self(undef);
+ ok(!defined SOAP::Lite->self);
+
+ print STDERR "Call without uri test(s)...\n";
+ $s = SOAP::Lite
+ -> proxy($proxy)
+ ;
+
+ ok($s->getStateName(1)->faultstring =~ /Denied access to method \(getStateName\) in class \(main\)/);
+
+ print STDERR "Different settings for method and namespace test(s)...\n";
+
+ ok($s->call(SOAP::Data
+ ->name('getStateName')
+ ->attr({xmlns => 'urn:/My/Examples'}), 1)->result eq 'Alabama');
+
+ ok($s->call(SOAP::Data
+ ->name('a:getStateName')
+ ->uri('urn:/My/Examples'), 1)->result eq 'Alabama');
+
+ ok($s->call(SOAP::Data
+ ->name('getStateName')
+ ->uri('urn:/My/Examples'), 1)->result eq 'Alabama');
+
+ ok($s->call(SOAP::Data
+ ->name('a:getStateName')
+ ->attr({'xmlns:a' => 'urn:/My/Examples'}), 1)->result eq 'Alabama');
+
+ eval { $s->call(SOAP::Data->name('a:getStateName')) };
+
+ ok($@ =~ /Can't find namespace for method \(a:getStateName\)/);
+
+ $s->serializer->namespaces->{'urn:/My/Examples'} = '';
+
+ ok($s->getStateName(1)->result eq 'Alabama');
+
+ eval "use SOAP::Lite
+ uri => 'urn:/My/Examples', proxy => '$proxy'; 1" or die;
+
+ print STDERR "Global settings test(s)...\n";
+ $s = new SOAP::Lite;
+
+ ok($s->getStateName(1)->result eq 'Alabama');
+
+ SOAP::Trace->import(transport =>
+ sub {$_[0]->content_type('something/wrong') if UNIVERSAL::isa($_[0] => 'HTTP::Request')}
+ );
+
+ if ($proxy =~ /^tcp:/) {
+ skip('No Content-Type checks for tcp: protocol on server side' => undef);
+ } else {
+ ok($s->getStateName(1)->faultstring =~ /Content-Type must be/);
+ }
+}
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+SOAP::Test - Test framework for SOAP::Lite
+
+=head1 SYNOPSIS
+
+ use SOAP::Test;
+
+ SOAP::Test::Server::run_for('http://localhost/cgi-bin/soap.cgi');
+
+=head1 DESCRIPTION
+
+SOAP::Test provides simple framework for testing server implementations.
+Specify your address (endpoint) and run provided tests against your server.
+See t/1*.t for examples.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Trace.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Trace.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Trace.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,166 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2003 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Trace.pm,v 1.1 2004/10/12 18:47:55 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Trace - used only to manage and manipulate the runtime tracing of execution within the toolkit
+
+=head1 DESCRIPTION
+
+This class has no methods or objects. It is used only to manage and manipulate the runtime tracing of execution within the toolkit. In absence of methods, this section reviews the events that may be configured and the ways of configuring them.
+
+=head1 SYNOPSIS
+
+Tracing is enabled by the SOAP::Lite import method. This is usually done at compile-time, though it may be done explicitly by calling import directly. The commands for setting up tracing start with the keyword +trace. Alternately, +debug may be used; the two are interchangeable. After the initial keyword, one or more of the signals detailed here may be specified, optionally with a callback to handle them. When specifying multiple signals to be handled by a single callback, it is sufficient to list all of them first, followed finally by the callback, as in:
+
+ use SOAP::Lite +trace =>
+ method => fault => \&message_level,
+ trace => objects => \&lower_level;
+
+In the fragment, the reference to message_level is installed as the callback for both method and fault signals, while lower_level is installed for trace and object events. If callbacks aren't explicitly provided, the default tracing action is to log a message to Perl's STDOUT file descriptor. Callbacks should expect a one or more arguments passed in, though the nature of the arguments varies based on the signal.
+
+Any signal can be disabled by prefacing the name with a hyphen, such as -result. This is useful with the pseudosignal "all," which is shorthand for the full list of signals. The following fragment disables only the two signals, while still enabling the rest:
+
+ SOAP::Lite->import(+trace => all => -result => -parameters);
+
+If the keyword +trace (or +debug) is used without any signals specified, it enables all signals (as if all were implied).
+
+The signals and their meaning follow. Each also bears a note as to whether the signal is relevant to a server application, client application, or both.
+
+=head1 TRACE SIGNALS
+
+=over
+
+=item transport I<Client only>
+
+Triggered in the transport layer just before a request is sent and immediately after a response is received. Each time the signal is sent, the sole argument to the callback is the relevant object. On requests, this is a L<HTTP::Request> object; for responses, it's a L<HTTP::Response> object.
+
+=item dispatch I<Server only>
+
+Triggered with the full name of the method being dispatched, just before execution is passed to it. It is currently disabled in SOAP::Lite 0.55.
+
+=item result I<Server only>
+
+Triggered after the method has been dispatched and is passed the results returned from the method as a list. The result values have not yet been serialized when this signal is sent.
+
+=item parameters I<Server only>
+
+Triggered before a method call is actually dispatched, with the data that is intended for the call itself. The parameters for the method call are passed in as a list, after having been deserialized into Perl data.
+
+=item headers I<Server only>
+
+This signal should be for triggering on the headers of an incoming message, but it isn't implemented as of SOAP::Lite 0.55.
+
+=item objects I<Client or server>
+
+Highlights when an object is instantiated or destroyed. It is triggered in the new and DESTROY methods of the various SOAP::Lite classes.
+
+=item method I<Client or server>
+
+Triggered with the list of arguments whenever the envelope method of L<SOAP::Serializer> is invoked with an initial argument of method. The initial string itself isn't passed to the callback.
+
+=item fault I<Client or server>
+
+As with the method signal earlier, except that this signal is triggered when SOAP::Serializer::envelope is called with an initial argument of fault.
+
+=item freeform I<Client or server>
+
+Like the two previous, this signal is triggered when the method SOAP::Serializer::envelope is called with an initial parameter of freeform. This syntax is used when the method is creating SOAP::Data objects from free-form input data.
+
+=item trace I<Client or server>
+
+Triggered at the entry-point of many of the more-significant functions. Not all the functions within the SOAP::Lite classes trigger this signal. Those that do are primarily the highly visible functions described in the interface descriptions for the various classes.
+
+=item debug I<Client or server>
+
+Used in the various transport modules to track the contents of requests and responses (as ordinary strings, not as objects) at different points along the way.
+
+=back
+
+=head1 EXAMPLES
+
+=head2 SELECTING SIGNALS TO TRACE
+
+The following code snippet will enable tracing for all signals:
+
+ use SOAP::Lite +trace => 'all';
+
+Or, the following will also do the trick:
+
+ use SOAP::Lite +trace;
+
+You can disable tracing for a set of signals by prefixing the signal name with a hyphen. Therefore, if you wish to enable tracing for every signal EXCEPT transport signals, then you would use the code below:
+
+ use SOAP::Lite +trace => [ qw(all -transport) ];
+
+=head2 LOGGING SIGNALS TO A FILE
+
+You can optionally provide a subroutine or callback to each signal trace you declare. Each time a signal is received, it is passed to the corresponding subroutine. For example, the following code effectively logs all fault signals to a file called fault.log:
+
+ use SOAP::Lite +trace => [ fault => \&log_faults ];
+
+ sub log_faults {
+ open LOGFILE,">fault.log";
+ print LOGFILE, $_[0] . "\n";
+ close LOGFILE;
+ }
+
+You can also use a single callback for multiple signals using the code below:
+
+ use SOAP::Lite +trace => [ method, fault => \&log ];
+
+=head2 LOGGING MESSAGE CONTENTS
+
+The transport signal is unique in the that the signal is not a text string, but the actually HTTP::Request being sent (just prior to be sent), or HTTP::Response object (immediately after it was received). The following code sample shows how to make use of this:
+
+ use SOAP::Lite +trace => [ transport => &log_message ];
+
+ sub log_message {
+ my ($in) = @_;
+ if (class($in) eq "HTTP::Request") {
+ # do something...
+ print $in->contents; # ...for example
+ } elsif (class($in) eq "HTTP::Response") {
+ # do something
+ }
+ }
+
+=head2 ON_DEBUG
+
+The C<on_debug> method is available, as in:
+
+ use SOAP::Lite;
+ my $client = SOAP::Lite
+ ->uri($NS)
+ ->proxy($HOST)
+ ->on_debug( sub { print @_; } );
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/FTP.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/FTP.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/FTP.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,82 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: FTP.pm,v 1.3 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Transport::FTP;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+use Net::FTP;
+use IO::File;
+use URI;
+
+# ======================================================================
+
+package SOAP::Transport::FTP::Client;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Client);
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my(@params, @methods);
+ while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
+ $self = bless {@params} => $class;
+ while (@methods) { my($method, $params) = splice(@methods,0,2);
+ $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ }
+ }
+ return $self;
+}
+
+sub send_receive {
+ my($self, %parameters) = @_;
+ my($envelope, $endpoint, $action) =
+ @parameters{qw(envelope endpoint action)};
+
+ $endpoint ||= $self->endpoint; # ftp://login:password@ftp.something/dir/file
+
+ my $uri = URI->new($endpoint);
+ my($server, $auth) = reverse split /@/, $uri->authority;
+ my $dir = substr($uri->path, 1, rindex($uri->path, '/'));
+ my $file = substr($uri->path, rindex($uri->path, '/')+1);
+
+ eval {
+ my $ftp = Net::FTP->new($server, %$self) or die "Can't connect to $server: $@\n";
+ $ftp->login(split /:/, $auth) or die "Couldn't login\n";
+ $dir and ($ftp->cwd($dir) or
+ $ftp->mkdir($dir, 'recurse') and $ftp->cwd($dir) or die "Couldn't change directory to '$dir'\n");
+
+ my $FH = IO::File->new_tmpfile; print $FH $envelope; $FH->flush; $FH->seek(0,0);
+ $ftp->put($FH => $file) or die "Couldn't put file '$file'\n";
+ $ftp->quit;
+ };
+
+ (my $code = $@) =~ s/\n$//;
+
+ $self->code($code);
+ $self->message($code);
+ $self->is_success(!defined $code || $code eq '');
+ $self->status($code);
+
+ return;
+}
+
+# ======================================================================
+
+1;
+
+__END__
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/HTTP.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/HTTP.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/HTTP.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,632 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: HTTP.pm,v 1.16 2005/10/19 00:43:23 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Transport::HTTP;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+use SOAP::Lite;
+use SOAP::Packager;
+
+# ======================================================================
+
+package SOAP::Transport::HTTP::Client;
+
+use vars qw(@ISA $COMPRESS $USERAGENT_CLASS);
+$USERAGENT_CLASS = 'LWP::UserAgent';
+ at ISA = qw(SOAP::Client);
+#@ISA = ("SOAP::Client",$USERAGENT_CLASS);
+
+$COMPRESS = 'deflate';
+
+my(%redirect, %mpost, %nocompress);
+
+# hack for HTTP connection that returns Keep-Alive
+# miscommunication (?) between LWP::Protocol and LWP::Protocol::http
+# dies after timeout, but seems like we could make it work
+sub patch {
+ BEGIN { local ($^W) = 0; }
+ no warnings "redefine";
+ { sub LWP::UserAgent::redirect_ok; *LWP::UserAgent::redirect_ok = sub {1} }
+ { package LWP::Protocol;
+ my $collect = \&collect; # store original
+ *collect = sub {
+ if (defined $_[2]->header('Connection') && $_[2]->header('Connection') eq 'Keep-Alive') {
+ my $data = $_[3]->();
+ my $next = SOAP::Utils::bytelength($$data) == $_[2]->header('Content-Length') ? sub { my $str = ''; \$str; } : $_[3];
+ my $done = 0; $_[3] = sub { $done++ ? &$next : $data };
+ }
+ goto &$collect;
+ };
+ }
+ *patch = sub {};
+};
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub http_request {
+ my $self = shift;
+ if (@_) { $self->{'_http_request'} = shift; return $self }
+ return $self->{'_http_request'};
+}
+
+sub http_response {
+ my $self = shift;
+ if (@_) { $self->{'_http_response'} = shift; return $self }
+ return $self->{'_http_response'};
+}
+
+sub new {
+ my $self = shift;
+ return $self if ref $self;
+ push @ISA,$USERAGENT_CLASS;
+ eval("require $USERAGENT_CLASS") or die "Could not load UserAgent class $USERAGENT_CLASS: $@";
+ require HTTP::Request;
+ require HTTP::Headers;
+ patch() if $SOAP::Constants::PATCH_HTTP_KEEPALIVE;
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my(@params, @methods);
+ while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
+ $self = $class->SUPER::new(@params);
+ die "SOAP::Transport::HTTP::Client must inherit from LWP::UserAgent, or one of its subclasses"
+ if !$self->isa("LWP::UserAgent");
+ $self->agent(join '/', 'SOAP::Lite', 'Perl', SOAP::Transport::HTTP->VERSION);
+ $self->options({});
+ $self->http_request(HTTP::Request->new);
+ $self->http_request->headers(HTTP::Headers->new);
+ # TODO - add application/dime
+ $self->http_request->header(Accept => ['text/xml', 'multipart/*', 'application/soap']);
+ while (@methods) { my($method, $params) = splice(@methods,0,2);
+ $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ }
+ SOAP::Trace::objects('()');
+ }
+ return $self;
+}
+
+sub send_receive {
+ my ($self, %parameters) = @_;
+ my ($context, $envelope, $endpoint, $action, $encoding, $parts) =
+ @parameters{qw(context envelope endpoint action encoding parts)};
+ $endpoint ||= $self->endpoint;
+
+ my $method = 'POST';
+ $COMPRESS = 'gzip';
+
+ $self->options->{is_compress}
+ ||= exists $self->options->{compress_threshold}
+ && eval { require Compress::Zlib };
+
+ # Initialize the basic about the HTTP Request object
+ $self->http_request->method($method);
+ $self->http_request->url($endpoint);
+
+ no strict 'refs';
+ if ($parts) {
+ my $packager = $context->packager;
+ $envelope = $packager->package($envelope,$context);
+ foreach my $hname (keys %{$packager->headers_http}) {
+ $self->http_request->headers->header($hname => $packager->headers_http->{$hname});
+ }
+ # TODO - DIME support
+ }
+
+ COMPRESS: {
+ my $compressed
+ = !exists $nocompress{$endpoint} &&
+ $self->options->{is_compress} &&
+ ($self->options->{compress_threshold} || 0) < length $envelope;
+ $envelope = Compress::Zlib::memGzip($envelope) if $compressed;
+ my $original_encoding = $self->http_request->content_encoding;
+
+ while (1) {
+ # check cache for redirect
+ $endpoint = $redirect{$endpoint} if exists $redirect{$endpoint};
+ # check cache for M-POST
+ $method = 'M-POST' if exists $mpost{$endpoint};
+
+ # 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
+ my $bytelength = SOAP::Utils::bytelength($envelope);
+ $envelope = pack('C0A*', $envelope)
+ if !$SOAP::Constants::DO_NOT_USE_LWP_LENGTH_HACK && length($envelope) != $bytelength;
+
+ $self->http_request->content($envelope);
+ $self->http_request->protocol('HTTP/1.1');
+
+ $self->http_request->proxy_authorization_basic($ENV{'HTTP_proxy_user'},
+ $ENV{'HTTP_proxy_pass'})
+ if ($ENV{'HTTP_proxy_user'} && $ENV{'HTTP_proxy_pass'});
+ # by Murray Nesbitt
+
+ if ($method eq 'M-POST') {
+ my $prefix = sprintf '%04d', int(rand(1000));
+ $self->http_request->header(Man => qq!"$SOAP::Constants::NS_ENV"; ns=$prefix!);
+ $self->http_request->header("$prefix-SOAPAction" => $action) if defined $action;
+ } else {
+ $self->http_request->header(SOAPAction => $action) if defined $action;
+ }
+
+
+ # allow compress if present and let server know we could handle it
+ $self->http_request->header('Accept-Encoding' =>
+ [$SOAP::Transport::HTTP::Client::COMPRESS])
+ if $self->options->{is_compress};
+ $self->http_request->content_encoding($SOAP::Transport::HTTP::Client::COMPRESS)
+ if $compressed;
+
+ if(!$self->http_request->content_type){
+ $self->http_request->content_type(join '; ',
+ $SOAP::Constants::DEFAULT_HTTP_CONTENT_TYPE,
+ !$SOAP::Constants::DO_NOT_USE_CHARSET && $encoding ?
+ 'charset=' . lc($encoding) : ());
+ }elsif (!$SOAP::Constants::DO_NOT_USE_CHARSET && $encoding ){
+ my $tmpType = $self->http_request->headers->header('Content-type');
+ $self->http_request->content_type($tmpType.'; charset=' . lc($encoding));
+ }
+
+ $self->http_request->content_length($bytelength);
+ SOAP::Trace::transport($self->http_request);
+ SOAP::Trace::debug($self->http_request->as_string);
+
+ $self->SUPER::env_proxy if $ENV{'HTTP_proxy'};
+
+ $self->http_response($self->SUPER::request($self->http_request));
+ SOAP::Trace::transport($self->http_response);
+ SOAP::Trace::debug($self->http_response->as_string);
+
+ # 100 OK, continue to read?
+ if (($self->http_response->code == 510 || $self->http_response->code == 501) && $method ne 'M-POST') {
+ $mpost{$endpoint} = 1;
+ } elsif ($self->http_response->code == 415 && $compressed) {
+ # 415 Unsupported Media Type
+ $nocompress{$endpoint} = 1;
+ $envelope = Compress::Zlib::memGunzip($envelope);
+# $self->http_request->content_encoding($original_encoding);
+ $self->http_request->headers->remove_header('Content-Encoding');
+ redo COMPRESS; # try again without compression
+ } else {
+ last;
+ }
+ }
+ }
+
+ $redirect{$endpoint} = $self->http_response->request->url
+ if $self->http_response->previous && $self->http_response->previous->is_redirect;
+
+ $self->code($self->http_response->code);
+ $self->message($self->http_response->message);
+ $self->is_success($self->http_response->is_success);
+ $self->status($self->http_response->status_line);
+
+ my $content =
+ ($self->http_response->content_encoding || '')
+ =~ /\b$SOAP::Transport::HTTP::Client::COMPRESS\b/o &&
+ $self->options->{is_compress} ?
+ Compress::Zlib::memGunzip($self->http_response->content)
+ : ($self->http_response->content_encoding || '') =~ /\S/
+ ? die "Can't understand returned Content-Encoding (@{[$self->http_response->content_encoding]})\n"
+ : $self->http_response->content;
+ $self->http_response->content_type =~ m!^multipart/!i ?
+ join("\n", $self->http_response->headers_as_string, $content)
+ : $content;
+}
+
+# ======================================================================
+
+package SOAP::Transport::HTTP::Server;
+
+use vars qw(@ISA $COMPRESS);
+ at ISA = qw(SOAP::Server);
+
+use URI;
+
+$COMPRESS = 'deflate';
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new { require LWP::UserAgent;
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ $self = $class->SUPER::new(@_);
+ $self->{'_on_action'} = sub {
+ (my $action = shift || '') =~ s/^(\"?)(.*)\1$/$2/;
+ die "SOAPAction shall match 'uri#method' if present (got '$action', expected '@{[join('#', @_)]}'\n"
+ if $action && $action ne join('#', @_)
+ && $action ne join('/', @_)
+ && (substr($_[0], -1, 1) ne '/' || $action ne join('', @_));
+ };
+ SOAP::Trace::objects('()');
+ }
+ return $self;
+}
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(request response)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+ }
+ }
+}
+
+sub handle {
+ my $self = shift->new;
+
+ if ($self->request->method eq 'POST') {
+ $self->action($self->request->header('SOAPAction') || undef);
+ } elsif ($self->request->method eq 'M-POST') {
+ return $self->response(HTTP::Response->new(510, # NOT EXTENDED
+ "Expected Mandatory header with $SOAP::Constants::NS_ENV as unique URI"))
+ if $self->request->header('Man') !~ /^"$SOAP::Constants::NS_ENV";\s*ns\s*=\s*(\d+)/;
+ $self->action($self->request->header("$1-SOAPAction") || undef);
+ } else {
+ return $self->response(HTTP::Response->new(405)) # METHOD NOT ALLOWED
+ }
+
+ my $compressed = ($self->request->content_encoding || '') =~ /\b$COMPRESS\b/;
+ $self->options->{is_compress} ||= $compressed && eval { require Compress::Zlib };
+
+ # signal error if content-encoding is 'deflate', but we don't want it OR
+ # something else, so we don't understand it
+ return $self->response(HTTP::Response->new(415)) # UNSUPPORTED MEDIA TYPE
+ if $compressed && !$self->options->{is_compress} ||
+ !$compressed && ($self->request->content_encoding || '') =~ /\S/;
+
+ my $content_type = $self->request->content_type || '';
+ # in some environments (PerlEx?) content_type could be empty, so allow it also
+ # anyway it'll blow up inside ::Server::handle if something wrong with message
+ # TBD: but what to do with MIME encoded messages in THOSE environments?
+ return $self->make_fault($SOAP::Constants::FAULT_CLIENT, "Content-Type must be 'text/xml,' 'multipart/*,' or 'application/dime' instead of '$content_type'")
+ if $content_type &&
+ $content_type ne 'text/xml' &&
+ $content_type ne 'application/dime' &&
+ $content_type !~ m!^multipart/!;
+
+ # TODO - Handle the Expect: 100-Continue HTTP/1.1 Header
+ if ($self->request->header("Expect") eq "100-Continue") {
+
+ }
+
+
+ # TODO - this should query SOAP::Packager to see what types it supports, I don't
+ # like how this is hardcoded here.
+ my $content = $compressed ?
+ Compress::Zlib::uncompress($self->request->content)
+ : $self->request->content;
+ my $response = $self->SUPER::handle(
+ $self->request->content_type =~ m!^multipart/! ?
+ join("\n", $self->request->headers_as_string, $content)
+ : $content
+ ) or return;
+
+ $self->make_response($SOAP::Constants::HTTP_ON_SUCCESS_CODE, $response);
+}
+
+sub make_fault {
+ my $self = shift;
+ $self->make_response($SOAP::Constants::HTTP_ON_FAULT_CODE => $self->SUPER::make_fault(@_));
+ return;
+}
+
+sub make_response {
+ my $self = shift;
+ my($code, $response) = @_;
+
+ my $encoding = $1
+ if $response =~ /^<\?xml(?: version="1.0"| encoding="([^\"]+)")+\?>/;
+ $response =~ s!(\?>)!$1<?xml-stylesheet type="text/css"?>!
+ if $self->request->content_type eq 'multipart/form-data';
+
+ $self->options->{is_compress} ||=
+ exists $self->options->{compress_threshold} && eval { require Compress::Zlib };
+
+ my $compressed = $self->options->{is_compress} &&
+ grep(/\b($COMPRESS|\*)\b/, $self->request->header('Accept-Encoding')) &&
+ ($self->options->{compress_threshold} || 0) < SOAP::Utils::bytelength $response;
+ $response = Compress::Zlib::compress($response) if $compressed;
+ # this next line does not look like a good test to see if something is multipart
+ # perhaps a /content-type:.*multipart\//gi is a better regex?
+ my ($is_multipart) = ($response =~ /content-type:.* boundary="([^\"]*)"/im);
+ $self->response(HTTP::Response->new(
+ $code => undef,
+ HTTP::Headers->new(
+ 'SOAPServer' => $self->product_tokens,
+ $compressed ? ('Content-Encoding' => $COMPRESS) : (),
+ 'Content-Type' => join('; ', 'text/xml',
+ !$SOAP::Constants::DO_NOT_USE_CHARSET &&
+ $encoding ? 'charset=' . lc($encoding) : ()),
+ 'Content-Length' => SOAP::Utils::bytelength $response),
+ $response,
+ ));
+ $self->response->headers->header('Content-Type' => 'Multipart/Related; type="text/xml"; start="<main_envelope>"; boundary="'.$is_multipart.'"') if $is_multipart;
+}
+
+sub product_tokens { join '/', 'SOAP::Lite', 'Perl', SOAP::Transport::HTTP->VERSION }
+
+# ======================================================================
+
+package SOAP::Transport::HTTP::CGI;
+
+use vars qw(@ISA);
+ at 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('()');
+ }
+ return $self;
+}
+
+sub make_response {
+ my $self = shift;
+ $self->SUPER::make_response(@_);
+}
+
+sub handle {
+ my $self = shift->new;
+
+ my $length = $ENV{'CONTENT_LENGTH'} || 0;
+
+ if (!$length) {
+ $self->response(HTTP::Response->new(411)) # LENGTH REQUIRED
+ } elsif (defined $SOAP::Constants::MAX_CONTENT_SIZE && $length > $SOAP::Constants::MAX_CONTENT_SIZE) {
+ $self->response(HTTP::Response->new(413)) # REQUEST ENTITY TOO LARGE
+ } else {
+ if ($ENV{EXPECT} =~ /\b100-Continue\b/i) {
+ print "HTTP/1.1 100 Continue\r\n\r\n";
+ }
+ my $content;
+ binmode(STDIN);
+ read(STDIN,$content,$length);
+ $self->request(HTTP::Request->new(
+ $ENV{'REQUEST_METHOD'} || '' => $ENV{'SCRIPT_NAME'},
+# HTTP::Headers->new(map {(/^HTTP_(.+)/i ? $1 : $_) => $ENV{$_}} keys %ENV),
+ HTTP::Headers->new(map {(/^HTTP_(.+)/i ? ($1=~m/SOAPACTION/) ?('SOAPAction'):($1) : $_) => $ENV{$_}} keys %ENV),
+ $content,
+ ));
+ $self->SUPER::handle;
+ }
+
+ # imitate nph- cgi for IIS (pointed by Murray Nesbitt)
+ my $status = defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/
+ ? $ENV{SERVER_PROTOCOL} || 'HTTP/1.0' : 'Status:';
+ my $code = $self->response->code;
+ binmode(STDOUT); print STDOUT
+ "$status $code ", HTTP::Status::status_message($code),
+ "\015\012", $self->response->headers_as_string("\015\012"),
+ "\015\012", $self->response->content;
+}
+
+
+# ======================================================================
+
+package SOAP::Transport::HTTP::Daemon;
+
+use Carp ();
+use vars qw($AUTOLOAD @ISA);
+ at ISA = qw(SOAP::Transport::HTTP::Server);
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+#sub new { require HTTP::Daemon;
+sub new {
+ my $self = shift;
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+
+ my(@params, @methods);
+ while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
+ $self = $class->SUPER::new;
+
+ # Added in 0.65 - Thanks to Nils Sowen
+ # use SSL if there is any parameter with SSL_* in the name
+ $self->SSL(1) if !$self->SSL && grep /^SSL_/, @params;
+ my $http_daemon = $self->http_daemon_class;
+ eval "require $http_daemon" or Carp::croak $@ unless
+ UNIVERSAL::can($http_daemon => 'new');
+ $self->{_daemon} = $http_daemon->new(@params) or Carp::croak "Can't create daemon: $!";
+ # End SSL patch
+ # $self->{_daemon} = HTTP::Daemon->new(@params) or Carp::croak "Can't create daemon: $!";
+ $self->myuri(URI->new($self->url)->canonical->as_string);
+ while (@methods) { my($method, $params) = splice(@methods,0,2);
+ $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ }
+ SOAP::Trace::objects('()');
+ }
+ return $self;
+}
+
+sub SSL {
+ my $self = shift->new;
+ @_ ? ($self->{_SSL} = shift, return $self) : return
+ $self->{_SSL};
+}
+
+sub http_daemon_class { shift->SSL ? 'HTTP::Daemon::SSL' : 'HTTP::Daemon' }
+
+sub AUTOLOAD {
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+ return if $method eq 'DESTROY';
+
+ no strict 'refs';
+ *$AUTOLOAD = sub { shift->{_daemon}->$method(@_) };
+ goto &$AUTOLOAD;
+}
+
+sub handle {
+ my $self = shift->new;
+ while (my $c = $self->accept) {
+ while (my $r = $c->get_request) {
+ $self->request($r);
+ $self->SUPER::handle;
+ $c->send_response($self->response)
+ }
+ # replaced ->close, thanks to Sean Meisner <Sean.Meisner at VerizonWireless.com>
+ # shutdown() doesn't work on AIX. close() is used in this case. Thanks to Jos Clijmans <jos.clijmans at recyfin.be>
+ UNIVERSAL::isa($c, 'shutdown') ? $c->shutdown(2) : $c->close();
+ $c->close;
+ }
+}
+
+# ======================================================================
+
+package SOAP::Transport::HTTP::Apache;
+
+use vars qw(@ISA);
+ at 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('()');
+ }
+ die "Could not find or load mod_perl"
+ unless (eval "require mod_perl");
+ die "Could not detect your version of mod_perl"
+ if (!defined($mod_perl::VERSION));
+ if ($mod_perl::VERSION < 1.99) {
+ require Apache;
+ require Apache::Constants;
+ Apache::Constants->import('OK');
+ $self->{'MOD_PERL_VERSION'} = 1;
+ } elsif ($mod_perl::VERSION < 3) {
+ require Apache::RequestRec;
+ require Apache::RequestIO;
+ require Apache::Const;
+ Apache::Const->import(-compile => 'OK');
+ $self->{'MOD_PERL_VERSION'} = 2;
+ } else {
+ die "Unsupported version of mod_perl";
+ }
+ return $self;
+}
+
+sub handler {
+ my $self = shift->new;
+ my $r = shift;
+ $r = Apache->request if (!$r && $self->{'MOD_PERL_VERSION'} == 1);
+
+ if ($r->header_in('Expect') =~ /\b100-Continue\b/i) {
+ $r->print("HTTP/1.1 100 Continue\r\n\r\n");
+ }
+
+ $self->request(HTTP::Request->new(
+ $r->method() => $r->uri,
+ HTTP::Headers->new($r->headers_in),
+ do {
+ my ($c,$buf);
+ while ($r->read($buf,$r->header_in('Content-length'))) {
+ $c.=$buf;
+ }
+ $c;
+ }
+ ));
+ $self->SUPER::handle;
+
+ # we will specify status manually for Apache, because
+ # if we do it as it has to be done, returning SERVER_ERROR,
+ # Apache will modify our content_type to 'text/html; ....'
+ # which is not what we want.
+ # will emulate normal response, but with custom status code
+ # which could also be 500.
+ $r->status($self->response->code);
+ $self->response->headers->scan(sub { $r->header_out(@_) });
+ $r->send_http_header(join '; ', $self->response->content_type);
+ $r->print($self->response->content);
+ return $self->{'MOD_PERL_VERSION'} == 2 ? &Apache::OK : &Apache::Constants::OK;
+}
+
+sub configure {
+ my $self = shift->new;
+ my $config = shift->dir_config;
+ foreach (%$config) {
+ $config->{$_} =~ /=>/
+ ? $self->$_({split /\s*(?:=>|,)\s*/, $config->{$_}})
+ : ref $self->$_() ? () # hm, nothing can be done here
+ : $self->$_(split /\s+|\s*,\s*/, $config->{$_})
+ if $self->can($_);
+ }
+ $self;
+}
+
+{ sub handle; *handle = \&handler } # just create alias
+
+# ======================================================================
+#
+# Copyright (C) 2001 Single Source oy (marko.asplund at kronodoc.fi)
+# a FastCGI transport class for SOAP::Lite.
+#
+# ======================================================================
+
+package SOAP::Transport::HTTP::FCGI;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Transport::HTTP::CGI);
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new { require FCGI; Exporter::require_version('FCGI' => 0.47); # requires thread-safe interface
+ my $self = shift;
+
+ if (!ref($self)) {
+ my $class = ref($self) || $self;
+ $self = $class->SUPER::new(@_);
+ $self->{_fcgirq} = FCGI::Request(\*STDIN, \*STDOUT, \*STDERR);
+ SOAP::Trace::objects('()');
+ }
+ return $self;
+}
+
+sub handle {
+ my $self = shift->new;
+
+ my ($r1, $r2);
+ my $fcgirq = $self->{_fcgirq};
+
+ while (($r1 = $fcgirq->Accept()) >= 0) {
+ $r2 = $self->SUPER::handle;
+ }
+
+ return undef;
+}
+
+# ======================================================================
+
+1;
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/IO.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/IO.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/IO.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,75 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: IO.pm,v 1.3 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Transport::IO;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+use IO::File;
+use SOAP::Lite;
+
+# ======================================================================
+
+package SOAP::Transport::IO::Server;
+
+use strict;
+use Carp ();
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Server);
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ $self = $class->SUPER::new(@_);
+ }
+ return $self;
+}
+
+sub BEGIN {
+ no strict 'refs';
+ my %modes = (in => '<', out => '>');
+ for my $method (keys %modes) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ return $self->{$field} unless @_;
+
+ my $file = shift;
+ if (defined $file && !ref $file && !defined fileno($file)) {
+ my $name = $file;
+ open($file = new IO::File, $modes{$method} . $name) or Carp::croak "$name: $!";
+ }
+ $self->{$field} = $file;
+ return $self;
+ }
+ }
+}
+
+sub handle {
+ my $self = shift->new;
+
+ $self->in(*STDIN)->out(*STDOUT) unless defined $self->in;
+ my $in = $self->in;
+ my $out = $self->out;
+
+ my $result = $self->SUPER::handle(join '', <$in>);
+ no strict 'refs'; print {$out} $result if defined $out;
+}
+
+# ======================================================================
+
+1;
+
+__END__
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/JABBER.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/JABBER.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/JABBER.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,245 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: JABBER.pm,v 1.3 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Transport::JABBER;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+use Net::Jabber 1.0021 qw(Client);
+use URI::Escape;
+use URI;
+use SOAP::Lite;
+
+my $NAMESPACE = "http://namespaces.soaplite.com/transport/jabber";
+
+{ local $^W;
+ # fix problem with printData in 1.0021
+ *Net::Jabber::printData = sub {'nothing'} if Net::Jabber->VERSION == 1.0021;
+
+ # fix problem with Unicode encoding in EscapeXML. Jabber ALWAYS convert latin to utf8
+ *Net::Jabber::EscapeXML = *Net::Jabber::EscapeXML = # that's Jabber 1.0021
+ *XML::Stream::EscapeXML = *XML::Stream::EscapeXML = # that's Jabber 1.0022
+ \&SOAP::Utils::encode_data;
+
+ # There is also an error in XML::Stream::UnescapeXML 1.12, but
+ # we can't do anything there, except hack it also :(
+}
+
+# ======================================================================
+
+package URI::jabber; # ok, lets do 'jabber://' scheme
+require URI::_server; require URI::_userpass;
+ at URI::jabber::ISA=qw(URI::_server URI::_userpass);
+
+ # jabber://soaplite_client:soapliteclient@jabber.org:5222/soaplite_server@jabber.org/Home
+ # ^^^^^^ ^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^ ^^^^^^^^^^ ^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^ ^^^^
+
+# ======================================================================
+
+package SOAP::Transport::JABBER::Query;
+
+sub new {
+ my $proto = shift;
+ bless {} => ref($proto) || $proto;
+}
+
+sub SetPayload {
+ shift; Net::Jabber::SetXMLData("single",shift->{QUERY},"payload",shift,{});
+}
+
+sub GetPayload {
+ shift; Net::Jabber::GetXMLData("value",shift->{QUERY},"payload","");
+}
+
+# ======================================================================
+
+package SOAP::Transport::JABBER::Client;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Client Net::Jabber::Client);
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my(@params, @methods);
+ while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
+ $self = $class->SUPER::new(@params);
+ while (@methods) { my($method, $params) = splice(@methods,0,2);
+ $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ }
+ SOAP::Trace::objects('()');
+ }
+ return $self;
+}
+
+sub endpoint {
+ my $self = shift;
+
+ return $self->SUPER::endpoint unless @_;
+
+ my $endpoint = shift;
+
+ # nothing to do if new endpoint is the same as current one
+ return $self if $self->SUPER::endpoint && $self->SUPER::endpoint eq $endpoint;
+
+ my $uri = URI->new($endpoint);
+ my($undef, $to, $resource) = split m!/!, $uri->path, 3;
+ $self->Connect(
+ hostname => $uri->host,
+ port => $uri->port,
+ ) or Carp::croak "Can't connect to @{[$uri->host_port]}: $!";
+
+ my @result = $self->AuthSend(
+ username => $uri->user,
+ password => $uri->password,
+ resource => 'soapliteClient',
+ );
+ $result[0] eq "ok" or Carp::croak "Can't authenticate to @{[$uri->host_port]}: @result";
+
+ $self->AddDelegate(
+ namespace => $NAMESPACE,
+ parent => 'Net::Jabber::Query',
+ parenttype => 'query',
+ delegate => 'SOAP::Transport::JABBER::Query',
+ );
+
+ # Get roster and announce presence
+ $self->RosterGet();
+ $self->PresenceSend();
+
+ $self->SUPER::endpoint($endpoint);
+}
+
+sub send_receive {
+ my($self, %parameters) = @_;
+ my($envelope, $endpoint, $encoding) =
+ @parameters{qw(envelope endpoint encoding)};
+
+ $self->endpoint($endpoint ||= $self->endpoint);
+
+ my($undef, $to, $resource) = split m!/!, URI->new($endpoint)->path, 3;
+
+ # Create a Jabber info/query message
+ my $iq = new Net::Jabber::IQ();
+ $iq->SetIQ(
+ type => 'set',
+ to => join '/', $to => $resource || 'soapliteServer',
+ );
+ my $query = $iq->NewQuery($NAMESPACE);
+ $query->SetPayload($envelope);
+
+ SOAP::Trace::debug($envelope);
+
+ my $iq_rcvd = $self->SendAndReceiveWithID($iq);
+ my($query_rcvd) = $iq_rcvd->GetQuery($NAMESPACE) if $iq_rcvd; # expect only one
+ my $msg = $query_rcvd->GetPayload() if $query_rcvd;
+
+ SOAP::Trace::debug($msg);
+
+ my $code = $self->GetErrorCode();
+
+ $self->code($code);
+ $self->message($code);
+ $self->is_success(!defined $code || $code eq '');
+ $self->status($code);
+
+ return $msg;
+}
+
+# ======================================================================
+
+package SOAP::Transport::JABBER::Server;
+
+use Carp ();
+use vars qw(@ISA $AUTOLOAD);
+ at ISA = qw(SOAP::Server);
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my $uri = URI->new(shift);
+ $self = $class->SUPER::new(@_);
+
+ $self->{_jabberserver} = Net::Jabber::Client->new;
+ $self->{_jabberserver}->Connect(
+ hostname => $uri->host,
+ port => $uri->port,
+ ) or Carp::croak "Can't connect to @{[$uri->host_port]}: $!";
+
+ my($undef, $resource) = split m!/!, $uri->path, 2;
+ my @result = $self->AuthSend(
+ username => $uri->user,
+ password => $uri->password,
+ resource => $resource || 'soapliteServer',
+ );
+ $result[0] eq "ok" or Carp::croak "Can't authenticate to @{[$uri->host_port]}: @result";
+
+ $self->{_jabberserver}->SetCallBacks(
+ iq => sub {
+ shift;
+ my $iq = new Net::Jabber::IQ(@_);
+
+ my($query) = $iq->GetQuery($NAMESPACE); # expect only one
+ my $request = $query->GetPayload();
+
+ SOAP::Trace::debug($request);
+
+ # Set up response
+ my $reply = $iq->Reply;
+ my $x = $reply->NewQuery($NAMESPACE);
+
+ my $response = $self->SUPER::handle($request);
+ $x->SetPayload($response);
+
+ # Send response
+ $self->{_jabberserver}->Send($reply);
+ }
+ );
+
+ $self->AddDelegate(
+ namespace => $NAMESPACE,
+ parent => 'Net::Jabber::Query',
+ parenttype => 'query',
+ delegate => 'SOAP::Transport::JABBER::Query',
+ );
+
+ $self->RosterGet();
+ $self->PresenceSend();
+ }
+ return $self;
+}
+
+sub AUTOLOAD {
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+ return if $method eq 'DESTROY';
+
+ no strict 'refs';
+ *$AUTOLOAD = sub { shift->{_jabberserver}->$method(@_) };
+ goto &$AUTOLOAD;
+}
+
+sub handle {
+ shift->Process();
+}
+
+# ======================================================================
+
+1;
+
+__END__
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/LOCAL.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/LOCAL.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/LOCAL.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,58 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: LOCAL.pm,v 1.3 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Transport::LOCAL;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+# ======================================================================
+
+package SOAP::Transport::LOCAL::Client;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Client SOAP::Server);
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my(@params, @methods);
+ while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
+ $self = $class->SUPER::new(@params);
+ $self->is_success(1); # it's difficult to fail in this module
+ $self->dispatch_to(@INC);
+ while (@methods) { my($method, $params) = splice(@methods,0,2);
+ $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ }
+ }
+ return $self;
+}
+
+sub send_receive {
+ my($self, %parameters) = @_;
+ my($envelope, $endpoint, $action) =
+ @parameters{qw(envelope endpoint action)};
+
+ SOAP::Trace::debug($envelope);
+ my $response = $self->SUPER::handle($envelope);
+ SOAP::Trace::debug($response);
+
+ $response;
+}
+
+# ======================================================================
+
+1;
+
+__END__
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/MAILTO.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/MAILTO.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/MAILTO.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,86 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: MAILTO.pm,v 1.3 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Transport::MAILTO;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+use MIME::Lite;
+use URI;
+
+# ======================================================================
+
+package SOAP::Transport::MAILTO::Client;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Client);
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my(@params, @methods);
+ while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
+ $self = bless {@params} => $class;
+ while (@methods) { my($method, $params) = splice(@methods,0,2);
+ $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ }
+ SOAP::Trace::objects('()');
+ }
+ return $self;
+}
+
+sub send_receive {
+ my($self, %parameters) = @_;
+ my($envelope, $endpoint, $action) =
+ @parameters{qw(envelope endpoint action)};
+
+ $endpoint ||= $self->endpoint;
+ my $uri = URI->new($endpoint);
+ %parameters = (%$self, map {URI::Escape::uri_unescape($_)} map {split/=/,$_,2} split /[&;]/, $uri->query || '');
+
+ my $msg = MIME::Lite->new(
+ To => $uri->to,
+ Type => 'text/xml',
+ Encoding => $parameters{Encoding} || 'base64',
+ Data => $envelope,
+ $parameters{From} ? (From => $parameters{From}) : (),
+ $parameters{'Reply-To'} ? ('Reply-To' => $parameters{'Reply-To'}) : (),
+ $parameters{Subject} ? (Subject => $parameters{Subject}) : (),
+ );
+ $msg->replace('X-Mailer' => join '/', 'SOAP::Lite', 'Perl', SOAP::Transport::MAILTO->VERSION);
+ $msg->add(SOAPAction => $action);
+
+ SOAP::Trace::transport($msg);
+ SOAP::Trace::debug($msg->as_string);
+
+ MIME::Lite->send(map {exists $parameters{$_} ? ($_ => $parameters{$_}) : ()} 'smtp', 'sendmail');
+ eval { local $SIG{__DIE__}; $MIME::Lite::AUTO_CC = 0; $msg->send };
+ (my $code = $@) =~ s/ at .*\n//;
+
+ $self->code($code);
+ $self->message($code);
+ $self->is_success(!defined $code || $code eq '');
+ $self->status($code);
+
+ return;
+}
+
+# ======================================================================
+
+1;
+
+__END__
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/MQ.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/MQ.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/MQ.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,238 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: MQ.pm,v 1.3 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Transport::MQ;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+use MQClient::MQSeries;
+use MQSeries::QueueManager;
+use MQSeries::Queue;
+use MQSeries::Message;
+
+use URI;
+use URI::Escape;
+use SOAP::Lite;
+
+# ======================================================================
+
+package URI::mq; # ok, lets do 'mq://' scheme
+require URI::_server; require URI::_userpass;
+ at URI::mq::ISA=qw(URI::_server URI::_userpass);
+
+ # mq://user@host:port?Channel=A;QueueManager=B;RequestQueue=C;ReplyQueue=D
+ # ^^ ^^^^ ^^^^ ^^^^ ^^^^^^^^^ ^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^ ^^^^^^^^^^^^
+
+# ======================================================================
+
+package SOAP::Transport::MQ::Client;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Client);
+
+use MQSeries qw(:constants);
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my(@params, @methods);
+ while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
+ $self = bless {@params} => $class;
+ while (@methods) { my($method, $params) = splice(@methods,0,2);
+ $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ }
+ SOAP::Trace::objects('()');
+ }
+ return $self;
+}
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(requestqueue replyqueue)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+ }
+ }
+}
+
+sub endpoint {
+ my $self = shift;
+
+ return $self->SUPER::endpoint unless @_;
+
+ my $endpoint = shift;
+
+ # nothing to do if new endpoint is the same as the current one
+ return $self if $self->SUPER::endpoint eq $endpoint;
+
+ my $uri = URI->new($endpoint);
+ my %parameters = (%$self, map {URI::Escape::uri_unescape($_)} map {split/=/,$_,2} split /[&;]/, $uri->query || '');
+
+ $ENV{MQSERVER} = sprintf "%s/TCP/%s(%s)", $parameters{Channel}, $uri->host, $uri->port
+ if $uri->host;
+
+ my $qmgr = MQSeries::QueueManager->new(QueueManager => $parameters{QueueManager}) ||
+ die "Unable to connect to queue manager $parameters{QueueManager}\n";
+
+ $self->requestqueue(MQSeries::Queue->new (
+ QueueManager => $qmgr,
+ Queue => $parameters{RequestQueue},
+ Mode => 'output',
+ ) || die "Unable to open $parameters{RequestQueue}\n");
+
+ $self->replyqueue(MQSeries::Queue->new (
+ QueueManager => $qmgr,
+ Queue => $parameters{ReplyQueue},
+ Mode => 'input',
+ ) || die "Unable to open $parameters{ReplyQueue}\n");
+
+ $self->SUPER::endpoint($endpoint);
+}
+
+sub send_receive {
+ my($self, %parameters) = @_;
+ my($envelope, $endpoint) =
+ @parameters{qw(envelope endpoint)};
+
+ $self->endpoint($endpoint ||= $self->endpoint);
+
+ %parameters = (%$self, %parameters);
+ my $expiry = $parameters{Expiry} || 60000;
+
+ SOAP::Trace::debug($envelope);
+
+ my $request = MQSeries::Message->new (
+ MsgDesc => {Format => MQFMT_STRING, Expiry => $expiry},
+ Data => $envelope,
+ );
+
+ $self->requestqueue->Put(Message => $request) ||
+ die "Unable to put message to queue\n";
+
+ my $reply = MQSeries::Message->new (
+ MsgDesc => {CorrelId => $request->MsgDesc('MsgId')},
+ );
+
+ my $result = $self->replyqueue->Get (
+ Message => $reply,
+ Wait => $expiry,
+ );
+
+ my $msg = $reply->Data if $result > 0;
+
+ SOAP::Trace::debug($msg);
+
+ my $code = $result > 0 ? undef :
+ $result < 0 ? 'Timeout' : 'Error occured while waiting for response';
+
+ $self->code($code);
+ $self->message($code);
+ $self->is_success(!defined $code || $code eq '');
+ $self->status($code);
+
+ return $msg;
+}
+
+# ======================================================================
+
+package SOAP::Transport::MQ::Server;
+
+use Carp ();
+use vars qw(@ISA $AUTOLOAD);
+ at ISA = qw(SOAP::Server);
+
+use MQSeries qw(:constants);
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my $uri = URI->new(shift);
+ $self = $class->SUPER::new(@_);
+
+ my %parameters = (%$self, map {URI::Escape::uri_unescape($_)} map {split/=/,$_,2} split /[&;]/, $uri->query || '');
+
+ $ENV{MQSERVER} = sprintf "%s/TCP/%s(%s)", $parameters{Channel}, $uri->host, $uri->port
+ if $uri->host;
+
+ my $qmgr = MQSeries::QueueManager->new(QueueManager => $parameters{QueueManager}) ||
+ Carp::croak "Unable to connect to queue manager $parameters{QueueManager}";
+
+ $self->requestqueue(MQSeries::Queue->new (
+ QueueManager => $qmgr,
+ Queue => $parameters{RequestQueue},
+ Mode => 'input',
+ ) || Carp::croak "Unable to open $parameters{RequestQueue}");
+
+ $self->replyqueue(MQSeries::Queue->new (
+ QueueManager => $qmgr,
+ Queue => $parameters{ReplyQueue},
+ Mode => 'output',
+ ) || Carp::croak "Unable to open $parameters{ReplyQueue}");
+ }
+ return $self;
+}
+
+sub BEGIN {
+ no strict 'refs';
+ for my $method (qw(requestqueue replyqueue)) {
+ my $field = '_' . $method;
+ *$method = sub {
+ my $self = shift->new;
+ @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+ }
+ }
+}
+
+sub handle {
+ my $self = shift->new;
+
+ my $msg = 0;
+ while (1) {
+ my $request = MQSeries::Message->new;
+
+ # nonblock waiting
+ $self->requestqueue->Get (
+ Message => $request,
+ ) || die "Error occured while waiting for requests\n";
+
+ return $msg if $self->requestqueue->Reason == MQRC_NO_MSG_AVAILABLE;
+
+ my $reply = MQSeries::Message->new (
+ MsgDesc => {
+ CorrelId => $request->MsgDesc('MsgId'),
+ Expiry => $request->MsgDesc('Expiry'),
+ },
+ Data => $self->SUPER::handle($request->Data),
+ );
+
+ $self->replyqueue->Put (
+ Message => $reply,
+ ) || die "Unable to put reply message\n";
+
+ $msg++;
+ }
+}
+
+# ======================================================================
+
+1;
+
+__END__
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/POP3.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/POP3.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/POP3.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,121 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: POP3.pm,v 1.2 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Transport::POP3;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+use Net::POP3;
+use URI;
+use SOAP::Lite;
+
+# ======================================================================
+
+package SOAP::Transport::POP3::Server;
+
+use Carp ();
+use vars qw(@ISA $AUTOLOAD);
+ at ISA = qw(SOAP::Server);
+
+sub DESTROY { my $self = shift; $self->quit if $self->{_pop3server} }
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my $address = shift;
+ Carp::carp "URLs without 'pop://' scheme are deprecated. Still continue"
+ if $address =~ s!^(pop://)?!pop://!i && !$1;
+ my $server = URI->new($address);
+ $self = $class->SUPER::new(@_);
+ $self->{_pop3server} = Net::POP3->new($server->host_port) or Carp::croak "Can't connect to '@{[$server->host_port]}': $!";
+ my $method = !$server->auth || $server->auth eq '*' ? 'login' :
+ $server->auth eq '+APOP' ? 'apop' :
+ Carp::croak "Unsupported authentication scheme '@{[$server->auth]}'";
+ $self->{_pop3server}->$method(split /:/, $server->user) or Carp::croak "Can't authenticate to '@{[$server->host_port]}' with '$method' method"
+ if defined $server->user;
+ }
+ return $self;
+}
+
+sub AUTOLOAD {
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+ return if $method eq 'DESTROY';
+
+ no strict 'refs';
+ *$AUTOLOAD = sub { shift->{_pop3server}->$method(@_) };
+ goto &$AUTOLOAD;
+}
+
+sub handle {
+ my $self = shift->new;
+ my $messages = $self->list or return;
+ foreach my $msgid (keys %$messages) {
+ $self->SUPER::handle(join '', @{$self->get($msgid)});
+ } continue {
+ $self->delete($msgid);
+ }
+ return scalar keys %$messages;
+}
+
+sub make_fault { return }
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+SOAP::Transport::POP3 - Server side POP3 support for SOAP::Lite
+
+=head1 SYNOPSIS
+
+ use SOAP::Transport::POP3;
+
+ my $server = SOAP::Transport::POP3::Server
+ -> new('pop://pop.mail.server')
+ # if you want to have all in one place
+ # -> new('pop://user:password@pop.mail.server')
+ # or, if you have server that supports MD5 protected passwords
+ # -> new('pop://user:password;AUTH=+APOP@pop.mail.server')
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ;
+ # you don't need to use next line if you specified your password in new()
+ $server->login('user' => 'password') or die "Can't authenticate to POP3 server\n";
+
+ # handle will return number of processed mails
+ # you can organize loop if you want
+ do { $server->handle } while sleep 10;
+
+ # you may also call $server->quit explicitly to purge deleted messages
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/TCP.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/TCP.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/TCP.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,225 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: TCP.pm,v 1.4 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package SOAP::Transport::TCP;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+use URI;
+use IO::Socket;
+use IO::Select;
+use IO::SessionData;
+use SOAP::Lite;
+
+# ======================================================================
+
+package URI::tcp; # ok, let's do 'tcp://' scheme
+require URI::_server;
+ at URI::tcp::ISA=qw(URI::_server);
+
+# ======================================================================
+
+package SOAP::Transport::TCP::Client;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Client);
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ my(@params, @methods);
+ while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
+ $self = bless {@params} => $class;
+ while (@methods) { my($method, $params) = splice(@methods,0,2);
+ $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
+ }
+ # use SSL if there is any parameter with SSL_* in the name
+ $self->SSL(1) if !$self->SSL && grep /^SSL_/, keys %$self;
+ SOAP::Trace::objects('()');
+ }
+ return $self;
+}
+
+sub SSL {
+ my $self = shift->new;
+ @_ ? ($self->{_SSL} = shift, return $self) : return $self->{_SSL};
+}
+
+sub io_socket_class { shift->SSL ? 'IO::Socket::SSL' : 'IO::Socket::INET' }
+
+sub syswrite {
+ my($self, $sock, $data) = @_;
+
+ my $timeout = $sock->timeout;
+
+ my $select = IO::Select->new($sock);
+
+ my $len = length $data;
+ while (length $data > 0) {
+ return unless $select->can_write($timeout);
+ local $SIG{PIPE} = 'IGNORE';
+ # added length() to make it work on Mac. Thanks to Robin Fuller <rfuller at broadjump.com>
+ my $wc = syswrite($sock, $data, length($data));
+ if (defined $wc) {
+ substr($data, 0, $wc) = '';
+ } elsif (!IO::SessionData::WOULDBLOCK($!)) {
+ return;
+ }
+ }
+ return $len;
+}
+
+sub sysread {
+ my($self, $sock) = @_;
+
+ my $timeout = $sock->timeout;
+ my $select = IO::Select->new($sock);
+
+ my $result = '';
+ my $data;
+ while (1) {
+ return unless $select->can_read($timeout);
+ my $rc = sysread($sock, $data, 4096);
+ if ($rc) {
+ $result .= $data;
+ } elsif (defined $rc) {
+ return $result;
+ } elsif (!IO::SessionData::WOULDBLOCK($!)) {
+ return;
+ }
+ }
+}
+
+sub send_receive {
+ my($self, %parameters) = @_;
+ my($envelope, $endpoint, $action) =
+ @parameters{qw(envelope endpoint action)};
+
+ $endpoint ||= $self->endpoint;
+ warn "URLs with 'tcp:' scheme are deprecated. Use 'tcp://'. Still continue\n"
+ if $endpoint =~ s!^tcp:(//)?!tcp://!i && !$1;
+ my $uri = URI->new($endpoint);
+
+ local($^W, $@, $!);
+ my $socket = $self->io_socket_class;
+ eval "require $socket" or Carp::croak $@ unless UNIVERSAL::can($socket => 'new');
+ my $sock = $socket->new (
+ PeerAddr => $uri->host, PeerPort => $uri->port, Proto => $uri->scheme, %$self
+ );
+
+ SOAP::Trace::debug($envelope);
+
+ # bytelength hack. See SOAP::Transport::HTTP.pm for details.
+ my $bytelength = SOAP::Utils::bytelength($envelope);
+ $envelope = pack('C0A*', $envelope)
+ if !$SOAP::Constants::DO_NOT_USE_LWP_LENGTH_HACK && length($envelope) != $bytelength;
+
+ my $result;
+ if ($sock) {
+ $sock->blocking(0);
+ $self->syswrite($sock, $envelope) and
+ $sock->shutdown(1) and # stop writing
+ $result = $self->sysread($sock);
+ }
+
+ SOAP::Trace::debug($result);
+
+ my $code = $@ || $!;
+
+ $self->code($code);
+ $self->message($code);
+ $self->is_success(!defined $code || $code eq '');
+ $self->status($code);
+
+ return $result;
+}
+
+# ======================================================================
+
+package SOAP::Transport::TCP::Server;
+
+use IO::SessionSet;
+
+use Carp ();
+use vars qw($AUTOLOAD @ISA);
+ at ISA = qw(SOAP::Server);
+
+sub DESTROY { SOAP::Trace::objects('()') }
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+
+ my(@params, @methods);
+ while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
+ $self = $class->SUPER::new(@methods);
+
+ # use SSL if there is any parameter with SSL_* in the name
+ $self->SSL(1) if !$self->SSL && grep /^SSL_/, @params;
+
+ my $socket = $self->io_socket_class;
+ eval "require $socket" or Carp::croak $@ unless UNIVERSAL::can($socket => 'new');
+ $self->{_socket} = $socket->new(Proto => 'tcp', @params)
+ or Carp::croak "Can't open socket: $!";
+
+ SOAP::Trace::objects('()');
+ }
+ return $self;
+}
+
+sub SSL {
+ my $self = shift->new;
+ @_ ? ($self->{_SSL} = shift, return $self) : return $self->{_SSL};
+}
+
+sub io_socket_class { shift->SSL ? 'IO::Socket::SSL' : 'IO::Socket::INET' }
+
+sub AUTOLOAD {
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+ return if $method eq 'DESTROY';
+
+ no strict 'refs';
+ *$AUTOLOAD = sub { shift->{_socket}->$method(@_) };
+ goto &$AUTOLOAD;
+}
+
+sub handle {
+ my $self = shift->new;
+ my $sock = $self->{_socket};
+ my $session_set = IO::SessionSet->new($sock);
+ my %data;
+ while (1) {
+ my @ready = $session_set->wait($sock->timeout);
+ for my $session (@ready) {
+ my $data;
+ if (my $rc = $session->read($data, 4096)) {
+ $data{$session} .= $data if $rc > 0;
+ } else {
+ $session->write($self->SUPER::handle(delete $data{$session}));
+ $session->close;
+ }
+ }
+ }
+}
+
+# ======================================================================
+
+1;
+
+__END__
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,705 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2003 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Transport.pm,v 1.3 2004/10/22 22:23:44 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Transport - an abstract class extended by more specialized transport modules
+
+=head1 DESCRIPTION
+
+Objects of the SOAP::Transport class manage two roles: they manage both the parameters related to transport as set through the containing SOAP::Lite object, and they abstract the selection and loading of an appropriate transport module. This is done with an AUTOLOAD function within the class that intercepts all methods beyond the two defined next and reroutes them to the underlying transport implementation code.
+
+=head1 METHODS
+
+=over
+
+=item new
+
+ $trans = SOAP::Transport->new;
+
+This is the constructor, which isn't usually called by an application directly. An application can use this to create a fresh new SOAP::Transport object, which may be installed using the SOAP::Lite->transport method defined earlier. No arguments are recognized.
+
+=item proxy(optional URL string)
+
+ $trans->proxy('http://www.blackperl.com/SOAP');
+
+Gets or sets the proxy (endpoint). This method must be called before any other methods are called. The proper transport code is loaded based on the scheme specified by the URL itself (http, jabber, etc.). Until this method is called the first time with a URL string, the underlying code has yet to be loaded, and the methods aren't available. When getting the current proxy (calling with no parameters), the returned value is a reference to the client object created from the protocol class that matched the endpoint, not the endpoint itself.
+
+=back
+
+=head1 SOAP Transport Sub-Classes
+
+Because the bulk of the work is done within the C<SOAP::Lite> module itself, many of the transport-level modules are very simple in their implementations. Transport modules are expected to define both client and server classes within their files. If a module defines only one of the types, it is assumed that the transport protocol itself supports only that side of the conversation. An example is L<SOAP::Transport::FTP>, which provides only a C<SOAP::Transport::FTP::Client> class.
+
+L</"SOAP::Transport::FTP"> - Client class only
+
+L</"SOAP::Transport::HTTP"> - Client, and server classes for CGI, FCGI, Daemon and mod_perl
+
+L</"SOAP::Transport::IO"> - Server class only
+
+L</"SOAP::Transport::JABBER"> - Server and Client classes
+
+L</"SOAP::Transport::LOCAL"> - Client class only
+
+L</"SOAP::Transport::MAILTO"> - Client class only
+
+L</"SOAP::Transport::MQ"> - Server and Client classes
+
+L</"SOAP::Transport::POP3"> - Server class only
+
+L</"SOAP::Transport::TCP"> - Server and Client classes
+
+=head2 METHODS
+
+Each SOAP::Transport sub-class is expected to define (or inherit, if it is subclassing another transport class) at least two methods. Any newly developed transport classes are also expected to adhere to this interface. Clients are expected to implement the C<new> and C<send_receive> methods, and servers are expected to implement the C<new> and C<handle> methods. Here they are:
+
+=over
+
+=item new(optional key/value pairs)
+
+ $object = $class->new(%params);
+
+Creates a new object instance and returns it. Like the constructors for both C<SOAP::Lite> and L<SOAP::Server> classes, all arguments passed in are treated as key/value pairs, where the key is expected to be one of the methods the class supports, and the value is the argument (or list reference of arguments) to the method.
+
+=item send_receive(key/value pairs)
+
+ $client->send_recieve(%hash_table);
+
+(Required for client classes only) When the SOAP::Lite objects attempt to send out requests, the means for doing so is to attempt to call this method on the object held within the SOAP::Transport object contained within the client itself. All clients are expected to provide this, and the call to this method always passes four values for the hash keys:
+
+=over
+
+=item action
+
+The URI specifying the action being performed, usually the result from the on_action hook on the client object.
+
+=item encoding
+
+The URI of the encoding scheme that governs the message being sent.
+
+=item endpoint
+
+The URI specifying the endpoint to which the message is being sent.
+
+=item envelope
+
+The XML content of the message to be sent. It is generally the return value of the envelope method from the L<SOAP::Serializer> object instance that the client object maintains.
+
+=item parts
+
+Attachments to add to the request. Currently this only supports an array of MIME::Entity objects, but in theory could support attachments of any format.
+
+=back
+
+=item handle
+
+ $server->handle;
+
+(Required for server classes only.) This method is the central point for the various server classes to provide an interface to handling requests. The exact set and nature of parameters generally varies based on the classes themselves.
+
+=back
+
+=head2 SOAP::Transport::FTP
+
+The SOAP::Transport::FTP module is automatically loaded by the SOAP::Transport portion of the client structure. It is brought in when an endpoint is specified via the proxy method that starts with the characters, ftp://. This module provides only a client class.
+
+=head3 SOAP::Transport::FTP::Client
+
+Inherits from: L<SOAP::Client>.
+
+Support is provided for clients to connect to FTP servers using SOAP. The methods defined within the class are just the basic new and send_receive.
+
+=head2 SOAP::Transport::HTTP
+
+The most commonly used transport module is the HTTP implementation. This is loaded whenever an endpoint is given that starts with the characters, http:// or https://. This is also the most involved of the transport modules, defining not only a client class but several different server classes as well.
+
+=head3 HTTP PROXY SETTINGS
+
+Because C<SOAP::Client> inherits from C<LWP::UserAgent>, you can use any of C<LWP::UserAgent>'s proxy settings. For example:
+
+ SOAP::Lite->proxy("http://endpoint.server/",
+ proxy => ["http" => "http://my.proxy.server"]);
+
+or
+
+ $soap->transport->proxy("http" => "http://my.proxy.server");
+
+The above code samples should specify a proxy server for you. And should you use C<HTTP_proxy_user>
+and C<HTTP_proxy_pass> for proxy authorization, C<SOAP::Lite> will handle it properly.
+
+=head3 HTTP BASIC AUTHENTICATION
+
+HTTP Basic authentication is accomplished by overriding the get_basic_credentials suboutine in C<LWP::UserAgent> (which C<SOAP::Transport::HTTP::Client> is a subclass):
+
+ BEGIN {
+ sub SOAP::Transport::HTTP::Client::get_basic_credentials {
+ return 'username' => 'password';
+ }
+ }
+
+=head3 COOKIE-BASED AUTHENTICATION
+
+ use HTTP::Cookies;
+ my $cookies = HTTP::Cookies->new(ignore_discard => 1);
+ # you may also add 'file' if you want to keep them between sessions
+ my $soap = SOAP::Lite->proxy('http://localhost/');
+ $soap->transport->cookie_jar($cookies);
+
+Or, alternatively, you can do the above on a single line:
+
+ $soap->proxy('http://localhost/',
+ cookie_jar => HTTP::Cookies->new(ignore_discard => 1));
+
+Cookies will be taken from the response and provided to the request. You may access and manipulate cookies received, as well as add cookies of your own by using the C<HTTP::Cookies> interfaces.
+
+=head3 SSL CERTIFICATE AUTHENTICATION
+
+To get certificate authentication working you need to set three environment variables: C<HTTPS_CERT_FILE>, C<HTTPS_KEY_FILE>, and optionally C<HTTPS_CERT_PASS>. This can be done either through the command line, or directly within your Perl script using the C<$ENV> variable:
+
+ $ENV{HTTPS_CERT_FILE} = 'client-cert.pem';
+ $ENV{HTTPS_KEY_FILE} = 'client-key.pem';
+
+These settings are referrenced by C<Crypt::SSLeay>, the module SOAP::Lite used for HTTPS support. Other options (e.g. CA peer verification) can be specified in a similar way. See L<Crypt::SSLeay> documentation for more information.
+
+Those who would like to use encrypted keys may find the following thread in the SOAP::Lite newsgroup helpful:
+
+http://groups.yahoo.com/group/soaplite/message/729
+
+=head3 COMPRESSION
+
+SOAP::Lite provides you with the option for enabling compression over the wire using HTTP I<only> in both the server and client contexts, provided that you have L<Compress::Zlib> installed. Compression and decompression is done transparantly to your application.
+
+A server will respond with an encoded/compressed message only if the client has asserted that it can accept it (indicated by client sending an C<Accept-Encoding> HTTP header with a 'deflate' or '*' value).
+
+C<SOAP::Lite> clients all have fallback logic implemented so that if a server doesn't understand the specified encoding (i.e. "Content-Encoding: deflate") and returns the proper HTTP status code (415 NOT ACCEPTABLE), the client will repeat the request without using encoding/compression. The client will then store this server in a per-session cache, so that all subsequent requests to that server will be transmitted without encoding.
+
+Compression is enabled on the client side by specifying the C<compress_threshold> option, and if the size of the current request exceeds that threshold.
+
+B<Client Code Sample>
+
+ print SOAP::Lite
+ ->uri('http://localhost/My/Parameters')
+ ->proxy('http://localhost/', options => {compress_threshold => 10000})
+ ->echo(1 x 10000)
+ ->result;
+
+Servers will respond with a compressed message if the C<compress_threshold> option has been specified, if the size of the current response exceeds that threshold, and if the calling client transmitted the proper C<Accept-Encoding> HTTP Header.
+
+B<Server Code Sample>
+
+ my $server = SOAP::Transport::HTTP::CGI
+ ->dispatch_to('My::Parameters')
+ ->options({compress_threshold => 10000})
+ ->handle;
+
+See also: L<Compress::Zlib>
+
+=head3 SOAP::Transport::HTTP::Client
+
+Inherits from: L<SOAP::Client>, L<LWP::UserAgent> (from the LWP package).
+
+With this class, clients are able to use HTTP for sending messages. This class provides just the basic new and send_receive methods. Objects of this class understand the compress_threshold option and use it if the server being communicated to also understands it.
+
+=head4 CHANGING THE DEFAULT USERAGENT CLASS
+
+By default, C<SOAP::Transport::HTTP::Client> extends C<LWP::UserAgent>.
+But under some circumstances, a user may wish to change the default
+UserAgent class with their in order to better handle persist connections, or
+to C<LWP::UserAgent::ProxyAny>, for example, which has better Win32/Internet
+Explorer interoperability.
+
+One can use the code below as an example of how to change the default UserAgent class.
+
+ use SOAP::Lite;
+ use SOAP::Transport::HTTP;
+ $SOAP::Transport::HTTP::Client::USERAGENT_CLASS = "My::UserAgent";
+ my $client = SOAP::Lite->proxy(..)->uri(..);
+ my $som = $client->myMethod();
+
+There is one caveat, however. The UserAgent class you use, I<MUST> also be a subclass of C<LWP::UserAgent>. If it is not, then C<SOAP::Lite> will issue the following error: "Could not load UserAgent class <USERAGENT CLASS>."
+
+=head4 HTTP-KEEP-ALIVE, TIMEOUTS, AND MORE
+
+Because C<SOAP::Transport::HTTP::Client> extends C<LWP::UserAgent>, all methods available C<LWP::UserAgent> are also available to your SOAP Clients. For example, using C<LWP::UserAgent> HTTP keep alive's are accomplished using the following code:
+
+ my $ua = LWP::UserAgent->new(
+ keep_alive => 1,
+ timeout => 30
+ );
+
+Therefore, the same initialization parameters you would pass to C<LWP::UserAgent> can also be passed to your SOAP::Lite client's C<proxy> subroutine like so:
+
+ my $soap = SOAP::Lite
+ ->uri($uri)
+ ->proxy($proxyUrl,
+ timeout => 30,
+ keep_alive => 1,
+ );
+
+This is true for all initialization parameters and methods of C<LWP::UserAgent>.
+
+=head4 METHODS
+
+=over
+
+=item http_request
+
+This method gives you acess to the HTTP Request object that will be, or was transmitted to a SOAP Server. It returns a L<HTTP::Request> object.
+
+=item http_response
+
+This method gives you acess to the HTTP Response object that will be, or was transmitted to a SOAP Server. It returns a L<HTTP::Response> object.
+
+=back
+
+=head3 SOAP::Transport::HTTP::Server
+
+Inherits from: L<SOAP::Server>.
+
+This is the most basic of the HTTP server implementations. It provides the basic methods, new and handle. The handle method's behavior is defined here, along with other methods specific to this class. The role of this class is primarily to act as a superclass for the other HTTP-based server classes.
+
+=over
+
+=item handle
+
+ $server->handle;
+
+Expects the request method to have been used to associate a HTTP::Request object with the server object prior to being called. This method retrieves that object reference to get at the request being handled.
+
+=item request(I<optional value>)
+
+ $server->request($req_object)
+
+Gets or sets the HTTP::Request object reference that the server will process within the handle method.
+
+=item response(I<optional value>)
+
+ $server->response(HTTP::Response->new(...));
+
+Gets or sets the HTTP::Response object reference that the server has prepared for sending back to the client.
+
+=item make_response(I<code>, I<body>)
+
+ $server->make_response(200, $body_xml);
+
+Constructs and returns an object of the HTTP::Response class, using the response code and content provided.
+
+=item make_fault(I<fault arguments>)
+
+ $server->response($server->make_fault(@data));
+
+Creates a HTTP::Response object reference using a predefined HTTP response code to signify that a fault has occurred. The arguments are the same as those for the make_fault method of the SOAP::Server class.
+
+=item product_tokens
+
+This method takes no arguments and simply returns a string identifying the elements of the server class itself. It is similar to the product_tokens methods in the HTTP::Daemon and Apache classes.
+
+=back
+
+=head3 SOAP::Transport::HTTP::CGI
+
+Inherits from: L<SOAP::Transport::HTTP::Server>.
+
+This class is a direct subclass of SOAP::Transport::HTTP::Server and defines no additional methods. It includes logic in its implementation of the handle method that deals with the request headers and parameters specific to a CGI environment.
+
+=head4 EXAMPLE CGI
+
+The following code sample is a CGI based Web Service that converts celcius to fahrenheit:
+
+ #!/usr/bin/perl
+ use SOAP::Transport::HTTP;
+ SOAP::Transport::HTTP::CGI
+ ->dispatch_to('C2FService')
+ ->handle;
+ BEGIN {
+ package C2FService;
+ use vars qw(@ISA);
+ @ISA = qw(Exporter SOAP::Server::Parameters);
+ use SOAP::Lite;
+ sub c2f {
+ my $self = shift;
+ my $envelope = pop;
+ my $temp = $envelope->dataof("//c2f/temperature");
+ return SOAP::Data->name('convertedTemp' => (((9/5)*($temp->value)) + 32));
+ }
+ }
+
+=head4 EXAMPLE APACHE::REGISTRY USAGE
+
+Using a strictly CGI based Web Service has certain performance drawbacks. Running the same CGI under the Apache::Registery system has certain performance gains.
+
+B<httpd.conf>
+
+ Alias /mod_perl/ "/Your/Path/To/Deployed/Modules"
+ <Location /mod_perl>
+ SetHandler perl-script
+ PerlHandler Apache::Registry
+ PerlSendHeader On
+ Options +ExecCGI
+ </Location>
+
+B<soap.cgi>
+
+ use SOAP::Transport::HTTP;
+
+ SOAP::Transport::HTTP::CGI
+ ->dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ->handle;
+
+I<WARNING: Dynamic deployments with C<Apache::Registry> will fail because the module will be only loaded dynamically the first time. Subsequent calls will produce "denied access" errors because once the module is already in memory C<SOAP::Lite> will bypass dynamic deployment. To work around this, simply specify both the full PATH and MODULE name in C<dispatch_to()> and the module will be loaded dynamically, but will then work as if under static deployment. See F<examples/server/soap.mod_cgi> as an example.>
+
+=head3 SOAP::Transport::HTTP::Daemon
+
+Inherits from: L<SOAP::Transport::HTTP::Server>.
+
+The SOAP::Transport::HTTP::Daemon class encapsulates a reference to an object of the HTTP::Daemon class (from the LWP package). The class catches methods that aren't provided locally or by the superclass and attempts to call them on the HTTP::Daemon object. Thus, all methods defined in the documentation for that class are available to this class as well. Any that conflict with methods in SOAP::Transport::HTTP::Server (such as product_tokens) go to the superclass. Additionally, the behavior of the handle method is specific to this class:
+
+=over
+
+=item handle
+
+When invoked, this method enters into the typical accept loop in which it waits for a request on the socket that the daemon object maintains and deals with the content of the request. When all requests from the connection returned by the accept method of the HTTP::Daemon object have been processed, this method returns.
+
+=back
+
+=head4 REUSING SOCKETS ON RESTART
+
+Often when implementing an HTTP daemon, sockets will get tied up when you try to restart the daemon server. This prevents the server from restarting. Often users will see an error like "Cannot start server: port already in use." To circumvent this, instruct SOAP::Lite to reuse open sockets using C<< Reuse => 1 >>:
+
+ my $daemon = SOAP::Transport::HTTP::Daemon
+ -> new (LocalPort => 80000, Reuse => 1)
+
+=head4 EXAMPLE DAEMON SERVER
+
+ use SOAP::Transport::HTTP;
+ # change LocalPort to 81 if you want to test it with soapmark.pl
+ my $daemon = SOAP::Transport::HTTP::Daemon
+ -> new (LocalAddr => 'localhost', LocalPort => 80)
+ # specify list of objects-by-reference here
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ;
+ print "Contact to SOAP server at ", $daemon->url, "\n";
+ $daemon->handle;
+
+=head3 SOAP::Transport::HTTP::Apache
+
+Inherits from: L<SOAP::Transport::HTTP::Server>.
+
+This class provides an integration of the SOAP::Server base class with the mod_perl extension for Apache. To work as a location handler, the package provides a method called handler, for which handle is made an alias. The new method isn't functionally different from the superclass. Here are the other methods provided by this class:
+
+=over
+
+=item handler(I<Apache request>)
+
+ $server->handler($r)
+
+Defines the basis for a location handler in the mod_perl fashion. The method expects an Apache request object as the parameter, from which it pulls the body of the request and calls the superclass handle method.
+
+Note that in this class, the local method named handle is aliased to this method.
+
+=item configure(I<Apache request>)
+
+ $server->configure(Apache->request);
+
+Per-location configuration information can be provided to the server object using the Apache DirConfig directive and calling this method on the object itself. When invoked, the method reads the directory configuration information from Apache and looks for lines of the form:
+
+ method => param
+
+Each line that matches the pattern is regarded as a potential method to call on the server object, with the remaining token taken as the parameter to the method. Methods that take hash references as arguments may be specified as:
+
+ method => key => param, key => param
+
+The key/value pairs will be made into a hash reference on demand. If the server object doesn't recognize the named method as valid, it ignores the line.
+
+=back
+
+=head4 EXAMPLE APACHE MOD_PERL SERVER
+
+See F<examples/server/Apache.pm> and L<Apache::SOAP> for more information.
+
+B<httpd.conf>
+
+ <Location /soap>
+ SetHandler perl-script
+ PerlHandler SOAP::Apache
+ PerlSetVar options "compress_threshold => 10000"
+ </Location>
+
+B<SOAP::Apache.pm>
+
+ package SOAP::Apache;
+ use SOAP::Transport::HTTP;
+ my $server = SOAP::Transport::HTTP::Apache
+ ->dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method');
+ sub handler { $server->handler(@_) }
+ 1;
+
+See also L<Apache::SOAP>.
+
+=head3 SOAP::Transport::HTTP::FCGI
+
+Inherits from: L<SOAP::Transport::HTTP::CGI>.
+
+This is an extension of the SOAP::Transport::HTTP::CGI that implements the differences needed for the FastCGI protocol. None of the methods are functionally different.
+
+=head2 SOAP::Transport::IO
+
+The SOAP::Transport::IO-based class allows for a sort of I/O proxying by allowing the application to configure what files or filehandles are used. This module supplies only a server class.
+
+=head3 SOAP::Transport::IO::Server
+
+Inherits from: L<SOAP::Server>.
+
+The server class defined here inherits all methods from SOAP::Server, and adds two additional methods specific to the nature of the class:
+
+=over
+
+=item in
+
+ $server->in(IO::File->new($file));
+
+Gets or sets the current filehandle being used as the input source.
+
+=item out
+
+ $server->out(\*STDERR);
+
+Gets or sets the filehandle being used as the output destination.
+
+=back
+
+=head2 SOAP::Transport::JABBER
+
+This class uses the Net::Jabber classes to abstract the Jabber protocol away from the direct notice of the application. Besides maintaining any needed objects internally, the package also uses a separate class as a proxy between communication layers, SOAP::Transport::JABBER::Query. The Jabber support provides both client and server classes.
+
+=head3 SOAP::Transport::JABBER::Client
+
+Inherits from: L<SOAP::Client>, L<Net::Jabber::Client>.
+This class provides localized implementations for both the new and send_receive methods, neither of which are changed in terms of interface. The only difference is that the send_receive method doesn't directly use the action hash key on the input it receives. In addition to these two basic methods, the server class overrides the endpoint
+method it would otherwise inherit from SOAP::Client:
+
+=over
+
+=item endpoint
+
+In the general sense, this still acts as a basic accessor method, with the same get value/set value behavior used consistently through the SOAP::Lite module. The difference between this version and most others is that when the endpoint is initially set or is changed, the client object makes the connection to the Jabber endpoint, sending the proper authentication credentials and setting up the conversation mechanism using the SOAP::Transport::JABBER::Query class as a delegate. It then calls the superclass endpoint method to ensure that all other related elements are taken care of.
+
+=back
+
+=head3 SOAP::Transport::JABBER::Server
+
+Inherits from: L<SOAP::Server>.
+
+The server class provided for Jabber support defines a slightly different interface to the constructor. The server manages the Jabber communication by means of an internal Net::Jabber::Client instance. In a fashion similar to that used by SOAP::Transport::HTTP::Daemon, the server class catches methods that are meant for the Jabber client and treats them as if the class inherits directly from that class, without actually doing so. In doing so, the handle method is implemented as a frontend to the Process method of the Jabber client class. The difference in the interface to the constructor is:
+
+=over
+
+=item new(I<URI>, I<optional server key/value options>)
+
+ $srv = SOAP::Transport::JABBER::Server-> new($uri);
+
+The constructor for the class expects that the first argument will be a Jabber-style URI, followed by the standard set of optional key/value pairs of method names and their parameters. All the method/parameter
+pairs are delegated to the superclass constructor; only the Jabber URI is handled locally. It's used to set up the Net::Jabber::Client instance that manages the actual communications.
+
+=back
+
+=head2 SOAP::Transport::LOCAL
+
+The SOAP::Transport::LOCAL module is designed to provide a no-transport client class for tracing and debugging communications traffic. It links SOAP::Client and SOAP::Server so that the same object that "sends" the request also "receives" it.
+
+=head3 SOAP::Transport::LOCAL::Client
+
+Inherits from: L<SOAP::Client>, L<SOAP::Server>.
+The implementations of the new and send_receive methods aren't noticeably different in their interface. Their behavior warrants description, however:
+
+=over
+
+=item new
+
+When the constructor creates a new object of this class, it sets up a few things beyond the usual SOAP::Client layout. The is_success method is set to a default value of 1. The dispatch_to method inherited from SOAP::Server is called with the current value of the global array @INC, allowing the client to call any methods that can be found in the current valid search path. And as with most of the constructors in this module, the optional key/value pairs are treated as method names and parameters.
+
+=item send_receive
+
+The implementation of this method simply passes the envelope portion of the input data to the handle method of SOAP::Server. While no network traffic results (directly) from this, it allows for debug signals to be sent through the SOAP::Trace facility.
+
+=back
+
+=head2 SOAP::Transport::MAILTO
+
+This transport class manages SMTP-based sending of messages from a client perspective. It doesn't provide a server class. The class gets selected when a client object passes a URI to proxy or endpoint that starts with the characters, mailto:.
+
+=head3 SOAP::Transport::MAILTO::Client
+
+Inherits from: L<SOAP::Client>.
+
+The client class for this protocol doesn't define any new methods. The constructor functions in the same style as the others class constructors. The functionality of the send_receive method is slightly different from other classes, however.
+
+When invoked, the send_receive method uses the MIME::Lite package to encapsulate and transmit the message. Because mail messages are one-way communications (the reply being a separate process), there is no response message to be returned by the method. Instead, all the status-related attributes (code, message, status, is_success) are set, and no value is explicitly returned.
+
+=head2 SOAP::Transport::MQ
+
+This class provides implementations of both client and server frameworks built on IBM's Message Queue set of classes. The SOAP objects encapsulate additional objects from these classes, creating and using them behind the scenes as needed.
+
+=head3 SOAP::Transport::MQ::Client
+
+Inherits from: L<SOAP::Client>.
+
+The client class provides two methods specific to it, as well as specialized versions of the endpoint and send_receive methods. It also provides a localized new method, but the interface isn't changed from the superclass method. The new methods are:
+
+=over
+
+=item requestqueue
+
+ $client->requestqueue->Put(message => $request);
+
+Manages the MQSeries::Queue object the client uses for enqueuing requests to the server. In general, an application shouldn't need to directly access this attribute, let alone set it. If setting it, the new value should be an object of (or derived from) the MQSeries::Queue class.
+
+=item replyqueue
+
+ $client->replyqueue(MQSeries::Queue->new(%args));
+
+Manages the queue object used for receiving messages back from the designated server (endpoint). It is also primarily for internal use, though if the application needs to set it explicitly, the new value should be an object of (or derived from) the MQSeries::Queue class.
+
+=back
+
+The two previous methods are mainly used by the localized versions of the methods:
+
+=over
+
+=item endpoint
+
+This accessor method has the same interface as other similar classes but is worth noting for the internal actions that take place. When the endpoint is set or changed, the method creates a queue-manager object (from the MQSeries::QueueManager class) and references this object when creating queues for replies and requests using the methods described earlier. The URI structure used with these classes (strings beginning with the characters mq://user@host:port) contains the information needed for these operations.
+
+=item send_receive
+
+This method uses the same interface as other classes, but makes use of only the endpoint and envelope keys in the hash-table input data. The endpoint key is needed only if the client wishes to switch endpoints prior to sending the message. The message (the value of the envelope key) is inserted into the queue stored in the requestqueue attribute. The client then waits for a reply to the message to appear in the queue stored in the replyqueue attribute.
+
+=back
+
+=head3 SOAP::Transport::MQ::Server
+
+Inherits from: L<SOAP::Server>.
+
+The server class also defines requestqueue and replyqueue methods under the same terms as the client class. Of course, the server reads from the request queue and writes to the reply queue, the opposite of the client's behavior.
+The methods whose functionality are worth noting are:
+
+=over
+
+=item new(URI, optional parameters)
+
+When called, the constructor creates the MQSeries::QueueManager object and the two MQSeries::Queue objects, similar to what the client does inside its endpoint method. Like the Jabber server described earlier, the first argument to this constructor is expected to be the URI that describes the server itself. The remainder of the arguments are treated as key/value pairs, as with other class constructors previously described.
+
+=item handle
+
+When this method is called, it attempts to read a pending message from the request-queue stored on the requestqueue attribute. The message itself is passed to the handle method of the superclass, and the result from that operation is enqueued to the replyqueue object. This process loops until no more messages are present in the request queue. The return value is the number of messages processed. The reads from the request queue are done in a nonblocking fashion, so if there is no message pending, the method immediately returns with a value of zero.
+
+=back
+
+=head2 SOAP::Transport::POP3
+
+POP3 support is limited to a server implementation. Just as the MAILTO class detailed earlier operates by sending requests without expecting to process a response, the server described here accepts request messages and dispatches them without regard for sending a response other than that which POP3 defines for successful delivery of a message.
+
+=head3 SOAP::Transport::POP3::Server
+
+Inherits from: L<SOAP::Server>.
+
+The new method of this class creates an object of the Net::POP3 class to use internally for polling a specified POP3 server for incoming messages. When an object of this class is created, it expects an endpoint to be specified with a URI that begins with the characters pop:// and includes user ID and password information as well as the hostname itself.
+
+The handle method takes the messages present in the remote mailbox and passes them (one at a time) to the superclass handle method. Each message is deleted after being routed. All messages in the POP3 mailbox are presumed to be SOAP messages.
+
+Methods for the Net::POP3 object are detected and properly routed, allowing operations such as $server->ping( ).
+
+This means that the endpoint string doesn't need to provide the user ID and password because the login method from the POP3 API may be used directly.
+
+=head2 SOAP::Transport::TCP
+
+The classes provided by this module implement direct TCP/IP communications methods for both clients and servers.
+
+The connections don't use HTTP or any other higher-level protocol. These classes are selected when the client or server object being created uses an endpoint URI that starts with tcp://. Both client and server classes support using Secure Socket Layer if it is available. If any of the parameters to a new method from either of the classes begins with SSL_ (such as SSL_server in place of Server), the class attempts to load the IO::Socket::SSL package and use it to create socket objects.
+
+Both of the following classes catch methods that are intended for the socket objects and pass them along, allowing calls such as $client->accept( ) without including the socket class in the inheritance tree.
+
+=head3 SOAP::Transport::TCP::Client
+
+Inherits from: L<SOAP::Client>.
+
+The TCP client class defines only two relevant methods beyond new and send_receive. These methods are:
+
+=over
+
+=item SSL(I<optional new boolean value>)
+
+ if ($client->SSL) # Execute only if in SSL mode
+
+Reflects the attribute that denotes whether the client object is using SSL sockets for communications.
+
+=item io_socket_class
+
+ ($client->io_socket_class)->new(%options);
+
+Returns the name of the class to use when creating socket objects for internal use in communications. As implemented, it returns one of IO::Socket::INET or IO::Socket::SSL, depending on the return value of the previous SSL method.
+
+=back
+
+If an application creates a subclass that inherits from this client class, either method is a likely target for overloading.
+
+The new method behaves identically to most other classes, except that it detects the presence of SSL-targeted values in the parameter list and sets the SSL method appropriately if they are present.
+
+The send_receive method creates a socket of the appropriate class and connects to the configured endpoint. It then sets the socket to nonblocking I/O, sends the message, shuts down the client end of the connection (preventing further writing), and reads the response back from the server. The socket object is discarded after the response and
+appropriate status codes are set on the client object.
+
+=head3 SOAP::Transport::TCP::Server
+
+Inherits from: L<SOAP::Server>.
+
+The server class also defines the same two additional methods as in the client class:
+
+=over
+
+=item SSL(I<optional new boolean value>)
+
+ if ($client->SSL) # Execute only if in SSL mode
+
+Reflects the attribute that denotes whether the client object is using SSL sockets for communications.
+
+=item io_socket_class
+
+ ($client->io_socket_class)->new(%options);
+
+Returns the name of the class to use when creating socket objects for internal use in communications. As implemented, it returns one of IO::Socket::INET or IO::Socket::SSL, depending on the return value of the previous SSL method. The new method also manages the automatic selection of SSL in the same fashion as the client class does.
+
+The handle method in this server implementation isn't designed to be called once with each new request. Rather, it is called with no arguments, at which time it enters into an infinite loop of waiting for a connection, reading the request, routing the request and sending back the serialized response. This continues until the process itself is interrupted by an untrapped signal or similar means.
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+Special thanks to O'Reilly publishing which has graciously allowed SOAP::Lite to republish and redistribute large excerpts from I<Programming Web Services with Perl>, mainly the SOAP::Lite reference found in Appendix B.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+Randy J. Ray (rjray at blackperl.com)
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/SOAP/Utils.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Utils.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Utils.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,45 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2003 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Utils.pm,v 1.1 2004/10/12 18:47:55 byrnereese Exp $
+#
+# ======================================================================
+
+=pod
+
+=head1 NAME
+
+SOAP::Utils - a utility package for SOAP::Lite
+
+=head1 DESCRIPTION
+
+This class gives you access to a number of subroutines to assist in data formating, encoding, etc. Many of the subroutines are private, and are not documented here, but a few are made public.
+
+=head1 METHODS
+
+=over
+
+=item format_datetime
+
+Returns a valid xsd:datetime string given a time object returned by Perl's localtime function. Usage:
+
+ print SOAP::Utils::format_datetime(localtime);
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS
+
+Byrne Reese (byrne at majordojo.com)
+
+=cut
+
Added: packages/soap-lite/branches/upstream/current/lib/UDDI/Lite.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/UDDI/Lite.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/UDDI/Lite.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,725 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Lite.pm,v 1.6 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package UDDI::Lite;
+
+use 5.004;
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+use SOAP::Lite;
+
+# ======================================================================
+
+package UDDI::Constants;
+
+BEGIN {
+ use vars qw(%UDDI_VERSIONS $ELEMENTS $ATTRIBUTES $WITHNAMES $NAMESPACE $GENERIC);
+
+ %UDDI_VERSIONS = (
+ 1 => {
+ ELEMENTS => {address=>{addressLine=>1},authToken=>{authInfo=>1},bindingDetail=>{bindingTemplate=>1},bindingTemplate=>{accessPoint=>1,description=>1,hostingRedirector=>1,tModelInstanceDetails=>1},bindingTemplates=>{bindingTemplate=>1},businessDetail=>{businessEntity=>1},businessDetailExt=>{businessEntityExt=>1},businessEntity=>{businessServices=>1,categoryBag=>1,contacts=>1,description=>1,discoveryURLs=>1,identifierBag=>1,name=>1},businessEntityExt=>{businessEntity=>1},businessInfo=>{description=>1,name=>1,serviceInfos=>1},businessInfos=>{businessInfo=>1},businessList=>{businessInfos=>1},businessService=>{bindingTemplates=>1,categoryBag=>1,description=>1,name=>1},businessServices=>{businessService=>1},categoryBag=>{keyedReference=>1},contact=>{address=>1,description=>1,email=>1,personName=>1,phone=>1},contacts=>{contact=>1},delete_binding=>{authInfo=>1,bindingKey=>1},delete_business=>{authInfo=>1,businessKey=>1},delete_service=>{authInfo=>1,serviceKey=>1},delete_tModel=>{authInfo=>1,tModelKey=>1},discard_authToken=>{authInfo=>1},discoveryURLs=>{discoveryUrl=>1},dispositionReport=>{result=>1},findQualifiers=>{findQualifier=>1},find_binding=>{findQualifiers=>1,tModelBag=>1},find_business=>{categoryBag=>1,discoveryURLs=>1,findQualifiers=>1,identifierBag=>1,name=>1,tModelBag=>1},find_service=>{categoryBag=>1,findQualifiers=>1,name=>1,tModelBag=>1},find_tModel=>{categoryBag=>1,findQualifiers=>1,identifierBag=>1,name=>1},get_bindingDetail=>{bindingKey=>1},get_businessDetail=>{businessKey=>1},get_businessDetailExt=>{businessKey=>1},get_registeredInfo=>{authInfo=>1},get_serviceDetail=>{serviceKey=>1},get_tModelDetail=>{tModelKey=>1},identifierBag=>{keyedReference=>1},instanceDetails=>{description=>1,instanceParms=>1,overviewDoc=>1},overviewDoc=>{description=>1,overviewURL=>1},registeredInfo=>{businessInfos=>1,tModelInfos=>1},result=>{errInfo=>1},save_binding=>{authInfo=>1,bindingTemplate=>1},save_business=>{authInfo=>1,businessEntity=>1,uploadRegister=>1},save_service=>{authInfo=>1,businessService=>1},save_tModel=>{authInfo=>1,tModel=>1,uploadRegister=>1},serviceDetail=>{businessService=>1},serviceInfo=>{name=>1},serviceInfos=>{serviceInfo=>1},serviceList=>{serviceInfos=>1},tModel=>{categoryBag=>1,description=>1,identifierBag=>1,name=>1,overviewDoc=>1},tModelBag=>{tModelKey=>1},tModelDetail=>{tModel=>1},tModelInfo=>{name=>1},tModelInfos=>{tModelInfo=>1},tModelInstanceDetails=>{tModelInstanceInfo=>1},tModelInstanceInfo=>{description=>1,instanceDetails=>1},tModelList=>{tModelInfos=>1},validate_categorization=>{businessEntity=>1,businessService=>1,keyValue=>1,tModel=>1,tModelKey=>1}},
+ ATTRIBUTES => {accessPoint=>{URLType=>2},address=>{sortCode=>2,useType=>2},authToken=>{generic=>2,operator=>2},bindingDetail=>{generic=>2,operator=>2,truncated=>2},bindingTemplate=>{bindingKey=>2,serviceKey=>2},businessDetail=>{generic=>2,operator=>2,truncated=>2},businessDetailExt=>{generic=>2,operator=>2,truncated=>2},businessEntity=>{authorizedName=>2,businessKey=>2,operator=>2},businessInfo=>{businessKey=>2},businessList=>{generic=>2,operator=>2,truncated=>2},businessService=>{businessKey=>2,serviceKey=>2},contact=>{useType=>2},delete_binding=>{generic=>2},delete_business=>{generic=>2},delete_service=>{generic=>2},delete_tModel=>{generic=>2},description=>{lang=>2},discard_authToken=>{generic=>2},discoveryUrl=>{useType=>2},dispositionReport=>{generic=>2,operator=>2,truncated=>2},email=>{useType=>2},errInfo=>{errCode=>2},find_binding=>{generic=>2,maxRows=>2,serviceKey=>2},find_business=>{generic=>2,maxRows=>2},find_service=>{businessKey=>2,generic=>2,maxRows=>2},find_tModel=>{generic=>2,maxRows=>2},get_authToken=>{cred=>2,generic=>2,userID=>2},get_bindingDetail=>{generic=>2},get_businessDetail=>{generic=>2},get_businessDetailExt=>{generic=>2},get_registeredInfo=>{generic=>2},get_serviceDetail=>{generic=>2},get_tModelDetail=>{generic=>2},hostingRedirector=>{bindingKey=>2},keyedReference=>{keyName=>2,keyValue=>2,tModelKey=>2},phone=>{useType=>2},registeredInfo=>{generic=>2,operator=>2,truncated=>2},result=>{errno=>2,keyType=>2},save_binding=>{generic=>2},save_business=>{generic=>2},save_service=>{generic=>2},save_tModel=>{generic=>2},serviceDetail=>{generic=>2,operator=>2,truncated=>2},serviceInfo=>{businessKey=>2,serviceKey=>2},serviceList=>{generic=>2,operator=>2,truncated=>2},tModel=>{authorizedName=>2,operator=>2,tModelKey=>2},tModelDetail=>{generic=>2,operator=>2,truncated=>2},tModelInfo=>{tModelKey=>2},tModelInstanceInfo=>{tModelKey=>2},tModelList=>{generic=>2,operator=>2,truncated=>2},validate_categorization=>{generic=>2}},
+ WITHNAMES => [qw/accessPoint address addressLine authInfo authToken bindingDetail bindingKey bindingTemplate bindingTemplates businessDetail businessDetailExt businessEntity businessEntityExt businessInfo businessInfos businessKey businessList businessService businessServices categoryBag contact contacts description discoveryURLs discoveryUrl dispositionReport email errInfo findQualifier findQualifiers hostingRedirector identifierBag instanceDetails instanceParms keyValue keyedReference name overviewDoc overviewURL personName phone registeredInfo result serviceDetail serviceInfo serviceInfos serviceKey serviceList tModel tModelBag tModelDetail tModelInfo tModelInfos tModelInstanceDetails tModelInstanceInfo tModelKey tModelList uploadRegister/],
+ NAMESPACE => 'urn:uddi-org:api',
+ GENERIC => '1.0', # string, not number; '.0' matters
+ },
+ 2 => {
+ ELEMENTS => {add_publisherAssertions=>{authInfo=>1,publisherAssertion=>1},address=>{addressLine=>1},assertionStatusItem=>{fromKey=>1,keyedReference=>1,keysOwned=>1,toKey=>1},assertionStatusReport=>{assertionStatusItem=>1},authToken=>{authInfo=>1},bindingDetail=>{bindingTemplate=>1},bindingTemplate=>{accessPoint=>1,description=>1,hostingRedirector=>1,tModelInstanceDetails=>1},bindingTemplates=>{bindingTemplate=>1},businessDetail=>{businessEntity=>1},businessDetailExt=>{businessEntityExt=>1},businessEntity=>{businessServices=>1,categoryBag=>1,contacts=>1,description=>1,discoveryURLs=>1,identifierBag=>1,name=>1},businessEntityExt=>{businessEntity=>1},businessInfo=>{description=>1,name=>1,serviceInfos=>1},businessInfos=>{businessInfo=>1},businessList=>{businessInfos=>1},businessService=>{bindingTemplates=>1,categoryBag=>1,description=>1,name=>1},businessServices=>{businessService=>1},categoryBag=>{keyedReference=>1},contact=>{address=>1,description=>1,email=>1,personName=>1,phone=>1},contacts=>{contact=>1},delete_binding=>{authInfo=>1,bindingKey=>1},delete_business=>{authInfo=>1,businessKey=>1},delete_publisherAssertions=>{authInfo=>1,publisherAssertion=>1},delete_service=>{authInfo=>1,serviceKey=>1},delete_tModel=>{authInfo=>1,tModelKey=>1},discard_authToken=>{authInfo=>1},discoveryURLs=>{discoveryURL=>1},dispositionReport=>{result=>1},findQualifiers=>{findQualifier=>1},find_binding=>{findQualifiers=>1,tModelBag=>1},find_business=>{categoryBag=>1,discoveryURLs=>1,findQualifiers=>1,identifierBag=>1,name=>1,tModelBag=>1},find_relatedBusinesses=>{businessKey=>1,findQualifiers=>1,keyedReference=>1},find_service=>{categoryBag=>1,findQualifiers=>1,name=>1,tModelBag=>1},find_tModel=>{categoryBag=>1,findQualifiers=>1,identifierBag=>1,name=>1},get_assertionStatusReport=>{authInfo=>1,completionStatus=>1},get_bindingDetail=>{bindingKey=>1},get_businessDetail=>{businessKey=>1},get_businessDetailExt=>{businessKey=>1},get_publisherAssertions=>{authInfo=>1},get_registeredInfo=>{authInfo=>1},get_serviceDetail=>{serviceKey=>1},get_tModelDetail=>{tModelKey=>1},identifierBag=>{keyedReference=>1},instanceDetails=>{description=>1,instanceParms=>1,overviewDoc=>1},keysOwned=>{fromKey=>1,toKey=>1},overviewDoc=>{description=>1,overviewURL=>1},publisherAssertion=>{fromKey=>1,keyedReference=>1,toKey=>1},publisherAssertions=>{publisherAssertion=>1},registeredInfo=>{businessInfos=>1,tModelInfos=>1},relatedBusinessInfo=>{businessKey=>1,description=>1,name=>1,sharedRelationships=>1},relatedBusinessInfos=>{relatedBusinessInfo=>1},relatedBusinessesList=>{businessKey=>1,relatedBusinessInfos=>1},result=>{errInfo=>1},save_binding=>{authInfo=>1,bindingTemplate=>1},save_business=>{authInfo=>1,businessEntity=>1,uploadRegister=>1},save_service=>{authInfo=>1,businessService=>1},save_tModel=>{authInfo=>1,tModel=>1,uploadRegister=>1},serviceDetail=>{businessService=>1},serviceInfo=>{name=>1},serviceInfos=>{serviceInfo=>1},serviceList=>{serviceInfos=>1},set_publisherAssertions=>{authInfo=>1,publisherAssertion=>1},sharedRelationships=>{keyedReference=>1},tModel=>{categoryBag=>1,description=>1,identifierBag=>1,name=>1,overviewDoc=>1},tModelBag=>{tModelKey=>1},tModelDetail=>{tModel=>1},tModelInfo=>{name=>1},tModelInfos=>{tModelInfo=>1},tModelInstanceDetails=>{tModelInstanceInfo=>1},tModelInstanceInfo=>{description=>1,instanceDetails=>1},tModelList=>{tModelInfos=>1},validate_values=>{businessEntity=>1,businessService=>1,tModel=>1}},
+ ATTRIBUTES => {accessPoint=>{URLType=>2},add_publisherAssertions=>{generic=>2},address=>{sortCode=>2,tModelKey=>2,useType=>2},addressLine=>{keyName=>2,keyValue=>2},assertionStatusItem=>{completionStatus=>2},assertionStatusReport=>{generic=>2,operator=>2},authToken=>{generic=>2,operator=>2},bindingDetail=>{generic=>2,operator=>2,truncated=>2},bindingTemplate=>{bindingKey=>2,serviceKey=>2},businessDetail=>{generic=>2,operator=>2,truncated=>2},businessDetailExt=>{generic=>2,operator=>2,truncated=>2},businessEntity=>{authorizedName=>2,businessKey=>2,operator=>2},businessInfo=>{businessKey=>2},businessList=>{generic=>2,operator=>2,truncated=>2},businessService=>{businessKey=>2,serviceKey=>2},contact=>{useType=>2},delete_binding=>{generic=>2},delete_business=>{generic=>2},delete_publisherAssertions=>{generic=>2},delete_service=>{generic=>2},delete_tModel=>{generic=>2},description=>{lang=>2},discard_authToken=>{generic=>2},discoveryURL=>{useType=>2},dispositionReport=>{generic=>2,operator=>2,truncated=>2},email=>{useType=>2},errInfo=>{errCode=>2},find_binding=>{generic=>2,maxRows=>2,serviceKey=>2},find_business=>{generic=>2,maxRows=>2},find_relatedBusinesses=>{generic=>2,maxRows=>2},find_service=>{businessKey=>2,generic=>2,maxRows=>2},find_tModel=>{generic=>2,maxRows=>2},get_assertionStatusReport=>{generic=>2},get_authToken=>{cred=>2,generic=>2,userID=>2},get_bindingDetail=>{generic=>2},get_businessDetail=>{generic=>2},get_businessDetailExt=>{generic=>2},get_publisherAssertions=>{generic=>2},get_registeredInfo=>{generic=>2},get_serviceDetail=>{generic=>2},get_tModelDetail=>{generic=>2},hostingRedirector=>{bindingKey=>2},keyedReference=>{keyName=>2,keyValue=>2,tModelKey=>2},name=>{lang=>2},phone=>{useType=>2},publisherAssertions=>{authorizedName=>2,generic=>2,operator=>2},registeredInfo=>{generic=>2,operator=>2,truncated=>2},relatedBusinessesList=>{generic=>2,operator=>2,truncated=>2},result=>{errno=>2,keyType=>2},save_binding=>{generic=>2},save_business=>{generic=>2},save_service=>{generic=>2},save_tModel=>{generic=>2},serviceDetail=>{generic=>2,operator=>2,truncated=>2},serviceInfo=>{businessKey=>2,serviceKey=>2},serviceList=>{generic=>2,operator=>2,truncated=>2},set_publisherAssertions=>{generic=>2},sharedRelationships=>{direction=>2},tModel=>{authorizedName=>2,operator=>2,tModelKey=>2},tModelDetail=>{generic=>2,operator=>2,truncated=>2},tModelInfo=>{tModelKey=>2},tModelInstanceInfo=>{tModelKey=>2},tModelList=>{generic=>2,operator=>2,truncated=>2},validate_values=>{generic=>2}},
+ WITHNAMES => [qw/accessPoint address addressLine assertionStatusItem assertionStatusReport authInfo authToken bindingDetail bindingKey bindingTemplate bindingTemplates businessDetail businessDetailExt businessEntity businessEntityExt businessInfo businessInfos businessKey businessList businessService businessServices categoryBag completionStatus contact contacts description discoveryURL discoveryURLs dispositionReport email errInfo findQualifier findQualifiers fromKey hostingRedirector identifierBag instanceDetails instanceParms keyedReference keysOwned name overviewDoc overviewURL personName phone publisherAssertion publisherAssertions registeredInfo relatedBusinessInfo relatedBusinessInfos relatedBusinessesList result serviceDetail serviceInfo serviceInfos serviceKey serviceList sharedRelationships tModel tModelBag tModelDetail tModelInfo tModelInfos tModelInstanceDetails tModelInstanceInfo tModelKey tModelList toKey uploadRegister/],
+ NAMESPACE => 'urn:uddi-org:api_v2',
+ GENERIC => '2.0',
+ },
+ 3 => {
+ ELEMENTS => {add_publisherAssertions=>{authInfo=>1,publisherAssertion=>1},address=>{addressLine=>1},assertionStatusItem=>{fromKey=>1,keyedReference=>1,keysOwned=>1,toKey=>1},assertionStatusReport=>{assertionStatusItem=>1},authToken=>{authInfo=>1},bindingDetail=>{bindingTemplate=>1,listDescription=>1},bindingTemplate=>{accessPoint=>1,categoryBag=>1,description=>1,Signature=>1,hostingRedirector=>1,tModelInstanceDetails=>1},bindingTemplates=>{bindingTemplate=>1},businessDetail=>{businessEntity=>1},businessEntity=>{businessServices=>1,categoryBag=>1,contacts=>1,description=>1,discoveryURLs=>1,Signature=>1,identifierBag=>1,name=>1},businessInfo=>{description=>1,name=>1,serviceInfos=>1},businessInfos=>{businessInfo=>1},businessList=>{businessInfos=>1,listDescription=>1},businessService=>{bindingTemplates=>1,categoryBag=>1,description=>1,Signature=>1,name=>1},businessServices=>{businessService=>1},categoryBag=>{keyedReference=>1,keyedReferenceGroup=>1,keyedReferenceGroup=>1},contact=>{address=>1,description=>1,email=>1,personName=>1,phone=>1},contacts=>{contact=>1},delete_binding=>{authInfo=>1,bindingKey=>1},delete_business=>{authInfo=>1,businessKey=>1},delete_publisherAssertions=>{authInfo=>1,publisherAssertion=>1},delete_service=>{authInfo=>1,serviceKey=>1},delete_tModel=>{authInfo=>1,tModelKey=>1},discard_authToken=>{authInfo=>1},discoveryURLs=>{discoveryURL=>1},dispositionReport=>{result=>1},findQualifiers=>{findQualifier=>1},find_binding=>{authInfo=>1,categoryBag=>1,findQualifiers=>1,find_tModel=>1,tModelBag=>1},find_business=>{authInfo=>1,categoryBag=>1,discoveryURLs=>1,findQualifiers=>1,find_relatedBusinesses=>1,find_tModel=>1,identifierBag=>1,name=>1,tModelBag=>1},find_relatedBusinesses=>{authInfo=>1,businessKey=>1,findQualifiers=>1,fromKey=>1,keyedReference=>1,toKey=>1},find_service=>{authInfo=>1,categoryBag=>1,findQualifiers=>1,find_tModel=>1,name=>1,tModelBag=>1},find_tModel=>{authInfo=>1,categoryBag=>1,findQualifiers=>1,identifierBag=>1,name=>1},get_assertionStatusReport=>{authInfo=>1,completionStatus=>1},get_bindingDetail=>{authInfo=>1,bindingKey=>1},get_businessDetail=>{authInfo=>1,businessKey=>1},get_operationalInfo=>{authInfo=>1,entityKey=>1},get_publisherAssertions=>{authInfo=>1},get_registeredInfo=>{authInfo=>1},get_serviceDetail=>{authInfo=>1,serviceKey=>1},get_tModelDetail=>{authInfo=>1,tModelKey=>1},identifierBag=>{keyedReference=>1},instanceDetails=>{description=>1,instanceParms=>1,instanceParms=>1,overviewDoc=>1},keyedReferenceGroup=>{keyedReference=>1},keysOwned=>{fromKey=>1,toKey=>1,toKey=>1},listDescription=>{actualCount=>1,includeCount=>1,listHead=>1},operationalInfo=>{authorizedName=>1,created=>1,modified=>1,modifiedIncludingChildren=>1,nodeID=>1},operationalInfos=>{operationalInfo=>1},overviewDoc=>{description=>1,overviewURL=>1,overviewURL=>1},publisherAssertion=>{Signature=>1,fromKey=>1,keyedReference=>1,toKey=>1},publisherAssertions=>{publisherAssertion=>1},registeredInfo=>{businessInfos=>1,tModelInfos=>1},relatedBusinessInfo=>{businessKey=>1,description=>1,name=>1,sharedRelationships=>1},relatedBusinessInfos=>{relatedBusinessInfo=>1},relatedBusinessesList=>{businessKey=>1,listDescription=>1,relatedBusinessInfos=>1},result=>{errInfo=>1},save_binding=>{authInfo=>1,bindingTemplate=>1},save_business=>{authInfo=>1,businessEntity=>1},save_service=>{authInfo=>1,businessService=>1},save_tModel=>{authInfo=>1,tModel=>1},serviceDetail=>{businessService=>1},serviceInfo=>{name=>1},serviceInfos=>{serviceInfo=>1},serviceList=>{listDescription=>1,serviceInfos=>1},set_publisherAssertions=>{authInfo=>1,publisherAssertion=>1},sharedRelationships=>{keyedReference=>1,publisherAssertion=>1},tModel=>{categoryBag=>1,description=>1,Signature=>1,identifierBag=>1,name=>1,overviewDoc=>1},tModelBag=>{tModelKey=>1},tModelDetail=>{tModel=>1},tModelInfo=>{description=>1,name=>1},tModelInfos=>{tModelInfo=>1},tModelInstanceDetails=>{tModelInstanceInfo=>1},tModelInstanceInfo=>{description=>1,instanceDetails=>1},tModelList=>{listDescription=>1,tModelInfos=>1}},
+ ATTRIBUTES => {accessPoint=>{useType=>2},address=>{sortCode=>2,tModelKey=>2,useType=>2,lang=>2},addressLine=>{keyName=>2,keyValue=>2},assertionStatusItem=>{completionStatus=>2},bindingDetail=>{truncated=>2},bindingTemplate=>{bindingKey=>2,serviceKey=>2},businessDetail=>{truncated=>2},businessEntity=>{businessKey=>2},businessInfo=>{businessKey=>2},businessList=>{truncated=>2},businessService=>{businessKey=>2,serviceKey=>2},contact=>{useType=>2},description=>{lang=>2},discoveryURL=>{useType=>2},dispositionReport=>{truncated=>2},email=>{useType=>2},errInfo=>{errCode=>2},find_binding=>{listHead=>2,maxRows=>2,serviceKey=>2},find_business=>{listHead=>2,maxRows=>2},find_relatedBusinesses=>{listHead=>2,maxRows=>2},find_service=>{businessKey=>2,listHead=>2,maxRows=>2},find_tModel=>{listHead=>2,maxRows=>2},get_authToken=>{cred=>2,userID=>2},get_registeredInfo=>{infoSelection=>2},hostingRedirector=>{bindingKey=>2},keyedReference=>{keyName=>2,keyValue=>2,tModelKey=>2},keyedReferenceGroup=>{tModelKey=>2},name=>{lang=>2},operationalInfo=>{entityKey=>2},operationalInfos=>{truncated=>2},overviewURL=>{useType=>2},personName=>{lang=>2},phone=>{useType=>2},registeredInfo=>{truncated=>2},relatedBusinessesList=>{truncated=>2},result=>{errno=>2,keyType=>2},serviceDetail=>{truncated=>2},serviceInfo=>{businessKey=>2,serviceKey=>2},serviceList=>{truncated=>2},sharedRelationships=>{direction=>2},tModel=>{deleted=>2,tModelKey=>2},tModelDetail=>{truncated=>2},tModelInfo=>{tModelKey=>2},tModelInstanceInfo=>{tModelKey=>2},tModelList=>{truncated=>2}},
+ WITHNAMES => [qw/accessPoint actualCount address addressLine assertionStatusItem assertionStatusReport authToken authorizedName bindingDetail bindingKey bindingTemplate bindingTemplates businessDetail businessEntity businessInfo businessInfos businessKey businessList businessService businessServices categoryBag completionStatus contact contacts created description discoveryURL discoveryURLs dispositionReport email entityKey errInfo findQualifier findQualifiers fromKey hostingRedirector identifierBag includeCount infoSelection instanceDetails instanceParms keyedReference keyedReferenceGroup keysOwned listDescription listHead modified modifiedIncludingChildren name nodeID operationalInfo operationalInfos overviewDoc overviewURL personName phone publisherAssertion publisherAssertions registeredInfo relatedBusinessInfo relatedBusinessInfos relatedBusinessesList result serviceDetail serviceInfo serviceInfos serviceKey serviceList sharedRelationships tModel tModelBag tModelDetail tModelInfo tModelInfos tModelInstanceDetails tModelInstanceInfo tModelKey tModelList toKey/],
+ NAMESPACE => 'urn:uddi-org:api_v3',
+ GENERIC => undef,
+ },
+ );
+}
+
+# ======================================================================
+
+package UDDI::SOM;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::SOM);
+
+sub result { # result should point to immediate child of Body
+ my $self = shift;
+ my $result = '/Envelope/Body/[1]';
+ ref $self or return $result;
+ defined $self->fault ? undef : $self->valueof($result);
+};
+
+# ======================================================================
+
+package UDDI::Data;
+
+use Carp ();
+
+use vars qw(@ISA $AUTOLOAD);
+ at ISA = qw(SOAP::Data);
+
+use overload fallback => 1, '""' => sub { shift->SUPER::value };
+
+sub _init {
+ use vars qw(@EXPORT_OK %EXPORT_TAGS);
+ @EXPORT_OK = (with => @$UDDI::Constants::WITHNAMES);
+ %EXPORT_TAGS = (all => [@EXPORT_OK]);
+
+ use vars qw($elements $attributes);
+ $elements = $UDDI::Constants::ELEMENTS;
+ $attributes = $UDDI::Constants::ATTRIBUTES;
+}
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+
+ unless (ref $self) {
+ $self = $class->SUPER::new(@_, type => 'uddi');
+ }
+ return $self;
+}
+
+sub with {
+ my $self = shift;
+ $self = (__PACKAGE__->can($self) || Carp::croak "Don't know what to do with '$self'")->()
+ unless ref $self && UNIVERSAL::isa($self => __PACKAGE__);
+
+ my $name = $self->SUPER::name;
+ my @values;
+ while (@_) {
+ my $data = shift;
+ my($method, $attr, @value) = UNIVERSAL::isa($data => __PACKAGE__)
+ ? ($data->SUPER::name, $data->SUPER::attr, $data->SUPER::value)
+ : ($data, {}, shift);
+ exists $attributes->{$name}{$method}
+ # attribute
+ ? $self->$method(@value)
+ # sub element
+ : push(@values, ($self->can($method) || Carp::croak "Don't know what to do with '$method'")->(@value)->attr($attr));
+ }
+ $self->set_value([@values]);
+}
+
+sub _compileit {
+ no strict 'refs';
+ my $method = shift;
+ *$method = sub {
+
+ # GENERATE element if no parameters: businessInfo()
+ return __PACKAGE__->SUPER::name($method)
+ if !@_ && exists $elements->{$method};
+
+ die "Expected element (UDDI::Data) as parameter for $method()\n"
+ if !ref $_[0] && exists $elements->{$method};
+
+ # MAKE ELEMENT: name( [{attr => value},] 'old')
+ if (!UNIVERSAL::isa($_[0] => __PACKAGE__)) {
+ # get optional list of attributes as a first parameter
+ my $attr = ref $_[0] eq 'HASH' ? shift @_ : {};
+ return __PACKAGE__->SUPER::name($method => @_)->attr($attr);
+ }
+
+ my $name = $_[0]->SUPER::name;
+
+ if (defined $name) {
+ # GET/SET ATTRIBUTE: businessInfo->businessKey
+ return @_ > 1
+ ? scalar($_[0]->attr->{$method} = $_[1], $_[0]) # SET
+ : __PACKAGE__->SUPER::name($method => $_[0]->attr->{$method}) # GET
+ if exists $attributes->{$name} && exists $attributes->{$name}{$method};
+
+ # GET ELEMENT: businessInfos->businessInfo
+ my @elems = grep {
+ ref $_ && UNIVERSAL::isa($_ => __PACKAGE__) && $_->SUPER::name eq $method
+ } map {ref $_ eq 'ARRAY' ? @$_ : $_} $_[0]->value;
+ return wantarray? @elems : $elems[0]
+ if exists $elements->{$name} && exists $elements->{$name}{$method};
+
+ # MAKE ELEMENT: businessInfos(businessInfo('something'))
+ return __PACKAGE__->SUPER::name($method => @_)
+ if exists $elements->{$method} && exists $elements->{$method}{$name};
+ }
+
+ # handle UDDI::Data->method() calls for those SOAP::Data methods
+ # that conflict with UDDI methods, like name()
+ if (UNIVERSAL::can($ISA[0] => $method)) {
+ my $pkg = shift @_;
+ return eval "\$pkg->SUPER::$method(\@_)";
+ }
+
+ Carp::croak "Don't know what to do with '$method' and '$name' elements";
+ }
+}
+
+sub BEGIN { _compileit('name') }
+
+sub AUTOLOAD {
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+ return if $method eq 'DESTROY';
+
+ _compileit($method);
+ goto &$AUTOLOAD;
+}
+
+# ======================================================================
+
+package UDDI::Serializer;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Serializer);
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+
+ unless (ref $self) {
+ $self = $class->SUPER::new(
+ attr => {},
+ namespaces => {
+ $SOAP::Constants::PREFIX_ENV ? ($SOAP::Constants::NS_ENV => $SOAP::Constants::PREFIX_ENV) : (),
+ },
+ autotype => 0,
+ @_,
+ );
+ }
+ return $self;
+}
+
+use overload; # protect from stringification in UDDI::Data
+sub gen_id { overload::StrVal($_[1]) =~ /\((0x\w+)\)/o; $1 }
+
+sub as_uddi {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return $self->encode_array($value, $name, undef, $attr) if ref $value eq 'ARRAY';
+ return $self->encode_hash($value, $name, undef, $attr) if ref $value eq 'HASH';
+ [$name, {%{$attr || {}}}, ref $value ? ([$self->encode_object($value)], $self->gen_id($value)) : $value];
+}
+
+sub encode_array {
+ my $self = shift;
+ my $encoded = $self->SUPER::encode_array(@_);
+ delete $encoded->[1]->{SOAP::Utils::qualify($self->encprefix => 'arrayType')};
+ return $encoded;
+}
+
+# ======================================================================
+
+package UDDI::Deserializer;
+
+use vars qw(@ISA);
+ at ISA = qw(SOAP::Deserializer);
+
+sub decode_value {
+ my $self = shift;
+ my $ref = shift;
+ my($name, $attrs, $children, $value) = @$ref;
+
+ # base class knows what to do with elements in SOAP namespace
+ return $self->SUPER::decode_value($ref)
+ if exists $attrs->{href} ||
+ (SOAP::Utils::splitlongname($name))[0] eq $SOAP::Constants::NS_ENV;
+
+ UDDI::Data
+ -> SOAP::Data::name($name)
+ -> attr($attrs)
+ -> set_value(ref $children && @$children ? map(scalar(($self->decode_object($_))[1]), @$children) : $value);
+}
+
+sub deserialize {
+ bless shift->SUPER::deserialize(@_) => 'UDDI::SOM';
+}
+
+# ======================================================================
+
+package UDDI::Lite;
+
+use vars qw(@ISA $AUTOLOAD %EXPORT_TAGS);
+use Exporter;
+use Carp ();
+ at ISA = qw(SOAP::Lite Exporter);
+
+BEGIN { # handle exports
+ %EXPORT_TAGS = (
+ 'delete' => [qw/delete_binding delete_business delete_service
+ delete_tModel delete_publisherAssertions/],
+ # ^-------------------- v2/3
+ 'auth' => [qw/get_authToken discard_authToken get_registeredInfo/],
+ 'save' => [qw/save_binding save_business save_service save_tModel
+ add_publisherAssertions set_publisherAssertions/],
+ # ^----------------- v2/3 ^----------------- v2/3
+ 'validate' => [qw/validate_categorization validate_values/],
+ # ^------------------- v1 ^------------v2
+ 'find' => [qw/find_binding find_business find_service find_tModel
+ find_relatedBusinesses/],
+ # ^---------------- v2/3
+ 'get' => [qw/get_bindingDetail get_businessDetail get_businessDetailExt
+ get_serviceDetail get_tModelDetail
+ get_assertionStatusReport get_publisherAssertions/],
+ # ^------------------- v2/3 ^----------------- v2/3
+ );
+ $EXPORT_TAGS{inquiry} = [map {@{$EXPORT_TAGS{$_}}} qw/find get/];
+ $EXPORT_TAGS{publish} = [map {@{$EXPORT_TAGS{$_}}} qw/delete auth save validate/];
+ $EXPORT_TAGS{all} = [map {@{$EXPORT_TAGS{$_}}} qw/inquiry publish/];
+ Exporter::export_ok_tags('all');
+}
+
+my $uddiversion;
+
+sub uddiversion {
+ my $self = shift;
+ my $version = shift or return $uddiversion;
+
+ die qq!Wrong UDDI version. Supported versions: @{[
+ join ", ", keys %UDDI::Constants::UDDI_VERSIONS]}\n!
+ unless defined $UDDI::Constants::UDDI_VERSIONS{$version};
+
+ foreach (keys %{$UDDI::Constants::UDDI_VERSIONS{$version}}) {
+ eval "\$UDDI::Constants::$_ = \$UDDI::Constants::UDDI_VERSIONS{$version}->{$_}" or die;
+ }
+
+ UDDI::Data->_init;
+
+ $uddiversion = $version;
+ $self;
+}
+
+BEGIN { UDDI::Lite->uddiversion(1) }
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+
+ unless (ref $self) {
+ $self = $class->SUPER::new(
+ on_action => sub {'""'},
+ serializer => UDDI::Serializer->new, # register UDDI Serializer
+ deserializer => UDDI::Deserializer->new, # and Deserializer
+ @_,
+ );
+ }
+ return $self;
+}
+
+sub AUTOLOAD {
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+ return if $method eq 'DESTROY';
+
+ no strict 'refs';
+ *$AUTOLOAD = sub {
+ return shift->call($method => @_) if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $som = (__PACKAGE__->self || Carp::croak "Method call on unspecified object. Died")->call($method => @_);
+ UNIVERSAL::isa($som => 'SOAP::SOM') ? $som->result : $som;
+ };
+ goto &$AUTOLOAD;
+}
+
+sub call { SOAP::Trace::trace('()');
+ my $self = shift;
+ my $method = shift;
+ my @parameters;
+ my $attr = ref $_[0] eq 'HASH' ? shift() : {};
+ while (@_) {
+ push(@parameters, UNIVERSAL::isa($_[0] => 'UDDI::Data')
+ ? shift : SOAP::Data->name(shift, shift));
+ }
+ my $message = SOAP::Data
+ -> name($method => \SOAP::Data->value(@parameters))
+ -> attr({xmlns => $UDDI::Constants::NAMESPACE,
+ (defined $UDDI::Constants::GENERIC ? (generic => $UDDI::Constants::GENERIC) : ()),
+ %$attr});
+
+ my $serializer = $self->serializer;
+ $serializer->on_nonserialized($self->on_nonserialized);
+
+ my $respond = $self->transport->send_receive(
+ endpoint => $self->endpoint,
+ action => $self->on_action->($self->uri),
+ envelope => $serializer->envelope(freeform => $message),
+ encoding => $serializer->encoding,
+ );
+
+ return $respond if $self->outputxml;
+
+ unless ($self->transport->is_success) {
+ my $result = eval { $self->deserializer->deserialize($respond) } if $respond;
+ return $self->on_fault->($self, $@ ? $respond : $result) || $result;
+ }
+
+ return unless $respond; # nothing to do for one-ways
+ return $self->deserializer->deserialize($respond);
+}
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+UDDI::Lite - Library for UDDI clients in Perl
+
+=head1 SYNOPSIS
+
+ use UDDI::Lite;
+ print UDDI::Lite
+ -> proxy('http://uddi.microsoft.com/inquire')
+ -> find_business(name => 'old')
+ -> result
+ -> businessInfos->businessInfo->serviceInfos->serviceInfo->name;
+
+The same code with autodispatch:
+
+ use UDDI::Lite +autodispatch =>
+ proxy => 'http://uddi.microsoft.com/inquire'
+ ;
+
+ print find_business(name => 'old')
+ -> businessInfos->businessInfo->serviceInfos->serviceInfo->name;
+
+Or with importing:
+
+ use UDDI::Lite
+ 'UDDI::Lite' => [':inquiry'],
+ proxy => 'http://uddi.microsoft.com/inquire'
+ ;
+
+ print find_business(name => 'old')
+ -> businessInfos->businessInfo->serviceInfos->serviceInfo->name;
+
+Publishing API:
+
+ use UDDI::Lite
+ import => ['UDDI::Data'],
+ import => ['UDDI::Lite'],
+ proxy => "https://some.server.com/endpoint_fot_publishing_API";
+
+ my $auth = get_authToken({userID => 'USERID', cred => 'CRED'})->authInfo;
+ my $busent = with businessEntity =>
+ name("Contoso Manufacturing"),
+ description("We make components for business"),
+ businessKey(''),
+ businessServices with businessService =>
+ name("Buy components"),
+ description("Bindings for buying our components"),
+ serviceKey(''),
+ bindingTemplates with bindingTemplate =>
+ description("BASDA invoices over HTTP post"),
+ accessPoint('http://www.contoso.com/buy.asp'),
+ bindingKey(''),
+ tModelInstanceDetails with tModelInstanceInfo =>
+ description('some tModel'),
+ tModelKey('UUID:C1ACF26D-9672-4404-9D70-39B756E62AB4')
+ ;
+ print save_business($auth, $busent)->businessEntity->businessKey;
+
+=head1 DESCRIPTION
+
+UDDI::Lite for Perl is a collection of Perl modules which provides a
+simple and lightweight interface to the Universal Description, Discovery
+and Integration (UDDI) server.
+
+To learn more about UDDI, visit http://www.uddi.org/.
+
+The main features of the library are:
+
+=over 3
+
+=item *
+
+Supports both inquiry and publishing API
+
+=item *
+
+Builded on top of SOAP::Lite module, hence inherited syntax and features
+
+=item *
+
+Supports easy-to-use interface with convinient access to (sub)elements
+and attributes
+
+=item *
+
+Supports HTTPS protocol
+
+=item *
+
+Supports SMTP protocol
+
+=item *
+
+Supports Basic/Digest server authentication
+
+=back
+
+=head1 OVERVIEW OF CLASSES AND PACKAGES
+
+This table should give you a quick overview of the classes provided by the
+library.
+
+ UDDI::Lite.pm
+ -- UDDI::Lite -- Main class provides all logic
+ -- UDDI::Data -- Provides extensions for serialization architecture
+ -- UDDI::Serializer -- Serializes data structures to UDDI/SOAP package
+ -- UDDI::Deserializer -- Deserializes result into objects
+ -- UDDI::SOM -- Provides access to deserialized object tree
+
+=head2 UDDI::Lite
+
+All methods that UDDI::Lite gives you access to can be used for both
+setting and retrieving values. If you provide no parameters, you'll
+get current value, and if you'll provide parameter(s), new value
+will be assigned and method will return object (if not stated something
+else). This is suitable for stacking these calls like:
+
+ $uddi = UDDI::Lite
+ -> on_debug(sub{print at _})
+ -> proxy('http://uddi.microsoft.com/inquire')
+ ;
+
+Order is insignificant and you may call new() method first. If you
+don't do it, UDDI::Lite will do it for you. However, new() method
+gives you additional syntax:
+
+ $uddi = new UDDI::Lite
+ on_debug => sub {print at _},
+ proxy => 'http://uddi.microsoft.com/inquire'
+ ;
+
+new() accepts hash with method names and values, and will call
+appropriate method with passed value.
+
+Since new() is optional it won't be mentioned anymore.
+
+Other available methods inherited from SOAP::Lite and most usable are:
+
+=over 4
+
+=item proxy()
+
+Shortcut for C<transport-E<gt>proxy()>. This lets you specify an endpoint and
+also loads the required module at the same time. It is required for dispatching SOAP
+calls. The name of the module will be defined depending on the protocol
+specific for the endpoint. SOAP::Lite will do the rest work.
+
+=item on_fault()
+
+Lets you specify handler for on_fault event. Default behavior is die
+on transport error and does nothing on others. You can change this
+behavior globally or locally, for particular object.
+
+=item on_debug()
+
+Lets you specify handler for on_debug event. Default behavior is do
+nothing. Use +trace/+debug option for UDDI::Lite instead.
+
+=back
+
+To change to UDDI Version 2, use the following pragma:
+
+ use UDDI::Lite uddiversion => 2;
+
+=head2 UDDI::Data
+
+You can use this class if you want to specify value and name for UDDI
+elements.
+For example, C<UDDI::Data-E<gt>name('businessInfo')-E<gt>value(123)> will
+be serialized to C<E<lt>businessInfoE<gt>123E<lt>/businessInfoE<gt>>, as
+well as C<UDDI::Data->name(businessInfo =E<gt> 123)>.
+
+If you want to provide names for your parameters you can either specify
+
+ find_business(name => 'old')
+
+or do it with UDDI::Data:
+
+ find_business(UDDI::Data->name(name => 'old'))
+
+Later has some advantages: it'll work on any level, so you can do:
+
+ find_business(UDDI::Data->name(name => UDDI::Data->name(subname => 'old')))
+
+and also you can create arrays with this syntax:
+
+ find_business(UDDI::Data->name(name =>
+ [UDDI::Data->name(subname1 => 'name1'),
+ UDDI::Data->name(subname2 => 'name2')]))
+
+will be serialized into:
+
+ <find_business xmlns="urn:uddi-org:api" generic="1.0">
+ <name>
+ <subname1>name1</subname1>
+ <subname2>name2</subname2>
+ </name>
+ </find_business>
+
+For standard elements more convinient syntax is available:
+
+ find_business(
+ findQualifiers(findQualifier('sortByNameAsc',
+ 'caseSensitiveMatch')),
+ name('M')
+ )
+
+and
+
+ find_business(
+ findQualifiers([findQualifier('sortByNameAsc'),
+ findQualifier('caseSensitiveMatch')]),
+ name('M')
+ )
+
+both will generate:
+
+ <SOAP-ENV:Envelope
+ xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
+ <SOAP-ENV:Body>
+ <find_business xmlns="urn:uddi-org:api" generic="1.0">
+ <findQualifiers>
+ <findQualifier>sortByNameAsc</findQualifier>
+ <findQualifier>caseSensitiveMatch</findQualifier>
+ </findQualifiers>
+ <name>M</name>
+ </find_business>
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+You can use ANY valid combinations (according to "UDDI Programmer's
+API Specification"). If you try to generate something unusual, like
+C<name(name('myname'))>, you'll get:
+
+ Don't know what to do with 'name' and 'name' elements ....
+
+If you REALLY need to do it, use C<UDDI::Data> syntax described above.
+
+As special case you can pass hash as the first parameter of method
+call and values of this hash will be added as attributes to top element:
+
+ find_business({maxRows => 10}, UDDI::Data->name(name => old))
+
+gives you
+
+ <find_business xmlns="urn:uddi-org:api" generic="1.0" maxRows="10">
+ ....
+ </find_business>
+
+You can also pass back parameters exactly as you get it from method call
+(like you probably want to do with authInfo).
+
+You can get access to attributes and elements through the same interface:
+
+ my $list = find_business(name => old);
+ my $bis = $list->businessInfos;
+ for ($bis->businessInfo) {
+ my $s = $_->serviceInfos->serviceInfo;
+ print $s->name, # element
+ $s->businessKey, # attribute
+ "\n";
+ }
+
+To match advantages provided by C<with> operator available in other
+languages (like VB) we provide similar functionality that adds you
+flexibility:
+
+ with findQualifiers =>
+ findQualifier => 'sortByNameAsc',
+ findQualifier => 'caseSensitiveMatch'
+
+is the same as:
+
+ with(findQualifiers =>
+ findQualifier('sortByNameAsc'),
+ findQualifier('caseSensitiveMatch'),
+ )
+
+and:
+
+ findQualifiers->with(
+ findQualifier('sortByNameAsc'),
+ findQualifier('caseSensitiveMatch'),
+ )
+
+will all generate the same code as mentioned above:
+
+ findQualifiers(findQualifier('sortByNameAsc',
+ 'caseSensitiveMatch')),
+
+Advantage of C<with> syntax is the you can specify both attributes and
+elements through the same interface. First argument is element where all
+other elements and attributes will be attached. Provided examples and
+tests cover different syntaxes.
+
+=head2 AUTODISPATCHING
+
+UDDI::Lite provides autodispatching feature that lets you create
+code that looks similar for local and remote access.
+
+For example:
+
+ use UDDI::Lite +autodispatch =>
+ proxy => 'http://uddi.microsoft.com/inquire';
+
+tells autodispatch all UDDI calls to
+'http://uddi.microsoft.com/inquire'. All subsequent calls can look
+like:
+
+ find_business(name => 'old');
+ find_business(UDDI::Data->name(name => 'old'));
+ find_business(name('old'));
+
+=head1 BUGS AND LIMITATIONS
+
+=over 4
+
+=item *
+
+Interface is still subject to change.
+
+=item *
+
+Though HTTPS/SSL is supported you should specify it yourself (with
+C<proxy> or C<endpoint>) for publishing API calls.
+
+=back
+
+=head1 AVAILABILITY
+
+For now UDDI::Lite is distributed as part of SOAP::Lite package.
+You can download it from ( http://soaplite.com/ )
+or from CPAN ( http://search.cpan.org/search?dist=SOAP-Lite ).
+
+=head1 SEE ALSO
+
+L<SOAP::Lite> ( http://search.cpan.org/search?dist=SOAP-Lite )
+L<UDDI> ( http://search.cpan.org/search?dist=UDDI )
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2004 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/XML/Parser/Lite.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/XML/Parser/Lite.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/XML/Parser/Lite.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,203 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Lite.pm,v 1.2 2005/02/22 01:47:42 byrnereese Exp $
+#
+# ======================================================================
+
+package XML::Parser::Lite;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = '0.65_3';
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ return $self if ref $self;
+
+ $self = bless {} => $class;
+ my %parameters = @_;
+ $self->setHandlers(); # clear first
+ $self->setHandlers(%{$parameters{Handlers} || {}});
+ return $self;
+}
+
+sub setHandlers {
+ my $self = shift;
+ no strict 'refs'; local $^W;
+ # clear all handlers if called without parameters
+ unless (@_) { foreach (qw(Start End Char Final Init)) { *$_ = sub {} } }
+ while (@_) { my($name => $func) = splice(@_, 0, 2); *$name = defined $func ? $func : sub {} }
+ return $self;
+}
+
+sub regexp {
+ my $patch = shift || '';
+ my $package = __PACKAGE__;
+
+ # This parser is based on "shallow parser" http://www.cs.sfu.ca/~cameron/REX.html
+
+ # Robert D. Cameron "REX: XML Shallow Parsing with Regular Expressions",
+ # Technical Report TR 1998-17, School of Computing Science, Simon Fraser University, November, 1998.
+ # Copyright (c) 1998, Robert D. Cameron.
+ # The following code may be freely used and distributed provided that
+ # this copyright and citation notice remains intact and that modifications
+ # or additions are clearly identified.
+
+ my $TextSE = "[^<]+";
+ my $UntilHyphen = "[^-]*-";
+ my $Until2Hyphens = "$UntilHyphen(?:[^-]$UntilHyphen)*-";
+ my $CommentCE = "$Until2Hyphens>?";
+ my $UntilRSBs = "[^\\]]*](?:[^\\]]+])*]+";
+ my $CDATA_CE = "$UntilRSBs(?:[^\\]>]$UntilRSBs)*>";
+ my $S = "[ \\n\\t\\r]+";
+ my $NameStrt = "[A-Za-z_:]|[^\\x00-\\x7F]";
+ my $NameChar = "[A-Za-z0-9_:.-]|[^\\x00-\\x7F]";
+ my $Name = "(?:$NameStrt)(?:$NameChar)*";
+ my $QuoteSE = "\"[^\"]*\"|'[^']*'";
+ my $DT_IdentSE = "$S$Name(?:$S(?:$Name|$QuoteSE))*";
+ my $MarkupDeclCE = "(?:[^\\]\"'><]+|$QuoteSE)*>";
+ my $S1 = "[\\n\\r\\t ]";
+ my $UntilQMs = "[^?]*\\?+";
+ my $PI_Tail = "\\?>|$S1$UntilQMs(?:[^>?]$UntilQMs)*>";
+ my $DT_ItemSE = "<(?:!(?:--$Until2Hyphens>|[^-]$MarkupDeclCE)|\\?$Name(?:$PI_Tail))|%$Name;|$S";
+ my $DocTypeCE = "$DT_IdentSE(?:$S)?(?:\\[(?:$DT_ItemSE)*](?:$S)?)?>?";
+ my $DeclCE = "--(?:$CommentCE)?|\\[CDATA\\[(?:$CDATA_CE)?|DOCTYPE(?:$DocTypeCE)?";
+ my $PI_CE = "$Name(?:$PI_Tail)?";
+
+ # these expressions were modified for backtracking and events
+ my $EndTagCE = "($Name)(?{${package}::end(\$2)})(?:$S)?>";
+ my $AttValSE = "\"([^<\"]*)\"|'([^<']*)'";
+ my $ElemTagCE = "($Name)(?:$S($Name)(?:$S)?=(?:$S)?(?:$AttValSE)(?{[\@{\$^R||[]},\$4=>defined\$5?\$5:\$6]}))*(?:$S)?(/)?>(?{${package}::start(\$3,\@{\$^R||[]})})(?{\${7} and ${package}::end(\$3)})";
+ my $MarkupSPE = "<(?:!(?:$DeclCE)?|\\?(?:$PI_CE)?|/(?:$EndTagCE)?|(?:$ElemTagCE)?)";
+
+ # Next expression is under "black magic".
+ # Ideally it should be '($TextSE)(?{${package}::char(\$1)})|$MarkupSPE',
+ # but it doesn't work under Perl 5.005 and only magic with
+ # (?:....)?? solved the problem.
+ # I would appreciate if someone let me know what is the right thing to do
+ # and what's the reason for all this magic.
+ # Seems like a problem related to (?:....)? rather than to ?{} feature.
+ # Tests are in t/31-xmlparserlite.t if you decide to play with it.
+ "(?:($TextSE)(?{${package}::char(\$1)}))$patch|$MarkupSPE";
+}
+
+sub compile { local $^W;
+ # try regexp as it should be, apply patch if doesn't work
+ foreach (regexp(), regexp('??')) {
+ eval qq{sub parse_re { use re "eval"; 1 while \$_[0] =~ m{$_}go }; 1} or die;
+ last if eval { parse_re('<foo>bar</foo>'); 1 }
+ };
+
+ *compile = sub {};
+}
+
+setHandlers();
+compile();
+
+sub parse {
+ init();
+ parse_re($_[1]);
+ final();
+}
+
+my(@stack, $level);
+
+sub init {
+ @stack = (); $level = 0;
+ Init(__PACKAGE__, @_);
+}
+
+sub final {
+ die "not properly closed tag '$stack[-1]'\n" if @stack;
+ die "no element found\n" unless $level;
+ Final(__PACKAGE__, @_)
+}
+
+sub start {
+ die "multiple roots, wrong element '$_[0]'\n" if $level++ && !@stack;
+ push(@stack, $_[0]);
+ Start(__PACKAGE__, @_);
+}
+
+sub char {
+ Char(__PACKAGE__, $_[0]), return if @stack;
+
+ # check for junk before or after element
+ # can't use split or regexp due to limitations in ?{} implementation,
+ # will iterate with loop, but we'll do it no more than two times, so
+ # it shouldn't affect performance
+ for (my $i=0; $i < length $_[0]; $i++) {
+ die "junk '$_[0]' @{[$level ? 'after' : 'before']} XML element\n"
+ if index("\n\r\t ", substr($_[0],$i,1)) < 0; # or should '< $[' be there
+ }
+}
+
+sub end {
+ pop(@stack) eq $_[0] or die "mismatched tag '$_[0]'\n";
+ End(__PACKAGE__, $_[0]);
+}
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+XML::Parser::Lite - Lightweight regexp-based XML parser
+
+=head1 SYNOPSIS
+
+ use XML::Parser::Lite;
+
+ $p1 = new XML::Parser::Lite;
+ $p1->setHandlers(
+ Start => sub { shift; print "start: @_\n" },
+ Char => sub { shift; print "char: @_\n" },
+ End => sub { shift; print "end: @_\n" },
+ );
+ $p1->parse('<foo id="me">Hello World!</foo>');
+
+ $p2 = new XML::Parser::Lite
+ Handlers => {
+ Start => sub { shift; print "start: @_\n" },
+ Char => sub { shift; print "char: @_\n" },
+ End => sub { shift; print "end: @_\n" },
+ }
+ ;
+ $p2->parse('<foo id="me">Hello <bar>cruel</bar> World!</foo>');
+
+=head1 DESCRIPTION
+
+This Perl module gives you access to XML parser with interface similar to
+XML::Parser interface. Though only basic calls are supported (init, final,
+start, char, and end) you should be able to use it in the same way you use
+XML::Parser. Due to using experimantal regexp features it'll work only on
+Perl 5.6 and may behave differently on different platforms.
+
+=head1 SEE ALSO
+
+ XML::Parser
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+This parser is based on "shallow parser" http://www.cs.sfu.ca/~cameron/REX.html
+Copyright (c) 1998, Robert D. Cameron.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/XMLRPC/Lite.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/XMLRPC/Lite.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/XMLRPC/Lite.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,421 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Lite.pm,v 1.2 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package XMLRPC::Lite;
+
+use SOAP::Lite;
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $SOAP::Lite::VERSION;
+
+# ======================================================================
+
+package XMLRPC::Constants;
+
+BEGIN {
+ no strict 'refs';
+ for (qw(
+ FAULT_CLIENT FAULT_SERVER
+ HTTP_ON_SUCCESS_CODE HTTP_ON_FAULT_CODE
+ DO_NOT_USE_XML_PARSER DO_NOT_USE_CHARSET
+ DO_NOT_USE_LWP_LENGTH_HACK DO_NOT_CHECK_CONTENT_TYPE
+ )) {
+ *$_ = \${'SOAP::Constants::' . $_}
+ }
+ # XML-RPC spec requires content-type to be "text/xml"
+ $XMLRPC::Constants::DO_NOT_USE_CHARSET = 1;
+}
+
+# ======================================================================
+
+package XMLRPC::Data;
+
+ at XMLRPC::Data::ISA = qw(SOAP::Data);
+
+# ======================================================================
+
+package XMLRPC::Serializer;
+
+ at XMLRPC::Serializer::ISA = qw(SOAP::Serializer);
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ $self = $class->SUPER::new(
+ typelookup => {
+ base64 => [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64'],
+ int => [20, sub {$_[0] =~ /^[+-]?\d+$/}, 'as_int'],
+ double => [30, sub {$_[0] =~ /^(-?(?:\d+(?:\.\d*)?|\.\d+)|([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)$/}, 'as_double'],
+ dateTime => [35, sub {$_[0] =~ /^\d{8}T\d\d:\d\d:\d\d$/}, 'as_dateTime'],
+ string => [40, sub {1}, 'as_string'],
+ },
+ attr => {},
+ namespaces => {},
+ @_,
+ );
+ }
+ return $self;
+}
+
+sub envelope {
+ my $self = shift->new;
+ my $type = shift;
+
+ my($body);
+ if ($type eq 'method' || $type eq 'response') {
+ my $method = shift or die "Unspecified method for XMLRPC call\n";
+ if ($type eq 'response') {
+ $body = XMLRPC::Data->name(methodResponse => \XMLRPC::Data->value(
+ XMLRPC::Data->type(params => [@_])
+ ));
+ } else {
+ $body = XMLRPC::Data->name(methodCall => \XMLRPC::Data->value(
+ XMLRPC::Data->type(methodName => UNIVERSAL::isa($method => 'XMLRPC::Data') ? $method->name : $method),
+ XMLRPC::Data->type(params => [@_])
+ ));
+ }
+ } elsif ($type eq 'fault') {
+ $body = XMLRPC::Data->name(methodResponse =>
+ \XMLRPC::Data->type(fault => {faultCode => $_[0], faultString => $_[1]}),
+ );
+ } else {
+ die "Wrong type of envelope ($type) for XMLRPC call\n";
+ }
+
+ $self->xmlize($self->encode_object($body));
+}
+
+sub encode_object {
+ my $self = shift;
+ my @encoded = $self->SUPER::encode_object(@_);
+ return $encoded[0]->[0] =~ /^(?:array|struct|i4|int|boolean|string|double|dateTime\.iso8601|base64)$/o
+ ? ['value', {}, [@encoded]] : @encoded;
+}
+
+sub encode_scalar {
+ my $self = shift;
+ return ['value', {}] unless defined $_[0];
+ return $self->SUPER::encode_scalar(@_);
+}
+
+sub encode_array {
+ my($self, $array) = @_;
+
+ return ['array', {}, [
+ ['data', {}, [map {$self->encode_object($_)} @$array]]
+ ]];
+}
+
+sub encode_hash {
+ my($self, $hash) = @_;
+
+ return ['struct', {}, [
+ map {
+ ['member', {}, [['name', {}, $_], $self->encode_object($hash->{$_})]]
+ } keys %$hash
+ ]];
+}
+
+sub as_methodName {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return ['methodName', $attr, $value];
+}
+
+sub as_params {
+ my $self = shift;
+ my($params, $name, $type, $attr) = @_;
+
+ return ['params', $attr, [
+ map {
+ ['param', {}, [$self->encode_object($_)]]
+ } @$params
+ ]];
+}
+
+sub as_fault {
+ my($self, $fault) = @_;
+
+ return ['fault', {}, [$self->encode_object($fault)]];
+}
+
+sub BEGIN {
+ no strict 'refs';
+ for my $type (qw(double i4 int)) {
+ my $method = 'as_' . $type;
+ *$method = sub {
+ my($self, $value) = @_;
+ return [$type, {}, $value];
+ }
+ }
+}
+
+sub as_base64 {
+ my $self = shift;
+ my $value = shift;
+ require MIME::Base64;
+ return ['base64', {}, MIME::Base64::encode_base64($value,'')];
+}
+
+sub as_string {
+ my $self = shift;
+ my $value = shift;
+ return ['string', {}, SOAP::Utils::encode_data($value)];
+}
+
+sub as_dateTime {
+ my $self = shift;
+ my $value = shift;
+ return ['dateTime.iso8601', {}, $value];
+}
+
+sub as_boolean {
+ my $self = shift;
+ my $value = shift;
+ return ['boolean', {}, $value ? 1 : 0];
+}
+
+sub typecast {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+
+ die "Wrong/unsupported datatype '$type' specified\n" if defined $type;
+
+ $self->SUPER::typecast(@_);
+}
+
+# ======================================================================
+
+package XMLRPC::SOM;
+
+ at XMLRPC::SOM::ISA = qw(SOAP::SOM);
+
+sub BEGIN {
+ no strict 'refs';
+ my %path = (
+ root => '/',
+ envelope => '/[1]',
+ method => '/methodCall/methodName',
+ fault => '/methodResponse/fault',
+ );
+ for my $method (keys %path) {
+ *$method = sub {
+ my $self = shift;
+ ref $self or return $path{$method};
+ Carp::croak "Method '$method' is readonly and doesn't accept any parameters" if @_;
+ $self->valueof($path{$method});
+ };
+ }
+ my %fault = (
+ faultcode => 'faultCode',
+ faultstring => 'faultString',
+ );
+ for my $method (keys %fault) {
+ *$method = sub {
+ my $self = shift;
+ ref $self or Carp::croak "Method '$method' doesn't have shortcut";
+ Carp::croak "Method '$method' is readonly and doesn't accept any parameters" if @_;
+ defined $self->fault ? $self->fault->{$fault{$method}} : undef;
+ };
+ }
+ my %results = (
+ result => '/methodResponse/params/[1]',
+ paramsin => '/methodCall/params/param',
+ paramsall => '/methodResponse/params/param',
+ );
+ for my $method (keys %results) {
+ *$method = sub {
+ my $self = shift;
+ ref $self or return $results{$method};
+ Carp::croak "Method '$method' is readonly and doesn't accept any parameters" if @_;
+ defined $self->fault ? undef : $self->valueof($results{$method});
+ };
+ }
+}
+
+# ======================================================================
+
+package XMLRPC::Deserializer;
+
+ at XMLRPC::Deserializer::ISA = qw(SOAP::Deserializer);
+
+BEGIN {
+ no strict 'refs';
+ for my $method (qw(o_child o_qname o_chars)) { # import from SOAP::Utils
+ *$method = \&{'SOAP::Utils::'.$method};
+ }
+}
+
+sub deserialize {
+ bless shift->SUPER::deserialize(@_) => 'XMLRPC::SOM';
+}
+
+sub decode_value {
+ my $self = shift;
+ my $ref = shift;
+ my($name, $attrs, $children, $value) = @$ref;
+
+ if ($name eq 'value') {
+ $children ? scalar(($self->decode_object($children->[0]))[1]) : $value;
+ } elsif ($name eq 'array') {
+ return [map {scalar(($self->decode_object($_))[1])} @{o_child($children->[0]) || []}];
+ } elsif ($name eq 'struct') {
+ return {map {
+ my %hash = map {o_qname($_) => $_} @{o_child($_) || []};
+ # v----- scalar is required here, because 5.005 evaluates 'undef' in list context as empty array
+ (o_chars($hash{name}) => scalar(($self->decode_object($hash{value}))[1]));
+ } @{$children || []}};
+ } elsif ($name eq 'base64') {
+ require MIME::Base64;
+ MIME::Base64::decode_base64($value);
+ } elsif ($name =~ /^(?:int|i4|boolean|string|double|dateTime\.iso8601|methodName)$/) {
+ return $value;
+ } elsif ($name =~ /^(?:params)$/) {
+ return [map {scalar(($self->decode_object($_))[1])} @{$children || []}];
+ } elsif ($name =~ /^(?:methodResponse|methodCall)$/) {
+ return +{map {$self->decode_object($_)} @{$children || []}};
+ } elsif ($name =~ /^(?:param|fault)$/) {
+ return scalar(($self->decode_object($children->[0]))[1]);
+ } else {
+ die "wrong element '$name'\n";
+ }
+}
+
+# ======================================================================
+
+package XMLRPC::Server;
+
+ at XMLRPC::Server::ISA = qw(SOAP::Server);
+
+sub initialize {
+ return (
+ deserializer => XMLRPC::Deserializer->new,
+ serializer => XMLRPC::Serializer->new,
+ on_action => sub {},
+ on_dispatch => sub { return map {s!\.!/!g; $_} shift->method =~ /^(?:(.*)\.)?(\w+)$/ },
+ );
+}
+
+# ======================================================================
+
+package XMLRPC::Server::Parameters;
+
+ at XMLRPC::Server::Parameters::ISA = qw(SOAP::Server::Parameters);
+
+# ======================================================================
+
+package XMLRPC;
+
+ at XMLRPC::ISA = qw(SOAP);
+
+# ======================================================================
+
+package XMLRPC::Lite;
+
+ at XMLRPC::Lite::ISA = qw(SOAP::Lite);
+
+sub new {
+ my $self = shift;
+
+ unless (ref $self) {
+ my $class = ref($self) || $self;
+ $self = $class->SUPER::new(
+ serializer => XMLRPC::Serializer->new,
+ deserializer => XMLRPC::Deserializer->new,
+ on_action => sub {return},
+ uri => 'http://unspecified/',
+ @_
+ );
+ }
+ return $self;
+}
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+XMLRPC::Lite - client and server implementation of XML-RPC protocol
+
+=head1 SYNOPSIS
+
+=over 4
+
+=item Client
+
+ use XMLRPC::Lite;
+ print XMLRPC::Lite
+ -> proxy('http://betty.userland.com/RPC2')
+ -> call('examples.getStateStruct', {state1 => 12, state2 => 28})
+ -> result;
+
+=item CGI server
+
+ use XMLRPC::Transport::HTTP;
+
+ my $server = XMLRPC::Transport::HTTP::CGI
+ -> dispatch_to('methodName')
+ -> handle
+ ;
+
+=item Daemon server
+
+ use XMLRPC::Transport::HTTP;
+
+ my $daemon = XMLRPC::Transport::HTTP::Daemon
+ -> new (LocalPort => 80)
+ -> dispatch_to('methodName')
+ ;
+ print "Contact to XMLRPC server at ", $daemon->url, "\n";
+ $daemon->handle;
+
+=back
+
+=head1 DESCRIPTION
+
+XMLRPC::Lite is a Perl modules which provides a simple nterface to the
+XML-RPC protocol both on client and server side. Based on SOAP::Lite module,
+it gives you access to all features and transports available in that module.
+
+See F<t/26-xmlrpc.t> for client examples and F<examples/XMLRPC/*> for server
+implementations.
+
+=head1 DEPENDENCIES
+
+ SOAP::Lite
+
+=head1 SEE ALSO
+
+ SOAP::Lite
+
+=head1 CREDITS
+
+The B<XML-RPC> standard is Copyright (c) 1998-2001, UserLand Software, Inc.
+See <http://www.xmlrpc.com> for more information about the B<XML-RPC>
+specification.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/XMLRPC/Test.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/XMLRPC/Test.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/XMLRPC/Test.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,190 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Test.pm,v 1.1.1.1 2002/11/01 14:53:58 paulclinger Exp $
+#
+# ======================================================================
+
+package XMLRPC::Test;
+
+use 5.004;
+use vars qw($VERSION $TIMEOUT);
+$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+
+$TIMEOUT = 5;
+
+# ======================================================================
+
+package My::PingPong; # we'll use this package in our tests
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ bless {_num=>shift} => $class;
+}
+
+sub next {
+ my $self = shift;
+ $self->{_num}++;
+}
+
+sub value {
+ my $self = shift;
+ $self->{_num};
+}
+
+# ======================================================================
+
+package XMLRPC::Test::Server;
+
+use strict;
+use Test;
+use XMLRPC::Lite;
+
+sub run_for {
+ my $proxy = shift or die "Proxy/endpoint is not specified";
+
+ # ------------------------------------------------------
+ my $s = XMLRPC::Lite->proxy($proxy)->on_fault(sub{});
+ eval { $s->transport->timeout($XMLRPC::Test::TIMEOUT) };
+ my $r = $s->test_connection;
+
+ unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+ }
+ # ------------------------------------------------------
+
+ plan tests => 17;
+
+ eval q!use XMLRPC::Lite on_fault => sub{ref $_[1] ? $_[1] : new XMLRPC::SOM}; 1! or die;
+
+ print "Perl XMLRPC server test(s)...\n";
+
+ $s = XMLRPC::Lite
+ -> proxy($proxy)
+ ;
+
+ ok($s->call('My.Examples.getStateName', 1)->result eq 'Alabama');
+ ok($s->call('My.Examples.getStateNames', 1,4,6,13)->result =~ /^Alabama\s+Arkansas\s+Colorado\s+Illinois\s*$/);
+
+ $r = $s->call('My.Examples.getStateList', [1,2,3,4])->result;
+ ok(ref $r && $r->[0] eq 'Alabama');
+
+ $r = $s->call('My.Examples.getStateStruct', {item1 => 1, item2 => 4})->result;
+ ok(ref $r && $r->{item2} eq 'Arkansas');
+
+ print "dispatch_from test(s)...\n";
+ eval "use XMLRPC::Lite
+ dispatch_from => ['A', 'B'],
+ proxy => '$proxy',
+ ; 1" or die;
+
+ eval { C->c };
+ ok($@ =~ /Can't locate object method "c"/);
+
+ print "Object autobinding and XMLRPC:: prefix test(s)...\n";
+
+ eval "use XMLRPC::Lite +autodispatch =>
+ proxy => '$proxy'; 1" or die;
+
+ ok(XMLRPC::Lite->autodispatched);
+
+ # forget everything
+ XMLRPC::Lite->self(undef);
+
+ {
+ my $on_fault_was_called = 0;
+ print "Die in server method test(s)...\n";
+ my $s = XMLRPC::Lite
+ -> proxy($proxy)
+ -> on_fault(sub{$on_fault_was_called++;return})
+ ;
+ ok($s->call('My.Parameters.die_simply')->faultstring =~ /Something bad/);
+ ok($on_fault_was_called > 0);
+
+ # get Fault as hash of subelements
+ my $fault = $s->call('My.Parameters.die_with_fault');
+ ok($fault->faultcode =~ 'Server\.Custom');
+ ok($fault->faultstring eq 'Died in server method');
+ }
+
+ print "Number of parameters test(s)...\n";
+
+ $s = XMLRPC::Lite
+ -> proxy($proxy)
+ ;
+ { my @all = $s->call('My.Parameters.echo')->paramsall; ok(@all == 0) }
+ { my @all = $s->call('My.Parameters.echo', 1)->paramsall; ok(@all == 1) }
+ { my @all = $s->call('My.Parameters.echo', (1) x 10)->paramsall; ok(@all == 10) }
+
+ print "Memory refresh test(s)...\n";
+
+ # Funny test.
+ # Let's forget about ALL settings we did before with 'use XMLRPC::Lite...'
+ XMLRPC::Lite->self(undef);
+ ok(!defined XMLRPC::Lite->self);
+
+ eval "use XMLRPC::Lite
+ proxy => '$proxy'; 1" or die;
+
+ print "Global settings test(s)...\n";
+ $s = new XMLRPC::Lite;
+
+ ok($s->call('My.Examples.getStateName', 1)->result eq 'Alabama');
+
+ SOAP::Trace->import(transport =>
+ sub {$_[0]->content_type('something/wrong') if UNIVERSAL::isa($_[0] => 'HTTP::Request')}
+ );
+
+ if ($proxy =~ /^tcp:/) {
+ skip('No Content-Type checks for tcp: protocol on server side' => undef);
+ } else {
+ ok($s->call('My.Examples.getStateName', 1)->faultstring =~ /Content-Type must be/);
+ }
+
+ # check status for fault messages
+ if ($proxy =~ /^http/) {
+ ok($s->transport->status =~ /^200/);
+ } else {
+ skip('No Status checks for non http protocols on server side' => undef);
+ }
+}
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+XMLRPC::Test - Test framework for XMLRPC::Lite
+
+=head1 SYNOPSIS
+
+ use XMLRPC::Test;
+
+ XMLRPC::Test::Server::run_for('http://localhost/cgi-bin/XMLRPC.cgi');
+
+=head1 DESCRIPTION
+
+XMLRPC::Test provides simple framework for testing server implementations.
+Specify your address (endpoint) and run provided tests against your server.
+See t/1*.t for examples.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/HTTP.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/HTTP.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/HTTP.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,196 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: HTTP.pm,v 1.2 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package XMLRPC::Transport::HTTP;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $XMLRPC::Lite::VERSION;
+
+use XMLRPC::Lite;
+use SOAP::Transport::HTTP;
+
+# ======================================================================
+
+package XMLRPC::Transport::HTTP::CGI;
+
+ at XMLRPC::Transport::HTTP::CGI::ISA = qw(SOAP::Transport::HTTP::CGI);
+
+sub initialize; *initialize = \&XMLRPC::Server::initialize;
+
+sub make_fault {
+ local $SOAP::Constants::HTTP_ON_FAULT_CODE = 200;
+ shift->SUPER::make_fault(@_);
+}
+
+sub make_response {
+ local $SOAP::Constants::DO_NOT_USE_CHARSET = 1;
+ shift->SUPER::make_response(@_);
+}
+
+# ======================================================================
+
+package XMLRPC::Transport::HTTP::Daemon;
+
+ at XMLRPC::Transport::HTTP::Daemon::ISA = qw(SOAP::Transport::HTTP::Daemon);
+
+sub initialize; *initialize = \&XMLRPC::Server::initialize;
+sub make_fault; *make_fault = \&XMLRPC::Transport::HTTP::CGI::make_fault;
+sub make_response; *make_response = \&XMLRPC::Transport::HTTP::CGI::make_response;
+
+# ======================================================================
+
+package XMLRPC::Transport::HTTP::Apache;
+
+ at XMLRPC::Transport::HTTP::Apache::ISA = qw(SOAP::Transport::HTTP::Apache);
+
+sub initialize; *initialize = \&XMLRPC::Server::initialize;
+sub make_fault; *make_fault = \&XMLRPC::Transport::HTTP::CGI::make_fault;
+sub make_response; *make_response = \&XMLRPC::Transport::HTTP::CGI::make_response;
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+XMLRPC::Transport::HTTP - Server/Client side HTTP support for XMLRPC::Lite
+
+=head1 SYNOPSIS
+
+=over 4
+
+=item Client
+
+ use XMLRPC::Lite
+ proxy => 'http://localhost/',
+ # proxy => 'http://localhost/cgi-bin/xmlrpc.cgi', # local CGI server
+ # proxy => 'http://localhost/', # local daemon server
+ # proxy => 'http://login:password@localhost/cgi-bin/xmlrpc.cgi', # local CGI server with authentication
+ ;
+
+ print getStateName(1);
+
+=item CGI server
+
+ use XMLRPC::Transport::HTTP;
+
+ my $server = XMLRPC::Transport::HTTP::CGI
+ -> dispatch_to('methodName')
+ -> handle
+ ;
+
+=item Daemon server
+
+ use XMLRPC::Transport::HTTP;
+
+ my $daemon = XMLRPC::Transport::HTTP::Daemon
+ -> new (LocalPort => 80)
+ -> dispatch_to('methodName')
+ ;
+ print "Contact to XMLRPC server at ", $daemon->url, "\n";
+ $daemon->handle;
+
+=back
+
+=head1 DESCRIPTION
+
+This class encapsulates all HTTP related logic for a XMLRPC server,
+independent of what web server it's attached to.
+If you want to use this class you should follow simple guideline
+mentioned above.
+
+=head2 PROXY SETTINGS
+
+You can use any proxy setting you use with LWP::UserAgent modules:
+
+ XMLRPC::Lite->proxy('http://endpoint.server/',
+ proxy => ['http' => 'http://my.proxy.server']);
+
+or
+
+ $xmlrpc->transport->proxy('http' => 'http://my.proxy.server');
+
+should specify proxy server for you. And if you use C<HTTP_proxy_user>
+and C<HTTP_proxy_pass> for proxy authorization SOAP::Lite should know
+how to handle it properly.
+
+=head2 COOKIE-BASED AUTHENTICATION
+
+ use HTTP::Cookies;
+
+ my $cookies = HTTP::Cookies->new(ignore_discard => 1);
+ # you may also add 'file' if you want to keep them between sessions
+
+ my $xmlrpc = XMLRPC::Lite->proxy('http://localhost/');
+ $xmlrpc->transport->cookie_jar($cookies);
+
+Cookies will be taken from response and provided for request. You may
+always add another cookie (or extract what you need after response)
+with HTTP::Cookies interface.
+
+You may also do it in one line:
+
+ $xmlrpc->proxy('http://localhost/',
+ cookie_jar => HTTP::Cookies->new(ignore_discard => 1));
+
+=head2 COMPRESSION
+
+XMLRPC::Lite provides you option for enabling compression on wire (for HTTP
+transport only). Both server and client should support this capability,
+but this logic should be absolutely transparent for your application.
+Server will respond with encoded message only if client can accept it
+(client sends Accept-Encoding with 'deflate' or '*' values) and client
+has fallback logic, so if server doesn't understand specified encoding
+(Content-Encoding: deflate) and returns proper error code
+(415 NOT ACCEPTABLE) client will repeat the same request not encoded and
+will store this server in per-session cache, so all other requests will
+go there without encoding.
+
+Having options on client and server side that let you specify threshold
+for compression you can safely enable this feature on both client and
+server side.
+
+Compression will be enabled on client side IF: threshold is specified AND
+size of current message is bigger than threshold AND module Compress::Zlib
+is available. Client will send header 'Accept-Encoding' with value 'deflate'
+if threshold is specified AND module Compress::Zlib is available.
+
+Server will accept compressed message if module Compress::Zlib is available,
+and will respond with compressed message ONLY IF: threshold is specified AND
+size of current message is bigger than threshold AND module Compress::Zlib
+is available AND header 'Accept-Encoding' is presented in request.
+
+=head1 DEPENDENCIES
+
+ Crypt::SSLeay for HTTPS/SSL
+ HTTP::Daemon for XMLRPC::Transport::HTTP::Daemon
+ Apache, Apache::Constants for XMLRPC::Transport::HTTP::Apache
+
+=head1 SEE ALSO
+
+ See ::CGI, ::Daemon and ::Apache for implementation details.
+ See examples/XMLRPC/* for examples.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/POP3.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/POP3.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/POP3.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,74 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: POP3.pm,v 1.2 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package XMLRPC::Transport::POP3;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $XMLRPC::Lite::VERSION;
+
+use XMLRPC::Lite;
+use SOAP::Transport::POP3;
+
+# ======================================================================
+
+package XMLRPC::Transport::POP3::Server;
+
+ at XMLRPC::Transport::POP3::Server::ISA = qw(SOAP::Transport::POP3::Server);
+
+sub initialize; *initialize = \&XMLRPC::Server::initialize;
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+XMLRPC::Transport::POP3 - Server side POP3 support for XMLRPC::Lite
+
+=head1 SYNOPSIS
+
+ use XMLRPC::Transport::POP3;
+
+ my $server = XMLRPC::Transport::POP3::Server
+ -> new('pop://pop.mail.server')
+ # if you want to have all in one place
+ # -> new('pop://user:password@pop.mail.server')
+ # or, if you have server that supports MD5 protected passwords
+ # -> new('pop://user:password;AUTH=+APOP@pop.mail.server')
+ # specify path to My/Examples.pm here
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ;
+ # you don't need to use next line if you specified your password in new()
+ $server->login('user' => 'password') or die "Can't authenticate to POP3 server\n";
+
+ # handle will return number of processed mails
+ # you can organize loop if you want
+ do { $server->handle } while sleep 10;
+
+ # you may also call $server->quit explicitly to purge deleted messages
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/TCP.pm
===================================================================
--- packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/TCP.pm 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/lib/XMLRPC/Transport/TCP.pm 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,64 @@
+# ======================================================================
+#
+# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger at yahoo.com)
+# SOAP::Lite is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: TCP.pm,v 1.2 2004/11/14 19:30:50 byrnereese Exp $
+#
+# ======================================================================
+
+package XMLRPC::Transport::TCP;
+
+use strict;
+use vars qw($VERSION);
+#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/);
+$VERSION = $XMLPRC::Lite::VERSION;
+
+use XMLRPC::Lite;
+use SOAP::Transport::TCP;
+
+# ======================================================================
+
+package XMLRPC::Transport::TCP::Server;
+
+ at XMLRPC::Transport::TCP::Server::ISA = qw(SOAP::Transport::TCP::Server);
+
+sub initialize; *initialize = \&XMLRPC::Server::initialize;
+
+# ======================================================================
+
+1;
+
+__END__
+
+=head1 NAME
+
+XMLRPC::Transport::TCP - Server/Client side TCP support for XMLRPC::Lite
+
+=head1 SYNOPSIS
+
+ use XMLRPC::Transport::TCP;
+
+ my $daemon = XMLRPC::Transport::TCP::Server
+ -> new (LocalAddr => 'localhost', LocalPort => 82, Listen => 5, Reuse => 1)
+ -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
+ -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
+ ;
+ print "Contact to XMLRPC server at ", join(':', $daemon->sockhost, $daemon->sockport), "\n";
+ $daemon->handle;
+
+=head1 DESCRIPTION
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger at yahoo.com)
+
+=cut
Added: packages/soap-lite/branches/upstream/current/t/01-core.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/01-core.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/01-core.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,277 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+BEGIN { plan tests => 35; }
+
+use SOAP::Lite;
+
+my($a, $s, $r, $serialized, $deserialized);
+
+{ # check 'use ...'
+ print "'use SOAP::Lite ...' test(s)...\n";
+ eval 'use SOAP::Lite 99.99'; # hm, definitely should fail
+ ok($@ =~ /99\.99 required/);
+}
+
+{ # check use of use_prefix and uri together
+ # test 2 - turn OFF default namespace
+ $SIG{__WARN__} = sub { ; }; # turn off deprecation warnings
+ $serialized = SOAP::Serializer->use_prefix(1)->uri("urn:Test")->method(
+ 'testMethod', SOAP::Data->name(test => 123)
+ );
+ ok($serialized =~ m!<soap:Body><namesp(\d):testMethod xmlns:namesp\1="urn:Test"><test xsi:type="xsd:int">123</test></namesp\1:testMethod></soap:Body>!);
+
+ # test 3 - turn ON default namespace
+ $serialized = SOAP::Serializer->use_prefix(0)->uri("urn:Test")->method(
+ 'testMethod', SOAP::Data->name(test => 123)
+ );
+ ok($serialized =~ m!<soap:Envelope(?: xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"| soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"){5}><soap:Body><testMethod xmlns="urn:Test"><test xsi:type="xsd:int">123</test></testMethod></soap:Body></soap:Envelope>!);
+
+}
+
+{ # check use of default_ns, ns, and use_prefix
+ $serialized = SOAP::Serializer->ns("urn:Test")->method(
+ 'testMethod', SOAP::Data->name(test => 123)
+ );
+ ok($serialized =~ m!<namesp(\d):testMethod xmlns:namesp\1="urn:Test"><test xsi:type="xsd:int">123</test></namesp\1:testMethod>!);
+
+ $serialized = SOAP::Serializer->ns("urn:Test","testns")->method(
+ 'testMethod', SOAP::Data->name(test => 123)
+ );
+ ok($serialized =~ m!<testns:testMethod xmlns:testns="urn:Test"><test xsi:type="xsd:int">123</test></testns:testMethod>!);
+
+ $serialized = SOAP::Serializer->default_ns("urn:Test")->method(
+ 'testMethod', SOAP::Data->name(test => 123)
+ );
+ ok($serialized =~ m!<soap:Body><testMethod xmlns="urn:Test"><test xsi:type="xsd:int">123</test></testMethod></soap:Body>!);
+
+
+
+}
+
+{ # check serialization
+ print "Arrays, structs, refs serialization test(s)...\n";
+ $serialized = SOAP::Serializer->serialize(
+ SOAP::Data->name(test => \SOAP::Data->value(1, [1,2], {a=>3}, \4))
+ );
+ ok($serialized =~ m!<test(?: xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){4}><c-gensym(\d+) xsi:type="xsd:int">1</c-gensym\1><soapenc:Array(?: xsi:type="soapenc:Array"| soapenc:arrayType="xsd:int\[2\]"){2}><item xsi:type="xsd:int">1</item><item xsi:type="xsd:int">2</item></soapenc:Array><c-gensym(\d+)><a xsi:type="xsd:int">3</a></c-gensym\2><c-gensym(\d+)><c-gensym(\d+) xsi:type="xsd:int">4</c-gensym\4></c-gensym\3></test>!);
+
+}
+
+{ # check simple circular references
+ print "Simple circular references (\$a=\\\$a) serialization test(s)...\n";
+
+ $a = \$a;
+ $serialized = SOAP::Serializer->namespaces({})->serialize($a);
+
+ ok($serialized =~ m!<c-gensym(\d+) id="ref-(\w+)"><c-gensym(\d+) href="#ref-\2" /></c-gensym\1>!);
+
+ $a = SOAP::Deserializer->deserialize($serialized)->root;
+ ok(0+$a == 0+(values%$a)[0]);
+}
+
+{ # check complex circular references
+ print "Complex circlular references serialization test(s)...\n";
+
+ $a = SOAP::Deserializer->deserialize(<<'EOX')->root;
+<root xmlns="urn:Foo">
+ <a id="id1">
+ <x>1</x>
+ <next id="id2">
+ <x>7</x>
+ <next href="#id3" />
+ </next>
+ </a>
+ <item id="id3">
+ <x>8</x>
+ <next href="#id1" />
+ </item>
+</root>
+EOX
+
+ ok($a->{a}->{next}->{next}->{next}->{next}->{x} ==
+ $a->{a}->{next}->{x});
+
+ $a = { a => 1 }; my $b = { b => $a }; $a->{a} = $b;
+ $serialized = SOAP::Serializer->autotype(0)->namespaces({})->serialize($a);
+
+ ok($serialized =~ m!<c-gensym(\d+) id="ref-(\w+)"><a id="ref-\w+"><b href="#ref-\2" /></a></c-gensym\1>!);
+}
+
+{ # check multirefs
+ print "Multireferences serialization test(s)...\n";
+
+ $a = 1; my $b = \$a;
+
+ $serialized = SOAP::Serializer->new(multirefinplace=>1)->serialize(
+ SOAP::Data->name(test => \SOAP::Data->value($b, $b))
+ );
+
+ ok($serialized =~ m!<test(?: xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){4}><c-gensym(\d+) id="ref-(\w+)"><c-gensym(\d+) xsi:type="xsd:int">1</c-gensym\3></c-gensym\1><c-gensym\d+ href="#ref-\2" /></test>!);
+
+ $serialized = SOAP::Serializer->namespaces({})->serialize(
+ SOAP::Data->name(test => \SOAP::Data->value($b, $b))
+ );
+
+ ok($serialized =~ m!<c-gensym\d+ href="#ref-(\w+)" /><c-gensym\d+ href="#ref-\1" /><c-gensym(\d+) id="ref-\1"><c-gensym(\d+) xsi:type="xsd:int">1</c-gensym\3></c-gensym\2>!);
+}
+
+{ # check base64, XML encoding of elements and attributes
+ print "base64, XML encoding of elements and attributes test(s)...\n";
+
+ $serialized = SOAP::Serializer->serialize(
+ SOAP::Data->name(test => \SOAP::Data->value("\0\1\2\3 \4\5\6", "<123>&\015</123>"))
+ );
+
+ ok($serialized =~ m!<c-gensym(\d+) xsi:type="xsd:base64Binary">AAECAyAgIAQFBg==</c-gensym\1><c-gensym(\d+) xsi:type="xsd:string"><123>&amp;
</123></c-gensym\2>!);
+
+ $serialized = SOAP::Serializer->namespaces({})->serialize(
+ SOAP::Data->name(name=>'value')->attr({attr => '<123>"&"</123>'})
+ );
+
+ ok($serialized =~ m!^<\?xml version="1.0" encoding="UTF-8"\?><name(?: xsi:type="xsd:string"| attr="<123>"&amp"</123>"){2}>value</name>$!);
+}
+
+{ # check objects and SOAP::Data
+ print "Blessed references and SOAP::Data encoding test(s)...\n";
+
+ $serialized = SOAP::Serializer->serialize(SOAP::Data->uri('some_urn' => bless {a => 1} => 'ObjectType'));
+
+ ok($serialized =~ m!<namesp(\d+):c-gensym(\d+)(:? xsi:type="namesp\d+:ObjectType"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl"| xmlns:namesp\1="some_urn"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){7}><a xsi:type="xsd:int">1</a></namesp\1:c-gensym\2>!);
+}
+
+{ # check serialization/deserialization of simple types
+ print "Serialization/deserialization of simple types test(s)...\n";
+
+ $a = 'abc234xyz';
+
+ $serialized = SOAP::Serializer->serialize(SOAP::Data->type(hex => $a));
+
+ ok($serialized =~ m!<c-gensym(\d+)(?: xsi:type="xsd:hexBinary"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){5}>61626332333478797A</c-gensym(\d+)>!);
+ ok(SOAP::Deserializer->deserialize($serialized)->root eq $a);
+
+ $a = <<"EOBASE64";
+qwertyuiop[]asdfghjkl;'zxcvbnm,./QWERTYUIOP{}ASDFGHJKL:"ZXCVBNM<>?`1234567890-=\~!@#$%^&*()_+|
+EOBASE64
+
+ $serialized = SOAP::Serializer->serialize($a);
+
+ ok(index($serialized, quotemeta(q!qwertyuiop[]asdfghjkl;'zxcvbnm,./QWERTYUIOP{}ASDFGHJKL:"ZXCVBNM<>?`1234567890-=~\!@#0^&*()_+|!)));
+
+ if (UNIVERSAL::isa(SOAP::Deserializer->parser->parser => 'XML::Parser::Lite')) {
+ skip(q!Entity decoding is not supported in XML::Parser::Lite! => undef);
+ } else {
+ ok(SOAP::Deserializer->deserialize($serialized)->root eq $a);
+ }
+
+ $a = <<"EOBASE64";
+
+qwertyuiop[]asdfghjkl;'zxcvbnm,./
+QWERTYUIOP{}ASDFGHJKL:"ZXCVBNM<>?
+\x00
+
+EOBASE64
+
+ $serialized = SOAP::Serializer->serialize($a);
+
+ ok($serialized =~ /base64/);
+}
+
+{ # check serialization/deserialization of blessed reference
+ print "Serialization/deserialization of blessed reference test(s)...\n";
+
+ $serialized = SOAP::Serializer->serialize(bless {a => 1} => 'SOAP::Lite');
+ $a = SOAP::Deserializer->deserialize($serialized)->root;
+
+ ok(ref $a eq 'SOAP::Lite' && UNIVERSAL::isa($a => 'HASH'));
+
+ $a = SOAP::Deserializer->deserialize(
+ SOAP::Serializer->serialize(bless [a => 1] => 'SOAP::Lite')
+ )->root;
+
+ ok(ref $a eq 'SOAP::Lite' && UNIVERSAL::isa($a => 'ARRAY'));
+}
+
+{ # check serialization/deserialization of undef/empty elements
+ print "Serialization/deserialization of undef/empty elements test(s)...\n";
+
+ { local $^W; # suppress warnings
+ $a = undef;
+ $serialized = SOAP::Serializer->serialize(
+ SOAP::Data->type(negativeInteger => $a)
+ );
+
+ ok(! defined SOAP::Deserializer->deserialize($serialized)->root);
+
+ my $type = 'nonstandardtype';
+ eval {
+ $serialized = SOAP::Serializer->serialize(
+ SOAP::Data->type($type => $a)
+ );
+ };
+ ok($@ =~ /for type '$type' is not specified/);
+
+ $serialized = SOAP::Serializer->serialize(
+ SOAP::Data->type($type => {})
+ );
+
+ ok(ref SOAP::Deserializer->deserialize($serialized)->root eq $type);
+ }
+}
+
+{
+ print "Check for unspecified Transport module test(s)...\n";
+
+ eval { SOAP::Lite->new->abc() };
+ ok($@ =~ /A service address has not been specified/);
+}
+
+{
+ print "Deserialization of CDATA test(s)...\n";
+
+ UNIVERSAL::isa(SOAP::Deserializer->parser->parser => 'XML::Parser::Lite') ?
+ skip(q!CDATA decoding is not supported in XML::Parser::Lite! => undef) :
+ ok(SOAP::Deserializer->deserialize('<root><![CDATA[<123>]]></root>')->root eq '<123>');
+}
+
+{
+ print "Test of XML::Parser External Entity vulnerability...\n";
+ UNIVERSAL::isa(SOAP::Deserializer->parser->parser => 'XML::Parser::Lite') ?
+ skip(q!External entity references are not supported in XML::Parser::Lite! => undef) :
+ ok(!eval { SOAP::Deserializer->deserialize('<?xml version="1.0"?><!DOCTYPE foo [ <!ENTITY ll SYSTEM "foo.txt"> ]><root>≪</root>')->root } and $@ =~ /^External entity/);
+}
+
+{
+ print "Test SOAP:: prefix with no +autodispatch option...\n";
+ eval { A->SOAP::b };
+ ok($@ =~ /^SOAP:: prefix/);
+}
+
+{
+ # check deserialization of an array of multiple elements
+ # nested within a complex type
+ print "Deserialization of doc/lit arrays nested in complex types...\n";
+ my $input = '<?xml version="1.0" encoding="utf-8"?><soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"><soap:Body><getFooResponse xmlns="http://example.com/v1"><getFooReturn><id>100</id><complexFoo><arrayFoo>one</arrayFoo><arrayFoo>two</arrayFoo></complexFoo></getFooReturn></getFooResponse></soap:Body></soap:Envelope>';
+ my $deserializer = SOAP::Deserializer->new;
+ my $ret = $deserializer->deserialize($input);
+ my @arr = @{$ret->result->{'complexFoo'}{'arrayFoo'}};
+ ok($#arr == 1);
+ ok("one" eq $arr[0]);
+ ok("two" eq $arr[1]);
+
+ ok(100 == $ret->result->{"id"});
+
+ # If only one araryFoo tag is found, it's deserialized as a scalar.
+ $input = '<?xml version="1.0" encoding="utf-8"?><soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"><soap:Body><getFooResponse xmlns="http://example.com/v1"><getFooReturn><id>100</id><complexFoo><arrayFoo>one</arrayFoo></complexFoo></getFooReturn></getFooResponse></soap:Body></soap:Envelope>';
+ $ret = $deserializer->deserialize($input);
+ ok("one" eq $ret->result->{'complexFoo'}{'arrayFoo'});
+}
Added: packages/soap-lite/branches/upstream/current/t/02-payload.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/02-payload.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/02-payload.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,765 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+BEGIN { plan tests => 125 }
+
+use SOAP::Lite;
+$SIG{__WARN__} = sub { ; }; # turn off deprecation warnings
+
+my($a, $s, $r, $serialized, $deserialized);
+
+{ # check root, mustUnderstand
+ print "root and mustUnderstand attributes with SOAP::Data test(s)...\n";
+
+ $serialized = SOAP::Serializer->serialize(SOAP::Data->root(1 => 1)->name('rootandunderstand')->mustUnderstand(1));
+
+ ok($serialized =~ m!<rootandunderstand( xsi:type="xsd:int"| soap:mustUnderstand="1"| soapenc:root="1"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){7}>1</rootandunderstand>!);
+}
+
+{ # check deserialization of envelope with result
+ print "Deserialization of envelope with result test(s)...\n";
+
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?>
+<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsd="http://www.w3.org/2001/XMLSchema"
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<soap:Body>
+<m:doublerResponse xmlns:m="http://simon.fell.com/calc">
+<nums xsi:type="soapenc:Array" soapenc:arrayType="xsd:int[5]">
+<item xsi:type="xsd:int">20</item>
+<item xsi:type="xsd:int">40</item>
+<item xsi:type="xsd:int">60</item>
+<item xsi:type="xsd:int">100</item>
+<item xsi:type="xsd:int">200</item>
+</nums>
+</m:doublerResponse>
+</soap:Body>
+</soap:Envelope>
+');
+
+ ok($deserialized->result->[2] == 60);
+ ok((my @array = $deserialized->paramsall) == 1);
+ ok(ref $deserialized->body eq 'HASH'); # not blessed anymore since 0.51
+}
+
+{ # check deserialization of envelope with fault
+ print "Deserialization of envelope with fault test(s)...\n";
+
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?>
+<soap:Envelope xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
+<soap:Body>
+<soap:Fault><faultcode>soap:Client</faultcode><faultstring>Application Error</faultstring><detail>Invalid Password</detail></soap:Fault></soap:Body></soap:Envelope>
+');
+
+ ok($deserialized->faultcode eq 'soap:Client');
+ ok($deserialized->faultstring eq 'Application Error');
+ ok($deserialized->faultdetail eq 'Invalid Password');
+}
+
+{ # check deserialization of circular references
+ print "Deserialization of circular references test(s)...\n";
+
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?>
+<Struct prefix:id="123" xmlns:prefix="aaa" id="ref-0xb61350"><a id="ref-0xb61374"><b href="#ref-0xb61350"/></a></Struct>
+');
+
+ ok(ref $deserialized->valueof('/Struct') eq ref $deserialized->valueof('//b'));
+
+ ok($deserialized->dataof('/Struct')->attr->{'{aaa}id'} == 123);
+ ok(exists $deserialized->dataof('/Struct')->attr->{'id'});
+}
+
+{ # check SOAP::SOM
+ print "SOM test(s)...\n";
+
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?>
+<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<soap:Body>
+<m:doublerResponse xmlns:m="http://simon.fell.com/calc">
+<nums>
+<item1 xsi:type="xsd:int">20</item1>
+<item1 xsi:type="xsd:int">40</item1>
+<item2 xsi:type="xsd:int">60</item2>
+<item2 xsi:type="xsd:int">100</item2>
+<item3 xsi:type="xsd:int">200</item3>
+</nums>
+</m:doublerResponse>
+</soap:Body>
+</soap:Envelope>
+');
+
+ # should return STRING '/Envelope/Body/[1]/[1]'
+ my $result = SOAP::SOM::result;
+ ok($deserialized->valueof("$result/[1]") == 20);
+ ok($deserialized->valueof("$result/[3]") == 60);
+ ok($deserialized->valueof("$result/[5]") == 200);
+
+ # match should return true/false in boolean context (and object ref otherwise)
+ ok($deserialized->match('aaa') ? 0 : 1);
+
+ # should return same string as above
+ ok($deserialized->match(SOAP::SOM->result));
+
+ ok($deserialized->valueof('[1]') == 20);
+ ok($deserialized->valueof('[3]') == 60);
+ ok($deserialized->valueof('[5]') == 200);
+
+ $deserialized->match('//Body/[1]/[1]'); # match path and change current node on success
+ ok($deserialized->valueof('[1]') == 20);
+ ok($deserialized->valueof('[3]') == 60);
+ ok($deserialized->valueof('[5]') == 200);
+}
+
+{ # check output parameters
+ print "Output parameters test(s)...\n";
+
+ $deserialized = SOAP::Deserializer->deserialize('
+<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<soap:Body>
+ <mehodResponse>
+ <res1>name1</res1>
+ <res2>name2</res2>
+ <res3>name3</res3>
+ </mehodResponse>
+</soap:Body>
+</soap:Envelope>
+');
+ my @paramsout = $deserialized->paramsout;
+
+ ok($paramsout[0] eq 'name2' && $paramsout[1] eq 'name3');
+}
+
+{ # check nonqualified namespace
+ print "Nonqualified namespace test(s)...\n";
+
+ $deserialized = SOAP::Deserializer->deserialize('
+<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<soap:Body>
+<doublerResponse xmlns="http://simon.fell.com/calc">
+<nums xsi:type="soapenc:Array" soapenc:arrayType="xsd:int[5]">
+<item xsi:type="xsd:int">20</item>
+<item xsi:type="xsd:int">40</item>
+<item xsi:type="xsd:int">60</item>
+<item xsi:type="xsd:int">100</item>
+<item xsi:type="xsd:int">200</item>
+</nums>
+</doublerResponse>
+</soap:Body>
+</soap:Envelope>
+');
+
+ ok($deserialized->namespaceuriof(SOAP::SOM::method) eq 'http://simon.fell.com/calc');
+ ok($deserialized->namespaceuriof('//doublerResponse') eq 'http://simon.fell.com/calc');
+}
+
+{ # check for Array of Array serialization
+ print "Array of Array serialization test(s)...\n";
+
+ $serialized = SOAP::Serializer
+ ->readable(1)
+ ->method('mymethod' => [[1, 2], [3, 4]]);
+ ok($serialized =~ m!soapenc:arrayType="soapenc:Array\[2\]"!);
+}
+
+{ # check for serialization with SOAPStruct
+ print "Serialization w/out SOAPStruct test(s)...\n";
+ $a = { a => 1 };
+ $serialized = SOAP::Serializer->namespaces({})->serialize($a);
+ ok($serialized =~ m!<c-gensym(\d+)><a xsi:type="xsd:int">1</a></c-gensym\1>!);
+}
+
+{ # check header/envelope serialization/deserialization
+ print "Header/Envelope serialization/deserialization test(s)...\n";
+
+ $serialized = SOAP::Serializer->method( # same as ->envelope(method =>
+ 'mymethod', 1, 2, 3,
+ SOAP::Header->name(t1 => 5)->mustUnderstand(1)->uri('http://namespaces.soaplite.com/headers'),
+ SOAP::Header->name(t2 => 7)->mustUnderstand(2),
+ );
+ $deserialized = SOAP::Deserializer->deserialize($serialized);
+
+ my $t1 = $deserialized->match(SOAP::SOM::header)->headerof('t1');
+ my $t2 = $deserialized->dataof('t2');
+ my $t3 = eval { $deserialized->headerof(SOAP::SOM::header . '/{http://namespaces.soaplite.com/headers}t3'); };
+
+ ok(!$@ && !defined $t3);
+
+ my @paramsin = $deserialized->paramsin;
+ my @paramsall = $deserialized->paramsall;
+
+ ok($t2->type =~ /^int$/);
+ ok($t2->mustUnderstand == 1);
+ ok(@paramsin == 3);
+ ok(@paramsall == 3);
+
+ eval { $deserialized->result(1) };
+ ok($@ =~ /Method 'result' is readonly/);
+
+ $serialized = SOAP::Serializer->method( # same as ->envelope(method =>
+ SOAP::Data->name('mymethod')->attr({something => 'value'}), 1, 2, 3,
+ );
+ ok($serialized =~ /<mymethod something="value">/);
+
+ $serialized = SOAP::Serializer
+ -> envprefix('')
+ -> method('mymethod');
+
+ ok($serialized =~ m!<Envelope(?: xmlns:namesp\d+="http://schemas.xmlsoap.org/soap/envelope/"| namesp\d+:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){5}><Body><mymethod xsi:nil="true" /></Body></Envelope>!);
+
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0" encoding="UTF-8"?><soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><soap:Body><getStateName><c-gensym5 xsi:type="xsd:int">1</c-gensym5></getStateName></soap:Body></soap:Envelope>');
+ ok(! defined $deserialized->namespaceuriof('//getStateName'));
+
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0" encoding="UTF-8"?><soap:Envelope xmlns="a" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/1999/XMLSchema"><soap:Body><getStateName><c-gensym5 xsi:type="xsd:int">1</c-gensym5></getStateName></soap:Body></soap:Envelope>');
+ ok($deserialized->namespaceuriof('//getStateName') eq 'a');
+}
+
+# TODO - These tests are failing at line 243 because of the odd $key value
+{ # Map type serialization/deserialization
+ print "Map type serialization/deserialization test(s)...\n";
+
+ my $key = "\0\1";
+ $serialized = SOAP::Serializer->method(aa => SOAP::Data->type(map => {a => 123, $key => 456})->name('maaap'));
+
+ { local $^W; # disable warning on implicit map encoding
+ my $implicit = SOAP::Serializer->method(aa => SOAP::Data->name(maaap => {a => 123, $key => 456}));
+ ok($implicit eq $serialized);
+ }
+ ok($serialized =~ /apachens:Map/);
+ ok($serialized =~ m!xmlns:apachens="http://xml.apache.org/xml-soap"!);
+
+ $deserialized = SOAP::Deserializer->deserialize($serialized);
+ $a = $deserialized->valueof('//maaap');
+ ok(UNIVERSAL::isa($a => 'HASH'));
+ ok(ref $a && $a->{$key} == 456);
+}
+
+{ # Stringified type serialization
+ print "Stringified type serialization test(s)...\n";
+
+ $serialized = SOAP::Serializer->serialize(bless { a => 1, _current => [] } => 'SOAP::SOM');
+
+ ok($serialized =~ m!<SOAP__SOM(?: xsi:type="namesp(\d+):SOAP__SOM"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){6}><a xsi:type="xsd:int">1</a><_current(?: soapenc:arrayType="xsd:anyType\[0\]"| xsi:type="soapenc:Array"){2} /></SOAP__SOM>!);
+
+ $serialized =~ s/__/./g; # check for SOAP.SOM instead of SOAP__SOM
+ ok(ref SOAP::Deserializer->deserialize($serialized)->root eq 'SOAP::SOM');
+}
+
+{ # Serialization of non-allowed element
+ print "Serialization of non-allowed element test(s)...\n";
+
+ eval { $serialized = SOAP::Serializer->serialize(SOAP::Data->name('---' => 'aaa')) };
+
+ ok($@ =~ /^Element/);
+}
+
+{ # Custom serialization of blessed reference
+ print "Custom serialization of blessed reference test(s)...\n";
+
+ eval q!
+ sub SOAP::Serializer::as_My__Own__Class {
+ my $self = shift;
+ my($value, $name, $type, $attr) = @_;
+ return [$name, {%{$attr || {}}, 'xsi:type' => 'xsd:string'}, join ', ', map {"$_ => $value->{$_}"} sort keys %$value];
+ }
+ 1;
+ ! or die;
+
+ $serialized = SOAP::Serializer->serialize(bless {a => 1, b => 2} => 'My::Own::Class');
+ ok($serialized =~ m!<My__Own__Class( xsi:type="xsd:string"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){5}>a => 1, b => 2</My__Own__Class>!);
+}
+
+{ # Multirefs serialization
+ print "Multirefs serialization test(s)...\n";
+
+ my $b = { b => 2 };
+ my $a = { a => $b };
+ my $c = { c1 => $a, c2 => $a };
+
+ $serialized = SOAP::Serializer->autotype(0)->method(a => $c);
+ ok($serialized =~ m!<soap:Body><a><c-gensym(\d+)><c1 href="#ref-(\d+)" /><c2 href="#ref-\2" /></c-gensym\1></a><c-gensym(\d+) id="ref-(\d+)"><b>2</b></c-gensym\3><c-gensym(\d+) id="ref-\2"><a href="#ref-\4" /></c-gensym\5></soap:Body>! ||
+ $serialized =~ m!<soap:Body><a><c-gensym(\d+)><c1 href="#ref-(\d+)" /><c2 href="#ref-\2" /></c-gensym\1></a><c-gensym(\d+) id="ref-\2"><a href="#ref-(\d+)" /></c-gensym\3><c-gensym(\d+) id="ref-\4"><b>2</b></c-gensym\5></soap:Body>! ||
+ $serialized =~ m!<soap:Body><a><c-gensym(\d+)><c2 href="#ref-(\d+)" /><c1 href="#ref-\2" /></c-gensym\1></a><c-gensym(\d+) id="ref-(\d+)"><b>2</b></c-gensym\3><c-gensym(\d+) id="ref-\2"><a href="#ref-\4" /></c-gensym\5></soap:Body>! ||
+ $serialized =~ m!<soap:Body><a><c-gensym(\d+)><c2 href="#ref-(\d+)" /><c1 href="#ref-\2" /></c-gensym\1></a><c-gensym(\d+) id="ref-\2"><a href="#ref-(\d+)" /></c-gensym\3><c-gensym(\d+) id="ref-\4"><b>2</b></c-gensym\5></soap:Body>!);
+
+ $serialized = SOAP::Serializer->autotype(0)->namespaces({})->serialize($c);
+ ok($serialized =~ m!<c-gensym(\d+)><c1 href="#ref-(\d+)" /><c2 href="#ref-\2" /><c-gensym(\d+) id="ref-(\d+)"><b>2</b></c-gensym\3><c-gensym(\d+) id="ref-\2"><a href="#ref-\4" /></c-gensym\5></c-gensym\1>! ||
+ $serialized =~ m!<c-gensym(\d+)><c1 href="#ref-(\d+)" /><c2 href="#ref-\2" /><c-gensym(\d+) id="ref-\2"><a href="#ref-(\d+)" /></c-gensym\3><c-gensym(\d+) id="ref-\4"><b>2</b></c-gensym\5></c-gensym\1>! ||
+ $serialized =~ m!<c-gensym(\d+)><c2 href="#ref-(\d+)" /><c1 href="#ref-\2" /><c-gensym(\d+) id="ref-(\d+)"><b>2</b></c-gensym\3><c-gensym(\d+) id="ref-\2"><a href="#ref-\4" /></c-gensym\5></c-gensym\1>! ||
+ $serialized =~ m!<c-gensym(\d+)><c2 href="#ref-(\d+)" /><c1 href="#ref-\2" /><c-gensym(\d+) id="ref-\2"><a href="#ref-(\d+)" /></c-gensym\3><c-gensym(\d+) id="ref-\4"><b>2</b></c-gensym\5></c-gensym\1>!);
+
+ my $root = SOAP::Deserializer->deserialize($serialized)->root;
+
+ ok($root->{c1}->{a}->{b} == 2);
+ ok($root->{c2}->{a}->{b} == 2);
+}
+
+{ # Serialization of multirefs shared between Header and Body
+ print "Serialization of multirefs shared between Header and Body test(s)...\n";
+
+ $a = { b => 2 };
+
+ $serialized = SOAP::Serializer->autotype(0)->method(a => SOAP::Header->value($a), $a);
+ ok($serialized =~ m!<soap:Header><c-gensym\d+ href="#ref-(\d+)" /></soap:Header><soap:Body><a><c-gensym\d+ href="#ref-\1" /></a><c-gensym(\d+) id="ref-\1"><b>2</b></c-gensym\2></soap:Body>!);
+}
+
+{ # Deserialization with typecast
+ print "Deserialization with typecast test(s)...\n";
+
+ my $desc = 0;
+ my $typecasts = 0;
+ eval {
+ package MyDeserializer;
+ @MyDeserializer::ISA = 'SOAP::Deserializer';
+ sub typecast;
+ *typecast = sub { shift;
+ my($value, $name, $attrs, $children, $type) = @_;
+ $desc = "$name @{[scalar @$children]}" if $name eq 'a';
+ $typecasts++;
+ return;
+ };
+ 1;
+ } or die;
+
+ $deserialized = MyDeserializer->deserialize('<a><b>1</b><c>2</c></a>');
+ ok($desc eq 'a 2'); #! fix "if $name eq 'a'", because $name is QName now ('{}a')
+ ok($typecasts == 5);
+}
+
+{ # Deserialization with wrong encodingStyle
+ print "Deserialization with wrong encodingStyle test(s)...\n";
+
+ eval { $deserialized = SOAP::Deserializer->deserialize(
+'<a
+ soap:encodingStyle="http://schemas.microsoft.com/soap/encoding/clr/1.0 http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+>1</a>') };
+ ok(!$@ && $deserialized);
+
+ eval { $deserialized = SOAP::Deserializer->deserialize(
+'<a
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+>1</a>') };
+ ok(!$@ && $deserialized);
+
+ eval { $deserialized = SOAP::Deserializer->deserialize(
+'<a
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/something"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+>1</a>') };
+ ok(!$@ && $deserialized);
+
+ eval { $deserialized = SOAP::Deserializer->deserialize(
+'<a>1</a>') };
+ ok(!$@ && $deserialized);
+
+ eval { $deserialized = SOAP::Deserializer->deserialize(
+'<a
+ soap:encodingStyle=""
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+>1</a>') };
+ ok(!$@ && $deserialized);
+}
+
+{ # Deserialization with root attribute
+ print "Deserialization with root attribute test(s)...\n";
+
+ # root="0", should skip
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?>
+<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<soap:Body>
+<m:doublerResponse1 soapenc:root="0" xmlns:m="http://soaplite.com/">
+<nums>1</nums>
+</m:doublerResponse1>
+<m:doublerResponse2 xmlns:m="http://soaplite.com/">
+<nums>2</nums>
+</m:doublerResponse2>
+</soap:Body>
+</soap:Envelope>
+');
+
+ ok($deserialized->result == 2);
+
+ # root="0", but in wrong namespace
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?>
+<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<soap:Body>
+<m:doublerResponse1 root="0" xmlns:m="http://soaplite.com/">
+<nums>1</nums>
+</m:doublerResponse1>
+<m:doublerResponse2 xmlns:m="http://soaplite.com/">
+<nums>2</nums>
+</m:doublerResponse2>
+</soap:Body>
+</soap:Envelope>
+');
+
+ ok($deserialized->result == 1);
+
+ # root="1"
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?>
+<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<soap:Body>
+<m:doublerResponse1 soapenc:root="1" xmlns:m="http://soaplite.com/">
+<nums>1</nums>
+</m:doublerResponse1>
+<m:doublerResponse2 xmlns:m="http://www.soaplite.com/2">
+<nums>2</nums>
+</m:doublerResponse2>
+<m:doublerResponse2 xmlns:m="http://www.soaplite.com/3">
+<nums>3</nums>
+</m:doublerResponse2>
+<doublerResponse2 xmlns="">
+<nums>4</nums>
+</doublerResponse2>
+</soap:Body>
+</soap:Envelope>
+');
+
+ ok($deserialized->result == 1);
+ ok($deserialized->valueof('//{http://www.soaplite.com/2}doublerResponse2/nums') == 2);
+ ok($deserialized->valueof('//{http://www.soaplite.com/3}doublerResponse2/nums') == 3);
+ ok($deserialized->valueof('//{}doublerResponse2/nums') == 4);
+ my @nums = $deserialized->valueof('//doublerResponse2/nums');
+ ok(@nums == 3);
+ ok($nums[0] == 2 && $nums[1] == 3);
+ my $body = $deserialized->body;
+ ok(ref $body->{doublerResponse1} && ref $body->{doublerResponse2});
+}
+
+{
+ print "Deserialization with null elements test(s)...\n";
+
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?>
+<soap:Envelope xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
+<soap:Body>
+<namesp23:object_infoResponse xmlns:namesp23="http://localhost/Test">
+<soapenc:Array xsi:type="soapenc:Array" soapenc:arrayType="xsd:integer[]">
+<item xsi:type="xsd:string">1</item>
+<item xsi:type="xsd:string">2</item>
+<item xsi:null="1"/>
+<item xsi:null="1"/>
+<item xsi:type="xsd:string">5</item>
+<item xsi:type="xsd:string"/>
+<item xsi:type="xsd:string">7</item>
+</soapenc:Array>
+</namesp23:object_infoResponse>
+</soap:Body>
+</soap:Envelope>
+')->result;
+
+ ok(scalar @$deserialized == 7);
+ ok(! defined $deserialized->[2]);
+ ok(! defined $deserialized->[3]);
+ ok($deserialized->[5] eq '');
+}
+
+{
+ print "Serialization of list with undef elements test(s)...\n";
+
+ $serialized = SOAP::Serializer->method(a => undef, 1, undef, 2);
+ my(@r) = SOAP::Deserializer->deserialize($serialized)->paramsall;
+
+ ok(2 == grep {!defined} @r);
+}
+
+{
+ print "Deserialization with xsi:type='string' test(s)...\n";
+
+ $a = 'SOAP::Lite';
+ $deserialized = SOAP::Deserializer->deserialize(qq!<inputString xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="string" xmlns="http://schemas.xmlsoap.org/soap/encoding/">$a</inputString>!)->root;
+
+ ok($deserialized eq $a);
+}
+
+{
+ print "Deserialization with typing inherited from Array element test(s)...\n";
+
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?>
+<soapenc:Array xsi:type="soapenc:Array" soapenc:arrayType="soapenc:base64[]" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
+<item xsi:type="xsd:string">MTIz</item>
+<item>MTIz</item>
+<item xsi:type="xsd:string"/>
+</soapenc:Array>')->root;
+
+ ok(scalar @$deserialized == 3);
+ ok($deserialized->[0] eq 'MTIz');
+ ok($deserialized->[1] eq 123);
+ ok($deserialized->[2] eq '');
+}
+
+{
+ print "Serialization with explicit typing test(s)...\n";
+
+ $serialized = SOAP::Serializer
+ ->method(a => SOAP::Data->name('return')->type(int => 1));
+ ok($serialized =~ /xsd:int/);
+
+ eval {
+ $serialized = SOAP::Serializer
+ ->method(a => SOAP::Data->name('return')->type(noint => 1));
+ };
+ ok($@ =~ /for type 'noint' is not specified/);
+}
+
+{
+ print "Serialization with explicit namespaces test(s)...\n";
+
+ $serialized = SOAP::Serializer->serialize(SOAP::Data->name('b' => 1));
+ ok($serialized =~ m!<b !);
+
+ $serialized = SOAP::Serializer->serialize(SOAP::Data->name('c:b' => 1));
+ ok($serialized =~ m!<c:b !);
+
+ $serialized = SOAP::Serializer->serialize(SOAP::Data->name('{a}b' => 1));
+ ok($serialized =~ m!<namesp\d+:b ! && $serialized =~ m!xmlns:namesp\d+="a"!);
+
+ $serialized = SOAP::Serializer->serialize(SOAP::Data->name('{}b' => 1));
+ ok($serialized =~ m!<b ! && $serialized =~ m!xmlns=""!);
+
+ my @prefix_uri_tests = (
+ # prefix, uri, test
+ [ undef, undef, '<b>1</b>' ],
+ [ undef, '', '<b xmlns="">1</b>' ],
+ [ undef, 'a', '<(namesp\d+):b xmlns:\1="a">1</\1:b>' ],
+ [ '', undef, '<b>1</b>' ],
+ [ '', '', '<b xmlns="">1</b>' ],
+ [ '', 'a', '<b xmlns="a">1</b>' ],
+ [ 'c', undef, '<c:b>1</c:b>' ],
+ [ 'c', '', '<b xmlns="">1</b>' ],
+ [ 'c', 'a', '<c:b xmlns:c="a">1</c:b>' ],
+ );
+
+ my $serializer = SOAP::Serializer->autotype(0)->namespaces({});
+ my $deserializer = SOAP::Deserializer->new;
+ my $testnum = 0;
+ foreach (@prefix_uri_tests) {
+ $testnum++;
+ my($prefix, $uri, $test) = @$_;
+ my $res = $serializer->serialize(
+ SOAP::Data->name('b')->prefix($prefix)->uri($uri)->value(1)
+ );
+ ok($res =~ /$test/);
+ next unless $testnum =~ /^([4569])$/;
+
+ my $data = $deserializer->deserialize($res)->dataof(SOAP::SOM::root);
+ ok(defined $prefix ? defined $data->prefix && $data->prefix eq $prefix
+ : !defined $data->prefix);
+ ok(defined $uri ? defined $data->uri && $data->uri eq $uri
+ : !defined $data->uri);
+ }
+}
+
+{
+ print "Deserialization for different SOAP versions test(s)...\n";
+
+ my $version = SOAP::Lite->soapversion;
+
+ $a = q!<?xml version="1.0" encoding="UTF-8"?>
+<soap:Envelope
+ xmlns:soapenc="http://www.w3.org/2003/05/soap-encoding"
+ soap:encodingStyle="http://www.w3.org/2003/05/soap-encoding"
+ xmlns:soap="http://www.w3.org/2003/05/soap-envelope"
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xmlns:xsd="http://www.w3.org/2001/XMLSchema">
+<soap:Body>
+<namesp9:echoIntegerArray xmlns:namesp9="http://soapinterop.org/">
+<inputIntegerArray soapenc:arrayType="xsd:int[3]" xsi:type="soapenc:Array">
+<item xsi:type="xsd:int">1</item>
+<item xsi:type="xsd:int">3</item>
+<item xsi:type="xsd:int">5</item>
+</inputIntegerArray>
+</namesp9:echoIntegerArray>
+</soap:Body>
+</soap:Envelope>!;
+
+ SOAP::Lite->soapversion(1.1);
+ $deserialized = SOAP::Deserializer->deserialize($a);
+ ok(ref $deserialized->result eq 'ARRAY');
+
+ SOAP::Lite->soapversion(1.2);
+ $deserialized = SOAP::Deserializer->deserialize($a);
+ ok(ref $deserialized->result eq 'ARRAY');
+
+ SOAP::Lite->soapversion($version);
+}
+
+{
+ print "Deserialization of multidimensional array of array test(s)...\n";
+
+ $a = q!<?xml version="1.0" encoding="UTF-8"?>
+<S:Envelope S:encodingStyle='http://schemas.xmlsoap.org/soap/encoding/'
+ xmlns:S='http://schemas.xmlsoap.org/soap/envelope/'
+ xmlns:E='http://schemas.xmlsoap.org/soap/encoding/'
+ xmlns:a='http://foo.bar.org/'
+ xmlns:b='http://www.w3.org/2001/XMLSchema'
+ xmlns:c='http://www.w3.org/2001/XMLSchema-instance'>
+<S:Body><a:SomeMethod>
+<nums E:arrayType='b:anyType[2,2]'>
+<i E:arrayType='b:anyType[3]'>
+<i c:type='b:short'>1</i><i c:type='b:short'>2</i><i c:type='b:short'>3</i>
+</i>
+<i E:arrayType='b:anyType[3]'>
+<i c:type='b:short'>4</i><i c:type='b:short'>5</i><i c:type='b:short'>6</i>
+</i>
+<i E:arrayType='b:anyType[3]'>
+<i c:type='b:short'>7</i><i c:type='b:short'>8</i><i c:type='b:short'>9</i>
+</i>
+<i E:arrayType='b:anyType[3]'>
+<i c:type='b:short'>10</i><i c:type='b:short'>11</i><i c:type='b:short'>12</i>
+</i>
+</nums></a:SomeMethod></S:Body></S:Envelope>!;
+
+ $deserialized = SOAP::Deserializer->deserialize($a)->result;
+
+ # [
+ # [
+ # ['1', '2', '3'],
+ # ['4', '5', '6']
+ # ],
+ # [
+ # ['7', '8', '9'],
+ # ['10', '11', '12']
+ # ]
+ # ]
+
+ ok(ref $deserialized eq 'ARRAY');
+ ok(@$deserialized == 2);
+ ok(@{$deserialized->[0]} == 2);
+ ok(@{$deserialized->[0]->[0]} == 3);
+ ok($deserialized->[0]->[0]->[2] == 3);
+}
+
+{
+ print "Serialization without specified typemapping test(s)...\n";
+
+ $serialized = SOAP::Serializer->method(a => bless {a => 1} => 'A');
+ ok($serialized =~ m!<A xsi:type="namesp\d+:A">!);
+ ok($serialized =~ m!^<\?xml!); # xml declaration
+
+ # higly questionably, but that's how it is
+ $serialized = SOAP::Serializer->encoding(undef)->method(a => bless {a => 1} => 'A');
+ ok($serialized =~ m!<A(?: xsi:type="namesp\d+:A"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl")>!);
+ ok($serialized !~ m!^<\?xml!); # no xml declaration
+}
+
+{
+ print "Deserialization with different XML Schemas on one element test(s)...\n";
+
+ my $deserializer = SOAP::Deserializer->new;
+ $deserializer->deserialize(q!<soap:Envelope
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi1="http://www.w3.org/2001/XMLSchema-instance"
+ xmlns:xsi0="http://www.w3.org/2000/10/XMLSchema-instance"
+ xmlns:xsi9="http://www.w3.org/1999/XMLSchema-instance"
+ xmlns:xsd9="http://www.w3.org/1999/XMLSchema"
+ xmlns:xsd1="http://www.w3.org/2001/XMLSchema"
+ xmlns:xsd0="http://www.w3.org/2000/10/XMLSchema" >
+ <soap:Body>
+ <ns0:echoString xmlns:ns0="http://soapinterop.org/" >
+ <inputString xsi0:type="xsd0:string" xsi1:type="xsd1:string"
+xsi9:type="xsd9:string">Simple Test String</inputString>
+ </ns0:echoString>
+ </soap:Body>
+</soap:Envelope>!);
+
+ ok($deserializer->xmlschema eq 'http://www.w3.org/1999/XMLSchema');
+
+ $deserializer->deserialize(q!<soap:Envelope
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi1="http://www.w3.org/2001/XMLSchema-instance"
+ xmlns:xsi0="http://www.w3.org/2000/10/XMLSchema-instance"
+ xmlns:xsi9="http://www.w3.org/1999/XMLSchema-instance"
+ xmlns:xsd9="http://www.w3.org/1999/XMLSchema"
+ xmlns:xsd1="http://www.w3.org/2001/XMLSchema"
+ xmlns:xsd0="http://www.w3.org/2000/10/XMLSchema" >
+ <soap:Body>
+ <ns0:echoString xmlns:ns0="http://soapinterop.org/" >
+ <inputString xsi0:type="xsd1:string" xsi1:type="xsd1:string"
+xsi9:type="xsd1:string">Simple Test String</inputString>
+ </ns0:echoString>
+ </soap:Body>
+</soap:Envelope>!);
+
+ ok($deserializer->xmlschema eq 'http://www.w3.org/2001/XMLSchema');
+}
+
+{
+ print "SOAP::Fault stringification test(s)...\n";
+
+ my $f = SOAP::Fault->faultcode('Client.Authenticate')
+ ->faultstring('Bad error');
+ ok($f eq 'Client.Authenticate: Bad error');
+}
+
+{
+ print "Memory leaks test(s)...\n"; # also check 36-leaks.t
+
+ my %calls;
+ {
+ SOAP::Lite->import(trace => [objects => sub {
+ if ((caller(2))[3] =~ /^(.+)::(.+)$/) {
+ $calls{$2}{$1}++;
+ }
+ }]);
+
+ my $soap = SOAP::Lite
+ -> uri("Echo")
+ -> proxy("http://services.soaplite.com/echo.cgi");
+ }
+ foreach (keys %{$calls{new}}) {
+ ok(exists $calls{DESTROY}{$_});
+ }
+
+ %calls = ();
+ {
+ local $SOAP::Constants::DO_NOT_USE_XML_PARSER = 1;
+ my $soap = SOAP::Lite
+ -> uri("Echo")
+ -> proxy("http://services.soaplite.com/echo.cgi");
+ }
+ foreach (keys %{$calls{new}}) {
+ ok(exists $calls{DESTROY}{$_});
+ }
+
+ SOAP::Lite->import(trace => '-objects');
+}
Added: packages/soap-lite/branches/upstream/current/t/03-server.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/03-server.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/03-server.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,303 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+BEGIN { plan tests => 32 }
+$SIG{__WARN__} = sub { ; }; # turn off deprecation warnings
+
+use SOAP::Lite;
+
+my($a, $s, $r, $serialized, $deserialized);
+
+my %tests = (
+ 'XML only' => <<'EOM',
+<?xml version="1.0" encoding="UTF-8"?>
+<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema">
+<soap:Body>
+<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
+ <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
+ <c-gensym7 xsi:type="xsd:int">5</c-gensym7>
+</namesp1:add>
+</soap:Body>
+</soap:Envelope>
+EOM
+
+ 'message with headers' => <<'EOM',
+Content-Type: text/xml
+
+<?xml version="1.0" encoding="UTF-8"?>
+<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema">
+<soap:Body>
+<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
+ <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
+ <c-gensym7 xsi:type="xsd:int">5</c-gensym7>
+</namesp1:add>
+</soap:Body>
+</soap:Envelope>
+EOM
+
+ 'singlepart MIME' => <<'EOM',
+Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<calc061400a.xml at soaplite.com>"
+
+--MIME_boundary
+Content-Type: text/xml; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+Content-ID: <calc061400a.xml at soaplite.com>
+
+<?xml version="1.0" encoding="UTF-8"?>
+<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema">
+<soap:Body>
+<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
+ <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
+ <c-gensym7 xsi:type="xsd:int">5</c-gensym7>
+</namesp1:add>
+</soap:Body>
+</soap:Envelope>
+
+--MIME_boundary--
+EOM
+
+ 'multipart MIME' => <<'EOM',
+Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<calc061400a.xml at soaplite.com>"
+
+--MIME_boundary
+Content-Type: text/xml; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+Content-ID: <calc061400a.xml at soaplite.com>
+
+<?xml version="1.0" encoding="UTF-8"?>
+<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema">
+<soap:Body>
+<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
+ <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
+ <c-gensym7 xsi:type="xsd:int">5</c-gensym7>
+</namesp1:add>
+</soap:Body>
+</soap:Envelope>
+
+--MIME_boundary
+Content-Type: text/plain
+Content-Transfer-Encoding: binary
+Content-ID: <calc061400a.a at soaplite.com>
+
+2
+--MIME_boundary
+Content-Type: text/plain
+Content-Transfer-Encoding: binary
+Content-ID: <calc061400a.b at soaplite.com>
+
+5
+--MIME_boundary--
+EOM
+
+ 'multipart MIME w/multiref' => <<'EOM',
+Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<calc061400a.xml at soaplite.com>"
+
+--MIME_boundary
+Content-Type: text/xml; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+Content-ID: <calc061400a.xml at soaplite.com>
+
+<?xml version="1.0" encoding="UTF-8"?>
+<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema">
+<soap:Body>
+<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
+ <c-gensym5 href="cid:calc061400a.a at soaplite.com"/>
+ <c-gensym7 href="cid:calc061400a.b at soaplite.com"/>
+</namesp1:add>
+</soap:Body>
+</soap:Envelope>
+
+--MIME_boundary
+Content-Type: text/plain
+Content-Transfer-Encoding: binary
+Content-ID: <calc061400a.a at soaplite.com>
+
+2
+--MIME_boundary
+Content-Type: text/plain
+Content-Transfer-Encoding: binary
+Content-ID: <calc061400a.b at soaplite.com>
+
+5
+--MIME_boundary--
+EOM
+);
+
+eval "SOAP::Packager::MIME->new->initialize_parser";
+my $is_mimetools_installed = $@ ? 0 : 1;
+(my $reason = $@) =~ s/ at .+// unless $is_mimetools_installed;
+print "MIME tests will be skipped: $reason" if defined $reason;
+my $package = '
+ package Calculator;
+ sub new { bless {} => ref($_[0]) || $_[0] }
+ sub add { $_[1] + $_[2] }
+ sub schema { $SOAP::Constants::DEFAULT_XML_SCHEMA }
+1;';
+
+# TEST 1-4
+{
+ print "Server handler test(s)...\n";
+
+ my $server = SOAP::Server->dispatch_to('Calculator');
+
+ foreach (keys %tests) {
+ my $result = SOAP::Deserializer->deserialize($server->handle($tests{$_}));
+ if ($_ =~ /XML/ || $is_mimetools_installed) {
+ ok( ($result->faultstring || '') =~ /Failed to access class \(Calculator\)/ );
+ } else {
+ skip($reason => undef);
+ }
+ }
+
+ eval $package or die;
+
+ foreach (keys %tests) {
+ my $result = SOAP::Deserializer->deserialize($server->handle($tests{$_}));
+ if ($_ =~ /XML/ || $is_mimetools_installed) {
+ ok(($result->result || 0) == 7);
+ } else {
+ skip($reason => undef);
+ }
+ }
+}
+
+{
+ print "Server handler with complex dispatches test(s)...\n";
+ foreach my $server (
+ # dispatch to class
+ SOAP::Server->dispatch_to('Calculator'),
+
+ # dispatch to object
+ SOAP::Server->dispatch_to(Calculator->new),
+
+ # dispatch to regexp
+ SOAP::Server->dispatch_to('Calc\w+'),
+
+ # dispatch URI to class
+ SOAP::Server->dispatch_with({'http://www.soaplite.com/Calculator' => 'Calculator'}),
+
+ # dispatch URI to object
+ SOAP::Server->dispatch_with({'http://www.soaplite.com/Calculator' => Calculator->new}),
+
+ # dispatch quoted SOAPAction to class
+ SOAP::Server->action('"http://action/#method"')
+ ->dispatch_with({'http://action/#method' => 'Calculator'}),
+
+ # dispatch non-quoted SOAPAction to class
+ SOAP::Server->action('http://action/#method')
+ ->dispatch_with({'http://action/#method' => 'Calculator'}),
+
+ # dispatch to class and BAD regexp.
+ SOAP::Server->dispatch_to('\protocols', 'Calculator')
+ ) { # end for
+ my $result = SOAP::Deserializer->deserialize($server->handle($tests{'XML only'}));
+ ok(($result->result || 0) == 7);
+ }
+}
+
+{
+ print "Error handling in server test(s)...\n";
+
+ $a = SOAP::Server->handle('<a></a>');
+ ok($a =~ /Can't find root/);
+
+ $a = SOAP::Server->handle('<Envelope></Envelope>');
+ ok($a =~ /Can't find method/);
+
+ $a = SOAP::Server->handle('<Envelope><Body><Add><a>1</a><b>1</b></Add></Body></Envelope>');
+ ok($a =~ /Denied access to method/);
+
+ $a = SOAP::Server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema">
+<soap:Body></soap:Body></soap:Envelope>');
+ ok($a =~ /Can't find method/);
+}
+
+{
+ print "Envelope with no namespaces test(s)...\n";
+
+ eval 'sub add { $_[1] + $_[2] }; 1' or die;
+
+ my $result = SOAP::Deserializer->deserialize(SOAP::Server->dispatch_to('add')->handle('<Envelope><Body><add><a>3</a><b>4</b></add></Body></Envelope>'));
+ ok(($result->result || 0) == 7);
+}
+
+{
+ print "Different XML Schemas test(s)...\n";
+
+ my $server = SOAP::Server->dispatch_to('Calculator');
+ $a = $server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:xsd="http://www.w3.org/1999/XMLSchema">
+<soap:Body>
+<namesp1:schema xmlns:namesp1="http://www.soaplite.com/Calculator"/>
+</soap:Body></soap:Envelope>');
+
+ ok($a =~ m!xsi="http://www.w3.org/2001/XMLSchema-instance"!);
+ ok($a =~ m!xsd="http://www.w3.org/2001/XMLSchema"!);
+ ok($a =~ m!>http://www.w3.org/2001/XMLSchema<!);
+
+ $a = $server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:xsd="http://www.w3.org/2001/XMLSchema">
+<soap:Body>
+<namesp1:schema xmlns:namesp1="http://www.soaplite.com/Calculator">
+ <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
+</namesp1:schema>
+</soap:Body></soap:Envelope>');
+
+ ok($a =~ m!xsi="http://www.w3.org/2001/XMLSchema-instance"!);
+ ok($a =~ m!xsd="http://www.w3.org/2001/XMLSchema"!);
+ ok($a =~ m!>http://www.w3.org/2001/XMLSchema<!);
+
+ $a = $server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
+ soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:xsd="http://www.w3.org/2001/XMLSchema">
+<soap:Body>
+<namesp1:schema xmlns:namesp1="http://www.soaplite.com/Calculator">
+ <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
+</namesp1:schema>
+</soap:Body></soap:Envelope>');
+
+ ok($a =~ m!xsi="http://www.w3.org/2001/XMLSchema-instance"!);
+ ok($a =~ m!xsd="http://www.w3.org/2001/XMLSchema"!);
+ ok($a =~ m!>http://www.w3.org/2001/XMLSchema<!);
+}
Added: packages/soap-lite/branches/upstream/current/t/04-attach.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/04-attach.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/04-attach.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,218 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+BEGIN {
+ use SOAP::Lite;
+ eval { SOAP::Packager::MIME->new->initialize_parser; 1 };
+ if ($@) {
+ $@ =~ s/ at .+//;
+ print "1..0 # Skip: $@"; exit;
+ }
+}
+
+BEGIN { plan tests => 15 }
+
+my($a, $soap, $d, $s, $r, $serialized, $deserialized);
+
+{ # check attachment deserialization
+ $soap = SOAP::Lite->init_context();
+
+ ##############################################################################
+ print "Attachment deserialization (Content-ID) test(s)...\n";
+ $a = $soap->deserializer->deserialize(<<'EOX');
+Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<claim061400a.xml at claiming-it.com>"
+SOAPAction: http://schemas.risky-stuff.com/Auto-Claim
+Content-Description: This is the optional message description.
+
+--MIME_boundary
+Content-Type: text/xml; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+Content-ID: <claim061400a.xml at claiming-it.com>
+
+<?xml version='1.0' ?>
+<soap:Envelope
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
+ <soap:Body>
+ <claim:insurance_claim_auto
+ id="insurance_claim_document_id"
+ xmlns:claim="http://schemas.risky-stuff.com/Auto-Claim">
+ <theSignedForm href="cid:claim061400a.tiff at claiming-it.com" />
+ <theCrashPhoto href="cid:claim061400a.jpeg at claiming-it.com" />
+ <somexml href="cid:claim061400a.somexml at claiming-it.com" />
+ <realxml href="cid:claim061400a.realxml at claiming-it.com" />
+ <!-- ... more claim details go here... -->
+ </claim:insurance_claim_auto>
+ </soap:Body>
+</soap:Envelope>
+
+--MIME_boundary
+Content-Type: image/tiff
+Content-Transfer-Encoding: base64
+Content-ID: <claim061400a.tiff at claiming-it.com>
+
+AAECAyAgIAQFBg==
+--MIME_boundary
+Content-Type: image/jpeg
+Content-Transfer-Encoding: binary
+Content-ID: <claim061400a.jpeg at claiming-it.com>
+
+...Raw JPEG image..
+--MIME_boundary
+Content-Type: text/plain
+Content-Transfer-Encoding: binary
+Content-ID: <claim061400a.somexml at claiming-it.com>
+
+<a><b>c</b></a>
+--MIME_boundary
+Content-Type: text/xml
+Content-Transfer-Encoding: binary
+Content-ID: <claim061400a.realxml at claiming-it.com>
+
+<a><b>c</b></a>
+--MIME_boundary--
+
+EOX
+
+ ok(ref $a);
+ ok(ref $a && ref $a->valueof('//insurance_claim_auto') &&
+ $a->valueof('//insurance_claim_auto')->{theCrashPhoto} =~ /JPEG/);
+ ok(ref $a && $a->valueof('//theCrashPhoto') =~ /Raw JPEG image/);
+ ok(ref $a && $a->valueof('//theSignedForm') eq "\0\1\2\3 \4\5\6");
+ ok(ref $a && $a->valueof('//somexml') =~ m!<a><b>c</b></a>!);
+ ok(ref $a && $a->valueof('//realxml')->{b} eq 'c');
+
+ ##############################################################################
+ print "Attachment deserialization (Content-ID and Content-Location) test(s)...\n";
+ $a = $soap->deserializer->deserialize(<<'EOX');
+MIME-Version: 1.0
+Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<http://claiming-it.com/claim061400a.xml>"
+Content-Description: This is the optional message description.
+
+--MIME_boundary
+Content-Type: text/xml; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+Content-ID: <http://claiming-it.com/claim061400a.xml>
+Content-Location: http://claiming-it.com/claim061400a.xml
+
+<?xml version='1.0' ?>
+<soap:Envelope
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
+ <soap:Body>
+ <claim:insurance_claim_auto
+ id="insurance_claim_document_id"
+ xmlns:claim="http://schemas.risky-stuff.com/Auto-Claim">
+ <theSignedForm href="http://claiming-it.com/claim061400a.tiff" />
+ </claim:insurance_claim_auto>
+ </soap:Body>
+</soap:Envelope>
+
+--MIME_boundary
+Content-Type: image/tiff
+Content-Transfer-Encoding: binary
+Content-ID: <http://claiming-it.com/claim061400a.tiff>
+Content-Location: http://claiming-it.com/claim061400a.tiff
+
+...binary TIFF image...
+--MIME_boundary--
+
+EOX
+
+ ok(ref $a);
+ ok(ref $a && ref $a->valueof('//insurance_claim_auto') &&
+ $a->valueof('//insurance_claim_auto')->{theSignedForm} =~ /TIFF/);
+ ok(ref $a && $a->valueof('//theSignedForm') =~ /binary TIFF image/);
+
+ ##############################################################################
+ print "Attachment deserialization (relative Content-Location) test(s)...\n";
+ # TODO - this unit test breaks - it does not seem to be picking up a base location
+ # from outer Content-Location
+ eval { $a = $soap->deserializer->deserialize(<<'EOX'); };
+MIME-Version: 1.0
+Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<http://claiming-it.com/claim061400a.xml>"
+Content-Description: This is the optional message description.
+Content-Location: http://claiming-it.com/
+
+--MIME_boundary
+Content-Type: text/xml; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+Content-ID: <http://claiming-it.com/claim061400a.xml>
+Content-Location: claim061400a.xml
+
+<?xml version='1.0' ?>
+<soap:Envelope
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
+ <soap:Body>
+ <claim:insurance_claim_auto
+ id="insurance_claim_document_id"
+ xmlns:claim="http://schemas.risky-stuff.com/Auto-Claim">
+ <theSignedForm href="cid:claim061400a.tiff" />
+ </claim:insurance_claim_auto>
+ </soap:Body>
+</soap:Envelope>
+
+--MIME_boundary
+Content-Type: image/tiff
+Content-Transfer-Encoding: binary
+Content-Id: <claim061400a.tiff>
+Content-Location: claim061400a.tiff
+
+...binary TIFF image...
+--MIME_boundary--
+
+EOX
+ ok(ref $a);
+ ok(ref $a && ref $a->valueof('//insurance_claim_auto') &&
+ $a->valueof('//insurance_claim_auto')->{theSignedForm} =~ /TIFF/);
+ ok(ref $a && $a->valueof('//theSignedForm') =~ /binary TIFF image/);
+
+ ##############################################################################
+ print "Attachment deserialization (no default Content-Location) test(s)...\n";
+ $a = $soap->deserializer->deserialize(<<'EOX');
+MIME-Version: 1.0
+Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<b6f4ccrt at 15.4.9.92/s445>"
+Content-Description: This is the optional message description.
+
+--MIME_boundary
+Content-Type: text/xml; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+Content-ID: <b6f4ccrt at 15.4.9.92/s445>
+Content-Location: claim061400a.xml
+
+<?xml version='1.0' ?>
+<soap:Envelope
+ xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
+ <soap:Body>
+ <claim:insurance_claim_auto
+ id="insurance_claim_document_id"
+ xmlns:claim="http://schemas.risky-stuff.com/Auto-Claim">
+ <theSignedForm href="cid:a34ccrt at 15.4.9.92/s445" />
+ </claim:insurance_claim_auto>
+ </soap:Body>
+</soap:Envelope>
+
+--MIME_boundary
+Content-Type: image/tiff
+Content-Transfer-Encoding: binary
+Content-ID: <a34ccrt at 15.4.9.92/s445>
+Content-Location: the_signed_form.tiff
+
+...binary TIFF image...
+--MIME_boundary-
+
+EOX
+# <theSignedForm href="cid:the_signed_form.tiff"/>
+
+ ok(ref $a);
+ ok(ref $a && ref $a->valueof('//insurance_claim_auto') &&
+ $a->valueof('//insurance_claim_auto')->{theSignedForm} =~ /TIFF/);
+ ok(ref $a && $a->valueof('//theSignedForm') =~ /binary TIFF image/);
+}
Added: packages/soap-lite/branches/upstream/current/t/05-customxml.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/05-customxml.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/05-customxml.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,204 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use SOAP::Lite;
+
+plan tests => 40;
+
+my($a, $s, $r, $serialized, $deserialized);
+
+$deserialized = SOAP::Custom::XML::Deserializer
+ -> deserialize(join '', <DATA>);
+
+ok(ref $deserialized);
+
+$r = $deserialized->valueof('/Envelope/Body');
+
+ok(ref $r);
+
+my @portfolios = $r->Report->Request->Composition->PortfolioDistribution;
+
+ok(@portfolios == 6);
+
+foreach my $portfolio (@portfolios) {
+ # test attributes
+ print $portfolio->type, " ", $portfolio->date, "\n";
+ ok($portfolio->type && $portfolio->date);
+ foreach my $row ($portfolio->Row) {
+ # test elements
+ print " ", $row->Element, " ", $row->Value, "\n";
+ ok($row->Element && $row->Value);
+ }
+}
+
+__DATA__
+<?xml version="1.0" encoding="UTF-8"?>
+<Envelope version="1.1">
+ <Header />
+ <Body>
+ <Report>
+ <Header>
+ <ClientRef />
+ <FundCusip>61744J366</FundCusip>
+ <SepAcctDesc />
+ </Header>
+ <Request>
+ <Errors>
+ <Error>Returned no data for request: PortfolioDistribution</Error>
+ <Error>Returned no data for request: PortfolioDistribution</Error>
+ <Error>Returned no data for request: PortfolioDistribution</Error>
+ <Error>Returned no data for request: PortfolioDistribution</Error>
+ <Error>Could not retrieve PortfolioDistribution</Error>
+ <Error>Could not retrieve PortfolioDistribution</Error>
+ <Error>Could not retrieve PortfolioDistribution</Error>
+ <Error>Could not retrieve PortfolioDistribution</Error>
+ </Errors>
+ <Composition>
+ <PortfolioDistribution type="CE" date="09/30/2000" />
+ <PortfolioDistribution type="GB" date="09/30/2000" />
+ <PortfolioDistribution type="ST" date="09/30/2000">
+ <Row>
+ <Element>Common Stocks</Element>
+ <Value>0.9991</Value>
+ </Row>
+ <Row>
+ <Element>Other</Element>
+ <Value>0.0021</Value>
+ </Row>
+ <Row>
+ <Element>Cash & Cash Equivalents</Element>
+ <Value>-0.0012</Value>
+ </Row>
+ </PortfolioDistribution>
+ <PortfolioDistribution type="TT" date="09/30/2000">
+ <Row>
+ <Element>General Electric Company</Element>
+ <Value>0.0458</Value>
+ </Row>
+ <Row>
+ <Element>Cisco Systems Inc</Element>
+ <Value>0.033</Value>
+ </Row>
+ <Row>
+ <Element>Microsoft Corporation</Element>
+ <Value>0.0263</Value>
+ </Row>
+ <Row>
+ <Element>Exxon Mobil Corp.</Element>
+ <Value>0.0263</Value>
+ </Row>
+ <Row>
+ <Element>Pfizer, Inc.</Element>
+ <Value>0.0231</Value>
+ </Row>
+ <Row>
+ <Element>Intel Corporation</Element>
+ <Value>0.0209</Value>
+ </Row>
+ <Row>
+ <Element>Citigroup Inc</Element>
+ <Value>0.02</Value>
+ </Row>
+ <Row>
+ <Element>Emc Corp.</Element>
+ <Value>0.0185</Value>
+ </Row>
+ <Row>
+ <Element>American International Group, Inc.</Element>
+ <Value>0.0181</Value>
+ </Row>
+ <Row>
+ <Element>Oracle Corporation</Element>
+ <Value>0.0172</Value>
+ </Row>
+ </PortfolioDistribution>
+ <PortfolioDistribution type="IB" date="09/30/2000">
+ <Row>
+ <Element>Pharmaceuticals</Element>
+ <Value>0.0941</Value>
+ </Row>
+ <Row>
+ <Element>Communications Equipment</Element>
+ <Value>0.0857</Value>
+ </Row>
+ <Row>
+ <Element>Computers & Peripherals</Element>
+ <Value>0.0764</Value>
+ </Row>
+ <Row>
+ <Element>Diversified Financials</Element>
+ <Value>0.0724</Value>
+ </Row>
+ <Row>
+ <Element>Industrial Conglomerates</Element>
+ <Value>0.0581</Value>
+ </Row>
+ <Row>
+ <Element>Diversified Telecommunication Services</Element>
+ <Value>0.058</Value>
+ </Row>
+ <Row>
+ <Element>Software</Element>
+ <Value>0.056</Value>
+ </Row>
+ <Row>
+ <Element>Other</Element>
+ <Value>0.5002</Value>
+ </Row>
+ <Row>
+ <Element>Cash & Cash Equivalents</Element>
+ <Value>-0.0012</Value>
+ </Row>
+ </PortfolioDistribution>
+ <PortfolioDistribution type="SB" date="09/30/2000">
+ <Row>
+ <Element>Information Technology</Element>
+ <Value>0.2964</Value>
+ </Row>
+ <Row>
+ <Element>Financials</Element>
+ <Value>0.154</Value>
+ </Row>
+ <Row>
+ <Element>Health Care</Element>
+ <Value>0.1265</Value>
+ </Row>
+ <Row>
+ <Element>Consumer Discretionary</Element>
+ <Value>0.1026</Value>
+ </Row>
+ <Row>
+ <Element>Industrials</Element>
+ <Value>0.0874</Value>
+ </Row>
+ <Row>
+ <Element>Telecommunication Services</Element>
+ <Value>0.0632</Value>
+ </Row>
+ <Row>
+ <Element>Consumer Staples</Element>
+ <Value>0.0575</Value>
+ </Row>
+ <Row>
+ <Element>Other</Element>
+ <Value>0.1136</Value>
+ </Row>
+ <Row>
+ <Element>Cash & Cash Equivalents</Element>
+ <Value>-0.0012</Value>
+ </Row>
+ </PortfolioDistribution>
+ </Composition>
+ </Request>
+ </Report>
+ </Body>
+</Envelope>
Added: packages/soap-lite/branches/upstream/current/t/06-modules.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/06-modules.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/06-modules.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,27 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+BEGIN { plan tests => 19 }
+
+foreach (qw(SOAP::Lite SOAP::Transport::HTTP SOAP::Transport::MAILTO
+ SOAP::Transport::FTP SOAP::Transport::TCP SOAP::Transport::IO
+ SOAP::Transport::LOCAL SOAP::Transport::POP3 XML::Parser::Lite
+ UDDI::Lite XMLRPC::Lite XMLRPC::Transport::HTTP
+ XMLRPC::Transport::TCP XMLRPC::Transport::POP3 Apache::XMLRPC::Lite
+ SOAP::Packager SOAP::Transport::MQ SOAP::Transport::JABBER
+ Apache::SOAP)) {
+ eval "require $_";
+ print $@;
+ $@ =~ /(Can\'t locate)|(XML::Parser::Lite requires)|(this is only version)|(load mod_perl)/
+ ? skip($@ => undef)
+ : ok(!$@);
+}
Added: packages/soap-lite/branches/upstream/current/t/07-xmlrpc_payload.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/07-xmlrpc_payload.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/07-xmlrpc_payload.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,51 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+BEGIN { plan tests => 8 }
+
+use XMLRPC::Lite;
+
+my($a, $s, $r, $serialized, $deserialized);
+
+{
+ print "XML-RPC deserialization test(s)...\n";
+
+ $deserialized = XMLRPC::Deserializer->deserialize('<?xml version="1.0" encoding="ISO-8859-1"?>
+<methodCall><methodName>SOAP.Lite.Bug.Report</methodName><params>
+<param><value><struct><member><name>This</name><value>Works</value></member></struct></value></param>
+</params></methodCall>
+ ')->root;
+
+ ok($deserialized->{params}->[0]->{This} eq 'Works');
+
+ $serialized = XMLRPC::Serializer->serialize({param1 => 'value1', param2 => undef, param3 => 0});
+
+ ok($serialized =~ m!<member><name>param2</name><value /></member>!);
+ ok($serialized =~ m!<member><name>param3</name><value><int>0</int></value></member>!);
+
+ $deserialized = XMLRPC::Deserializer->deserialize($serialized)->root;
+
+ ok($deserialized->{param2} eq '');
+ ok($deserialized->{param3} == 0);
+
+ $serialized = XMLRPC::Serializer->method(a => {param1 => 'value1', param2 => undef, param3 => 'value3'});
+
+ ok($serialized =~ m!<methodCall><methodName>a</methodName><params><param><value><struct>(<member><name>param1</name><value><string>value1</string></value></member>|<member><name>param2</name><value /></member>|<member><name>param3</name><value><string>value3</string></value></member>){3}</struct></value></param></params></methodCall>!);
+
+ $serialized = XMLRPC::Serializer->method(a => {param1 => 'value1'});
+
+ ok($serialized eq '<?xml version="1.0" encoding="UTF-8"?><methodCall><methodName>a</methodName><params><param><value><struct><member><name>param1</name><value><string>value1</string></value></member></struct></value></param></params></methodCall>');
+
+ eval { XMLRPC::Serializer->serialize(XMLRPC::Data->type(base63 => 1)) };
+
+ ok($@ =~ /unsupported datatype/);
+}
Added: packages/soap-lite/branches/upstream/current/t/08-schema.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/08-schema.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/08-schema.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,108 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+BEGIN { plan tests => 47 }
+
+use SOAP::Lite;
+
+my($a, $s, $r, $serialized, $deserialized);
+
+{ # check deserialization of envelope with result
+ print "Deserialization of envelope with result test(s)...\n";
+
+ $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?>
+<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
+ xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/"
+ xmlns:xsd="http://www.w3.org/2001/XMLSchema"
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<SOAP-ENV:Body>
+<m:doublerResponse xmlns:m="http://simon.fell.com/calc">
+<nums xsi:type="SOAP-ENC:Array" SOAP-ENC:arrayType="xsd:int[5]">
+<item xsi:type="xsd:int">20</item>
+<item xsi:type="xsd:int">40</item>
+<item xsi:type="xsd:int">60</item>
+<item xsi:type="xsd:int">100</item>
+<item xsi:type="xsd:int">200</item>
+</nums>
+</m:doublerResponse>
+</SOAP-ENV:Body>
+</SOAP-ENV:Envelope>
+');
+
+ ok($deserialized->result->[2] == 60);
+ ok((my @array = $deserialized->paramsall) == 1);
+ ok(ref $deserialized->body eq 'HASH'); # not blessed anymore since 0.51
+}
+
+{
+ print "hex encoding test(s)...\n";
+
+ $a = "\0 {a}\1";
+ $serialized = SOAP::Serializer->serialize(SOAP::Data->type(hex => $a));
+
+ ok($serialized =~ />00207B617D01</);
+ ok(SOAP::Deserializer->deserialize($serialized)->root eq $a);
+}
+
+{
+ print "Deserialization of 1999/2001 schemas test(s)...\n";
+
+ foreach (split "\n", <<EOX) {
+<i xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="SOAP-ENC:integer">12</i>
+<i xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="xsd:nonNegativeInteger">12</i>
+<i xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="xsd:anySimpleType">12</i>
+<i xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="xsd:anyType">12</i>
+<i xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="xsd:ur-type">12</i>
+<SOAP-ENC:integer xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/">12</SOAP-ENC:integer>
+<i>12</i>
+EOX
+ $deserialized = SOAP::Deserializer->deserialize($_);
+ ok($deserialized->root == 12);
+ }
+
+ eval { SOAP::Deserializer->deserialize('<i xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="xsd:something">12</i>') };
+ ok($@ =~ m!Unrecognized type '\{http://www.w3.org/1999/XMLSchema\}something'!);
+
+ eval { SOAP::Deserializer->deserialize('<i xmlns:xsd="http://some.thing.else/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="xsd:something">12</i>') };
+ ok($@ =~ m!Unrecognized type '{http://some.thing.else/XMLSchema}something'!);
+
+ foreach (qw(base64Binary hexBinary anyType anySimpleType
+ gMonth gYearMonth gYear gMonthDay gDay duration anyURI dateTime)) {
+ eval { SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="xsd:$_">12</i>!) };
+ ok($@ =~ m!Unrecognized type '{http://www.w3.org/1999/XMLSchema}$_'!);
+ }
+
+ ok(SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="xsd:boolean">true</i>!)->root eq '1');
+
+ eval { SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="xsd:boolean">something</i>!) };
+ ok($@ =~ m!Wrong boolean value!);
+
+ ok(SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="xsd:boolean">true</i>!)->root eq '1');
+ ok(SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="xsd:boolean">1</i>!)->root eq '1');
+ ok(SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="xsd:boolean">false</i>!)->root eq '0');
+ ok(SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="xsd:boolean">0</i>!)->root eq '0');
+
+ foreach (qw(ur-type base64 hex
+ timeDuration uriReference timeInstant month year recurringDate recurringDay)) {
+ eval { SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="xsd:$_">12</i>!) };
+ ok($@ =~ m!Unrecognized type '{http://www.w3.org/2001/XMLSchema}$_'!);
+ }
+
+ eval { SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="xsd:boolean">something</i>!) };
+ ok($@ =~ m!Wrong boolean value!);
+
+ ok(SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="xsd:boolean">true</i>!)->root eq '1');
+ ok(SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="xsd:boolean">1</i>!)->root eq '1');
+ ok(SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="xsd:boolean">false</i>!)->root eq '0');
+ ok(SOAP::Deserializer->deserialize(qq!<i xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="xsd:boolean">0</i>!)->root eq '0');
+}
Added: packages/soap-lite/branches/upstream/current/t/11-cgi.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/11-cgi.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/11-cgi.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,13 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use SOAP::Test;
+
+SOAP::Test::Server::run_for(shift || 'http://localhost/cgi-bin/soap.cgi');
+
Added: packages/soap-lite/branches/upstream/current/t/12-cgi_https.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/12-cgi_https.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/12-cgi_https.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,13 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use SOAP::Test;
+
+SOAP::Test::Server::run_for(shift || 'https://localhost/cgi-bin/soap.cgi');
+
Added: packages/soap-lite/branches/upstream/current/t/13-mod_perl.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/13-mod_perl.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/13-mod_perl.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,12 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use SOAP::Test;
+
+SOAP::Test::Server::run_for(shift || 'http://localhost/soap');
\ No newline at end of file
Added: packages/soap-lite/branches/upstream/current/t/14-cgi_apache.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/14-cgi_apache.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/14-cgi_apache.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,13 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use SOAP::Test;
+
+SOAP::Test::Server::run_for(shift || 'http://localhost/mod_perl/soap.mod_cgi');
+
Added: packages/soap-lite/branches/upstream/current/t/15-daemon.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/15-daemon.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/15-daemon.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,13 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use SOAP::Test;
+
+SOAP::Test::Server::run_for(shift || 'http://localhost/');
+
Added: packages/soap-lite/branches/upstream/current/t/16-tcp.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/16-tcp.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/16-tcp.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,13 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use SOAP::Test;
+
+SOAP::Test::Server::run_for(shift || 'tcp://localhost:82');
+
Added: packages/soap-lite/branches/upstream/current/t/17-mod_soap.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/17-mod_soap.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/17-mod_soap.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,13 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use SOAP::Test;
+
+SOAP::Test::Server::run_for(shift || 'http://localhost/mod_soap');
+
Added: packages/soap-lite/branches/upstream/current/t/19-apachesoap.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/19-apachesoap.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/19-apachesoap.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,52 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use SOAP::Lite
+ on_fault => sub {
+ my $soap = shift;
+ my $res = shift;
+ ref $res ? warn(join "\n", "--- SOAP FAULT ---", $res->faultcode, $res->faultstring, '')
+ : warn(join "\n", "--- TRANSPORT ERROR ---", $soap->transport->status, '');
+ return new SOAP::SOM;
+ }
+;
+
+my($a, $s, $r, $serialized, $deserialized);
+
+my $proxy = 'http://localhost:8080/soap/servlet/rpcrouter';
+
+# ------------------------------------------------------
+use SOAP::Test;
+
+$s = SOAP::Lite->uri('http://something/somewhere')->proxy($proxy)->on_fault(sub{});
+eval { $s->transport->timeout($SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT) };
+$r = $s->test_connection;
+
+unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+}
+# ------------------------------------------------------
+
+plan tests => 2;
+
+{
+# Local server with Apache SOAP (http://xml.apache.org/soap)
+ print "Apache SOAP server test(s)...\n";
+ $s = SOAP::Lite
+ -> uri('urn:xmltoday-delayed-quotes')
+ -> proxy($proxy)
+ ;
+
+ ok($s->getQuote('MSFT')->result > 0);
+ ok($s->getQuote(SOAP::Data->name(symbol => 'MSFT'))->result > 0);
+}
Added: packages/soap-lite/branches/upstream/current/t/21-public.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/21-public.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/21-public.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,256 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use SOAP::Lite
+ on_fault => sub {
+ my $soap = shift;
+ my $res = shift;
+ ref $res ? warn(join " ", "SOAP FAULT:", $res->faultstring, "\n")
+ : warn(join " ", "TRANSPORT ERROR:", $soap->transport->status, "\n");
+ return new SOAP::SOM;
+ },
+;
+
+$SOAP::Constants::DO_NOT_USE_CHARSET = 1;
+
+my($a, $s, $r, $serialized, $deserialized);
+
+# ------------------------------------------------------
+use SOAP::Test;
+
+$s = SOAP::Lite->uri('http://something/somewhere')->proxy('http://services.xmethods.net/soap/servlet/rpcrouter')->on_fault(sub{});
+eval { $s->transport->timeout($SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT) };
+$r = $s->test_connection;
+
+unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+}
+# ------------------------------------------------------
+
+plan tests => 21;
+
+{
+# Public test server with Frontier implementation (http://soap.weblogs.com/)
+ print "Frontier server test(s)...\n";
+ $s = SOAP::Lite
+ -> uri('/examples')
+ -> on_action(sub { sprintf '"%s"', @_ })
+ -> proxy('http://superhonker.userland.com/', timeout => $SOAP::Test::TIMEOUT)
+ ;
+
+ ok($s->getCurrentTime()->result);
+ ok($s->getStateName(SOAP::Data->name(statenum => 1))->result eq 'Alabama');
+
+ print "SOAP::Lite server test(s)...\n";
+ $s = SOAP::Lite
+ -> uri('http://www.soaplite.com/My/Examples')
+ -> proxy('http://services.soaplite.com/examples.cgi', timeout => $SOAP::Test::TIMEOUT)
+ ;
+ ok($s->getStateNames(1,4,6,13)->result =~ /^Alabama\s+Arkansas\s+Colorado\s+Illinois\s*$/);
+
+ $r = $s->getStateList([1,2,3,4])->result;
+ ok(ref $r && $r->[0] eq 'Alabama');
+
+ $r = $s->getStateStruct(SOAP::Data->type(ordered_hash => [item1 => 1, item2 => 4]))->result;
+ ok(ref $r && $r->{item2} eq 'Arkansas');
+
+# Public test server with COM implementation (http://www.zaks.demon.co.uk/com/4s4c/)
+ print "COM server test(s)...\n";
+ $s = SOAP::Lite
+ -> uri('http://simon.fell.com/calc')
+ -> proxy('http://soap.4s4c.com/ssss4c/soap.asp', timeout => $SOAP::Test::TIMEOUT)
+ ;
+
+ $r = $s->doubler(name SOAP::Data nums => [10,20,30,50,100])->result;
+ ok(ref $r && $r->[1] == 40);
+
+# Real server with ASP implementation (http://www.soap-wrc.com/webservices/)
+ print "ASP server test(s)...\n";
+ $s = SOAP::Lite
+ -> uri('www.soap-wrc.com')
+ -> proxy('http://www.soap-wrc.com/webservices/soapv11.asp', timeout => $SOAP::Test::TIMEOUT)
+ -> on_fault(sub{ref$_[1]?return$_[1]:return})
+ ;
+
+ import SOAP::Data 'name'; # no import by default
+
+ $r = $s->addResource(
+ name(Login => 'login'),
+ name(Password => 'password'),
+ name(Caption => 'caption'),
+ name(Description => 'description'),
+ name(URL => 'http://yahoo.com'),
+ );
+ ok(ref $r && $r->faultcode eq 'SOAP-ENV:Client');
+ # Password should be wrong. Put yours if you have it.
+ # Remember: this is the real server
+
+if (0) { # doesn't seem to be working on 2001/01/31
+ print "DevelopMentor's Perl server test(s)...\n";
+ ok((SOAP::Lite
+ -> uri('urn:soap-perl-test')
+ -> proxy('http://soapl.develop.com/soap?class=SPTest', timeout => $SOAP::Test::TIMEOUT)
+ -> add(SOAP::Data->name(a => 3), SOAP::Data->name(b => 4))
+ -> result or 0) == 7);
+}
+
+# Public server with Microsoft implementation (http://beta.search.microsoft.com/search/MSComSearchService.asmx)
+ print "Microsoft's server test(s)...\n";
+ ok((SOAP::Lite
+ -> uri('http://tempuri.org/')
+ -> proxy('http://beta.search.microsoft.com/search/MSComSearchService.asmx', timeout => $SOAP::Test::TIMEOUT)
+ -> on_action(sub{join'', at _})
+ -> GetVocabulary(SOAP::Data->name(Query => 'something_very_unusual')->uri('http://tempuri.org/'))
+ -> valueof('//Found') || '') eq 'false');
+
+ $r = SOAP::Lite
+ -> uri('http://tempuri.org/')
+ -> proxy('http://beta.search.microsoft.com/search/MSComSearchService.asmx', timeout => $SOAP::Test::TIMEOUT)
+ -> on_action(sub{join'', at _})
+ -> GetBestBets(SOAP::Data->name(Query => 'data')->uri('http://tempuri.org/'))
+ -> result;
+ ok(ref $r && $r->{VocabularyLastcache} =~ /T/);
+
+# Public server with 4s4c implementation (http://www.pocketsoap.com/4s4c/)
+ print "4s4c (aka Simon's SOAP Server Services For COM) server test(s)...\n";
+ $s = SOAP::Lite
+ -> uri('http://www.pocketsoap.com/whois')
+ -> proxy('http://soap.4s4c.com/whois/soap.asp', timeout => $SOAP::Test::TIMEOUT)
+ -> whois(SOAP::Data->name('name' => 'yahoo'));
+ $r = $s->result || '';
+ ok($r =~ /YAHOO/);
+
+# Public server with MS SOAP implementation (http://www.itfinity.net/soap/guid/details.html)
+ print "MS SOAP (on itfinity.net) server test(s)...\n";
+ ok((SOAP::Lite
+ -> uri('http://www.itfinity.net/soap/guid/guid.xsd')
+ -> proxy('http://www.itfinity.net/soap/guid/default.asp', timeout => $SOAP::Test::TIMEOUT)
+ -> NextGUID
+ -> result or '') =~ /.{8}-.{4}-.{4}-.{4}-.{12}/);
+
+# Public server with Apache implementation (http://www.lemurlabs.com/projects/soap/itime/index.jsp)
+ print "Apache SOAP (on lemurlabs.com) server test(s)...\n";
+ ok((SOAP::Lite
+ -> uri('urn:lemurlabs-ITimeService')
+ -> proxy('http://www.lemurlabs.com/rpcrouter', timeout => $SOAP::Test::TIMEOUT)
+ -> getInternetTime
+ -> result or '') =~ /\d/);
+
+ ok(@{SOAP::Lite
+ -> uri('urn:lemurlabs-Fortune')
+ -> proxy('http://www.lemurlabs.com/rpcrouter', timeout => $SOAP::Test::TIMEOUT)
+ -> getDictionaryNameList #getAnyFortune
+ -> result or []} > 1);
+
+ $r = (SOAP::Lite
+ -> uri('urn:lemurlabs-Fortune')
+ -> proxy('http://www.lemurlabs.com/rpcrouter', timeout => $SOAP::Test::TIMEOUT)
+ -> getFortuneByDictionary('work')
+ -> result) || '';
+
+ ok($r && ref($r = SOAP::Deserializer->deserialize($r)) && ($r = $r->valueof('//fortune') || ''));
+ print $r ? "Your fortune cookie:\n$r\n" : "No fortune cookies for you today\n\n";
+
+if (0) { # seems to be down as of 2001/04/18
+# Public server with Lucin implementation (http://www.lucin.com/lu003/sal.htm)
+ print "Lucin SOAP (lucin.com) server test(s)...\n";
+ $r = (SOAP::Lite
+ -> proxy('http://srv.lucin.net/bin/SOAP002.asp', timeout => $SOAP::Test::TIMEOUT)
+ -> uri('http://schema.soapranch.com/salACC/CAddress.xml')
+ -> Ping(SOAP::Data->new(name => 'ApplicID', type => 'xsd:long', value => 1001))
+ -> result) || '';
+
+ ok($r && $r =~ /^OKO/);
+}
+
+# Public server with SOAP::Lite/ApacheSOAP implementations (http://www.xmethods.net/)
+ print "XMethods (SOAP::Lite/ApacheSOAP) server test(s)...\n";
+ print "All connections are keep-alive\n";
+ $s = SOAP::Lite
+ -> uri('urn:xmethods-BNPriceCheck')
+ -> proxy('http://services.xmethods.net/soap/servlet/rpcrouter', timeout => $SOAP::Test::TIMEOUT);
+
+ my $isbn = '0672319225';
+ $r = ($s->getPrice(SOAP::Data->type(string => $isbn))->result) || 0;
+ print "Price for ISBN$isbn is \$$r\n";
+ ok($r > 20 && $r < 60);
+
+ $s = SOAP::Lite
+ -> uri('urn:xmethods-CurrencyExchange')
+ -> proxy('http://services.xmethods.net/soap', timeout => $SOAP::Test::TIMEOUT);
+
+ $r = ($s->getRate(SOAP::Data->name(country1 => 'England'),
+ SOAP::Data->name(country2 => 'Japan'))
+ ->result) || 0;
+ print "Currency rate for England/Japan is $r\n";
+ ok($r > 1);
+
+ $s = SOAP::Lite
+ -> uri('urn:xmethods-delayed-quotes')
+ -> proxy('http://services.xmethods.net/soap', timeout => $SOAP::Test::TIMEOUT);
+
+ $r = ($s->getQuote('MSFT')->result) || 0;
+ print "Quote for MSFT symbol is $r\n";
+ ok($r > 1);
+
+if (0) { # should work, but server wasn't ready as of 2001/04/18
+ $s = SOAP::Lite
+ -> uri('urn:xmethods-delayed-quotes')
+ -> proxy('https://services.xmethods.net/soap', timeout => $SOAP::Test::TIMEOUT);
+
+ $r = ($s->getQuote('MSFT')->result) || 0;
+ print "Quote for MSFT symbol from secure server is $r\n";
+ ok($r > 1);
+}
+
+ ok((SOAP::Lite
+ -> uri('urn:xmethods-DomainChecker')
+ -> proxy('http://services.xmethods.net/soap', timeout => $SOAP::Test::TIMEOUT)
+ -> checkDomain('yahoo.com')
+ -> result or '') eq 'unavailable');
+
+ ok((SOAP::Lite
+ -> uri('urn:xmethods-CATraffic')
+ -> proxy('http://services.xmethods.net/soap/servlet/rpcrouter', timeout => $SOAP::Test::TIMEOUT)
+ -> getTraffic(type SOAP::Data string => 101)
+ -> result or '') =~ /reported/);
+
+ ok((SOAP::Lite
+ -> uri('urn:xmethods-Temperature')
+ -> proxy('http://services.xmethods.net/soap/servlet/rpcrouter', timeout => $SOAP::Test::TIMEOUT)
+ -> getTemp(type SOAP::Data string => 64151)
+ -> result or '') =~ /\./);
+
+if (0) { # Tony brought it down as of 2001/06/11
+ ok((SOAP::Lite
+ -> uri('urn:xmethodsSoapPing')
+ -> proxy('http://services.xmethods.net/perl/soaplite.cgi', timeout => $SOAP::Test::TIMEOUT)
+ -> pingHost(name SOAP::Data hostname => 'www.yahoo.com')
+ -> result or 0) == 1);
+}
+
+ print "BabelFish translator server test(s)...\n";
+ ok((SOAP::Lite
+ -> uri('urn:xmethodsBabelFish')
+ -> proxy('http://services.xmethods.net/perl/soaplite.cgi', timeout => $SOAP::Test::TIMEOUT)
+ -> BabelFish(SOAP::Data->name(translationmode => 'en_it'),
+ SOAP::Data->name(sourcedata => 'I want to work'))
+ -> result or '') =~ /^Desidero lavorare$/);
+}
+
+if (0) { # Kafka response has xsi:type="string" response which is invalid
+ print "Kafka (http://www.vbxml.com/soapworkshop/utilities/kafka/) server test(s)...\n";
+ ok((SOAP::Lite
+ -> service('http://www.vbxml.com/soapworkshop/services/id/id.xml')
+ -> GetSecretIdentity('Superman') or '') eq 'Clark Kent');
+}
Added: packages/soap-lite/branches/upstream/current/t/22-interop_apache.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/22-interop_apache.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/22-interop_apache.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,133 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use SOAP::Lite
+ on_fault => sub {
+ my $soap = shift;
+ my $res = shift;
+ ref $res ? warn(join " ", "SOAP FAULT:", $res->faultstring, "\n")
+ : warn(join " ", "TRANSPORT ERROR:", $soap->transport->status, "\n");
+ return new SOAP::SOM;
+ }
+;
+
+my($a, $s, $r);
+
+# updated on 2001/08/17
+# http://services.xmethods.net:80/soap/servlet/rpcrouter
+my $proxy = 'http://nagoya.apache.org:5049/axis/servlet/AxisServlet';
+
+# ------------------------------------------------------
+use SOAP::Test;
+
+$s = SOAP::Lite->uri('http://something/somewhere')->proxy($proxy)->on_fault(sub{});
+eval { $s->transport->timeout($SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT) };
+$r = $s->test_connection;
+
+unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+}
+# ------------------------------------------------------
+
+plan tests => 15;
+
+{
+# XMethod's JavaSOAP server (http://xmethods.net/detail.html?id=11)
+ print "XMethod's JavaSOAP server test(s)...\n";
+ $s = SOAP::Lite
+ -> uri('http://soapinterop.org/')
+ -> proxy($proxy)
+ ;
+
+ $a = 'SOAP::Lite';
+ $r = $s->echoString($a)->result;
+ ok($r eq $a);
+
+ $a = ['a', 'b'];
+ $r = $s->echoStringArray($a)->result;
+ ok(ref $r && join('', @$r) eq join('', @$a));
+
+ $a = 11;
+ $r = $s->echoInteger($a)->result;
+ ok($r == $a);
+
+ $a = [1, 3, 5];
+ $r = $s->echoIntegerArray($a)->result;
+ ok(ref $r && join('', @$r) == join('', @$a));
+
+ $a = 11.02;
+ $r = $s->echoFloat($a)->result;
+ ok($r == $a);
+
+ $a = [1.1, 3.3, 5.5];
+ $r = $s->echoFloatArray($a)->result;
+ ok(ref $r && join('', @$r) eq join('', @$a));
+
+ # you may specify URI manually (but see maptype() below)
+ $a = {varString => 'b', varInt => 2, varFloat => 95.7};
+ $r = $s->echoStruct(
+ SOAP::Data->type('xx:SOAPStruct' => $a)
+ ->attr({'xmlns:xx' => 'http://soapinterop.org/xsd'})
+ )->result;
+ ok(ref $r && join('', sort values %$r) eq join('', sort values %$a));
+
+ # specify mapping to URI
+ $s->maptype({SOAPStruct => 'http://soapinterop.org/xsd'});
+
+ $a = {varString => 'b', varInt => 2, varFloat => 95.7};
+ $r = $s->echoStruct($a)->result;
+ ok(ref $r && join('', sort values %$r) eq join('', sort values %$a));
+
+ $a = {varString => 'b', varInt => 2, varFloat => 95.7};
+ $r = $s->echoStruct(SOAP::Data->name(something => $a))->result;
+ ok(ref $r && join('', sort values %$r) eq join('', sort values %$a));
+
+ $a = [
+ {varString => 'b', varInt => 2, varFloat => 95.7},
+ {varString => 'c', varInt => 3, varFloat => 85.7},
+ {varString => 'd', varInt => 4, varFloat => 75.7},
+ ];
+ $r = $s->echoStructArray($a)->result;
+ ok(ref $r && join('', map { sort values %$_ } @$r) eq join('', map { sort values %$_ } @$a));
+
+ $a = [
+ {varString => 'b', varInt => 2, varFloat => 95.7},
+ {varString => 'c', varInt => 3, varFloat => 85.7},
+ {varString => 'd', varInt => 4, varFloat => 75.7},
+ ];
+ $r = $s->echoStructArray(SOAP::Data->name(something => $a))->result;
+ ok(ref $r && join('', map { sort values %$_ } @$r) eq join('', map { sort values %$_ } @$a));
+
+ my $key = "\0\1";
+ my $value = 456;
+
+ { local $^W;
+ # implicit, warning with -w
+ $a = $s->echoMap({a => 123, $key => $value})->result;
+ ok($a->{$key} == $value);
+ }
+
+ # explicit
+ $a = $s->echoMap(SOAP::Data->type(map => {a => 123, $key => $value}))->result;
+ ok($a->{$key} == $value);
+
+ { local $^W;
+ # implicit, warning with -w
+ $a = $s->echoMapArray([{a => 123, $key => $value}, {b => 123, $key => 789}])->result;
+ ok($a->[0]->{$key} == $value);
+ }
+
+ # explicit
+ $a = $s->echoMapArray([SOAP::Data->type(map => {a => 123, $key => $value}), SOAP::Data->type(map => {b => 123, $key => 789})])->result;
+ ok($a->[0]->{$key} == $value);
+}
Added: packages/soap-lite/branches/upstream/current/t/23-ppm.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/23-ppm.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/23-ppm.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,58 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use SOAP::Lite
+ on_fault => sub {
+ my $soap = shift;
+ my $res = shift;
+ ref $res ? warn(join " ", "SOAP FAULT:", $res->faultstring, "\n")
+ : warn(join " ", "TRANSPORT ERROR:", $soap->transport->status, "\n");
+ return new SOAP::SOM;
+ }
+;
+
+my($a, $s, $r);
+
+my $proxy = 'http://ppm.activestate.com/cgibin/PPM/ppmserver.pl';
+
+# ------------------------------------------------------
+use SOAP::Test;
+
+$s = SOAP::Lite->uri('urn:/PPMServer')->proxy($proxy)->on_fault(sub{});
+eval { $s->transport->timeout($SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT) };
+$r = $s->test_connection;
+
+unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+}
+# ------------------------------------------------------
+
+plan tests => 3;
+
+{
+# ActiveState's PPM server (http://activestate.com/)
+ print "ActiveState's PPM server test(s)...\n";
+ $s = SOAP::Lite
+ -> uri('urn:/PPMServer')
+ -> proxy($proxy)
+ ;
+
+ $r = $s->fetch_ppd('SOAP-Lite')->result;
+
+ ok($r =~ 'SOAP-Lite');
+ ok($r =~ 'Paul Kulchenko');
+
+ $r = $s->fetch_ppd('SOAP-Super-Lite')->result;
+
+ ok(!defined $r);
+}
Added: packages/soap-lite/branches/upstream/current/t/24-wsdl.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/24-wsdl.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/24-wsdl.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,103 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use SOAP::Lite
+ on_fault => sub {
+ my $soap = shift;
+ my $res = shift;
+ ref $res ? warn(join "\n", "--- SOAP FAULT ---", $res->faultcode, $res->faultstring, '')
+ : warn(join "\n", "--- TRANSPORT ERROR ---", $soap->transport->status, '');
+ return new SOAP::SOM;
+ }
+;
+
+my($a, $s, $r, $serialized, $deserialized);
+
+# ------------------------------------------------------
+use SOAP::Test;
+
+$s = SOAP::Lite->uri('http://something/somewhere')->proxy('http://services.xmethods.net/soap/servlet/rpcrouter')->on_fault(sub{});
+eval { $s->transport->timeout($SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT) };
+$r = $s->test_connection;
+
+unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+}
+# ------------------------------------------------------
+
+plan tests => 12;
+
+{
+# Service description (WSDL) (http://www.xmethods.net/)
+ print "Service description (WSDL) test(s)...\n";
+ $s = SOAP::Lite
+ -> service('http://services.xmethods.net/soap/urn:xmethods-delayed-quotes.wsdl');
+
+ ok($s->getQuote('MSFT') > 1);
+
+ ok(SOAP::Lite
+ -> service('http://services.xmethods.net/soap/urn:xmethods-delayed-quotes.wsdl')
+ -> getQuote('MSFT') > 1);
+
+ # WSDL with <import> element and multiple ports (non-SOAP bindings)
+ ok(SOAP::Lite
+ -> service('http://www.xmethods.net/sd/StockQuoteImport.wsdl')
+ -> getQuote('MSFT') > 1);
+
+ my $schema = SOAP::Schema
+ -> schema('http://services.xmethods.net/soap/urn:xmethods-delayed-quotes.wsdl')
+ -> parse('net.xmethods.services.stockquote.StockQuoteService');
+
+ foreach (keys %{$schema->services}) {
+ eval { $schema->stub($_) } or die;
+ }
+
+ # SOAP::Schema converts
+ # net.xmethods.services.stockquote.StockQuoteService
+ # into
+ # net_xmethods_services_stockquote_StockQuoteService
+
+ print "Service description static stub test(s)...\n";
+ ok(net_xmethods_services_stockquote_StockQuoteService->getQuote('MSFT') > 1);
+
+ ok(defined net_xmethods_services_stockquote_StockQuoteService->self);
+
+ ok(net_xmethods_services_stockquote_StockQuoteService->self->call);
+
+ print "Service description static stub with import test(s)...\n";
+ net_xmethods_services_stockquote_StockQuoteService->import(':all');
+
+ ok(getQuote('MSFT') > 1);
+
+ ok(defined net_xmethods_services_stockquote_StockQuoteService->self);
+
+ ok(net_xmethods_services_stockquote_StockQuoteService->self->call);
+
+ # ok, now we'll test for passing SOAP::Data and SOAP::Headers as a parameters
+
+ my @params;
+ {
+ package TestStockQuoteService;
+ @TestStockQuoteService::ISA = 'net_xmethods_services_stockquote_StockQuoteService';
+ sub call { shift; @params = @_; new SOAP::SOM }
+ }
+
+ my @testparams = (SOAP::Data->name(param1 => 'MSFT'),
+ SOAP::Data->name('param2'),
+ SOAP::Header->name(header1 => 'value'));
+ TestStockQuoteService->new->getQuote(@testparams);
+
+ ok($params[1]->value->name eq 'param1');
+ ok($params[2]->name eq 'param2');
+ ok(ref $params[3] eq 'SOAP::Header' && $params[3]->name eq 'header1');
+}
Added: packages/soap-lite/branches/upstream/current/t/25-uddi.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/25-uddi.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/25-uddi.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,228 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use UDDI::Lite
+ import => 'UDDI::Data',
+ import => 'UDDI::Lite',
+ proxy => 'http://uddi.microsoft.com/inquire';
+
+my($a, $s, $r, $serialized, $deserialized);
+
+# ------------------------------------------------------
+use SOAP::Test;
+
+$s = SOAP::Lite->uri('http://something/somewhere')->proxy('http://uddi.microsoft.com/inquire')->on_fault(sub{});
+eval { $s->transport->timeout($SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT) };
+$r = $s->test_connection;
+
+unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+}
+# ------------------------------------------------------
+
+plan tests => 21;
+
+{
+ $a = bindingTemplate([
+ accessPoint('someurl'),
+ tModelInstanceDetails(
+ tModelInstanceInfo(
+ description('some tModel')
+ )->tModelKey('UUID:C1ACF26D-9672-4404-9D70-39B756E62AB4')
+ )
+ ])->bindingKey('');
+
+ ok(ref $a eq 'UDDI::Data');
+ ok($a->accessPoint eq 'someurl');
+ ok($a->tModelInstanceDetails->tModelInstanceInfo->description eq 'some tModel');
+ ok($a->bindingKey eq '');
+
+ $a = tModelInstanceInfo;
+ ok(ref $a eq 'UDDI::Data');
+
+ my @syntaxes = map { UDDI::Serializer->serialize($_) } (
+
+ # syntax 1
+ findQualifiers(findQualifier('sortByNameAsc',
+ 'caseSensitiveMatch')),
+
+ # syntax 2
+ findQualifiers([findQualifier('sortByNameAsc'),
+ findQualifier('caseSensitiveMatch')]),
+
+ # syntax 3
+ # WARNING! don't forget to put brakets if you use with
+ # and this is not the last expression in the list
+ with(findQualifiers =>
+ findQualifier('sortByNameAsc'),
+ findQualifier('caseSensitiveMatch'),
+ ),
+
+ # syntax 4
+ findQualifiers->with(
+ findQualifier('sortByNameAsc'),
+ findQualifier('caseSensitiveMatch'),
+ ),
+
+ # syntax 5
+ with findQualifiers =>
+ findQualifier => 'sortByNameAsc',
+ findQualifier => 'caseSensitiveMatch',
+ );
+
+ # all syntaxes should give the same serialized string
+ for (1..4) {
+ ok($syntaxes[0], $syntaxes[$_]);
+ }
+
+ @syntaxes = map { UDDI::Serializer->serialize($_) } (
+
+ # syntax 1
+ do {
+ my $tmodels = tModelInstanceDetails(
+ tModelInstanceInfo(
+ description('some tModel')
+ )->tModelKey('UUID:C1ACF26D-9672-4404-9D70-39B756E62AB4')
+ );
+ bindingTemplate([
+ accessPoint('someurl')->attr({foo => 'bar'}),
+ $tmodels
+ ])->bindingKey('');
+ },
+
+ # syntax 2
+ bindingTemplate([
+ accessPoint('someurl')->attr({foo => 'bar'}),
+ tModelInstanceDetails(
+ tModelInstanceInfo(
+ description('some tModel')
+ )->tModelKey('UUID:C1ACF26D-9672-4404-9D70-39B756E62AB4')
+ )
+ ])->bindingKey(''),
+
+ # syntax 3
+ do {
+ my $tmodels = tModelInstanceDetails(
+ tModelInstanceInfo(
+ description('some tModel')
+ )->tModelKey('UUID:C1ACF26D-9672-4404-9D70-39B756E62AB4')
+ );
+
+ my $ap = accessPoint('someurl');
+ $ap->attr({foo => 'bar'});
+ with bindingTemplate =>
+ $ap,
+ $tmodels,
+ bindingKey => ''
+ },
+
+ # syntax 4
+ with bindingTemplate =>
+ accessPoint('someurl')->attr({foo => 'bar'}),
+ tModelInstanceDetails =>
+ tModelInstanceInfo(
+ description('some tModel')
+ )->tModelKey('UUID:C1ACF26D-9672-4404-9D70-39B756E62AB4'),
+ bindingKey(''),
+ );
+
+ # all syntaxes should give the same serialized string
+ for (1..3) {
+ ok($syntaxes[0], $syntaxes[$_]);
+ }
+
+ # testing UDDI::Data and alternative syntaxes
+ @syntaxes = map { UDDI::Serializer->serialize($_) } (
+
+ # syntax 1
+ businessEntity(name('old')),
+
+ # syntax 2
+ businessEntity(UDDI::Data->name(name => 'old')),
+
+ # syntax 3
+ businessEntity(UDDI::Data->name('name')->value('old')),
+
+ # syntax 4
+ # while there is also method(name => 'old') syntax
+ # it only works for UDDI methods, like find_business:
+ # find_business(name => 'old')
+ # and doesn't work for all other data elements
+
+ );
+
+ # all syntaxes should give the same serialized string
+ for (1..2) {
+ ok($syntaxes[0], $syntaxes[$_]);
+ }
+
+ # testing attributes
+ my $u = UDDI::Data->name(name => 'old')->attr({foo => 'bar'});
+ ok($u->attr->{'foo'} eq 'bar');
+
+ @syntaxes = map { UDDI::Serializer->serialize($_) } (
+
+ # syntax 1
+ UDDI::Data->name(name => 'old')->attr({foo => 'bar'}),
+
+ # syntax 2
+ name({foo => 'bar'}, 'old'),
+
+ );
+
+ # all syntaxes should give the same serialized string
+ for (1..1) {
+ ok($syntaxes[0], $syntaxes[$_]);
+ }
+
+}
+
+{
+# UDDI access
+ print "UDDI access test(s)...\n";
+
+ my $proxy = 'http://uddi.microsoft.com/inquire';
+ my $uddi = new UDDI::Lite proxy => $proxy;
+
+ my @parameters = (
+ findQualifiers(findQualifier('sortByNameAsc',
+ 'caseSensitiveMatch')),
+ name('M'),
+ );
+
+ ok(ref $parameters[0] eq 'UDDI::Data');
+
+ $r = $uddi->find_business({maxRows => 1}, @parameters)->result;
+
+ ok(defined $r);
+ ok(@{[$r->businessInfos->businessInfo]} == 1); # test for maxRows
+
+ $r = $uddi->find_business(@parameters)->result;
+
+ for ($r->businessInfos->businessInfo) {
+ print $_->name, "\n";
+ if ($_->name eq "Microsoft Corporation") {
+ my $key = $_->businessKey;
+ print "$key\n";
+ ok($key =~ /.{8}-.{4}-.{4}-.{4}-.{12}/);
+
+ my $e = $uddi->get_businessDetail($key)->result->businessEntity;
+ my @services = $e->businessServices->businessService;
+ ok(@services > 1);
+
+ for (@services) {
+ print " ", $_->name, "\n";
+ }
+ }
+ }
+}
Added: packages/soap-lite/branches/upstream/current/t/26-xmlrpc.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/26-xmlrpc.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/26-xmlrpc.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,71 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use XMLRPC::Lite;
+
+my($a, $s, $r);
+
+my $proxy = 'http://betty.userland.com/RPC2';
+
+# ------------------------------------------------------
+use SOAP::Test;
+
+$s = XMLRPC::Lite->proxy($proxy)->on_fault(sub{});
+eval { $s->transport->timeout($SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT) };
+$r = $s->test_connection;
+
+unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+}
+# ------------------------------------------------------
+
+plan tests => 10;
+
+{
+ ok((XMLRPC::Lite
+ -> proxy($proxy)
+ -> call('examples.getStateStruct', {state1 => 12, state2 => 28})
+ -> result or '') eq 'Idaho,Nevada');
+
+ ok((XMLRPC::Lite
+ -> proxy($proxy)
+ -> call('examples.getStateName', 21)
+ -> result or '') eq 'Massachusetts');
+
+ ok((XMLRPC::Lite
+ -> proxy($proxy)
+ -> call('examples.getStateNames', 21,22,23,24)
+ -> result or '') =~ /Massachusetts\s+Michigan\s+Minnesota\s+Mississippi/);
+
+ $s = XMLRPC::Lite
+ -> proxy($proxy)
+ -> call('examples.getStateList', [21,22]);
+ ok(($s->result or '') eq 'Massachusetts,Michigan');
+ ok(! defined $s->fault);
+ ok(! defined $s->faultcode);
+
+ print "XMLRPC autodispatch and fault check test(s)...\n";
+
+ eval "use XMLRPC::Lite +autodispatch =>
+ proxy => '$proxy',
+ ; 1" or die;
+
+ XMLRPC->getStateName(21);
+
+ $r = XMLRPC::Lite->self->call;
+
+ ok(ref $r->fault eq 'HASH');
+ ok($r->fault->{faultString} =~ /Can't evaluate/);
+ ok($r->faultstring =~ /Can't evaluate/);
+ ok($r->faultcode == 7);
+}
Added: packages/soap-lite/branches/upstream/current/t/27-xmlparserlite.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/27-xmlparserlite.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/27-xmlparserlite.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,77 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+unless (eval { require XML::Parser::Lite }) {
+ print "1..0 # Skip: ", $@, "\n";
+ exit;
+}
+
+plan tests => 17;
+
+my($s, $c, $e, $a);
+
+($s, $c, $e) = (0) x 3;
+my $p1 = new XML::Parser::Lite;
+$p1->setHandlers(
+ Start => sub { shift; $s++; print "start: @_\n" },
+ Char => sub { shift; $c++; print "char: @_\n" },
+ End => sub { shift; $e++; print "end: @_\n" },
+);
+$p1->parse('<foo id="me">Hello World!</foo>');
+ok(1 => 1);
+ok($s == 1);
+ok($c == 1);
+ok($e == 1);
+
+($s, $c, $e) = (0) x 3;
+my %foo;
+my $p2 = new XML::Parser::Lite
+ Handlers => {
+ Start => sub { shift; $s++; %foo = @_[1..$#_] if $_[0] eq 'foo'; print "start: @_\n" },
+ Char => sub { shift; $c++; print "char: @_\n" },
+ End => sub { shift; $e++; print "end: @_\n" },
+ }
+;
+$p2->parse('<foo id="me" root="0" empty="">Hello <bar>cruel</bar> <foobar/> World!</foo>');
+ok(1 => 1);
+ok($s == 3);
+ok($c == 4);
+ok($e == 3);
+ok($foo{id} eq 'me');
+ok(defined $foo{root} && $foo{root} eq '0');
+ok(defined $foo{empty} && $foo{empty} eq '');
+
+$p2->setHandlers;
+
+# check for junk before
+eval { $p2->parse('foo<foo id="me">Hello World!</foo>') };
+ok($@ =~ /^junk .+ before/);
+
+# check for junk after
+eval { $p2->parse('<foo id="me">Hello World!</foo>bar') };
+ok($@ =~ /^junk .+ after/);
+
+# check for non-closed tag
+eval { $p2->parse('<foo id="me">Hello World!') };
+ok($@ =~ /^not properly closed tag 'foo'/);
+
+# check for non properly closed tag
+eval { $p2->parse('<foo id="me">Hello World!<bar></foo></bar>') };
+ok($@ =~ /^mismatched tag 'foo'/);
+
+# check for unwanted tag
+eval { $p2->parse('<foo id="me">Hello World!</foo><bar></bar>') };
+ok($@ =~ /^multiple roots, wrong element 'bar'/);
+
+# check for string without elements
+eval { $p2->parse(' ') };
+ok($@ =~ /^no element found/);
Added: packages/soap-lite/branches/upstream/current/t/28-uddi_search.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/28-uddi_search.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/28-uddi_search.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,81 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use UDDI::Lite
+ import => 'UDDI::Data',
+ import => 'UDDI::Lite',
+ proxy => 'http://www-3.ibm.com/services/uddi/inquiryapi'
+;
+
+my($a, $s, $r, $serialized, $deserialized);
+
+# ------------------------------------------------------
+use SOAP::Test;
+
+$s = SOAP::Lite->uri('http://something/somewhere')->proxy('http://www-3.ibm.com/services/uddi/inquiryapi')->on_fault(sub{});
+eval { $s->transport->timeout($SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT) };
+$r = $s->test_connection;
+
+unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+}
+# ------------------------------------------------------
+
+my($serviceInfo) = grep { $_->name =~ /stock quote/i } find_business(name('XMethods'))
+ -> businessInfos
+ -> businessInfo
+ -> serviceInfos
+ -> serviceInfo
+;
+
+unless (defined $serviceInfo) {
+ print "1..0 # Skip: getQuote service doesn't exist on XMethods\n";
+ exit;
+}
+
+plan tests => 6;
+
+ok($serviceInfo->name);
+ok($serviceInfo->serviceKey);
+print $serviceInfo->name, ", ", $serviceInfo->serviceKey, "\n";
+
+my $bindingTemplate = get_serviceDetail($serviceInfo->serviceKey)
+ -> businessService
+ -> bindingTemplates
+ -> bindingTemplate
+;
+
+my $accessPoint = $bindingTemplate->accessPoint->value;
+my $tModelKey = $bindingTemplate
+ -> tModelInstanceDetails
+ -> tModelInstanceInfo
+ -> tModelKey
+;
+
+ok($accessPoint);
+ok($tModelKey);
+print $accessPoint, ", ", $tModelKey, "\n";
+
+my $wsdl = get_tModelDetail($tModelKey)
+ -> tModel
+ -> overviewDoc
+ -> overviewURL
+ -> value
+;
+
+ok($wsdl);
+print $wsdl, "\n";
+
+my $quote = SOAP::Lite->service($wsdl)->proxy($accessPoint)->getQuote('MSFT');
+ok($quote > 0);
+print $quote, "\n";
Added: packages/soap-lite/branches/upstream/current/t/29-uddi_publishing.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/29-uddi_publishing.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/29-uddi_publishing.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,69 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use UDDI::Lite
+ import => 'UDDI::Data',
+ import => 'UDDI::Lite',
+ proxy => "https://uddi.xmethods.net:8005/glue/publish/uddi";
+
+my($a, $s, $r, $serialized, $deserialized);
+
+# ------------------------------------------------------
+use SOAP::Test;
+
+$s = SOAP::Lite->uri('http://something/somewhere')->proxy("https://uddi.xmethods.net:8005/glue/publish/uddi")->on_fault(sub{});
+eval { $s->transport->timeout($SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT) };
+$r = $s->test_connection;
+
+unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+}
+# ------------------------------------------------------
+
+plan tests => 7;
+
+{
+ # You may run these tests/examples for UDDI publishing API against
+ # UDDI registry that was kindly provided with following disclamer:
+ # "This is a free registry provided by XMethods.net and
+ # implemented using GLUE platform (Graham Glass, TheMindElectric)."
+ # Thanks to Tony Hong for his help and support
+
+ my $name = 'Sample business ' . $$ . time; # just to make it unique
+
+ print "Authorizing...\n";
+ my $auth = get_authToken({userID => 'soaplite', cred => 'soaplite'})->authInfo;
+ ok(defined $auth);
+ my $busent = businessEntity(name($name))->businessKey('');
+ ok(defined $busent);
+
+ print "Saving business '$name'...\n";
+ my $newent = save_business($auth, $busent)->businessEntity;
+ ok(UNIVERSAL::isa($newent => 'HASH'));
+ my $newkey = $newent->businessKey;
+ ok(length($newkey) == 36);
+
+ ok($newent->discoveryURLs->discoveryURL =~ /$newkey/);
+ print "Created...\n";
+ print $newkey, "\n";
+ print $newent->discoveryURLs->discoveryURL, "\n";
+
+ print "Deleting '$newkey'...\n";
+ my $result = delete_business($auth, $newkey)->result;
+ ok(defined $result);
+
+ # IBM returns 'successful' with type
+ # GLUE returns long sentence that has 'no failure'
+ ok($result->errInfo =~ /succ?essful|no failure/i);
+ print $result->errInfo, "\n";
+}
Added: packages/soap-lite/branches/upstream/current/t/36-leaks.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/36-leaks.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/36-leaks.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,77 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use strict;
+use Test;
+
+use SOAP::Lite
+ on_fault => sub {
+ my $soap = shift;
+ my $res = shift;
+ ref $res ? warn(join " ", "SOAP FAULT:", $res->faultstring, "\n")
+ : warn(join " ", "TRANSPORT ERROR:", $soap->transport->status, "\n");
+ return new SOAP::SOM;
+ }
+;
+
+my($a, $s, $r);
+
+my $proxy = 'http://services.soaplite.com/echo.cgi';
+
+# ------------------------------------------------------
+use SOAP::Test;
+
+$s = SOAP::Lite->uri('http://something/somewhere')->proxy($proxy)->on_fault(sub{});
+eval { $s->transport->timeout($SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT) };
+$r = $s->test_connection;
+
+unless (defined $r && defined $r->envelope) {
+ print "1..0 # Skip: ", $s->transport->status, "\n";
+ exit;
+}
+# ------------------------------------------------------
+
+plan tests => 16;
+
+{
+ print "Memory leaks test(s)...\n";
+
+ SOAP::Lite->self(undef);
+
+ my %calls;
+
+ SOAP::Lite->import(trace => [objects => sub {
+ $calls{$2}{$1}++ if (caller(2))[3] =~ /^(.+)::(.+)$/;
+ }]);
+ {
+ my $soap = SOAP::Lite
+ -> uri("Echo")
+ -> proxy($proxy)
+ -> echo;
+ }
+ foreach (keys %{$calls{new}}) {
+ print "default parser: $_\n";
+ ok(exists $calls{DESTROY}{$_});
+ }
+
+ %calls = ();
+ {
+ local $SOAP::Constants::DO_NOT_USE_XML_PARSER = 1;
+ my $soap = SOAP::Lite
+ -> uri("Echo")
+ -> proxy($proxy)
+ -> echo;
+ }
+ foreach (keys %{$calls{new}}) {
+ print "XML::Parser::Lite: $_\n";
+ ok(exists $calls{DESTROY}{$_});
+ }
+
+ SOAP::Lite->import(trace => '-objects');
+}
Added: packages/soap-lite/branches/upstream/current/t/37-mod_xmlrpc.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/37-mod_xmlrpc.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/37-mod_xmlrpc.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,13 @@
+#!/bin/env perl
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use XMLRPC::Test;
+
+XMLRPC::Test::Server::run_for(shift || 'http://localhost/mod_xmlrpc');
+
Added: packages/soap-lite/branches/upstream/current/t/38-packager.t
===================================================================
--- packages/soap-lite/branches/upstream/current/t/38-packager.t 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/38-packager.t 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,171 @@
+#!/bin/env perl
+
+use strict;
+use Test;
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+ plan tests => 10;
+}
+
+my ($mp, $env, $part, @part_data);
+
+use SOAP::Packager;
+$mp = SOAP::MIME::Packager->new;
+ok(ref $mp);
+
+# check attachment deserialization
+print "Attachment deserialization (Content-ID) test(s)...\n";
+$env = $mp->unpackage(<<'EOX');
+Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<claim061400a.xml at claiming-it.com>"
+SOAPAction: http://schemas.risky-stuff.com/Auto-Claim
+Content-Description: This is the optional message description.
+
+--MIME_boundary
+Content-Type: text/xml; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+Content-ID: <claim061400a.xml at claiming-it.com>
+
+<?xml version='1.0' ?>
+<SOAP-ENV:Envelope
+ xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
+ <SOAP-ENV:Body>
+ <claim:insurance_claim_auto id="insurance_claim_document_id"
+ xmlns:claim="http://schemas.risky-stuff.com/Auto-Claim">
+ <theSignedForm href="cid:claim061400a.tiff at claiming-it.com"/>
+ <theCrashPhoto href="cid:claim061400a.jpeg at claiming-it.com"/>
+ <somexml href="cid:claim061400a.somexml at claiming-it.com"/>
+ <realxml href="cid:claim061400a.realxml at claiming-it.com"/>
+ <!-- ... more claim details go here... -->
+ </claim:insurance_claim_auto>
+ </SOAP-ENV:Body>
+</SOAP-ENV:Envelope>
+
+--MIME_boundary
+Content-Type: image/tiff
+Content-Transfer-Encoding: base64
+Content-ID: <claim061401a.tiff at claiming-it.com>
+
+AAECAyAgIAQFBg==
+--MIME_boundary
+Content-Type: image/jpeg
+Content-Transfer-Encoding: binary
+Content-ID: <claim061402a.jpeg at claiming-it.com>
+
+...Raw JPEG image..
+--MIME_boundary
+Content-Type: text/plain
+Content-Transfer-Encoding: binary
+Content-ID: <claim061403a.somexml at claiming-it.com>
+
+<a><b>c</b></a>
+--MIME_boundary
+Content-Type: text/xml
+Content-Transfer-Encoding: binary
+Content-ID: <claim061404a.realxml at claiming-it.com>
+
+<a><b>c</b></a>
+--MIME_boundary--
+
+EOX
+
+# test to see how how many parts were found:
+ok(@{$mp->parts} == 4);
+ok(UNIVERSAL::isa(ref($mp->parts->[0]) => "MIME::Entity"));
+
+# Tests to see if data extraction works - TIFF not checked
+ at part_data = $mp->find_part( id => '<claim061402a.jpeg at claiming-it.com>' );
+ok($part_data[0] eq '...Raw JPEG image..');
+ at part_data = $mp->find_part( id => '<claim061403a.somexml at claiming-it.com>' );
+ok($part_data[0] eq '<a><b>c</b></a>');
+ at part_data = $mp->find_part( id => '<claim061404a.realxml at claiming-it.com>' );
+ok($part_data[0] eq '<a><b>c</b></a>');
+
+
+# Test: no start parameter specified
+$env = $mp->unpackage(<<'EOX');
+Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"
+SOAPAction: http://schemas.risky-stuff.com/Auto-Claim
+Content-Description: This is the optional message description.
+
+--MIME_boundary
+Content-Type: text/xml; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+Content-ID: <claim061400a.xml at claiming-it.com>
+
+<?xml version='1.0' ?>
+<SOAP-ENV:Envelope
+ xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
+ <SOAP-ENV:Body>
+ <claim:insurance_claim_auto id="insurance_claim_document_id"
+ xmlns:claim="http://schemas.risky-stuff.com/Auto-Claim">
+ <theSignedForm href="cid:claim061400a.tiff at claiming-it.com"/>
+ <theCrashPhoto href="cid:claim061400a.jpeg at claiming-it.com"/>
+ <somexml href="cid:claim061400a.somexml at claiming-it.com"/>
+ <realxml href="cid:claim061400a.realxml at claiming-it.com"/>
+ <!-- ... more claim details go here... -->
+ </claim:insurance_claim_auto>
+ </SOAP-ENV:Body>
+</SOAP-ENV:Envelope>
+
+--MIME_boundary
+Content-Type: text/plain
+Content-Transfer-Encoding: binary
+Content-ID: <claim061403a.somexml at claiming-it.com>
+
+<a><b>c</b></a>
+--MIME_boundary--
+
+EOX
+
+# test to see how how many parts were found:
+ok(@{$mp->parts} == 1);
+# Tests to see if data extraction worked
+ at part_data = $mp->find_part( id => '<claim061403a.somexml at claiming-it.com>' );
+ok($part_data[0] eq '<a><b>c</b></a>');
+
+# test to see if start parameter works if it doesn't point to root
+$env = $mp->unpackage(<<'EOX');
+Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<claim061400a.xml at claiming-it.com>"
+SOAPAction: http://schemas.risky-stuff.com/Auto-Claim
+Content-Description: This is the optional message description.
+
+--MIME_boundary
+Content-Type: text/plain
+Content-Transfer-Encoding: binary
+Content-ID: <claim061403a.somexml at claiming-it.com>
+
+<a><b>c</b></a>
+--MIME_boundary
+Content-Type: text/xml; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+Content-ID: <claim061400a.xml at claiming-it.com>
+
+<?xml version='1.0' ?>
+<SOAP-ENV:Envelope
+ xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
+ <SOAP-ENV:Body>
+ <claim:insurance_claim_auto id="insurance_claim_document_id"
+ xmlns:claim="http://schemas.risky-stuff.com/Auto-Claim">
+ <theSignedForm href="cid:claim061400a.tiff at claiming-it.com"/>
+ <theCrashPhoto href="cid:claim061400a.jpeg at claiming-it.com"/>
+ <somexml href="cid:claim061400a.somexml at claiming-it.com"/>
+ <realxml href="cid:claim061400a.realxml at claiming-it.com"/>
+ <!-- ... more claim details go here... -->
+ </claim:insurance_claim_auto>
+ </SOAP-ENV:Body>
+</SOAP-ENV:Envelope>
+
+--MIME_boundary--
+EOX
+
+# test to see how how many parts were found:
+ok(@{$mp->parts} == 1);
+# Tests to see if data extraction worked
+ at part_data = $mp->find_part( id => '<claim061403a.somexml at claiming-it.com>' );
+ok($part_data[0] eq '<a><b>c</b></a>');
+
+1;
Added: packages/soap-lite/branches/upstream/current/t/TEST.pl
===================================================================
--- packages/soap-lite/branches/upstream/current/t/TEST.pl 2005-12-24 19:37:58 UTC (rev 1748)
+++ packages/soap-lite/branches/upstream/current/t/TEST.pl 2005-12-25 18:17:11 UTC (rev 1749)
@@ -0,0 +1,15 @@
+#!/bin/env perl
+#!d:\perl\bin\perl.exe
+
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use Test::Harness;
+
+ at ARGV = sort <*.t> unless @ARGV;
+
+runtests(@ARGV);
\ No newline at end of file
More information about the Pkg-perl-cvs-commits
mailing list