ngcp-panel/lib/NGCP/Panel/Utils/SOAP.pm

146 lines
4.6 KiB

package NGCP::Panel::Utils::SOAP;
use strict;
use warnings;
use SOAP::Lite;
use SOAP::WSDL::Expat::WSDLParser;
use SOAP::WSDL::XSD::Schema;
use XML::Simple;
use Exporter qw(import);
our @EXPORT = qw();
our @EXPORT_OK = qw(typed);
our %EXPORT_TAGS = qw();
local $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
sub typed;
sub dotype;
my $Parser = SOAP::WSDL::Expat::WSDLParser->new();
my %Wsdls;
my $Wsdl;
my $TNS;
my $TTNS;
### SOAP data typing function ###
sub typed {
my $c = shift;
my $response = shift;
my $function = (caller(1))[3];
return $response unless $function =~ /^Sipwise::(SOAP)::([^:]+)::([^:]+)$/;
my $transport = $1;
my $package = $2;
$function = $3;
my $WSDL = 'http://127.0.0.1:'. $c->config->{intercept}{soap_port} .'/SOAP/' . $package . '.wsdl';
unless(exists $Wsdls{$package}) {
$Wsdls{$package} = $Parser->parse_uri($WSDL);
}
$Wsdl = $Wsdls{$package};
$TNS = $Wsdl->get_targetNamespace();
$TTNS = ${${$Wsdl->get_types()}[0]->get_schema()}[-1]->get_targetNamespace();
my $nss = ${${$Wsdl->get_types()}[0]->get_schema()}[-1]->get_xmlns();
my $typens = 'typens';
for(eval {keys %$nss}) {
if($$nss{$_} eq $TTNS) {
$typens = $_;
last;
}
}
my $resmsg = eval { ${$Wsdl->find_portType($TNS, $package.'PortType')->find_operation($TNS, $function)->get_output()}[0]->get_message()};
return $response unless defined $resmsg;
$resmsg =~ s/^.+://;
if(defined ${$Wsdl->find_message($TNS, $resmsg)->get_part()}[0]) {
my $resnam = ${$Wsdl->find_message($TNS, $resmsg)->get_part()}[0]->get_name();
my $restyp = ${$Wsdl->find_message($TNS, $resmsg)->get_part()}[0]->get_type();
if($restyp =~ /^$typens:/) {
$response = dotype($resnam, $restyp, $response, $transport);
# $response = SOAP::Data->name($resnam => $response);
} else {
$restyp =~ s/^(.+)://;
$response = SOAP::Data->name($resnam => $response)->type($restyp);
}
} else { # "empty_Response" for void functions
return $transport eq 'XMLRPC' ? undef : ();
}
return $response;
}
sub dotype {
my ($resnam, $restyp, $response, $transport) = @_;
my $tresponse;
if($restyp =~ /^(.+):(.+)$/) {
my $cns = $1;
my $ctype = $2;
if($ctype =~ s/Array$//) {
$ctype =~ s/^String$/string/;
if(eval { @$response }) {
if($ctype eq 'boolean' or $ctype eq 'int' or $ctype eq 'string') {
for(eval { @$response }) {
push @$tresponse, SOAP::Data->name(item => $_)->type($ctype);
}
} else {
for(eval { @$response }) {
push @$tresponse, dotype('item', "$cns:$ctype", $_, $transport);
}
}
$tresponse = SOAP::Data->name($resnam => $tresponse);
} else {
if($ctype eq 'boolean' or $ctype eq 'int' or $ctype eq 'string') {
$tresponse = SOAP::Data->name($resnam => [])->attr({'soapenc:arrayType' => "xsd:$ctype".'[0]'});
} else {
# FIXME: data types should be set to XMLRPC simple types for transport via XMLRPC
# (because no other data types are known)
# not fixed to avoid possible side-effects
$tresponse = SOAP::Data->name($resnam => [])->attr({'soapenc:arrayType' => "$cns:$ctype".'[0]'});
}
}
} elsif ($ctype =~ /Enum$/) {
# set data types to string for transport via XMLRPC
# (because the WSDL enum types are not known)
if ($transport eq 'XMLRPC' || $ENV{HTTP_USER_AGENT} =~ /SOAP::Lite/i) {
$tresponse = SOAP::Data->name($resnam => $response)->type('string');
} else {
$tresponse = SOAP::Data->name($resnam => $response)->type("$cns:$ctype");
}
} else {
$restyp =~ s/^(.+)://;
my $typdef = ${$Wsdl->get_types()}[0]->find_type($TTNS, $restyp);
foreach my $telem (@{$typdef->get_element()}) {
my $tnam = $telem->get_name();
my $ttyp = $telem->get_type();
$$tresponse{$tnam} = dotype($tnam, $ttyp, $$response{$tnam}, $transport);
}
# FIXME: data types should be set to XMLRPC simple types for transport via XMLRPC
# (because no other data types are known)
# not fixed to avoid possible side-effects
$tresponse = SOAP::Data->name($resnam => $tresponse)->type("$cns:$restyp");
}
} else {
# fix some types for transport via XMLRPC
# (because defaults are the SOAP types)
if ($transport eq 'XMLRPC') {
$restyp =~ s/^base64Binary$/base64/;
$restyp =~ s/^float$/double/;
# prevent "<int/>" in response for NULL values
if ($restyp eq 'int' and not defined $response) {
$response = 0;
}
}
$tresponse = SOAP::Data->name($resnam => $response)->type($restyp);
}
return $tresponse;
}
1;