APP-REST-RestTestSuite

 view release on metacpan or  search on metacpan

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



=head1 SUBROUTINES/METHODS

=head2 new

Object Constructor

=cut

sub new {
    my ( $proto, %args ) = @_;
    my $class = ref($proto) || $proto;
    my $self;

    $self = bless $proto->SUPER::new(%args), $class;
    return $self;
}

=head2 on_connect

redefine methods: on_connect gets called whenever we're about to
make a a connection

=cut

sub on_connect {
    my ( $self, $request, $response, $entry ) = @_;

    #print time,"Connecting to ", $request->url, "\n";
    print STDERR ".";
    $entry->{tick}->{start} = time;
}

=head2 on_failure

on_failure gets called whenever a connection fails right away
(either we timed out, or failed to connect to this address before,
or it's a duplicate). Please note that non-connection based
errors, for example requests for non-existant pages, will NOT call
on_failure since the response from the server will be a well
formed HTTP response!

=cut

sub on_failure {
    my ( $self, $request, $response, $entry ) = @_;
    print "Failed to connect to ", $request->url, "\n\t", $response->code, ", ",
      $response->message, "\n"
      if $response;
}

=head2 on_return

on_return gets called whenever a connection (or its callback)
returns EOF (or any other terminating status code available for
callback functions). Please note that on_return gets called for
any successfully terminated HTTP connection! This does not imply
that the response sent from the server is a success!

=cut

sub on_return {
    my ( $self, $request, $response, $entry ) = @_;
    print ".";

    #print time,"Response got from ", $request->url, "\n";

    $entry->{tick}->{end} = time;

    if ( $response->is_success ) {

#print "\n\nWoa! Request to ",$request->url," returned code ", $response->code,

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

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 ) = @_;

    return $self->{file}->{log_file_handle};
}

=head2 get_err_log_file_handle


=cut

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

    return $self->{file}->{err_log_file_handle};
}

=head2 get_config_file_handle


=cut

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

    return $self->{file}->{config_file_handle};
}

=head2 get_config_file


=cut

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

    return $self->{file}->{config_file};
}

=head2 get_sample_config_file


=cut

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

    return $self->{file}->{sample_config_file};
}

=head2 get_result_summary


=cut

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

    return (
        $self->{test_result_log}->{test_cases_in_config},
        $self->{test_result_log}->{test_cases_exececuted},
        $self->{test_result_log}->{test_cases_skipped},
        $self->{test_result_log}->{test_cases_passed},
        $self->{test_result_log}->{test_cases_failed},
    );
}

=head2 validate_test_cases


=cut

sub validate_test_cases {
    my ($self) = shift;

    my $err = undef;

    unless (@_) {
        $err = "There is no test cases defined to execute.\n";
    } elsif ( ( (@_) % 2 ) == 1 ) {
        $err =
            "Test cases are not properly configured in '"
          . $self->get_config_file()

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


    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 = @_;

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

    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 = @_;

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


    close($fh);

}

=head2 get_sample_test_suite 


=cut

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

    $self->_init_sample_config_file();

    my $file = $self->{file};
    my $wfh =
      $self->_open_fh( FILE => $file->{sample_config_file}, MODE => 'WRITE' );

    foreach ( @{$file->{config_file_content}}) {
        print $wfh $_;
    }
    close($wfh);
}

=head2 delta_time


=cut

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

    my $now = time;
    return ( ( $now - $args{start_time} ) * 1000 );    #convert to milli seconds
}

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

    $self->_init_config_file_handle(%args);

    # Read the config file based on the type of the input file (xml or text)
    if ( $args{CONFIG_FILE_TYPE} && ( $args{CONFIG_FILE_TYPE} =~ /xml/i ) ) {

        #Implement the xml reading
    } else {
        $self->_init_read_config(%args);
    }

    $self->_init_log_file_handle(%args);

    $self->_init_rest_base_uri(%args);
}

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

    $self->_init_config_files(%args);

    my $file = $self->{file};
    if ( $file->{config_file} ) {
        $file->{config_file_handle} =
          $self->_open_fh( FILE => $file->{config_file}, MODE => 'READ' );
    } else {
        $file->{config_file_handle} = \*APP::REST::RestTestSuite::DATA;
    }

    $self->{file} = $file;
}

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

    $self->_init_log_files(%args)
      ;    #Make compatible with windows and linux logging

    my $file = $self->{file};

    $file->{log_file_handle} =
      $self->_open_fh( FILE => $file->{log_file}, MODE => 'WRITE' );
    $file->{err_log_file_handle} =
      $self->_open_fh( FILE => $file->{err_log_file}, MODE => 'WRITE' );

    $self->{file} = $file;
}

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

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

    my @buffer           = ();
    my @start_end_buffer = ();

    my ( $start_case, $end_case, $test_no ) = (undef) x 3;
    my ( $start_common,    $end_common )    = (undef) x 2;
    my ( $start_http_code, $end_http_code ) = (undef) x 2;

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

            $start_http_code = 0;
            $end_http_code   = 0;
        } elsif ( !$start_http_code && $end_http_code ) {
            die "ERROR in config file format\n";
        }

    }
    close($fh);
}

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

    if ( $self->{username} ) {
        print STDERR "username configured: $self->{username}\n";
        print STDERR "Password: ";
        chomp( $self->{password} = <STDIN> );
    }

    if ( $self->{endpoint} && $self->{port} && $self->{base_uri} ) {
        $self->{rest_uri_base} =

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

        return;
    } elsif ( $self->{endpoint} ) {
        $self->{rest_uri_base} = qq|http://$self->{endpoint}|;
        return;    #use the endpoint in config file and return from sub
    } else {
        die qq|Endpoint should be configured in the config file\n|;
    }

}

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

    $self->{file}->{config_file} = $args{REST_CONFIG_FILE};
}

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

    my $separator;
    if ( $^O =~ /Win/ ) {
        $separator = '\\';
    } else {
        $separator = '/';
    }

    my $scfg = getcwd() || $ENV{PWD};
    my $scfg_file = $scfg . $separator . 'rest-project-xxxx.txt';

    $self->{file}->{sample_config_file} = $scfg_file;

}

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

    my $separator;
    if ( $^O =~ /Win/ ) {
        $separator = '\\';
    } else {
        $separator = '/';
    }

    my $log_path = $args{LOG_FILE_PATH} || getcwd() || $ENV{PWD};

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

              )
            ? ERR_LOG_FILE
              . ".html"
            : ERR_LOG_FILE
        )
    );
    $self->{file}->{log_file}     = $log_file;
    $self->{file}->{err_log_file} = $error_log_file;
}

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

    my ( $fh, $err ) = (undef) x 2;

    my $file = $args{FILE};
    my $mode = $args{MODE};

    if ( $mode =~ m/READ/i ) {
        open( $fh, '<', "$file" ) or ( $err = 'yes' );
    } elsif ( $mode =~ m/WRITE/i ) {

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

    }

    if ($err) {
        die qq|\nUnable to open file '$file' for $mode\nERROR: $!\n|;
    }

    return $fh;

}

sub _trim($) {

    return unless ( $_[0] );

    my $str = $_[0];
    $str =~ s/^\s+//g;
    $str =~ s/\s+$//g;

    return $str;
}

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

    no warnings;

    my $fh       = $args{fh};
    my $res      = $args{res};
    my $uri      = $args{uri};
    my $method   = $args{method};
    my $req_body = $args{req_body};

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

        print $fh "\n\nResponse Content    =>\n";
        print $fh $res->content;
        print $fh "\n\nTest execution time => ";
        print $fh $args{exec_time};
        print $fh " milli seconds";
        print $fh "\n", LINE, "\n";
    }

}

sub _compare_arrays {
    my ( $first, $second ) = @_;
    no warnings;    # silence spurious -w undef complaints
    return 0 unless @$first == @$second;
    for ( my $i = 0 ; $i < @$first ; $i++ ) {
        return 0 if $first->[$i] ne $second->[$i];
    }
    return 1;
}

=head1 AUTHOR

script/rest-client  view on Meta::CPAN

my $client  = File::Basename::basename($0);
my %options = (
    'c|configfile=s'      => \$config_file,
    'l|logdir=s'          => \$log_dir,
    'r|run-test-suite'    => \$action->{runtestsuite},
    't|test-load=s'       => \$action->{testload},
    's|get-sample-config' => \$action->{getsampleconfig},
    'd|debug'             => \$action->{debug},
    'h|help'              => \&usage,
    'V|version' =>
      sub { print "Version : ", APP::REST::RestTestSuite->VERSION, "\n"; exit; },

);

mini_usage() unless @ARGV;
GetOptions(%options) or mini_usage();

sub mini_usage {
    print STDERR <<HELP;

Usage: $client [options] command [...]

Try `$client --help` for more options.

HELP
    exit;
}

sub usage {
    print STDERR <<HELP;

Usage: $client [options] command [...]

Options:
  -h,--help                 Display this usage. 
  -V,--version              Print the version of the tool. 
  -c,--configfile=<file>    Input the config file with full path.
  -l,--logdir=<dir>         Input full path of the directory where you want to log the test results.
  -t,--test-load=n          Test the average response time by simulating 'n' number of requests on the web server.

t/boilerplate.t  view on Meta::CPAN

#!perl -T
use 5.006;
use strict;
use warnings FATAL => 'all';
use Test::More;

plan tests => 3;

sub not_in_file_ok {
    my ($filename, %regex) = @_;
    open( my $fh, '<', $filename )
        or die "couldn't open $filename for reading: $!";

    my %violated;

    while (my $line = <$fh>) {
        while (my ($desc, $regex) = each %regex) {
            if ($line =~ $regex) {
                push @{$violated{$desc}||=[]}, $.;

t/boilerplate.t  view on Meta::CPAN

    }

    if (%violated) {
        fail("$filename contains boilerplate text");
        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
    } else {
        pass("$filename contains no boilerplate text");
    }
}

sub module_boilerplate_ok {
    my ($module) = @_;
    not_in_file_ok($module =>
        'the great new $MODULENAME'   => qr/ - The great new /,
        'boilerplate description'     => qr/Quick summary of what the module/,
        'stub function definition'    => qr/function[12]/,
    );
}

TODO: {
  local $TODO = "Need to replace the boilerplate text";



( run in 0.256 second using v1.01-cache-2.11-cpan-a5abf4f5562 )