[Catalyst-commits] r7542 - in Catalyst-Controller-SOAP/1.0/trunk:
lib/Catalyst/Action lib/Catalyst/Action/SOAP
lib/Catalyst/Controller t
ruoso at dev.catalyst.perl.org
ruoso at dev.catalyst.perl.org
Tue Apr 1 18:05:01 BST 2008
Author: ruoso
Date: 2008-04-01 18:05:00 +0100 (Tue, 01 Apr 2008)
New Revision: 7542
Modified:
Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP.pm
Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/DocumentLiteral.pm
Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/HTTPGet.pm
Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/RPCEndpoint.pm
Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Controller/SOAP.pm
Catalyst-Controller-SOAP/1.0/trunk/t/PostApp.t
Log:
[C-C-S] Now supports WSDL encoding/decoding of messages.
Modified: Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/DocumentLiteral.pm
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/DocumentLiteral.pm 2008-04-01 15:39:19 UTC (rev 7541)
+++ Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/DocumentLiteral.pm 2008-04-01 17:05:00 UTC (rev 7542)
@@ -6,12 +6,18 @@
sub execute {
my $self = shift;
my ( $controller, $c ) = @_;
- $self->prepare_soap_helper($c);
- $self->prepare_soap_xml_post($c);
+ $self->prepare_soap_helper($controller,$c);
+ $self->prepare_soap_xml_post($controller,$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');
+ my $operation = $self->name;
+ $c->stash->{soap}->operation_name($operation);
+ if ($controller->wsdlobj) {
+ $body = $c->stash->{soap}->arguments
+ ($controller->decoders->{$operation}->($body));
+ }
$self->NEXT::execute($controller, $c, $body);
}
}
Modified: Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/HTTPGet.pm
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/HTTPGet.pm 2008-04-01 15:39:19 UTC (rev 7541)
+++ Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/HTTPGet.pm 2008-04-01 17:05:00 UTC (rev 7542)
@@ -5,7 +5,7 @@
sub execute {
my $self = shift;
my ( $controller, $c ) = @_;
- $self->prepare_soap_helper($c);
+ $self->prepare_soap_helper($controller,$c);
$self->NEXT::execute(@_);
}
};
Modified: Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/RPCEndpoint.pm
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/RPCEndpoint.pm 2008-04-01 15:39:19 UTC (rev 7541)
+++ Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP/RPCEndpoint.pm 2008-04-01 17:05:00 UTC (rev 7542)
@@ -7,8 +7,8 @@
my $self = shift;
my ( $controller, $c ) = @_;
- $self->prepare_soap_helper($c);
- $self->prepare_soap_xml_post($c);
+ $self->prepare_soap_helper($controller,$c);
+ $self->prepare_soap_xml_post($controller,$c);
unless ($c->stash->{soap}->fault) {
my $envelope = $c->stash->{soap}->parsed_envelope;
my $namespace = $c->stash->{soap}->namespace || NS_SOAP_ENV;
@@ -24,8 +24,14 @@
$operation ||= $smthing; # if there's no ns prefix,
# operation is the first
# part.
- my $arguments = $children[0]->getChildNodes();
- $c->stash->{soap}->arguments($arguments);
+ $c->stash->{soap}->operation_name($operation);
+ if ($controller->wsdlobj) {
+ $c->stash->{soap}->arguments
+ ($controller->decoders->{$operation}->($children[0]));
+ } else {
+ my $arguments = $children[0]->getChildNodes();
+ $c->stash->{soap}->arguments($arguments);
+ }
if (!grep { /RPC(Encoded|Literal)/ } @{$controller->action_for($operation)->attributes->{ActionClass}}) {
$c->stash->{soap}->fault
({ code => { 'env:Sender' => 'env:Body' },
Modified: Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP.pm
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP.pm 2008-04-01 15:39:19 UTC (rev 7541)
+++ Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Action/SOAP.pm 2008-04-01 17:05:00 UTC (rev 7542)
@@ -13,13 +13,13 @@
}
sub prepare_soap_helper {
- my ($self, $c) = @_;
+ my ($self, $controller, $c) = @_;
$c->stash->{soap} = Catalyst::Controller::SOAP::Helper->new();
}
sub prepare_soap_xml_post {
- my ($self, $c) = @_;
- # This should be applocation/soap+xml, but some clients doesn't seem to respect that.
+ my ($self, $controller, $c) = @_;
+ # This should be application/soap+xml, but some clients doesn't seem to respect that.
if ($c->req->content_type =~ /xml/ &&
$c->req->method eq 'POST') {
my $body = $c->req->body;
Modified: Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Controller/SOAP.pm
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Controller/SOAP.pm 2008-04-01 15:39:19 UTC (rev 7541)
+++ Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Controller/SOAP.pm 2008-04-01 17:05:00 UTC (rev 7542)
@@ -3,13 +3,62 @@
use strict;
use base qw/Catalyst::Controller/;
use XML::LibXML;
+ use XML::Compile::WSDL11;
+ use UNIVERSAL qw(isa);
use constant NS_SOAP_ENV => "http://schemas.xmlsoap.org/soap/envelope/";
- our $VERSION = '0.2.0';
+ our $VERSION = '0.3';
+ __PACKAGE__->mk_accessors qw(wsdlobj decoders encoders);
+
sub _parse_SOAP_attr {
my ($self, $c, $name, $value) = @_;
+
+ my $wsdlfile = $self->config->{wsdl};
+ if ($wsdlfile) {
+ $self->wsdlobj(XML::Compile::WSDL11->new($wsdlfile))
+ unless $self->wsdlobj;
+
+ my $operation = $self->wsdlobj->operation($name)
+ or die 'Every operation should be on the WSDL when using one.';
+ my $portop = $operation->portOperation();
+
+ my $input_parts = $self->wsdlobj->find(message => $portop->{input}{message})
+ ->{part};
+ $_->{compiled} = $self->wsdlobj->schemas->compile(READER => $_->{element})
+ for @{$input_parts};
+
+ $self->decoders({}) unless $self->decoders();
+ $self->decoders->{$name} = sub {
+ my $body = shift;
+ my @nodes = grep { UNIVERSAL::isa($_, 'XML::LibXML::Element') } $body->childNodes();
+ return
+ {
+ map {
+ my $data = $_->{compiled}->(shift @nodes);
+ $_->{name} => $data;
+ } @{$input_parts}
+ }, @nodes;
+ };
+
+ my $output_parts = $self->wsdlobj->find(message => $portop->{output}{message})
+ ->{part};
+ $_->{compiled} = $self->wsdlobj->schemas->compile(WRITER => $_->{element})
+ for @{$output_parts};
+
+ $self->encoders({}) unless $self->encoders();
+ $self->encoders->{$name} = sub {
+ my ($doc, $data) = @_;
+ return
+ [
+ map {
+ $_->{compiled}->($doc, $data->{$_->{name}})
+ } @{$output_parts}
+ ];
+ };
+ }
+
my $actionclass = ($value =~ /^\+/ ? $value :
'Catalyst::Action::SOAP::'.$value);
(
@@ -85,6 +134,12 @@
} else {
$body->appendChild($lit);
}
+ } elsif (my $cmp = $soap->compile_return) {
+ die 'Tried to use compile_return without WSDL'
+ unless $self->wsdlobj;
+
+ my $arr = $self->encoders->{$soap->operation_name}->($response, $cmp);
+ $body->appendChild($_) for @{$arr};
}
}
@@ -117,8 +172,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 namespace
+ encoded_return literal_return string_return
+ compile_return operation_name});
};
@@ -241,12 +297,28 @@
=back
+=head1 USING WSDL
+
+If you define "wsdl" as a configuration key,
+Catalyst::Controller::SOAP will automatically map your operations into
+the WSDL operations, in which case you will receive the parsed Perl
+structure as returned by XML::Compile according to the type defined in
+the WSDL message.
+
+Also, when using wsdl, you can also define the response using
+
+=over
+
+=item $c->stash->{soap}->compile_return($perl_structure)
+
+In this case, the given structure will be transformed by XML::Compile,
+according to what's described in the WSDL file.
+
+=back
+
=head1 TODO
-At this moment, almost everything is still to be done. The only thing
-done right now is getting the body from the message and dispatching
-the correct method. It is strongly recommended to use XML::Compile as
-a tool to deal with the XML nodes.
+No header features are implemented yet.
The SOAP Encoding support is also missing, when that is ready you'll
be able to do something like the code below:
@@ -262,7 +334,8 @@
L<Catalyst::Action::SOAP>, L<XML::LibXML>, L<XML::Compile>
L<Catalyst::Action::SOAP::DocumentLiteral>,
L<Catalyst::Action::SOAP::RPCLiteral>,
-L<Catalyst::Action::SOAP::HTTPGet>
+L<Catalyst::Action::SOAP::HTTPGet>, L<XML::Compile::WSDL11>,
+L<XML::Compile::Schema>
=head1 AUTHORS
Modified: Catalyst-Controller-SOAP/1.0/trunk/t/PostApp.t
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/t/PostApp.t 2008-04-01 15:39:19 UTC (rev 7541)
+++ Catalyst-Controller-SOAP/1.0/trunk/t/PostApp.t 2008-04-01 17:05:00 UTC (rev 7542)
@@ -1,4 +1,4 @@
-use Test::More tests => 3;
+use Test::More tests => 4;
use File::Spec::Functions;
use HTTP::Response;
use IPC::Open3;
@@ -25,6 +25,12 @@
);
ok($response->content =~ /\<foo\>\<bar\>\<baz\>Hello World\!\<\/baz\>\<\/bar\>\<\/foo\>/, 'Literal response: '.$response->content);
+$response = soap_xml_post
+ ('/withwsdl/Greet',
+ '<Envelope xmlns="http://schemas.xmlsoap.org/soap/envelope/"><Body><GreetingSpecifier><who>World</who><greeting>Hello</greeting></GreetingSpecifier></Body></Envelope>'
+ );
+ok($response->content =~ /greeting\>Hello World\!\<\//, 'Literal response: '.$response->content);
+
sub soap_xml_post {
my $path = shift;
my $content = shift;
More information about the Catalyst-commits
mailing list