Compare commits

..
1 Commits
Author SHA1 Message Date
Martin Kutter 95465c33d9 import SOAP-WSDL 1.20 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  1.20
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-1.20.tar.gz
2009-12-12 19:47:38 -08:00
4 changed files with 63 additions and 29 deletions
+5
View File
@@ -13,6 +13,11 @@ SOAP::WSDL requires the following perl modules:
- XML::XPath - XML::XPath
If you want to use file system caching (improves performance), you also
need the following packages:
- Cache::Cache
INSTALLING INSTALLING
Use the usual mantra: Use the usual mantra:
+18 -7
View File
@@ -4,7 +4,7 @@ package SOAP::WSDL;
use SOAP::Lite; use SOAP::Lite;
use vars qw($VERSION @ISA); use vars qw($VERSION @ISA);
use XML::XPath; use XML::XPath;
use Cache::FileCache; # use Cache::FileCache;
use Data::Dumper; use Data::Dumper;
@@ -13,7 +13,7 @@ use Data::Dumper;
@ISA= qw(SOAP::Lite); @ISA= qw(SOAP::Lite);
# let CVS handle this for you... # let CVS handle this for you...
$VERSION = sprintf("%d.%02d", q$Revision: 1.19 $ =~ /(\d+)\.(\d+)/); $VERSION = sprintf("%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/);
sub wsdlinit { sub wsdlinit {
my $self=shift; my $self=shift;
@@ -24,7 +24,7 @@ sub wsdlinit {
$self->{_WSDL}->{ checkoccurs } = 1 unless defined( $self->{_WSDL}->{ checkoccurs } ); $self->{_WSDL}->{ checkoccurs } = 1 unless defined( $self->{_WSDL}->{ checkoccurs } );
if (($self->{_WSDL}->{ caching }) && (! $self->{_WSDL }->{ fileCache })) { if (($self->{_WSDL}->{ caching }) && (! $self->{_WSDL }->{ fileCache })) {
$self->wsdl_cache_init() $self->wsdl_cache_init();
}; };
my $location=$self->transport->proxy->endpoint my $location=$self->transport->proxy->endpoint
@@ -225,11 +225,19 @@ sub wsdl_cache_init {
my $self=shift; my $self=shift;
my $p=shift || undef; my $p=shift || undef;
my $cache = undef; my $cache = undef;
if ( defined( $p ) ) { eval { require Cache::FileCache; };
$p->{ cache_root } = $self->{_WSDL}->{ cache_directory } unless ($p->{ cache_root }); if ($@) {
$cache=Cache::FileCache->new( $p ) if ($p->{ cache_root }); warn "File caching is enabled, but you do not have the Cache::FileCache module. Disabling Filesystem caching."
if ($self->{_WSDL}->{ cache_directory });
} else { } else {
$cache=Cache::FileCache->new( { cache_root => $self->{_WSDL}->{ cache_directory } } ) if ($self->{_WSDL}->{ cache_directory }); if ( defined( $p ) ) {
$p->{ cache_root } = $self->{_WSDL}->{ cache_directory } unless ($p->{ cache_root });
$cache=Cache::FileCache->new( $p ) if ($p->{ cache_root });
} else {
if ($self->{_WSDL}->{ cache_directory }) {
$cache=Cache::FileCache->new( { cache_root => $self->{_WSDL}->{ cache_directory } } );
}
}
} }
$self->{_WSDL}->{ fileCache } = $cache; $self->{_WSDL}->{ fileCache } = $cache;
} }
@@ -990,6 +998,9 @@ to the user.
=head1 CHANGES =head1 CHANGES
$Log: WSDL.pm,v $ $Log: WSDL.pm,v $
Revision 1.20 2004/07/29 06:56:45 lsc
removed "use" dependency on Cache::FileCache. require'ing it instead.
Revision 1.19 2004/07/27 13:00:03 lsc Revision 1.19 2004/07/27 13:00:03 lsc
- added missing test file - added missing test file
+20 -14
View File
@@ -1,11 +1,13 @@
#!/usr/bin/perl -w #!/usr/bin/perl -w
use strict; use strict;
use Test::More tests=> 7; use Test;
plan tests=> 6;
use Time::HiRes qw( gettimeofday tv_interval ); use Time::HiRes qw( gettimeofday tv_interval );
use lib '../..'; use lib '../..';
use Data::Dumper; use Data::Dumper;
use Cwd; use Cwd;
use_ok "SOAP::WSDL"; use SOAP::WSDL;
ok 1; # if we made it this far, we're ok
### test vars END ### test vars END
print "Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n"; print "Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n";
@@ -26,29 +28,33 @@ my $t0 = [gettimeofday];
ok( my $soap=SOAP::WSDL->new( ok( my $soap=SOAP::WSDL->new(
wsdl => "file://$dir/t/acceptance/helloworld.asmx.xml", wsdl => "file://$dir/t/acceptance/helloworld.asmx.xml",
no_dispatch => 1 no_dispatch => 1
), "Create SOAP::WSDL object (".tv_interval ( $t0, [gettimeofday]) ."ms)" ); #->proxy('http://erlm5aqa.ww001.siemens.net/lasttest/helloworld/helloworld.asmx' ); ) );
print "Create SOAP::WSDL object (".tv_interval ( $t0, [gettimeofday]) ."ms)\n" ;
$soap->proxy('http://helloworld/helloworld.asmx'); $soap->proxy('http://helloworld/helloworld.asmx');
$t0 = [gettimeofday]; $t0 = [gettimeofday];
ok($soap->wsdlinit(caching => 1), "wsdl file init (".tv_interval ( $t0, [gettimeofday]) ."s)" );; eval{ $soap->wsdlinit(caching => 1) };
unless ($@) {
ok(1);
} else {
ok 0;
print STDERR $@;
}
print "wsdl file init (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;;
$soap->readable(1); $soap->readable(1);
$t0 = [gettimeofday]; $t0 = [gettimeofday];
ok( $soap->call("sayHello" , %{ $data }), "1 x call pre-work (".tv_interval ( $t0, [gettimeofday]) ."s)" );; ok( $soap->call("sayHello" , %{ $data }));
print "1 x call pre-work (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
$t0 = [gettimeofday]; $t0 = [gettimeofday];
ok($soap->call(sayHello => %{ $data }), "1 x call pre-work (".tv_interval ( $t0, [gettimeofday]) ."s)" );; ok($soap->call(sayHello => %{ $data }) );
print "1 x call pre-work (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
$t0 = [gettimeofday]; $t0 = [gettimeofday];
for (my $i=1; $i<100; $i++) { for (my $i=1; $i<100; $i++) {
$soap->call(sayHello => %{ $data }); $soap->call(sayHello => %{ $data });
} }
ok(1, "100 x call pre-work (".tv_interval ( $t0, [gettimeofday]) ."s)" );; ok(1);
print "100 x call pre-work (".tv_interval ( $t0, [gettimeofday]) ."s)\n";
$soap->call(sayHello => %{ $data });
$t0 = [gettimeofday];
for (my $i=1; $i<100; $i++) {
$soap->call(sayHello => %{ $data });
}
ok(1, "100 x call pre-work (".tv_interval ( $t0, [gettimeofday]) ."s)" );;
+20 -8
View File
@@ -12,11 +12,13 @@
use strict; use strict;
use diagnostics; use diagnostics;
use Test::More tests => 5; use Test;
plan tests => 5;
use Time::HiRes qw( gettimeofday tv_interval ); use Time::HiRes qw( gettimeofday tv_interval );
use lib '../..'; use lib '../..';
use Cwd; use Cwd;
use_ok "SOAP::WSDL"; use SOAP::WSDL;
ok 1; # if we made it this far, we're ok
### test vars END ### test vars END
print "Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n"; print "Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n";
print "Acceptance test against sample output with simple WSDL\n"; print "Acceptance test against sample output with simple WSDL\n";
@@ -45,10 +47,12 @@ $dir=~s/\/t//;
ok( my $soap=SOAP::WSDL->new( ok( my $soap=SOAP::WSDL->new(
wsdl => 'file:///'.$dir.'/t/acceptance/test.wsdl.xml', wsdl => 'file:///'.$dir.'/t/acceptance/test.wsdl.xml',
no_dispatch => 1 no_dispatch => 1
), "Create SOAP::WSDL object (".tv_interval ( $t0, [gettimeofday]) ."s)" ); #->proxy('http://erlm5aqa.ww001.siemens.net/lasttest/helloworld/helloworld.asmx' ); ) );
print "Create SOAP::WSDL object (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
$soap->proxy('http://helloworld/helloworld.asmx'); $soap->proxy('http://helloworld/helloworld.asmx');
$t0 = [gettimeofday]; $t0 = [gettimeofday];
ok($soap->wsdlinit(), "WSDL init (".tv_interval ( $t0, [gettimeofday]) ."s)") ; ok($soap->wsdlinit());
print "WSDL init (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
$t0 = [gettimeofday]; $t0 = [gettimeofday];
do { do {
@@ -64,8 +68,12 @@ do {
$xml_test=~s/^.+\<([^\/]+?)\:Body\>//; $xml_test=~s/^.+\<([^\/]+?)\:Body\>//;
$xml_test=~s/\<\/$1\:Body\>.*//; $xml_test=~s/\<\/$1\:Body\>.*//;
if ( ($xml) && ($xml eq $xml_test) ) { pass ("Message encoding (" .tv_interval ( $t0, [gettimeofday]) ."s)") } else { if ( ($xml) && ($xml eq $xml_test) ) {
fail( "Message encoding (".tv_interval ( $t0, [gettimeofday]) ."s)") ; ok 1;
print "Message encoding (" .tv_interval ( $t0, [gettimeofday]) ."s)\n"
} else {
ok 0;
print "Message encoding (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
print "$xml\n$xml_test\n"; }; print "$xml\n$xml_test\n"; };
}; };
@@ -83,8 +91,12 @@ do {
$xml_test=~s/^.+\<([^\/]+?)\:Body\>//; $xml_test=~s/^.+\<([^\/]+?)\:Body\>//;
$xml_test=~s/\<\/$1\:Body\>.*//; $xml_test=~s/\<\/$1\:Body\>.*//;
if ( ($xml) && ($xml eq $xml_test) ) { pass ("Message encoding (" .tv_interval ( $t0, [gettimeofday]) ."s)") } else { if ( ($xml) && ($xml eq $xml_test) ) {
fail( "Message encoding (".tv_interval ( $t0, [gettimeofday]) ."s)") ; ok 1;
print "Message encoding (" .tv_interval ( $t0, [gettimeofday]) ."s)\n";
} else {
ok 0;
print "Message encoding (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
print "$xml\n$xml_test\n"; }; print "$xml\n$xml_test\n"; };
}; };