Net::DRI::Transport::SOAP - SOAP (HTTP/HTTPS) Transport for Net::DRI


Net-DRI documentation Contained in the Net-DRI distribution.

Index


Code Index:

NAME

Top

Net::DRI::Transport::SOAP - SOAP (HTTP/HTTPS) Transport for Net::DRI

DESCRIPTION

Top

When calling new_current_profile with this transport, in ref array of parameters for transport, pass an hash ref with the following keys, as needed:

CURRENT LIMITATIONS

* only for SOAP over HTTP/HTTPS
* only one CA certificate can be used in each given instance of Net::DRI (because it is given through %ENV)

SUPPORT

Top

For now, support questions should be sent to:

<netdri@dotandco.com>

Please also see the SUPPORT file in the distribution.

SEE ALSO

Top

<http://www.dotandco.com/services/software/Net-DRI/>

AUTHOR

Top

Patrick Mevzek, <netdri@dotandco.com>

COPYRIGHT

Top


Net-DRI documentation Contained in the Net-DRI distribution.

## Domain Registry Interface, SOAP Transport (HTTP/HTTPS)
##
## Copyright (c) 2005,2009,2010 Patrick Mevzek <netdri@dotandco.com>. All rights reserved.
##
## This file is part of Net::DRI
##
## Net::DRI is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## See the LICENSE file that comes with this distribution for more details.
#
# 
#
#########################################################################################

package Net::DRI::Transport::SOAP;

use strict;
use warnings;

use base qw(Net::DRI::Transport);

use Net::DRI::Exception;

use SOAP::Lite;

our $VERSION=do { my @r=(q$Revision: 1.6 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); };

####################################################################################################

sub new
{
 my ($class,$ctx,$rp)=@_;
 my %opts=%$rp;
 my $self=$class->SUPER::new($ctx,\%opts); ## We are now officially a Net::DRI::Transport instance
 $self->has_state(0);
 $self->is_sync(1);
 $self->name('soap');
 $self->version($VERSION);

 my %t;

 Net::DRI::Exception::usererr_insufficient_parameters('proxy_url must be defined') unless (exists($opts{proxy_url}));
 Net::DRI::Exception::usererr_invalid_parameters('proxy_url must be http:// or https://') unless ($opts{proxy_url}=~m!^https?://!);
 Net::DRI::Exception::usererr_insufficient_parameters('service_wsdl') unless (exists($opts{service_wsdl}));
 Net::DRI::Exception::usererr_invalid_parameters('service_wsdl must be a ref hash') unless (ref($opts{service_wsdl}) eq 'HASH'); ## Name (without .wsdl),ex: Domain => Path to corresponding wsdl file

 my $service=SOAP::Lite->on_fault(\&soap_fault);
 my %st;

 while(my ($k,$v)=each(%{$opts{service_wsdl}}))
 {
  my $go=$service->service($v);
  my $t=$go->transport();
  $t->agent(sprintf('Net::DRI/%s Net::DRI::Transport::SOAP/%s',$Net::DRI::VERSION,$VERSION).$t->agent());
  if ($self->timeout())
  {
   $t->proxy($opts{proxy_url},timeout => $self->timeout());
  } else
  {
   $t->proxy($opts{proxy_url});
  }

  # name:port,realm,user,login
  $t->credentials(@{$opts{credentials}}) if ($opts{credentials} && (ref($opts{credentials}) eq 'ARRAY'));

  $st{$k}=$go;
 }

 $t{service_wsdl}=\%st;

 if (exists($opts{ssl_ca_file}) && (-s $opts{ssl_ca_file}))
 {
  $ENV{HTTPS_CA_FILE}=$opts{ssl_ca_file}; ## How to handle multiple SOAP instances in the same process ??
 }

 $t{soap}=$service;
 $self->{transport}=\%t;
 bless($self,$class);
 return $self;
}

sub soap_fault
{
 my($soap,$res)=@_; 
 my $msg=ref $res ? $res->faultstring() : $soap->transport()->status();
 Net::DRI::Exception->die(1,'transport/soap',7,'SOAP fault: '.$msg);
}

sub send
{
 my ($self,$ctx,$tosend)=@_;
 $self->SUPER::send($ctx,$tosend,\&_soap_send,sub {});
}

sub _soap_send
{
 my ($self,$count,$tosend)=@_;
 my $t=$self->{transport};
 my $so=$t->{soap};
 my $sw=$t->{service_wsdl}; ## a ref hash
 my $service=$tosend->service();

 Net::DRI::Exception::usererr_insufficient_parameters("No wsdl file specified for service $service") unless (exists($sw->{$service}));

 my $m=$tosend->method();
 my $r=$sw->{$service}->$m(@{$tosend->params()});
 $t->{last_reply}=$r;
 return 1; ## very important
}

sub receive
{
 my ($self,$ctx,$count)=@_;
 return $self->SUPER::receive($ctx,\&_soap_receive);
}

sub _soap_receive
{
 my ($self,$count)=@_;
 my $t=$self->{transport};
 my $so=$t->{service};
 my $r=$t->{last_reply};
 $t->{last_reply}=undef;

 return $r; ## will we need one day access to $so ?
}

####################################################################################################
1;