perl Soap::Lite problem

[gwong76]

Hi,
I am having trouble running the problem running the following script. I am getting this error:

SOAP Lite version 0.710.08
Can't call method "parts" without a package or object reference at
./testsoap.pl line 227 (#1)
(F) You used the syntax of a method call, but the slot filled by the
object reference or package name contains an expression that returns a
defined value which is neither an object reference nor a package name.
Something like this will reproduce the error:

$BADREF = 42;
process $BADREF 1,2,3;
$BADREF->process(1,2,3);

Uncaught exception from user code:
Can't call method "parts" without a package or object reference at ./testsoap.pl line 227.
at ./testsoap.pl line 227

Here is the script
------------------------------------------------------------
#!/usr/bin/perl -w

# licensed under the Artistic License 2.0 or later versions
# as published by the Perl Foundation (Yet Another Society)
#

http://www.perlfoundation.org/artistic_license_2_0

# For the assistance of search engines:
# ops Open Patent Services OpenPatentServices EPO
# European Patent Office worldpatentdata getpatentdata
BEGIN {

# Note that we redefine the method &SOAP::Utils::encode_data()
# and use the stub produced by stubmaker.pl with dashes repaired by hand

use diagnostics;
use strict;
use warnings;
no warnings 'redefine';

# +trace => ['debug']
eval " use SOAP::Lite; "; # worked on version 0.71 Apr 2008
use warnings;

package OpenPatentServicesService;

# Generated by SOAP::Lite (v0.71) for Perl -- soaplite.com
# Copyright (C) 2000-2006 Paul Kulchenko, Byrne Reese
# -- generated at [Thu Apr 10 14:58:55 2008]
# -- generated from

http://ops.espacenet.com/OpenPatentServices/webService/getPatentData?wsdl

my %methods = (
getPatentData => {
endpoint => '

http://ops.espacenet.com/OpenPatentServices/webService',

soapaction => '',
namespace => 'urn:EPO-OpenPatentServices',
parameters => [SOAP:ata->new(name => 'input_request', type => 'xsd:string', attr => {}),], # end parameters
}, # end getPatentData

getDocumentData => {
endpoint => '

http://ops.espacenet.com/OpenPatentServices/webService',

soapaction => '',
namespace => 'urn:EPO-OpenPatentServices-documentData',
parameters => [SOAP:ata->new(name => 'input_request', type => 'xsd:string', attr => {}),], # end parameters
}, # end getDocumentData
); # end my %methods

# use SOAP::Lite; # careful- this may have previously been overridden.
use Exporter;
use Carp ();

use vars qw(@ISA $AUTOLOAD @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter SOAP::Lite);
@EXPORT_OK = (keys %methods);
%EXPORT_TAGS = ('all' => [@EXPORT_OK]);

sub _call {
my ($self, $method) = (shift, shift);
my $name = UNIVERSAL::isa($method => 'SOAP:ata') ? $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;
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})->ns($method{namespace});

# ->ns($method{namespace})
#->on_action(sub {qq!"$method{soapaction}"!});

$self->serializer->register_ns("

http://schemas.xmlsoap.org/wsdl/","wsdl");

$self->serializer->register_ns("

http://www.w3.org/2001/XMLSchema","xsd");

$self->serializer->register_ns("

http://ops.espacenet.com/OpenPatentServices/webService/getPatentData?wsdl","tns");

$self->serializer->register_ns("

http://schemas.xmlsoap.org/wsdl/soap/","soap");

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";
}

package SOAP::Utils;
my %encode_data = ('&' => '&amp;', '>' => '&gt;', '<' => '&lt;',
"\xd" => '&#xd;', '"' => '&quot;');

no warnings 'redefine';

eval( q! sub encode_data {
my $e = $_[0];
if ($e) {$e =~ s/([&<>"\015])/$encode_data{$1}/g; $e =~
s/\]\]>/\]\]&gt;/g;}
$e;
} !
);

use warnings;

} # end of BEGIN

# my $request = '\&lt;OpenPatentServices
#ACTION=\&quot;Family\&quot;&gt;&lt;WORLDPATENTDATA&gt;&lt;FAMILY
#SEED=&quot; EP 1006112A1&quot; SEED_FORMAT=&quot;D&quot;
#SEED_TYPE=&quot;PN&quot; DESC_LNG=&quot;ENG&quot;
#DATE_MIGR=&quot;00000000&quot;
#LEGAL=&quot;NO&quot;/&gt;&lt;/WORLDPATENTDATA&gt;&lt;/OpenPatentServices&gt;';

#use OpenPatentServicesService;
#&quot; EP 1006112A1&quot;

#my $request
#= '<OpenPatentServices ACTION="Family"><WORLDPATENTDATA><FAMILY
#SEED=" EP 0688878A1" SEED_FORMAT="D" SEED_TYPE="PN" DESC_LNG="ENG"
#DATE_MIGR="99999999"
#LEGAL="YES"></FAMILY></WORLDPATENTDATA></OpenPatentServices>';

#12345678901234567

# behind a firewall, using a proxy ? It gets rather arcane.
if (defined $ENV{http_proxy}) {$ENV{HTTP_proxy} = $ENV{http_proxy}}
$SOAP::Constants:REFIX_ENV = 'soapenv';
print 'SOAP Lite version ', $SOAP::Lite::VERSION, "\n"; #tested on 0.69
use MIME::Entity;
use Data:umper;

my $f = new OpenPatentServicesService;

#$f->use_prefix(0);

#$f->ns('urn:EPO-OpenPatentServices', 'urn');
#$f->readable(1);
#$f->want_som(1);

#my $som = $f->getPatentData($request);

# print Dumper($som);
#if ($som->fault) { # will be defined if Fault element is in the message
#print $som->faultstring; # returns value of 'detail' element as
#}
#else {
#print "no error for \$request = '$request'. \n"; # print
#$som->result, "\n";
#}

#foreach $request (
#'<OpenPatentServices ACTION="Biblio"><WORLDPATENTDATA><BIBLIO
#SEED="EP1000000" SEED_FORMAT="E"
#SEED_TYPE="PN"/></WORLDPATENTDATA></OpenPatentServices>',
#'<OpenPatentServices
#ACTION="FamilyAndLegalAndBiblio"><WORLDPATENTDATA><FAMILY SEED=" US
#5000063%%" SEED_FORMAT="D" SEED_TYPE="PN" DESC_LNG="ENG"
#DATE_MIGR="00000000"
#LEGAL="YES"/></WORLDPATENTDATA></OpenPatentServices>',

#
#12345678901234567
#'<OpenPatentServices ACTION="Claims"><WORLDPATENTDATA><BIBLIO
#SEED="EP1000000" SEED_FORMAT="E"
#SEED_TYPE="PN"/></WORLDPATENTDATA></OpenPatentServices>',
#'<OpenPatentServices
#ACTION="DocumentInquiry"><WORLDPATENTDATA><INQUIRY SEED="EP1000000"
#SEED_FORMAT="E" SEED_TYPE="PN"/></WORLDPATENTDATA></OpenPatentServices>',
#)
#{
#my $som = $f->getPatentData($request);

# print Dumper($som);
#if ($som->fault) { # will be defined if Fault element is in the
#message
#print $som->faultstring; # returns value of 'detail' element as
#}
#else {
#print "no error for \$request = '$request'. \n"; # print
#$som->result, "\n";
#}
#}

$f->ns('urn:EPO-OpenPatentServices-documentData', 'urn');
my $request = '<OpenPatentServices ACTION="DocumentRetrieval"><WORLDPATENTDATA><DOCUMENT ID="EP1000000PAFP " SYSTEM="BNS" FORMAT="SINGLE_PAGE_TIFF" PAGE_NUMBER="1"/></WORLDPATENTDATA></OpenPatentServices>';
my $som = $f->getDocumentData( $request );
#if ($som->fault) { # will be defined if Fault element is in the message
#print $som->faultstring; # returns value of 'detail' element
#}
#else {
my $mime_entity = ${$som->parts}[0];
print "mime_entity = $mime_entity\n";
my $body = $mime_entity->bodyhandle;
open(OUT, '>1.tif') or die "whoops $!";

#open ( OUT , '>1.pdf' ) or die "whoops $!" ;
binmode(OUT);
print OUT $body->as_string;
close OUT;
print "no error with Document Retrieval; check file system for output '1.tif'.\n";
#}
------------------------------------------------------------
It seems like the service is not sucessfully called. Would anyone be able to shed some light on this problem?

Thanks a bunch!

 

[Xaqte]

What happens when you change this:

#if ($som->fault) { # will be defined if Fault element is in the message
#print $som->faultstring; # returns value of 'detail' element
#}
#else {
my $mime_entity = ${$som->parts}[0];
print "mime_entity = $mime_entity\n";
my $body = $mime_entity->bodyhandle;
open(OUT, '>1.tif') or die "whoops $!";

#open ( OUT , '>1.pdf' ) or die "whoops $!" ;
binmode(OUT);
print OUT $body->as_string;
close OUT;
print "no error with Document Retrieval; check file system for output '1.tif'.\n";
#}

To this:

if ($som->fault) { # will be defined if Fault element is in the message
print $som->faultstring; # returns value of 'detail' element
}
else {
my $mime_entity = ${$som->parts}[0];
print "mime_entity = $mime_entity\n";
my $body = $mime_entity->bodyhandle;
open(OUT, '>1.tif') or die "whoops $!";

#open ( OUT , '>1.pdf' ) or die "whoops $!" ;
binmode(OUT);
print OUT $body->as_string;
close OUT;
print "no error with Document Retrieval; check file system for output '1.tif'.\n";
}

Because your skipping to check if there was a problem connecting... or it appears that way.

 

[gwong76]

Thanks Xaqte! I actually figured out what the problem was and got it to work.