File Coverage

blib/lib/HPPPM/ErrorHandler.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package HPPPM::ErrorHandler;

use strict;
use warnings;
use Moose;
use Pod::Usage;
use Log::Log4perl;
use Data::Dumper;
use Getopt::Long;
use LWP::UserAgent;
use Error::TryCatch;
use namespace::autoclean;
use English qw( -no_match_vars );

our $VERSION = '0.01';

has 'input_parsed_xml' => (
    is      => 'rw',
    isa     => 'XML::Simple',
);

#Checks if the input fields that will be used to construct the SOAP
#message have all the reqd. (per operation) types present.Both inputs
#fields and the reqd types are mandatory inputs.Returns True if the reqd.
#types are present

sub _check_reqd_types {
    my $self       = shift;
    my $fields     = shift || confess "No fields to check properties";
    my $reqd_types = shift || confess "No types to check";
    my $operation  = $self->current_operation();
    my $logger     = Log::Log4perl->get_logger( $PROGRAM_NAME );
    my (@present_types, $msg, $present, $reqd);

    @present_types = grep { exists $fields->{$_} } @{ $reqd_types };

    return 1 if @present_types == @{ $reqd_types };

    $reqd    = join " ",@{ $reqd_types };
    $present = join " ",@present_types;
    $msg  = "Properties present donot match the min. no of properties";
    $msg .= "needed for $operation operation.Properties present:$present";
    $msg .= " Properties required:$reqd Exiting!";

    $logger->logconfess($msg);
}


#Read and return file contents as a single string

sub _get_file_content {
    my $self   = shift;
    my $fname  = shift || confess "No filename to read content from";
    my $logger = Log::Log4perl->get_logger( $PROGRAM_NAME );
    my $fields;

    try {
        $logger->debug("About to read fields containing req fields");

        open my $fhandle, "<", $fname
                             || throw new Error::Unhandled -text => $OS_ERROR;
        local $INPUT_RECORD_SEPARATOR = undef;
        ($fields = <$fhandle>) =~ s/\\n//g;
    }
    catch Error::Unhandled with {
        print "Unable to read $fname..Exiting! $OS_ERROR";
        $logger->logcroak("Unable to read $fname $OS_ERROR");
    }

    $logger->debug("$fname read! content: $fields");

    return $fields;
}


sub validate_read_cmdargs {
    my $self = shift;
    my $p    = new Getopt::Long::Parser;
    my ($oper, $fields, $log_cfg, $ret, $logger,
        $user, $pawd, $help, $oper_exists);

    $p->getoptions(
        'operation=s'=> \$oper,
        'user=s'     => \$user,
        'password=s' => \$pawd,
        'fields=s'   => \$fields,
        'config=s'   => \$log_cfg,
        'help|?'     => \$help,
    ) || confess pod2usage(-verbose => 2, -noperldoc => 1,
                           -msg => 'Command line options parsing failed!');

    #validate command line args
    pod2usage(-verbose => 2, -noperldoc => 1) if $help;
    confess pod2usage(-verbose => 2, -noperldoc => 1, -msg => 'Insufficient Args!')
                 if ! ($oper || $user || $pawd || $fields || $log_cfg);
    confess pod2usage(-verbose => 2, -noperldoc => 1, -msg => "$log_cfg missing!")
                                             if ! (-f $log_cfg || -s $log_cfg);
    #Most important, initialize the logger first
    Log::Log4perl->init($log_cfg);
    $logger = Log::Log4perl->get_logger( $PROGRAM_NAME );

    $oper_exists = grep { /$oper/ } $self->get_supported_ops();
    $logger->info("Current operation:  $oper") if $oper_exists;
    $logger->logconfess("Unsupported operation: $oper") if ! $oper_exists;

    #set current oper, user and password
    $self->current_operation($oper);
    $self->user($user);
    $self->password($pawd);

    #If $fields points to a file, slurp it
    $fields = $self->_get_file_content($fields) if( -f $fields and -s $fields );

    return $fields;
}


sub validate_inputs {
    my $self            = shift;
    my $fields          = shift || confess "No args to validate";
    my $ignore_types    = shift;
    my $operation       = $self->current_operation();
    my $logger          = Log::Log4perl->get_logger( $PROGRAM_NAME );
    my %ops_inputs_reqd = %{$self->ops_inputs_reqd};
    my (@reqd_types, $ret, $url);

    #Lookup & localize reqd types needed perform the op
    @reqd_types = @{ $ops_inputs_reqd{ $operation } };
    $ret
	 = $self->_check_reqd_types($fields, \@reqd_types);
    $logger->debug("Reqd. Types for Current Oper Present!") if $ret;

    return 1;
}


sub validate_tokens {
    my $self      = shift;
    my $fields    = shift;
    my $operation = $self->current_operation();
    my $logger    = Log::Log4perl->get_logger( $PROGRAM_NAME );
    my %ops_inputs_reqd = %{ $self->ops_inputs_reqd };
    my (@tokens, $has_tokens, @illegal_tokens, $illegal);

    $logger->info("No token tag in input fields!")
                                        if ! $fields;

    @tokens = ($fields =~ /\b((?:REQD|REQ|UD|T)\.[A-Z\._0-9]+)\b/gc);
    @illegal_tokens
        = grep {! /(^(?:REQD|REQ|UD|T)\.?(?:VP|P)?\.[A-Z_0-9]+?)$/} @tokens;
    if(@illegal_tokens) {
	$illegal = join " ",@illegal_tokens;
        $logger->logconfess("Illegal Token names: $illegal Exiting!");
    }

    return 1;
}


sub check_url_availability {
    my $self         = shift;
    my $service_url  = shift || confess "No url to check availability";
    my $timeout      = shift || 60;
    my $ua           = LWP::UserAgent->new('timeout' => $timeout);
    my $logger       = Log::Log4perl->get_logger( $PROGRAM_NAME );
    my ($resp, $msg);

    try {
        $resp = $ua->get($service_url);
        throw new Error::Unhandled -text => $resp->status_line
                                                if ! $resp->is_success;
    }
    catch Error::Unhandled with {
        $logger->logcroak($resp->status_line);
    }

    return 1;
}


sub extract {
    my $self = shift;
    my $resp = shift || confess "No response to extract from";
    my $to_extract = shift || confess "Nothing to extract";
    my $logger     = Log::Log4perl->get_logger( $PROGRAM_NAME );
    my ($xml_parser, $xml_ref, %details, $key, $code, $string, %tag_vals);

    $logger->debug("Extracting values in tags ". join ' ', @{ $to_extract });
    #$resp =~ s/^.+(\

    try {
        require XML::Simple
               || throw new Error::Unhandled -text => 'XML::Simple not found';

        $xml_parser = XML::Simple->new();
        $xml_ref    = $xml_parser->XMLin($resp);

        $logger->debug("Extracting tag values using the neat XML Parsing");

        for my $key (keys %{$xml_ref}) {
            next if $key !~ /\:body$/i;

	    %details = %{$xml_ref->{$key}};
            #if ( $key =~ /\:fault$/i ) {
            #    $tag_vals{$_} ||= $details{$_} for @{ $to_extract };
            #}
	    #($key)   = keys %details;

            $tag_vals{$_} = $details{$key}->{$_} for @{ $to_extract };
        }
    }
    catch Error::Unhandled with {
        $logger->debug("Extraction Failed...");
    }

    if (! %tag_vals ) {
        $logger->debug("Trying to extract fault with regexp...");

	for my $tag ( @{ $to_extract } ) {
	    $tag_vals{$tag} = $1
	        if $resp =~ /<$tag>(.+)<\/$tag>/isx;
        }
    }

    $logger->debug("TAGS -> VALUES: ", %tag_vals);

    return \%tag_vals;
}

__PACKAGE__->meta->make_immutable;

1; # End of HPPPM::ErrorHandler

__END__