[Catalyst-commits] r7644 - in Catalyst-Model-SOAP/1.0/trunk:
lib/Catalyst/Model t/lib
ruoso at dev.catalyst.perl.org
ruoso at dev.catalyst.perl.org
Wed Apr 30 01:38:42 BST 2008
Author: ruoso
Date: 2008-04-30 01:38:42 +0100 (Wed, 30 Apr 2008)
New Revision: 7644
Modified:
Catalyst-Model-SOAP/1.0/trunk/lib/Catalyst/Model/SOAP.pm
Catalyst-Model-SOAP/1.0/trunk/t/lib/MyXMLModule.pm
Log:
[C-M-SOAP] Implements support for multi-port WSDL and for RPC/Literal
Modified: Catalyst-Model-SOAP/1.0/trunk/lib/Catalyst/Model/SOAP.pm
===================================================================
--- Catalyst-Model-SOAP/1.0/trunk/lib/Catalyst/Model/SOAP.pm 2008-04-29 16:12:59 UTC (rev 7643)
+++ Catalyst-Model-SOAP/1.0/trunk/lib/Catalyst/Model/SOAP.pm 2008-04-30 00:38:42 UTC (rev 7644)
@@ -2,8 +2,15 @@
use strict;
use warnings;
use XML::Compile::WSDL11;
+ use List::Util qw/first/;
use base qw(Catalyst::Model);
- our $VERSION = '0.0.5';
+ our $VERSION = '0.0.6';
+
+ __PACKAGE__->mk_accessors('transport');
+
+ use constant NS_SOAP_ENV => "http://schemas.xmlsoap.org/soap/envelope/";
+ use constant NS_WSDLSOAP => "http://schemas.xmlsoap.org/wsdl/soap/";
+
sub register_wsdl {
my ($self, $wsdl, $target) = @_;
@@ -29,20 +36,129 @@
$wsdl_obj->importDefinitions($schema)
}
- my $realtarget = $self.'::'.$target;
+ my $transport = $self->config->{transport};
+ my $service = $self->config->{service};
+ if (ref $target eq 'HASH') {
+ # I'll have to implement a piece of XML::Compile::SOAP::WSDL11 here,
+ # as it doesn't provide a way to list the operations for a single port
+ foreach my $portname (keys %{$target}) {
+ my $realtarget = $self.'::'.$target->{$portname};
+ no strict 'refs';
+ @{$realtarget.'::ISA'} = qw(Catalyst::Model::SOAP::Instance);
+
+ my $serv = $wsdl_obj->find(service => $service)
+ or die 'Could not find service '.$service;
+ my @ports = @{$serv->{port} || []};
+ my $port = first {$_->{name} eq $portname } @ports
+ or die 'Could not find port '.$portname;
+ my $bindname = $port->{binding}
+ or die 'Could not find binding for port '.$portname;
+ my $binding = $wsdl_obj->find(binding => $bindname)
+ or die 'Could not find binding '.$bindname;
+ my $porttypename = $binding->{type}
+ or die 'Could not find portType for binding '.$bindname;
+ my $portType = $wsdl_obj->find(portType => $porttypename)
+ or die 'Could not find portType '.$porttypename;
+ my $operations = $portType->{operation}
+ or die 'No operations found for portType '.$porttypename;
+
+
+ for my $operationhash (@$operations) {
+ my $operation = $wsdl_obj->operation(service => $service,
+ port => $portname,
+ operation => $operationhash->{name});
+
+ my $style = $binding->{'{'.NS_WSDLSOAP.'}binding'}[0]->getAttribute('style');
+ my $proto = $binding->{'{'.NS_WSDLSOAP.'}binding'}[0]->getAttribute('transport');
+
+ my ($use) = map { $_->{input}{'{'.NS_WSDLSOAP.'}body'}[0]->getAttribute('use') }
+ grep { $_->{name} eq $operation->name } @{ $binding->{operation} || [] };
+
+ $style = $style =~ /document/i ? 'document' : 'rpc';
+ $use = $use =~ /literal/i ? 'literal' : 'encoded';
+
+ $operation->{style} = $style;
+
+ $self->_register_operation($wsdl_obj, $operation, $realtarget, $transport, $style, $use, $proto);
+ }
+
+ }
+ } else {
+ my $realtarget = $self.'::'.$target;
+ no strict 'refs';
+ @{$realtarget.'::ISA'} = qw(Catalyst::Model::SOAP::Instance);
+ foreach my $operation ($wsdl_obj->operations(produce => 'OBJECTS')) {
+ $self->_register_operation($wsdl_obj, $operation,$realtarget,$transport,'','');
+ }
+ }
+ }
+ sub _register_operation {
+ my ($self, $wsdl_obj, $operation, $realtarget, $transport, $style, $use, $proto) = @_;
no strict 'refs';
- @{$realtarget.'::ISA'} = qw(Catalyst::Model::SOAP::Instance);
- foreach my $operation ($wsdl_obj->operations(produce => 'OBJECTS')) {
- my $code = $operation->compileClient();
- *{$realtarget.'::'.$operation->name()} = sub {
- my $self = shift;
- return $code->(@_);
+ my $send;
+ if ($transport) {
+ $send = $transport->compileClient(kind => $operation->kind);
+ }
+
+ my ($rpcin, $rpcout);
+ if ($style =~ /rpc/i && $use =~ /literal/i) {
+ my $portop = $operation->portOperation();
+
+ my $input_parts = $wsdl_obj->find(message => $portop->{input}{message})
+ ->{part};
+
+ for (@{$input_parts}) {
+ my $type = $_->{type} ? $_->{type} : $_->{element};
+ $_->{compiled_writer} = $wsdl_obj->schemas->compile
+ (WRITER => $type, elements_qualified => 'ALL');
};
- *{$realtarget.'::_'.$operation->name().'_data'} = sub {
- return ($wsdl_obj, $operation, $code);
+
+ my $output_parts = $wsdl_obj->find(message => $portop->{output}{message})
+ ->{part};
+ for (@{$output_parts}) {
+ my $type = $_->{type} ? $_->{type} : $_->{element};
+ $_->{compiled_reader} = $wsdl_obj->schemas->compile
+ (READER => $type);
+ }
+
+ $rpcin = sub {
+ my ($doc, $data) = @_;
+ my $operation_element = $doc->createElement($operation->name);
+ my @parts =
+ map {
+ $_->{compiled_writer}->($doc, $data->{$_->{name}})
+ } @{$input_parts};
+ $operation_element->appendChild($_)
+ for grep { ref $_ } @parts;
+ return $operation_element;
};
+
+ $rpcout = sub {
+ my $soap = shift;
+ my @nodes = grep { UNIVERSAL::isa($_, 'XML::LibXML::Element') } @_;
+ return
+ {
+ map {
+ my $data = $_->{compiled_reader}->(shift @nodes);
+ ( $_->{name} => $data )
+ } @{$output_parts}
+ };
+ };
+
}
+
+ my $code = $operation->compileClient($send ? ( transport => $send ) : (),
+ rpcin => $rpcout,
+ rpcout => $rpcin,
+ protocol => $proto);
+ *{$realtarget.'::'.$operation->name()} = sub {
+ my $self = shift;
+ return $code->(@_);
+ };
+ *{$realtarget.'::_'.$operation->name().'_data'} = sub {
+ return ($wsdl_obj, $operation, $code);
+ };
}
};
{ package Catalyst::Model::SOAP::Instance;
@@ -63,8 +179,14 @@
{# In the model class...
package MyApp::Model::SOAP;
use base qw(Catalyst::Model::SOAP);
+
+ __PACKAGE__->config->{transport} = XML::Compile::Transport::SOAPHTTP(...);
+
__PACKAGE__->register_wsdl('http://foo.bar/baz.wsdl', 'Baz');
__PACKAGE__->register_wsdl('http://baz.bar/foo.wsdl', 'Foo');
+ __PACKAGE__->register_wsdl('http://baz.bar/foo.wsdl',
+ { 'PortName1' => 'Class1',
+ 'PortName2' => 'Class2'});
# use several wsdl files
__PACKAGE__->register_wsdl([ $file1, $file2, $file3 ], 'Baz');
@@ -115,6 +237,17 @@
Note that XML::Compile->knownNamespace(...) can be used to help
declaring the wsdl.
+You can send a hashref for the $targetclass. Catalyst::Model::SOAP
+will use the key as the port name and the value as the class to
+install the operations available in that specific port.
+
+If this wsdl describes more than one service, you might want to use
+the "service" config key to declare the service name.
+
+You can also set the transport object (which will be later be used in
+a compileClient call). This way you can define transports for
+different protocols.
+
=back
=head1 ACCESSORS
Modified: Catalyst-Model-SOAP/1.0/trunk/t/lib/MyXMLModule.pm
===================================================================
--- Catalyst-Model-SOAP/1.0/trunk/t/lib/MyXMLModule.pm 2008-04-29 16:12:59 UTC (rev 7643)
+++ Catalyst-Model-SOAP/1.0/trunk/t/lib/MyXMLModule.pm 2008-04-30 00:38:42 UTC (rev 7644)
@@ -40,5 +40,8 @@
my $self = shift;
return $self->{name};
}
+ sub soapStyle {
+ 'document'
+ }
};
1;
More information about the Catalyst-commits
mailing list