[Catalyst-commits] r7540 - in Catalyst-Controller-SOAP/1.0/branches: . wsdl/lib/Catalyst/Action wsdl/lib/Catalyst/Action/SOAP wsdl/lib/Catalyst/Controller

drew at dev.catalyst.perl.org drew at dev.catalyst.perl.org
Tue Apr 1 15:15:48 BST 2008


Author: drew
Date: 2008-04-01 15:15:47 +0100 (Tue, 01 Apr 2008)
New Revision: 7540

Added:
   Catalyst-Controller-SOAP/1.0/branches/wsdl/
Modified:
   Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Action/SOAP.pm
   Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Action/SOAP/DocumentLiteral.pm
   Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Action/SOAP/RPCEndpoint.pm
   Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Controller/SOAP.pm
Log:
Experimental branch with changes for DocumentLiteral support.
No tests yet, but does have docs.


Copied: Catalyst-Controller-SOAP/1.0/branches/wsdl (from rev 7539, Catalyst-Controller-SOAP/1.0/trunk)

Modified: Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Action/SOAP/DocumentLiteral.pm
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/DocumentLiteral.pm	2008-04-01 12:58:53 UTC (rev 7539)
+++ Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Action/SOAP/DocumentLiteral.pm	2008-04-01 14:15:47 UTC (rev 7540)
@@ -1,22 +1,137 @@
-{ package Catalyst::Action::SOAP::DocumentLiteral;
+package Catalyst::Action::SOAP::DocumentLiteral;
 
-  use base qw/Catalyst::Action::SOAP/;
-  use constant NS_SOAP_ENV => "http://schemas.xmlsoap.org/soap/envelope/";
+use strict;
+use warnings;
+use base qw/Catalyst::Action::SOAP/;
+use constant NS_SOAP_ENV => "http://schemas.xmlsoap.org/soap/envelope/";
 
-  sub execute {
-      my $self = shift;
-      my ( $controller, $c ) = @_;
-      $self->prepare_soap_helper($c);
-      $self->prepare_soap_xml_post($c);
-      unless ($c->stash->{soap}->fault) {
-          my $envelope = $c->stash->{soap}->parsed_envelope;
-          my $namespace = $c->stash->{soap}->namespace || NS_SOAP_ENV;
-          my ($body) = $envelope->getElementsByTagNameNS($namespace, 'Body');
-          $self->NEXT::execute($controller, $c, $body);
-      }
-  }
-};
+use XML::Compile::SOAP11::Client;
+use XML::Compile::Util;
+use Data::Dumper;
+$Data::Dumper::Indent = 1;
 
+use Directski::Constants;
+
+
+# GIANT, UGLY HACK - Can't use COMPONENT because actions aren't components...
+our $SOAP_CLIENT = XML::Compile::SOAP11::Client->new;
+our $SCHEMAS     = {};
+our $OPERATIONS  = {};
+our $NAMESPACE   = '';
+
+
+sub execute {
+    my $self = shift;
+    my ( $controller, $c ) = @_;
+    $self->prepare_soap_helper($c);
+    $self->prepare_soap_xml_post($c);
+    unless ($c->stash->{soap}->fault) {
+        # What operation was requested?
+        # TODO: For SOAP 1.2, the SoapAction HTTP header is optional 
+        # so I assume there is a replacement method for specifying the
+        # SOAP operation... find it!
+        my $operation = $c->request->header('soapaction');
+        $operation =~ s/^"(.*)"$/$1/; # see SOAP spec for improving regex
+
+        my $envelope  = $c->stash->{soap}->parsed_envelope;
+        my $namespace = $c->stash->{soap}->namespace || NS_SOAP_ENV;
+        my ($body)    = $envelope->getElementsByTagNameNS($namespace, 'Body');
+
+        # only initialize once for performance
+        unless ($NAMESPACE and scalar keys %$OPERATIONS and scalar keys %$SCHEMAS) {
+            my ($ns, $ops, $schemas) = $controller->setup_soap($c);
+            $self->init_soap($c, $ns, $ops, $schemas);
+        }
+        
+        $c->stash->{soap}->server($SOAP_CLIENT);
+        $c->stash->{soap}->operations($OPERATIONS);
+        $c->stash->{soap}->namespace($NAMESPACE);
+
+        $self->get_params_from_request($c, $operation);
+        $self->NEXT::execute($controller, $c, $body);
+        $self->put_soap_on_stash($c, $operation) if defined $c->stash->{soap}->data_return;
+    }
+}
+
+=head2 init_soap
+
+Initialize a SOAP11::Client with all schemas
+
+=cut
+
+sub init_soap {
+    my ($self, $c, $namespace, $operations, $schemas) = @_;
+    $NAMESPACE  = $namespace;
+    $OPERATIONS = $operations;
+    
+    foreach my $schema (@$schemas) {
+        # $schema is full local path to WSDL file
+        next if exists $SCHEMAS->{$schema}; # don't load duplicates
+        $SOAP_CLIENT->schemas->importDefinitions($schema);
+        $SCHEMAS->{$schema} = undef;
+    }    
+}
+
+=head2 get_params_from_request
+
+Get the receive parameters from the request
+The params have already been stored in $c->stash->{soap}->envelope()
+$msg holds the request name
+
+=cut
+
+sub get_params_from_request {
+    my ($self, $c, $operation) = @_;
+
+    return if !defined $c->stash->{soap}->server;
+    my $msg = $c->stash->{soap}->operations->{$operation}->{in};
+    my $soap      = $c->stash->{soap}->server;
+    my $namespace = $c->stash->{soap}->namespace;
+    my $message   = pack_type($namespace, $msg);
+    my $xml = $c->stash->{soap}->envelope();
+    $c->log->debug("Message: $message");
+    $c->log->debug("Input: $xml");
+
+    my $server = $soap->compileMessage(
+        'RECEIVER',
+        body => [ request => $message ] );
+    $c->stash->{soap}->params($server->($xml)->{request});
+    $c->log->debug("Input Params: ", Dumper $c->stash->{soap}->params);
+}
+
+=head2 put_soap_on_stash
+
+Write the response to stash->{soap} for later processing.
+$msg holds the response name
+$data is the response (properly formatted).
+
+=cut
+
+sub put_soap_on_stash {
+    my ($self, $c, $operation) = @_;
+
+    my $data = $c->stash->{soap}->data_return;
+    my $msg  = $c->stash->{soap}->operations->{$operation}->{out};
+    my $wsdl = $c->stash->{soap}->server->schemas;
+    my $ns   = $c->stash->{soap}->namespace;
+    my $doc  = XML::LibXML::Document->new('1.0', 'UTF-8');
+    my $res  = pack_type($ns, $msg);
+    $c->log->debug("Response: message [$res]");
+    my $write = $wsdl->compile(WRITER =>
+        $res, 
+        elements_qualified => 'TOP' );
+    my $xml = eval { $write->($doc, $data) };
+    if ($@)
+    {
+        $c->log->error("ERROR CREATING RESPONSE: $@") if $@;
+        $c->stash->{soap}->fault({code => '1', reason => $@, detail => $@});
+        return;
+    }
+    
+    $c->log->debug("Response: Envelope [ @{[$xml->toString]} ]");
+    $c->stash->{soap}->literal_return($xml);
+}
+
 1;
 
 __END__

Modified: Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Action/SOAP/RPCEndpoint.pm
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/RPCEndpoint.pm	2008-04-01 12:58:53 UTC (rev 7539)
+++ Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Action/SOAP/RPCEndpoint.pm	2008-04-01 14:15:47 UTC (rev 7540)
@@ -1,5 +1,7 @@
 { package Catalyst::Action::SOAP::RPCEndpoint;
 
+  use XML::Compile::SOAP11::Client;
+  use XML::Compile::Util;
   use base qw/Catalyst::Action::SOAP/;
   use constant NS_SOAP_ENV => "http://schemas.xmlsoap.org/soap/envelope/";
 
@@ -11,7 +13,7 @@
       $self->prepare_soap_xml_post($c);
       unless ($c->stash->{soap}->fault) {
           my $envelope = $c->stash->{soap}->parsed_envelope;
-          my $namespace = $c->stash->{soap}->namespace || NS_SOAP_ENV;
+          my $namespace = NS_SOAP_ENV;
           my ($body) = $envelope->getElementsByTagNameNS($namespace,'Body',0);
           my @children = $body->getChildNodes();
           if (scalar @children != 1) {
@@ -33,11 +35,84 @@
                          'Invalid Operation'})
                 } else {
                     # this is our RPC action
+                    if (my @schema = $c->setup_soap($c)) {
+                        $self->init_soap($c, @schema);
+                        $self->get_params_from_request($c, $operation);
+                    }
                     $c->forward($operation);
+                    $self->put_soap_on_stash($c, $operation) if defined $c->stash->{soap}->data_return;
                 }
             }
       }
   }
+=head2 init_soap
+
+Initialize a SOAP11::Client with schema for the request
+
+=cut
+
+  sub init_soap {
+      my ($self, $c, @schema) = @_;
+
+      my $soap = XML::Compile::SOAP11::Client->new;
+
+      my $conf_path = $c->path_to('conf');
+      $soap->schemas->importDefinitions($_) for @schema;
+
+      $c->stash->{soap}->server($soap);
+  }
+
+=head2 get_params_from_request
+
+Get the receive parameters from the request
+The params have already been stored in $c->stash->{soap}->envelope()
+$msg holds the request name
+
+=cut
+
+  sub get_params_from_request {
+      my ($self, $c, $operation) = @_;
+  
+      return if !defined $c->stash->{soap}->server;
+      my $msg = $c->stash->{soap}->operations->{$operation}->{in};
+      my $soap      = $c->stash->{soap}->server;
+      my $namespace = $c->stash->{soap}->namespace;
+      my $server = $soap->compileMessage(
+          'RECEIVER',
+          body   => [ request => pack_type($namespace, $msg) ]
+      );
+
+      my $xml = $c->stash->{soap}->envelope();
+      $c->stash->{soap}->params($server->($xml)->{request});
+
+  }
+
+=head2 put_soap_on_stash
+
+Write the response to stash->{soap} for later processing.
+$msg holds the response name
+$data is the response (properly formatted).
+
+=cut
+
+  sub put_soap_on_stash {
+      my ($self, $c, $operation) = @_;
+
+      my $data = $c->stash->{soap}->data_return;
+      my $msg = $c->stash->{soap}->operations->{$operation}->{out};
+      my $wsdl      = $c->stash->{soap}->server->schemas;
+      my $namespace = $c->stash->{soap}->namespace;
+      my $doc    = XML::LibXML::Document->new('1.0', 'UTF-8');
+      my $res    = "{$namespace}$msg";
+      my $write  = $wsdl->compile(WRITER =>
+          $res, 
+          elements_qualified => 'TOP',
+      );
+      my $xml    = $write->($doc, $data);
+
+      $c->stash->{soap}->literal_return($xml);
+  }
+
 };
 
 1;

Modified: Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Action/SOAP.pm
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP.pm	2008-04-01 12:58:53 UTC (rev 7539)
+++ Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Action/SOAP.pm	2008-04-01 14:15:47 UTC (rev 7540)
@@ -1,5 +1,6 @@
 { package Catalyst::Action::SOAP;
 
+  use strict;
   use base qw/Catalyst::Action/;
   use XML::LibXML;
 

Modified: Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Controller/SOAP.pm
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Controller/SOAP.pm	2008-04-01 12:58:53 UTC (rev 7539)
+++ Catalyst-Controller-SOAP/1.0/branches/wsdl/lib/Catalyst/Controller/SOAP.pm	2008-04-01 14:15:47 UTC (rev 7540)
@@ -5,9 +5,11 @@
     use XML::LibXML;
 
     use constant NS_SOAP_ENV => "http://schemas.xmlsoap.org/soap/envelope/";
+    use constant NAMESPACE => 'tag://placeholder';
 
-    our $VERSION = '0.2.0';
 
+    our $VERSION = '0.2.1';
+
     sub _parse_SOAP_attr {
         my ($self, $c, $name, $value) = @_;
         my $actionclass = ($value =~ /^\+/ ? $value :
@@ -110,6 +112,7 @@
         }
     }
 
+    sub setup_soap {} # To be overloaded by actual controller
 
 };
 
@@ -117,8 +120,9 @@
 
     use base qw(Class::Accessor::Fast);
 
-    __PACKAGE__->mk_accessors(qw{envelope parsed_envelope arguments fault namespace 
-                               encoded_return literal_return string_return});
+    __PACKAGE__->mk_accessors(qw{envelope parsed_envelope arguments fault 
+        encoded_return literal_return string_return
+        namespace operations data_return params server});
 
 
 };




More information about the Catalyst-commits mailing list