view release on metacpan or  search on metacpan

lib/ASNMTAP/Asnmtap/Plugins/SOAP.pm  view on Meta::CPAN

# ----------------------------------------------------------------------------------------------------------
# © Copyright 2000-2011 by Alex Peeters [alex.peeters@citap.be]
# ----------------------------------------------------------------------------------------------------------
# 2011/mm/dd, v3.002.003, package ASNMTAP::Asnmtap::Plugins::SOAP Object-Oriented Perl
# ----------------------------------------------------------------------------------------------------------

# Class name  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
package ASNMTAP::Asnmtap::Plugins::SOAP;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

use strict;
use warnings;           # Must be used in test mode only. This reduces a little process speed
#use diagnostics;       # Must be used in test mode only. This reduces a lot of process speed

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

use Carp qw(cluck);

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

use ASNMTAP::Asnmtap qw(%ERRORS %TYPE);

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

BEGIN {
  use Exporter ();

  @ASNMTAP::Asnmtap::Plugins::SOAP::ISA         = qw(Exporter ASNMTAP::Asnmtap);

  %ASNMTAP::Asnmtap::Plugins::SOAP::EXPORT_TAGS = ( ALL => [ qw(&get_soap_request) ] );

  @ASNMTAP::Asnmtap::Plugins::SOAP::EXPORT_OK   = ( @{ $ASNMTAP::Asnmtap::Plugins::SOAP::EXPORT_TAGS{ALL} } );

  $ASNMTAP::Asnmtap::Plugins::SOAP::VERSION     = do { my @r = (q$Revision: 3.002.003$ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r };
}

# Utility methods - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub get_soap_request {
  my %defaults = ( asnmtapInherited     => undef,
                   custom               => undef,
                   customArguments      => undef,
                   proxy                => undef,
                   credentials          => undef,
                   namespace            => undef,
                   registerNamespace    => undef,
                   method               => undef,
                   soapaction           => undef,
                   xmlContent           => undef,
                   params               => undef,
                   envprefix            => 'soapenv',
                   encprefix            => 'soapenc',
                   encodingStyle        => undef,
                   readable             => 1,
                   cookies              => undef,
                   perfdataLabel        => undef,

                   PATCH_HTTP_KEEPALIVE => 0,
                   WSRF                 => 0,

                   TYPE_ERROR_RETURN    => 'REPLACE'
				 );

  my %parms = (%defaults, @_);

  my $asnmtapInherited = $parms{asnmtapInherited};
  unless ( defined $asnmtapInherited ) { cluck ( 'ASNMTAP::Asnmtap::Plugins::SOAP: asnmtapInherited missing' ); exit $ERRORS{UNKNOWN} }

  unless ( defined $parms{proxy} ) {
    $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => 'Missing SOAP parameter proxy' }, $TYPE{APPEND} );
    return ( $ERRORS{UNKNOWN} );
  }

  my $namespace = $parms{namespace};

  unless ( defined $namespace ) {
    $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => 'Missing SOAP parameter namespace' }, $TYPE{APPEND} );
    return ( $ERRORS{UNKNOWN} );
  }

  my $registerNamespace = $parms{registerNamespace};

  if ( defined $registerNamespace ) {
    unless ( ref $registerNamespace eq 'HASH' ) {
      $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => 'Missing SOAP parameter registerNamespace' }, $TYPE{APPEND} );
      return ( $ERRORS{UNKNOWN} );
    }
  }

  unless ( defined $parms{method} ) {
    $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => 'Missing SOAP parameter method' }, $TYPE{APPEND} );
    return ( $ERRORS{UNKNOWN} );
  }

  my $soapaction = $parms{soapaction};

  my $xmlContent = $parms{xmlContent};

  my $params = $parms{params};

  my $readable = $parms{readable};

  my $envprefix = $parms{envprefix};

  my $encprefix = $parms{envprefix};

  my $encodingStyle = $parms{encodingStyle};

  unless ( $readable =~ /^[01]$/ ) {
    $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => 'SOAP parameter readable must be 0 or 1' }, $TYPE{APPEND} );
    return ( $ERRORS{UNKNOWN} );
  }

  my $cookies = $parms{cookies};

  unless ( $cookies =~ /^[01]$/ ) {
    $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => 'SOAP parameter cookies must be 0 or 1' }, $TYPE{APPEND} );
    return ( $ERRORS{UNKNOWN} );
  }

  unless ( defined $parms{perfdataLabel} ) {
    $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => 'Missing SOAP parameter perfdataLabel' }, $TYPE{APPEND} );
    return ( $ERRORS{UNKNOWN} );
  }

  my $PATCH_HTTP_KEEPALIVE = $parms{PATCH_HTTP_KEEPALIVE};

  unless ( $PATCH_HTTP_KEEPALIVE =~ /^[01]$/ ) {
    $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => 'SOAP parameter PATCH_HTTP_KEEPALIVE must be 0 or 1' }, $TYPE{APPEND} );
    return ( $ERRORS{UNKNOWN} );
  }

  my $WSRF = $parms{WSRF};

  unless ( $WSRF =~ /^[01]$/ ) {
    $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => 'SOAP parameter WSRF must be 0 or 1' }, $TYPE{APPEND} );
    return ( $ERRORS{UNKNOWN} );
  }

  my $TYPE_ERROR_RETURN = $parms{TYPE_ERROR_RETURN};

  unless ( $TYPE_ERROR_RETURN =~ /^(?:REPLACE|APPEND|INSERT|COMMA_APPEND|COMMA_INSERT)$/ ) {
    $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => 'SOAP parameter TYPE_ERROR_RETURN must be [REPLACE|APPEND|INSERT|COMMA_APPEND|COMMA_INSERT]' }, $TYPE{APPEND} );
    return ( $ERRORS{UNKNOWN} );
  }

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  my $browseragent  = $$asnmtapInherited->browseragent ();
  my $timeout       = $$asnmtapInherited->timeout ();

  my $proxySettings = $$asnmtapInherited->getOptionsArgv ( 'proxy' );

  my $debug         = $$asnmtapInherited->getOptionsValue ( 'debug' );

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  sub _soapCheckTransportStatus {
    my ($asnmtapInherited, $service, $TYPE_ERROR_RETURN, $debug) = @_;

    my $transportStatus = $service->transport->status;
    print "ASNMTAP::Asnmtap::Plugins::SOAP::_soapCheckTransportStatus: $transportStatus\n" if ($debug);

    if ( $service->transport->is_success ) { 
      $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{OK}, alert => $transportStatus }, $TYPE{APPEND} );
      return $ERRORS{OK};
    };

lib/ASNMTAP/Asnmtap/Plugins/SOAP.pm  view on Meta::CPAN

    my $faultdetail = $som->faultdetail;
    my $faultstring = $som->faultstring;
    my $faultactor  = $som->faultactor;

    if ( $debug ) {
      print "ASNMTAP::Asnmtap::Plugins::SOAP::_soapCheckFault->faultcode   : ", $faultcode,   "\n" if (defined $faultcode);
      print "ASNMTAP::Asnmtap::Plugins::SOAP::_soapCheckFault->faultdetail : ", $faultdetail, "\n" if (defined $faultdetail);
      print "ASNMTAP::Asnmtap::Plugins::SOAP::_soapCheckFault->faultstring : ", $faultstring, "\n" if (defined $faultstring);
      print "ASNMTAP::Asnmtap::Plugins::SOAP::_soapCheckFault->faultactor  : ", $faultactor,  "\n" if (defined $faultactor);
    }

    $$asnmtapInherited->pluginValues ( { stateValue => $ERRORS{UNKNOWN}, error => $faultcode. ( defined $faultstring ? ' - ' .$faultstring : '' ) }, $TYPE{APPEND} ); 
    return $ERRORS{UNKNOWN};
  }

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  my ($service, $alert, $error, $result);

  if ( $WSRF ) {
    if ( $debug >= 4 ) {
      eval "use WSRF::Lite +trace => 'all'";
    } elsif ($debug == 1) {
      eval "use WSRF::Lite +trace => qw( debug )";
    } else {
      eval "use WSRF::Lite";
    }

    $service = new WSRF::Lite
      -> wsaddress  ( WSRF::WS_Address->new()->Address( $parms{proxy} ) )
      -> autotype   ( 1 )
      -> readable   ( $readable )
      -> envprefix  ( $envprefix )
      -> encprefix  ( $encprefix )
      -> xmlschema  ( 'http://www.w3.org/2001/XMLSchema' )
      -> uri        ( $namespace )
      -> on_action  ( sub { my $uri = $_[0]; $uri =~ s/\/$//; my $method = (defined $soapaction ? ( $soapaction eq '' ? '' : $soapaction ) : $uri .'/'. $_[1]) } )
      -> on_fault   ( sub { } )
    ;
  } else {
    if ( $debug >= 4 ) {
      eval "use SOAP::Lite +trace => 'all'";
    } elsif ($debug == 1) {
      eval "use SOAP::Lite +trace => qw( debug )";
    } else {
      eval "use SOAP::Lite";
    }

    $service = new SOAP::Lite
      -> autotype   ( 1 )
      -> readable   ( $readable )
      -> envprefix  ( $envprefix )
      -> encprefix  ( $encprefix )
      -> xmlschema  ( 'http://www.w3.org/2001/XMLSchema' )
      -> uri        ( $namespace )
      -> on_action  ( sub { my $uri = $_[0]; $uri =~ s/\/$//; my $method = (defined $soapaction ? ( $soapaction eq '' ? '' : $soapaction ) : $uri .'/'. $_[1]) } )
      -> on_fault   ( sub { } )
    ;
  }

  $service->serializer->encodingStyle ( $encodingStyle ) if ( defined $encodingStyle );
  $SOAP::Constants::PATCH_HTTP_KEEPALIVE = $PATCH_HTTP_KEEPALIVE;

  if ( defined $parms{registerNamespace} ) {
    while ( my ($key, $value) = each( %{ $parms{registerNamespace} } ) ) {
      $service->serializer->register_ns($key, $value);
    }
  }

  if ( defined $proxySettings ) {
    $service->proxy ( $parms{proxy}, timeout => $timeout, proxy => ['http' => "http://$proxySettings"] );
  } else {
    $service->proxy ( $parms{proxy}, timeout => $timeout );
  }

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  $service->transport->credentials( @{$parms{credentials}} ) if ( defined $parms{credentials} );

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # $service->proxy ( 'https://USERNAME:PASSWORD@secure.citap.be/authorization/hibye.cgi' );
  # or
  # $service->proxy ( 'https://secure.citap.be/authorization/hibye.cgi', credentials => [ 'secure.citap.be:443', "ASNMTAP's Authorization Access", 'USERNAME' => 'PASSWORD' ], timeout => $timeout );
  # or
  # $service->transport->credentials( 'secure.citap.be:443', "ASNMTAP's Authorization Access", 'USERNAME' => 'PASSWORD' );
  # or
  # use MIME::Base64;
  # $service->transport->http_request->header( 'Authorization' => 'Basic '. MIME::Base64::encode ( 'USERNAME' .':'. 'PASSWORD', '' ) );
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  $service->transport->agent( $browseragent );
  $service->transport->timeout( $timeout );  

  use HTTP::Cookies;
  $service->transport->cookie_jar( HTTP::Cookies->new ) if ( $cookies );

  $service->transport->default_headers->push_header( 'Accept-Language' => "no, en" );
  $service->transport->default_headers->push_header( 'Accept-Charset'  => "iso-8859-1,*,utf-8" );
  $service->transport->default_headers->push_header( 'Accept-Encoding' => "gzip, deflate" );
 
  print "ASNMTAP::Asnmtap::Plugins::SOAP::get_soap_request: () -->\n" if ( $debug );
  $$asnmtapInherited->setEndTime_and_getResponsTime ( $$asnmtapInherited->pluginValue ('endTime') );

  my $som = (defined $params and $params ne '') ? (ref $params eq 'ARRAY' ? $service->call( $parms{method} => @$params ) : $service->call( $parms{method} => $params )) : $service->call( $parms{method} );

  my $responseTime = $$asnmtapInherited->setEndTime_and_getResponsTime ( $$asnmtapInherited->pluginValue ('endTime') );
  $$asnmtapInherited->appendPerformanceData ( "'". $parms{perfdataLabel} ."'=". $responseTime ."ms;;;;" );
  print "ASNMTAP::Asnmtap::Plugins::SOAP::get_soap_request: () <->\n" if ( $debug );

  my $returnCode = _soapCheckTransportStatus ($asnmtapInherited, $service, $TYPE_ERROR_RETURN, $debug);

  unless ( $returnCode ) {
    unless ( defined $som and defined $som->fault ) {
      $result = UNIVERSAL::isa($som => ($WSRF ? 'WSRF::SOM' : 'SOAP::SOM')) ? (wantarray ? $som->paramsall : $som->result) : $som;

      if ( $debug ) {
        for ( ref $result ) {
          /^REF$/ &&
            do { 
              for ( ref $$result ) {
                /^ARRAY$/ &&