APP-REST-RestTestSuite

 view release on metacpan or  search on metacpan

lib/APP/REST/RestTestSuite.pm  view on Meta::CPAN

package APP::REST::RestTestSuite;

use 5.006;
use strict;
use warnings FATAL => 'all';
use Data::Dumper;
use HTTP::Request;
use Time::HiRes qw( time sleep );
use File::Path;
use Cwd;
use LWP::UserAgent;
use APP::REST::ParallelMyUA;


use constant LOG_FILE     => 'rest_client.log';
use constant ERR_LOG_FILE => 'rest_client_error.log';
use constant LINE         => '=' x 50;

$|                    = 1;    #make the pipe hot
$Data::Dumper::Indent = 1;

=head1 NAME

APP::REST::RestTestSuite - Suite for testing restful web services 

=head1 VERSION

Version 0.03

=cut

our $VERSION = '0.03';

=head1 SYNOPSIS

use APP::REST::RestTestSuite;
my $suite = APP::REST::RestTestSuite->new();

$suite->execute_test_cases( $suite->get_test_cases() );
my ( $cases_in_config, $executed, $skipped, $passed, $failed ) =
  $suite->get_result_summary();

#OR

use APP::REST::RestTestSuite;

# overrides the default config and log file paths
my $suite = APP::REST::RestTestSuite->new(
    REST_CONFIG_FILE => <config file>,
    LOG_FILE_PATH    => <path>,
);

$suite->execute_test_cases( $suite->get_test_cases() );
my ( $cases_in_config, $executed, $skipped, $passed, $failed ) =
  $suite->get_result_summary();

 
=head1 DESCRIPTION

APP::REST::RestTestSuite object is instantiated with the data in config file. 
Default config file format is defined in __DATA__ and that can be overridden
by passing the config file as an argument to the class.
Default LOG file path is the current working directory of the script which 
calls this module

=head1 SUBROUTINES/METHODS

=head2 new

Object Constructor

=cut

sub new {
    my ( $class, %args ) = @_;

    my $self = {};

    bless( $self, $class );

    $self->_init(%args);

    return $self;
}

=head2 get_test_cases


=cut

sub get_test_cases {
    my ( $self, %args ) = @_;

    if ( $self->{test_cases} ) {
        return %{ $self->{test_cases} };
    } else {
        return undef;
    }
}

=head2 get_log_file_handle


=cut

sub get_log_file_handle {
    my ( $self, %args ) = @_;

lib/APP/REST/RestTestSuite.pm  view on Meta::CPAN

        $err =
            "Test cases are not properly configured in '"
          . $self->get_config_file()
          . "'\nDefine test cases properly.\nPlease see the README file for more info.\n";
    }
    return $err if ($err);

    my %test_cases = @_;

    my @spec = sort qw(
      test_case
      uri
      request_content_type
      request_method
      request_body
      response_status
      execute
      response_content_type
    );

#below two are not mandatory for a test case as of now; if required add them to above array
# response_header
# response_body

    foreach my $count ( sort { $a <=> $b } keys(%test_cases) ) {

        my $tc   = $test_cases{$count};
        my @keys = sort keys %{$tc};

        no warnings;
        $err .= "Test case '$tc->{test_case}' not properly defined\n"
          unless ( _compare_arrays( \@spec, \@keys ) );
    }

    $err .= "Please see the README file to see the correct format.\n" if ($err);

    return $err;

}

=head2 execute_test_cases


=cut

sub execute_test_cases {
    my ($self) = shift;

  #expects an hash with keys as test case number and value as hash ref with test
  #specification; validate that before trying to execute them.
    my $err = $self->validate_test_cases(@_);

    die "ERROR: $err\n" if ($err);

    my %test_cases = @_;

    my $ua = LWP::UserAgent->new;

    $ua->agent("RTAT/$VERSION");
    $ua->timeout(90);    # in seconds
    $ua->default_header('Accept' => '*/*'); # to get cross platform support


    my ( $config, $total, $total_response_time, $skip, $pass, $fail ) = (0) x 6;
    my ( $uri, $method, $req_content_type, $req_body, $status ) = (undef) x 5;
    my ( $request,  $response ) = (undef) x 2;
    my ( $username, $password ) = (undef) x 2;

    $username = $self->{username};
    $password = $self->{password};

    my $fh     = $self->get_log_file_handle();
    my $err_fh = $self->get_err_log_file_handle();

    if ( $self->{html_log_required}
        && ( $self->{html_log_required} =~ /yes/i ) )
    {
        print $fh
          qq|<HTML> <HEAD> <TITLE>LOG for $self->{endpoint}</TITLE> </HEAD>|
          . qq|<BODY><textarea rows="999999" cols="120" style="border:none;">|;
        print $err_fh
qq|<HTML> <HEAD> <TITLE>ERROR LOG for $self->{endpoint}</TITLE> </HEAD>|
          . qq|<BODY><textarea rows="999999" cols="120" style="border:none;">|;
    }

    print STDERR "\nTest Suite executed on $self->{endpoint}\n";
    print $fh "\nTest Suite executed on $self->{endpoint}\n";
    print $err_fh "\nTest Suite executed on $self->{endpoint}\n";

    foreach my $count ( sort { $a <=> $b } keys(%test_cases) ) {

        my $tc = $test_cases{$count};

        $config++;
        print $fh "\n", LINE, "\n";
        if ( $tc->{execute} && ( $tc->{execute} =~ /no/i ) ) {
            print $fh "\nSkipping Test case $count => $tc->{test_case} \n";
            $skip++;
            next;
        }

        $uri              = qq|$self->{rest_uri_base}| . qq|$tc->{uri}|;
        $method           = uc( $tc->{request_method} );
        $req_content_type = $tc->{request_content_type};
        $req_body         = $tc->{request_body} || 0;
        $status           = $tc->{response_status};

        if ( $tc->{request_method} =~ /get/i ) {
            $request = HTTP::Request->new( $method, $uri );
            $request->authorization_basic( $username, $password )
              if ( $username && $password );
        } else {
            $request =
              HTTP::Request->new( $method, $uri, new HTTP::Headers, $req_body );
            $request->authorization_basic( $username, $password )
              if ( $username && $password );
            $request->content_type($req_content_type);
            $request->content_length( length($req_body) );
        }

        print STDERR "Executing Test case $count => $tc->{test_case}";

lib/APP/REST/RestTestSuite.pm  view on Meta::CPAN

      sprintf( "%.2f", ( $total_response_time * 1000 ) / $total );

    print STDERR "\nComplete test case report is in $self->{file}->{log_file}";
    print STDERR
      "\nFailed test case report is in $self->{file}->{err_log_file}\n\n";

    print STDERR
"Response time of $total web service calls => [$total_response_time seconds]\n";
    print STDERR
"Average response time of a web service => [$avg_response_time milli seconds]\n\n";

    print $fh
"Response time of $total web service calls => [$total_response_time seconds]\n";
    print $fh
"Average response time of a web service => [$avg_response_time milli seconds]\n\n";

    if ( $self->{html_log_required}
        && ( $self->{html_log_required} =~ /yes/i ) )
    {
        print $fh qq|</textarea></BODY></HTML>|;
        print $err_fh qq|</textarea></BODY></HTML>|;
    }

    $self->{test_result_log} = {
        test_cases_in_config  => $config,
        test_cases_exececuted => $total,
        test_cases_skipped    => $skip,
        test_cases_passed     => $pass,
        test_cases_failed     => $fail,
    };

    close($fh);
    close($err_fh);

}

=head2 execute_test_cases_in_parallel


=cut

sub execute_test_cases_in_parallel {
    my ($self) = shift;

#Code expects an hash with keys as test case number and value as hash ref with test
#specification; validate that before trying to execute them.
    my $err = $self->validate_test_cases(@_);

    die "ERROR: $err\n" if ($err);

    my %test_cases = @_;

    # use my customized user agent for parallel invokes
    my $pua = APP::REST::ParallelMyUA->new();

    $pua->agent("RTAT/$VERSION");
    $pua->in_order(1);      # handle requests in order of registration
    $pua->duplicates(0);    # ignore duplicates
    $pua->timeout(60);      # in seconds
    $pua->redirect(1);      # follow redirects
    $pua->default_header('Accept' => '*/*'); # to get cross platform support

    my ( $config, $total, $total_response_time, $skip, $pass, $fail ) = (0) x 6;
    my ( $uri, $method, $req_content_type, $req_body, $status ) = (undef) x 5;
    my ( $request,  $response ) = (undef) x 2;
    my ( $username, $password ) = (undef) x 2;

    $username = $self->{username};
    $password = $self->{password};

    my $fh = $self->get_log_file_handle();

    if ( $self->{html_log_required}
        && ( $self->{html_log_required} =~ /yes/i ) )
    {
        print $fh
          qq|<HTML> <HEAD> <TITLE>LOG for $self->{endpoint}</TITLE> </HEAD>|
          . qq|<BODY><textarea rows="999999" cols="120" style="border:none;">|;
    }

    print STDERR "\nTest Suite executed on $self->{endpoint}\n";
    print $fh "\nTest Suite executed on $self->{endpoint}\n";

    my @reqs;

    foreach my $count ( sort { $a <=> $b } keys(%test_cases) ) {

        my $tc = $test_cases{$count};

        $config++;
        if ( $tc->{execute} =~ /no/i ) {
            print $fh "\nSkipping Test case $count => $tc->{test_case} \n";
            $skip++;
            next;
        }

        $uri = qq|$self->{rest_uri_base}| . qq|$tc->{uri}|;

        #Support only GET methods at present
        if ( $tc->{request_method} =~ /get/i ) {

            # Create HTTP request pool for later execution by parallel useragent
            $method           = uc( $tc->{request_method} );
            $req_content_type = $tc->{request_content_type};
            $req_body         = $tc->{request_body} || 0;
            $status           = $tc->{response_status};

            my $request = HTTP::Request->new( $method, $uri );
            $request->authorization_basic( $username, $password )
              if ( $username && $password );
            push( @reqs, $request );
        }

        $total++;

    }

    print STDERR "\nRequesting [$total] web services together.\n";
    foreach my $req (@reqs) {

        # register all requests and wait for them to finish



( run in 2.272 seconds using v1.01-cache-2.11-cpan-f56aa216473 )