File Coverage

blib/lib/promessaging/MRS.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package promessaging::MRS;

use SOAP::Lite;
use XML::Simple;
use strict;

use 5.008003;

use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use promessaging::MRS ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
envelope get_xml MSISDNResolve getError get_xml_request get_xml_response MRSinfo
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
envelope get_xml MSISDNResolve getError get_xml_request get_xml_response MRSinfo
);

our $VERSION = '1.01';


# location of the WSDL-description of the SOAP-service
my $wsdl = "http://www.promessaging.net/End2EndMRS.wsdl";


# serializer class
BEGIN {

    package My::Serializer;
    @My::Serializer::ISA = 'SOAP::Serializer';

    sub envelope {
        my $self = shift;

        $self->{'xml_request'} = $self->SUPER::envelope(@_);
        return ( $self->{'xml_request'} );
    }

    sub get_xml {
        my $self = shift;

        return ( $self->{'xml_request'} );
    }
}

# constructor, no parameters needed
sub new {
    my $class = shift;
    my $self  = {};

    $self->{'error'}        = "";
    $self->{'xml_response'} = "";
    eval {
	if (
	    !(
	  $self->{'soapservice'} =
	      new SOAP::Lite->service($wsdl)->outputxml('true')
	      ->on_fault( sub { return; } )
	      )
	    )
	{
	    return (0);
	}
	$self->{'soapservice'}->serializer( My::Serializer->new );
    };
    if ($@) {
	return(0);
    }

    bless $self, $class;
}

sub MSISDNResolve {
    my $self = shift;

#    my ( $msisdn, $userid, $password, $serviceprofile, $max_retries,
#	 $interval_timeout, $interval_na ) = @_;

    my ($userid, $password, $serviceprofile, $msisdn, $max_retries, $interval_timeout, $interval_na) = @_;


    my $soapservice = $self->{'soapservice'};
    $self->{'error'} = "";

    my $retry = 0;
    my $result;
    my $interval;

    if ( !defined( $max_retries ) ) {
        $max_retries = 0;
    }
    if ( !defined( $interval_timeout ) ) {
	# default: 0 seconds because immediately retry is allowed
        $interval_timeout = 0;
    }
    if ( !defined( $interval_na ) ) {
        # default: 300 seconds (5 minutes)
        $interval_na = 300;
    }

    while ( $retry <= $max_retries ) {
        if ( $retry > 0 ) {
            sleep $interval;
        }

        my $answer;

	eval {
	    $answer = $self->{'soapservice'}->MSISDNResolve( $userid,
							     $password,
							     $serviceprofile,
							     $msisdn );

	    if ( substr( $answer, 0, 5 ) eq "
		$self->{'xml_response'} = $answer;
		my $xs      = new XML::Simple( suppressempty => "" );
		my $parsed  = $xs->XMLin($answer);
		my $xmlbody = $parsed->{'SOAP-ENV:Body'};

		if ( defined( $xmlbody->{'SOAP-ENV:Fault'} ) ) {
		    my $fault     = $xmlbody->{'SOAP-ENV:Fault'};
		    my $faultcode = $fault->{'faultcode'};
		    $result = $fault;

		    if ( $faultcode == 91 ) {
			$interval = $interval_timeout;
		    }
		    elsif ( $faultcode == 99 ) {
			$interval = $interval_na;
		    }
		    else {
			last;
		    }

		}
		elsif ( defined( $xmlbody->{'SOAP-ENV:MSISDNResolveResponse'} ) ) {
		    $result->{"response"} =
			$xmlbody->{'SOAP-ENV:MSISDNResolveResponse'};
		    last;
		}
		else {
		    $self->{'error'} = "no Fault or MSISDNResolveResponse in XML";
		    $interval        = $interval_na;
		    $result          = -1;
		}
	    }
	    else {
		chomp $answer;
		$self->{'error'} = $answer;
		$interval        = $interval_na;
		$result          = -2;
	    }
	};
	if ($@) {
	    $self->{'error'} = $@;
	    $interval        = $interval_na;
	    $result          = -3;
	}

	$retry++;
    }

    return ($result);
}

sub getError {
    my $self = shift;

    return ( $self->{'error'} );
}

sub get_xml_request {
    my $self = shift;

    return ( $self->{'soapservice'}->serializer->get_xml );
}

sub get_xml_response {
    my $self = shift;

    return ( $self->{'xml_response'} );
}

# just to show basic functionality
sub MRSinfo	{

    print "\nThis shows that you installed MRS.pm succesfully!\n";

}

# Preloaded methods go here.

1;
__END__