Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- SOAP::Serializer::envelope: Client Denied access to method (AnalyzeDocument) in class (main) at /usr/share/perl5/site_perl/SOAP/Lite.pm line 2806
- # TODO - sort this mess out:
- # The task is to test whether the class in question has already been loaded.
- #
- # 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 did not work reliably, either.
- #
- # Now we do the following: Check whether the class is main (always loaded)
- # or the class implements the method in question
- # or the package exists as file in %INC.
- #
- # This is still sort of a hack - but I don't know anything better
- # If you have some idea, please help me out...
- #
- unless (($class eq 'main') || $class->can($method_name)
- || 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);
- }
- vi /etc/apache2/sites-available/default
- <Location /SOAP/>
- SetHandler perl-script
- PerlHandler Apache::SOAP
- PerlSetVar dispatch_to '/usr/share/perl5/'
- </Location
- package HelloWorld;
- use strict;
- use warnings;
- sub sayHello {
- return "Hello @_n";
- }
- 1;
- use SOAP::Lite +trace;
- use strict; use warnings;
- my $client = SOAP::Lite->new;
- my $ua = $client->schema->useragent;
- $ua->agent("Fubar! 0.1");
- my $response = $client
- # WSDL url
- ->service("http://example.com/HelloWorld.xml") // this current wsdl
- # method from SOAP server Module
- ->sayHello("foo", "bar");
- print $response;
- <definitions xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
- xmlns:s="http://www.w3.org/2001/XMLSchema"
- xmlns:s0="urn:HelloWorld"
- targetNamespace="urn:HelloWorld"
- xmlns="http://schemas.xmlsoap.org/wsdl/">
- <types>
- <s:schema targetNamespace="urn:HelloWorld">
- </s:schema>
- </types>
- <message name="sayHello">
- <part name="name" type="s:string" />
- <part name="givenName" type="s:string" />
- </message>
- <message name="sayHelloResponse">
- <part name="sayHelloResult" type="s:string" />
- </message>
- <portType name="Service1Soap">
- <operation name="sayHello">
- <input message="s0:sayHello" />
- <output message="s0:sayHelloResponse" />
- </operation>
- </portType>
- <binding name="Service1Soap" type="s0:Service1Soap">
- <soap:binding transport="http://schemas.xmlsoap.org/soap/http"
- style="rpc" />
- <operation name="sayHello">
- <soap:operation soapAction="urn:HelloWorld#sayHello"/>
- <input>
- <soap:body use="encoded"
- encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
- </input>
- <output>
- <soap:body use="encoded"
- encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
- </output>
- </operation>
- </binding>
- <service name="HelloWorld">
- <port name="HelloWorldSoap" binding="s0:Service1Soap">
- <soap:address location="http://localhost:80/SOAP/" />
- </port>
- </service>
- </definitions>
- **use strict;
- use warnings;
- use LWP::Protocol::https;
- use SOAP::Lite;
- # Set SOAP username
- my $USER = "user";
- # Set SOAP password
- my $PASSWORD = "password";
- # Set SOAP API URL
- my $SERVICE_LOC = 'https://localhost:2443';
- # XML namespace
- my $SERVICE_NS = 'http://name.space.domain/widget';
- my $URI = $SERVICE_NS;
- my $OUTPUT_XML = 'true';
- # we use this lat
- # The username and password are set by overriding the
- # SOAP::Transport::HTTP::Client::get_basic_credentials method
- #### Authentication
- sub SOAP::Transport::HTTP::Client::get_basic_credentials {
- return $USER => $PASSWORD;
- }
- #### prototypes
- sub method1;
- sub method2;
- #### CONNECT TO SERVICE
- my $Service = SOAP::Lite-> proxy ($SERVICE_LOC);
- $Service->outputxml($OUTPUT_XML);
- #### Invoking Calls
- print "nHey does SOAP work?n";
- #### method1 Test
- print "==> Invoking method1";
- my $result1 = method1($Service);
- if($OUTPUT_XML eq 'true'){
- print $result1;
- } else {
- if($result1){
- for my $t ($result1->valueof('//tag/subtag')) {
- print $t->{value1} . " - " . $t->{value2} . "n";
- }
- } else {
- print "no SOAP for you";
- }
- }
- #### method2 Test
- my %DataStructure1 = (
- 'data1' => 'John Doe',
- 'data2' => '1234',
- );
- my %DataStructure2 = (
- 'data1' => 'Jane Doe',
- 'data2' => '4321',
- );
- my $result2 = method2($Service, %DataStructure1, %DataStructure2);
- if($OUTPUT_XML eq 'true'){
- print $result2;
- } else {
- if($result2){
- for my $t ($result2->valueof('//tag/subtag')) {
- print " " . $t->{value1} . " - " . $t->{value2} . " - " .
- $t->{subsubtag}{value3} . "n";
- }
- } else {
- print "no SOAP for you";
- }
- }
- #### Accessing Functions
- sub method1{
- my $SOAP = shift;
- print "n==> Invoking call method1n";
- my $URIs;
- my $SOM = $SOAP->method1('');
- if($SOM){
- if($OUTPUT_XML eq 'true'){
- return $SOM;
- }elsif($SOM->fault) {
- die $SOM->faultstring;
- }else{
- return $SOM;
- }
- }
- return 0;
- }
- sub method2{
- my $Service = $_[0];
- my $DataStructure1 = $_[1];
- my $DataStructure2 = $_[2];
- print "n==> Invoking call method2n";
- my $Location = 'loc';
- my $Structure1 = SOAP::Data->name('structure1')->value([
- SOAP::Data->name('data1')->value($DataStructure1->{'data1'}),
- SOAP::Data->name('data2')->value($DataStructure1->{'data2'}),
- ]);
- my $Structure2 = SOAP::Data->name('structure2')->value([
- SOAP::Data->name('data1')->value($DataStructure2->{'data1'}),
- SOAP::Data->name('data2')->value($DataStructure2->{'data2'}),
- ]);
- my $Meth = SOAP::Data->name('method2')->uri($SERVICE_NS);
- my $SOM = $Service->call($Meth, $SERVICE_NS, $Location);
- if($SOM){
- if($OUTPUT_XML eq 'true'){
- return $SOM;
- }elsif($SOM->fault) {
- die $SOM->faultstring;
- }else{
- return $SOM;
- }
- }
- return 0;
- }**
Add Comment
Please, Sign In to add comment