File Coverage

blib/lib/HPPPM/Demand/Management.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package HPPPM::Demand::Management;

use strict;
use warnings;
use Carp;
use Moose;
use Template;
use LWP::UserAgent;
use Error::TryCatch;
use POSIX qw(strftime);
use LWP::Protocol::https;
use HTTP::Request::Common;
use namespace::autoclean;
use English qw(-no_match_vars);

our $VERSION = '0.01';

has 'ops_inputs_reqd' => (
    is      => 'ro',
    isa     => 'HashRef',
    lazy    => 1,
    builder => '_set_ops_inputs_reqd',
);

has 'ops_inputs' => (
    is      => 'ro',
    isa     => 'HashRef',
    lazy    => 1,
    builder => '_set_ops_inputs',
);

has 'operations' => (
    is      => 'rw',
    isa     => 'HashRef',
    lazy    => 1,
    builder => '_set_operations',
);

has 'service_url' => (
    is      => 'rw',
    isa     => 'Str',
);

has 'current_operation' => (
    is      => 'rw',
    isa     => 'Str',
);

has 'user' => (
    is      => 'rw',
    isa     => 'Str',
);

has 'password' => (
    is      => 'rw',
    isa     => 'Str',
);

extends 'HPPPM::ErrorHandler';


#Stores the mapping between operation and the mandatory inputs/types.
#For e.x. "createRequest" operation needs atleast the "requestType"
#type to be present in the input fields.

sub _set_ops_inputs_reqd {
    my $self = shift;
    my %ops_inputs_reqd;

    %ops_inputs_reqd
        = (
            #operations          => Mandatory inputs/types
            createRequest        => ["serviceUrl", "requestType", "fields"],
            addRequestNotes      => ["serviceUrl", "requestId", "notes"],
            executeWFTransitions => ["serviceUrl", "receiver", "transition"],
            deleteRequests       => ["serviceUrl", "requestIds"],
            getRequests          => ["serviceUrl", "requestIds"],
            setRequestFields     => ["serviceUrl", "requestId", "fields"],
            setRequestRemoteReferenceStatus => ["serviceUrl", "receiver",
                                             "source", "status", "fields"],
          );

    return \%ops_inputs_reqd;
}


#Stores the mapping between operation and inputs/types.

sub _set_ops_inputs {
    my $self = shift;
    my %ops_inputs;

    %ops_inputs
        = (
            createRequest        => ["serviceUrl", "requestType", "fields",
                                     "URLReferences", "notes"],
            addRequestNotes      => ["serviceUrl", "requestId", "notes"],
            executeWFTransitions => ["serviceUrl", "receiver", "transition"],
            deleteRequests       => ["serviceUrl", "requestIds"],
            getRequests          => ["serviceUrl", "requestIds"],
            setRequestFields     => ["serviceUrl", "requestId", "fields"],
            setRequestRemoteReferenceStatus => ["serviceUrl", "receiver",
                                                "source", "status", "fields"],
          );

    return \%ops_inputs;
}


sub get_supported_ops {
    my $self = shift;

    return keys %{ $self->ops_inputs };
}


sub get_current_oper {
    my $self = shift;

    return $self->current_operation();
}


sub get_reqd_inputs {
    my $self = shift;
    my $oper = shift;

    return $self->ops_inputs_reqd->{ $oper } if $oper;
    return $self->ops_inputs_reqd();
}


sub get_inputs {
    my $self = shift;
    my $oper = shift;

    return $self->ops_inputs->{ $oper } if $oper;
    return $self->ops_inputs();
}


sub create_request {
    my $self   = shift;
    my $inputs = shift || confess "No inputs to construct request passed in!";
    my $tt     = Template->new( INTERPOLATE => 1);
    my $logger = Log::Log4perl->get_logger( $PROGRAM_NAME );
    my $oper   = $self->current_operation();
    my $req;

    $inputs->{'DATETIME'} = strftime ('%Y-%m-%dT%H:%M:%SZ', gmtime);
    $inputs->{'USER'}     = $self->user();
    $inputs->{'PASSWORD'} = $self->password();
    $inputs->{'CURRENT_OPERATION'} = $oper;

    $logger->info("Creating request for $oper operation");

    try {
        $tt->process("templates/$oper".'.tt2', $inputs, \$req)
                          || throw new Error::Unhandled -text => $tt->error;
    }
    catch Error::Unhandled with {
        $logger->logcroak($tt->error);
    }

    $logger->info("Request created successfully!");
    $logger->debug("Request created:\n$req");

    return $req;
}


sub post_request {
    my $self   = shift;
    my $url    = shift || confess "No WebService url passed in!";
    my $req    = shift || confess "No request to post passed in!";
    my $ct     = shift || 'application/xml';
    my $ua     = LWP::UserAgent->new();
    my $logger = Log::Log4perl->get_logger( $PROGRAM_NAME );
    my $oper   = $self->current_operation();
    my $res;

    return 0 if ! $self->check_url_availability( $url );

    $logger->info("About to POST request to $url");

    try {
        $res = $ua->request(
                    POST         => $url,
                    Content_type => $ct,
                    Content      => $req,
               ) || throw new Error::Unhandled -text => $res->status_line;
    }
    catch Error::Unhandled with {
        $logger->logcroak( $res->status_line );
    }

    $logger->info("POSTing successful!");
    $logger->debug("Response received:\n".$res);

    return $res->content;
}

__PACKAGE__->meta->make_immutable;

1; # End of HPPPM::Demand::Management

__END__