File Coverage

blib/lib/perfSONAR_PS/Transport.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package perfSONAR_PS::Transport;

use strict;
use warnings;
use Exporter;
use LWP::UserAgent;
use Log::Log4perl qw(get_logger :nowarn);
use perfSONAR_PS::Common;
use perfSONAR_PS::Messages;

our $VERSION = 0.09;
use base 'Exporter';
our @EXPORT = ();

use fields 'CONTACT_HOST', 'CONTACT_PORT', 'CONTACT_ENDPOINT';

sub new {
    my ($package, $contactHost, $contactPort, $contactEndPoint) = @_;

    my $self = fields::new($package);

    if(defined $contactHost and $contactHost ne "") {
        $self->{"CONTACT_HOST"} = $contactHost;
    }
    if(defined $contactPort and $contactPort ne "") {
        $self->{"CONTACT_PORT"} = $contactPort;
    }
    if(defined $contactEndPoint and $contactEndPoint ne "") {
        $self->{"CONTACT_ENDPOINT"} = $contactEndPoint;
    }

    return $self;
}

sub setContactHost {
    my ($self, $contactHost) = @_;
    my $logger = get_logger("perfSONAR_PS::Transport");
    if(defined $contactHost) {
        $self->{CONTACT_HOST} = $contactHost;
    }
    else {
        $logger->error("Missing argument.");
    }
    return;
}


sub setContactPort {
    my ($self, $contactPort) = @_;
    my $logger = get_logger("perfSONAR_PS::Transport");
    if(defined $contactPort) {
        $self->{CONTACT_PORT} = $contactPort;
    }
    else {
        $logger->error("Missing argument.");
    }
    return;
}


sub splitURI {
    my ($uri) = @_;
    my $logger = get_logger("perfSONAR_PS::Transport");
    my $host = undef;
    my $port= undef;
    my $endpoint = undef;
    if($uri =~ /^http:\/\/([^\/]*)\/?(.*)$/) {
        ($host, $port) = split(':', $1);
        $endpoint = $2;
    }
    if(not defined $port or $port eq '') {
        $port = 80;
    }
    if($port =~ m/^:/) {
        $port =~ s/^://g;
    }
    $endpoint = '/' . $endpoint unless $endpoint =~ /^\//;
    $logger->debug("Found host: " . $host . " port: " . $port . " endpoint: " . $endpoint);
    return ($host, $port, $endpoint);
}


sub getHttpURI {
    my ($host, $port, $endpoint) = @_;
    my $logger = get_logger("perfSONAR_PS::Transport");
    $logger->debug("Created URI: http://" . $host . ":" . $port . "/" . $endpoint);
    $endpoint = "/".$endpoint if ($endpoint =~ /^[^\/]/);
    return 'http://' . $host . ':' . $port . $endpoint;
}


sub setContactEndPoint {
    my ($self, $contactEndPoint) = @_;
    my $logger = get_logger("perfSONAR_PS::Transport");
    if(defined $contactEndPoint) {
        $self->{CONTACT_ENDPOINT} = $contactEndPoint;
    }
    else {
        $logger->error("Missing argument.");
    }
    return;
}

sub sendReceive {
    my($self, $envelope, $timeout, $error) = @_;
    my $logger = get_logger("perfSONAR_PS::Transport");
    my $method_uri = "http://ggf.org/ns/nmwg/base/2.0/message/";
    my $httpEndpoint = &getHttpURI( $self->{CONTACT_HOST}, $self->{CONTACT_PORT}, $self->{CONTACT_ENDPOINT});
    my $userAgent = "";
    if(defined $timeout and $timeout ne "") {
        $userAgent = LWP::UserAgent->new('timeout' => $timeout);
    }
    else {
        $userAgent = LWP::UserAgent->new('timeout' => 3000);
    }

    $logger->debug("Sending information to \"".$httpEndpoint."\": $envelope");

    my $sendSoap = HTTP::Request->new('POST', $httpEndpoint, new HTTP::Headers, $envelope);
    $sendSoap->header('SOAPAction' => $method_uri);
    $sendSoap->content_type  ('text/xml');
    $sendSoap->content_length(length($envelope));

    my $httpResponse = $userAgent->request($sendSoap);

    if (!($httpResponse->is_success)) {
        $logger->debug("Send to \"".$httpEndpoint."\" failed: ".$httpResponse->status_line);
        $$error = $httpResponse->status_line if defined $error;
        return "";
    }

    my $responseCode = $httpResponse->code();
    my $responseContent = $httpResponse->content();

    $logger->debug("Response returned: ".$responseContent);

    $$error = "" if defined $error;
    return $responseContent;
}


1;


__END__