r3232 - in /packages/soap-lite/branches/upstream/current: Changes
META.yml
lib/SOAP/Lite.pm lib/SOAP/Packager.pm lib/SOAP/Transport/HTTP.pm
t/01-core.t t/03-server.t
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Fri Jul 7 11:48:45 UTC 2006
Author: eloy
Date: Fri Jul 7 11:48:44 2006
New Revision: 3232
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3232
Log:
Load /tmp/tmp.Sbxgo19329/soap-lite-0.68 into
packages/soap-lite/branches/upstream/current.
Modified:
packages/soap-lite/branches/upstream/current/Changes
packages/soap-lite/branches/upstream/current/META.yml
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/Transport/HTTP.pm
packages/soap-lite/branches/upstream/current/t/01-core.t
packages/soap-lite/branches/upstream/current/t/03-server.t
Modified: packages/soap-lite/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/soap-lite/branches/upstream/current/Changes?rev=3232&op=diff
==============================================================================
--- packages/soap-lite/branches/upstream/current/Changes (original)
+++ packages/soap-lite/branches/upstream/current/Changes Fri Jul 7 11:48:44 2006
@@ -1,7 +1,7 @@
#
# Revision history for Perl extension SOAP::Lite.
#
-# $Id: Changes,v 1.19 2005/12/25 07:52:17 byrnereese Exp $
+# $Id: Changes,v 1.21 2006/07/06 18:14:38 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
@@ -10,6 +10,16 @@
-----------------------------------------------------------------------
THIS RELEASE
-----------------------------------------------------------------------
+
+0.68 July 6 2006
+
+ ! Patched support for mod_perl Apache2 (thanks to JT Justman)
+ ! Fixed bug where SOAP::SOM objects were not properly detected,
+ serialized and returned (thanks chris at prather dot o r g)
+ ! Fixed bug with default_ns and ns functions so that they
+ serialized XML properly.
+ + Started to add experimental DIME support - possible impacts to MIME
+ support as well
0.65-beta7 May 12 2005
Modified: packages/soap-lite/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/soap-lite/branches/upstream/current/META.yml?rev=3232&op=diff
==============================================================================
--- packages/soap-lite/branches/upstream/current/META.yml (original)
+++ packages/soap-lite/branches/upstream/current/META.yml Fri Jul 7 11:48:44 2006
@@ -1,12 +1,13 @@
# 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.67
+version: 0.68
version_from: lib/SOAP/Lite.pm
installdirs: site
requires:
Compress::Zlib: 0
Crypt::SSLeay: 0
+ FCGI: 0
HTTP::Daemon: 0
IO::File: 0
MIME::Base64: 0
Modified: packages/soap-lite/branches/upstream/current/lib/SOAP/Lite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/soap-lite/branches/upstream/current/lib/SOAP/Lite.pm?rev=3232&op=diff
==============================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Lite.pm (original)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Lite.pm Fri Jul 7 11:48:44 2006
@@ -4,7 +4,7 @@
# 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.39 2006/01/27 21:31:57 byrnereese Exp $
+# $Id: Lite.pm,v 1.41 2006/07/06 18:11:44 byrnereese Exp $
#
# ======================================================================
@@ -15,7 +15,7 @@
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.67';
+$VERSION = '0.68';
# ======================================================================
@@ -100,8 +100,12 @@
my($package, $method) = $AUTOLOAD =~ m/(?:(.+)::)([^:]+)$/;
return if $method eq 'DESTROY';
no strict 'refs';
+
+ my $export_var = $package . '::EXPORT';
+ my @export = @$export_var;
+
die "Type '$method' can't be found in a schema class '$package'\n"
- unless $method =~ s/^as_// && grep {$_ eq $method} @{"$package\::EXPORT"};
+ unless $method =~ s/^as_// && grep {$_ eq $method} @{$export_var};
$method =~ s/_/-/; # fix ur-type
@@ -813,11 +817,14 @@
"{$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) : (),
+# $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->register_ns($SOAP::Constants::NS_ENC,$SOAP::Constants::PREFIX_ENC);
+ $self->register_ns($SOAP::Constants::NS_ENV,$SOAP::Constants::PREFIX_ENV)
+ if $SOAP::Constants::PREFIX_ENV;
$self->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA);
SOAP::Trace::objects('()');
}
@@ -832,10 +839,17 @@
my $self = shift->new;
if (@_) {
my ($u,$p) = @_;
+ my $prefix;
+ if ($p) {
+ $prefix = $p;
+ } elsif (!$p && !($prefix = $self->find_prefix($u))) {
+ $prefix = gen_ns;
+ }
$self->{'_ns_uri'} = $u;
- $self->{'_ns_prefix'} = $p ? $p : $self->gen_ns;
+ $self->{'_ns_prefix'} = $prefix;
$self->{'_use_default_ns'} = 0;
- $self->register_ns($u,$self->{'_ns_prefix'});
+# $self->register_ns($u,$prefix);
+ $self->{'_namespaces'}->{$u} = $prefix;
return $self;
}
return $self->{'_ns_uri'};
@@ -1266,6 +1280,7 @@
my $self = shift->new;
# my $self = shift;
my ($ns,$prefix) = @_;
+# print STDERR ">> registering $prefix\n" if $prefix;
$prefix = gen_ns if !$prefix;
$self->{'_namespaces'}->{$ns} = $prefix if $ns;
}
@@ -2815,8 +2830,8 @@
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);
+# 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) {
@@ -3395,7 +3410,7 @@
return unless $response; # nothing to do for one-ways
# little bit tricky part that binds in/out parameters
- if (UNIVERSAL::isa($result => 'SOAPSOM') &&
+ if (UNIVERSAL::isa($result => 'SOAP::SOM') &&
($result->paramsout || $result->headers) &&
$serializer->signature) {
my $num = 0;
Modified: packages/soap-lite/branches/upstream/current/lib/SOAP/Packager.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/soap-lite/branches/upstream/current/lib/SOAP/Packager.pm?rev=3232&op=diff
==============================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Packager.pm (original)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Packager.pm Fri Jul 7 11:48:44 2006
@@ -140,7 +140,8 @@
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",
+ my $soapversion = defined($context) ? $context->soapversion : '1.1';
+ $top->attach('Type' => $soapversion == 1.1 ? "text/xml" : "application/soap+xml",
'Content-Transfer-Encoding' => $self->transfer_encoding(),
'Content-Location' => $self->env_location(),
'Content-ID' => $self->env_id(),
@@ -293,7 +294,8 @@
require DIME::Payload;
my $message = DIME::Message->new;
my $top = DIME::Payload->new;
- $top->attach('MIMEType' => $context->soapversion == 1.1 ?
+ my $soapversion = defined($context) ? $context->soapversion : '1.1';
+ $top->attach('MIMEType' => $soapversion == 1.1 ?
"http://schemas.xmlsoap.org/soap/envelope/" : "application/soap+xml",
'Data' => $envelope );
$message->add_payload($top);
Modified: packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/HTTP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/HTTP.pm?rev=3232&op=diff
==============================================================================
--- packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/HTTP.pm (original)
+++ packages/soap-lite/branches/upstream/current/lib/SOAP/Transport/HTTP.pm Fri Jul 7 11:48:44 2006
@@ -4,7 +4,7 @@
# 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.17 2006/01/27 21:30:38 byrnereese Exp $
+# $Id: HTTP.pm,v 1.19 2006/06/15 18:23:28 byrnereese Exp $
#
# ======================================================================
@@ -313,13 +313,14 @@
$content_type !~ m!^multipart/!;
# TODO - Handle the Expect: 100-Continue HTTP/1.1 Header
- if ($self->request->header("Expect") eq "100-Continue") {
+ if (defined($self->request->header("Expect")) &&
+ ($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.
+ # 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;
@@ -519,42 +520,99 @@
$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');
+
+# 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 Apache2::RequestRec;
+# require Apache2::RequestIO;
+# require Apache2::Const;
+# Apache2::Const->import(-compile => 'OK');
+# $self->{'MOD_PERL_VERSION'} = 2;
+# } else {
+# die "Unsupported version of mod_perl";
+# }
+
+ # Added this code thanks to JT Justman
+ # This code improves and provides more robust support for
+ # multiple versions of Apache and mod_perl
+ if( defined $ENV{MOD_PERL_API_VERSION} &&
+ $ENV{MOD_PERL_API_VERSION} >= 2) { # mod_perl 2.0
+ require Apache2::RequestRec;
+ require Apache2::RequestIO;
+ require Apache2::Const;
+ require APR::Table;
+ Apache2::Const->import(-compile => 'OK');
$self->{'MOD_PERL_VERSION'} = 2;
- } else {
- die "Unsupported version of mod_perl";
- }
+ $self->{OK} = &Apache2::Const::OK;
+ } else { # mod_perl 1.xx
+ 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;
+ $self->{OK} = &Apache::Constants::OK;
+ } else {
+ require Apache::RequestRec;
+ require Apache::RequestIO;
+ require Apache::Const;
+ Apache::Const->import(-compile => 'OK');
+ $self->{'MOD_PERL_VERSION'} = 1.99;
+ $self->{OK} = &Apache::OK;
+ }
+ }
+
+
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) {
+
+# Pre 0.68 code
+# $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");
+# }
+
+ # Begin patch from JT Justman
+ if (!$r) {
+ if ( $self->{'MOD_PERL_VERSION'} < 2 ) {
+ $r = Apache->request();
+ } else {
+ $r = Apache2::RequestUtil->request();
+ }
+ }
+
+ my $cont_len;
+ if ( $self->{'MOD_PERL_VERSION'} == 1 ) {
+ $cont_len = $r->header_in ('Content-length');
+ } else {
+ $cont_len = $r->headers_in->get('Content-length');
+ }
+ if ($r->headers_in->{'Expect'} =~ /\b100-Continue\b/i) {
$r->print("HTTP/1.1 100 Continue\r\n\r\n");
}
+ # End patch from JT Justman
$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'))) {
+ while ($r->read($buf,$cont_len)) {
$c.=$buf;
}
$c;
@@ -569,10 +627,25 @@
# 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);
+
+# pre 0.68
+# $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;
+
+ # Begin JT Justman patch
+ if ( $self->{'MOD_PERL_VERSION'} > 1 ) {
+ $self->response->headers->scan(sub { $r->headers_out->set(@_) });
+ $r->content_type(join '; ', $self->response->content_type);
+ } else {
+ $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;
+ return $self->{OK};
+ # End JT Justman patch
+
}
sub configure {
Modified: packages/soap-lite/branches/upstream/current/t/01-core.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/soap-lite/branches/upstream/current/t/01-core.t?rev=3232&op=diff
==============================================================================
--- packages/soap-lite/branches/upstream/current/t/01-core.t (original)
+++ packages/soap-lite/branches/upstream/current/t/01-core.t Fri Jul 7 11:48:44 2006
@@ -40,23 +40,23 @@
}
{ # check use of default_ns, ns, and use_prefix
+ # test 4
$serialized = SOAP::Serializer->ns("urn:Test")->method(
'testMethod', SOAP::Data->name(test => 123)
);
ok($serialized =~ m!<namesp(\d):testMethod><test xsi:type="xsd:int">123</test></namesp\1:testMethod>!);
+ # test 5
$serialized = SOAP::Serializer->ns("urn:Test","testns")->method(
'testMethod', SOAP::Data->name(test => 123)
);
ok($serialized =~ m!<testns:testMethod><test xsi:type="xsd:int">123</test></testns:testMethod>!);
+ # test 6
$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
Modified: packages/soap-lite/branches/upstream/current/t/03-server.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/soap-lite/branches/upstream/current/t/03-server.t?rev=3232&op=diff
==============================================================================
--- packages/soap-lite/branches/upstream/current/t/03-server.t (original)
+++ packages/soap-lite/branches/upstream/current/t/03-server.t Fri Jul 7 11:48:44 2006
@@ -171,22 +171,16 @@
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);
- }
+ skip(($_ =~ /XML/ || !$is_mimetools_installed),
+ ($result->faultstring || '') =~ /Failed to access class \(Calculator\)/);
}
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);
- }
+ skip(($_ =~ /XML/ || !$is_mimetools_installed),
+ ($result->result || 0) == 7);
}
}
More information about the Pkg-perl-cvs-commits
mailing list