[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