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";