view release on metacpan or search on metacpan
lib/APP/REST/ParallelMyUA.pm view on Meta::CPAN
=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,
# ": ", $response->message, "\n";
#print $response->content;
} else {
#print "\n\nBummer! Request to ",$request->url," returned code ", $response->code,
# ": ", $response->message, "\n";
#print $response->error_as_HTML;
}
return;
}
1;
=head1 AUTHOR
Mithun Radhakrishnan, C<< <rkmithun at cpan.org> >>
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
$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};
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
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}";
print $fh "Executing Test case $count => $tc->{test_case}";
my $start_time = time;
$response = $ua->request($request);
$total++;
my $exec_time = $self->delta_time( start_time => $start_time );
$total_response_time += $exec_time;
$exec_time = sprintf( "%.2f", $exec_time );
print STDERR " [Completed in $exec_time ms]\n";
print $fh " [Completed in $exec_time ms]\n";
$self->_print_logs(
fh => $fh,
uri => $uri,
method => $method,
req_body => $req_body,
);
$self->_print_logs(
fh => $fh,
res => $response,
exec_time => $exec_time,
);
#Level-1 check => check for response status code
#Level-2 check => check for expected response content_type
my $resp_code = $response->code;
if ( $status =~ m/$resp_code/ ) {
my $failed = 0;
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
$tc->{response_content_type};
#my $respose_content_type = $response->{_headers}->content_type;
my $respose_content_type = $response->header('Content-Type');
unless ( defined $respose_content_type ) {
$failed = 1;
} elsif ( $expected_response_content_type !~
m/$respose_content_type/ )
{
$failed = 1;
print $err_fh "\n", LINE, "\n";
print $err_fh
"Executing Test case $count => $tc->{test_case}";
print $err_fh
"\n*********ATTENTION CONTENT TYPE ERROR ******";
print $err_fh
"\n\nExpected content_type is $expected_response_content_type\n";
print $err_fh
"content_type recieved in response is $respose_content_type\n";
print $err_fh
"\n*********ATTENTION CONTENT TYPE ERROR ******";
$self->_print_logs(
fh => $err_fh,
uri => $uri,
method => $method,
req_body => $req_body,
);
$self->_print_logs(
fh => $err_fh,
res => $response,
exec_time => $exec_time,
);
}
}
($failed) ? $fail++ : $pass++;
} else {
$fail++;
print $err_fh "\n", LINE, "\n";
print $err_fh "Executing Test case $count => $tc->{test_case}";
$self->_print_logs(
fh => $err_fh,
uri => $uri,
method => $method,
req_body => $req_body,
);
$self->_print_logs(
fh => $err_fh,
res => $response,
exec_time => $exec_time,
);
}
}
#convert milli seconds to seconds for total_exec_time
$total_response_time = sprintf( "%.2f", $total_response_time / 1000 );
my $avg_response_time =
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,
};
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
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
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
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
if ( my $res = $pua->register($req) ) {
print STDERR $res->error_as_HTML;
}
}
print STDERR "Receiving response from web services. Please wait..!\n";
# will return once all forked web services are either completed or timeout
my $entries = $pua->wait();
print STDERR "\n\n";
foreach ( keys %$entries ) {
my $response = $entries->{$_}->response;
my $tick = $entries->{$_}->{tick};
my $exec_time = ( $tick->{end} - $tick->{start} ) * 1000 ;
$total_response_time += $exec_time;
$exec_time = sprintf( "%.2f", $exec_time );
print STDERR "\n", $response->request->url,
"\n ! Response Status [", $response->code,
"]\tResponse Time [$exec_time ms]";
$self->_print_logs(
fh => $fh,
uri => $response->request->url,
method => $response->request->method,
req_body => ''
);
$self->_print_logs(
fh => $fh,
res => $response,
exec_time => $exec_time,
);
}
#convert milli seconds to seconds for total_exec_time
$total_response_time = sprintf( "%.2f", $total_response_time / 1000 );
my $avg_response_time =
sprintf( "%.2f", ( $total_response_time * 1000 ) / $total );
print STDERR
"\n\n\nComplete test case report is in $self->{file}->{log_file}";
print STDERR
"\n\nResponse 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
"\n\nResponse 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>|;
}
$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,
};
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
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 {
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
}
}
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} =
qq|http://$self->{endpoint}|
. qq|:$self->{port}|
. qq|$self->{base_uri}|;
return; #use the port and uri in config file and return from sub
} elsif ( $self->{endpoint} && $self->{base_uri} ) {
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
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};
my $define =
"Definition of status code not available; Please define in config if this is a custom code";
unless ( $args{res} ) {
print $fh "\n";
print $fh "URI => $uri\n";
print $fh "HTTP Method => $method\n";
print $fh "Request Body => \n$req_body\n" if ( $method !~ /get/i );
} else {
print $fh "\n";
print $fh "Response code => ";
print $fh $res->code;
print $fh " [ ";
print $fh ( exists $self->{http_status_code}->{ $res->code } )
? $self->{http_status_code}->{ $res->code }
: $define;
print $fh " ]\n";
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];
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.
script/rest-client view on Meta::CPAN
# Give average response time by simulating huge traffic in the web server.
$client --run-test-suite --configfile=<rest_config_file> --logdir=<log-directory-path>
$client --test-load=10 --configfile=<rest_config_file> --logdir=<log-directory-path>
# Create LOG files in the path specified by executing the test cases.
HELP
exit;
}
print
"\n===============================Rest Test Automation Tool=============================\n";
if ( $^O =~ /Win/ ) {
$config_file =~ s/\//\\/g if ($config_file);
$log_dir =~ s/\//\\/g if ($log_dir);
}
if ( $config_file && $log_dir ) {
print "Parsing Config File : $config_file\n";
print "Using log dir as : $log_dir\n";
$suite = new APP::REST::RestTestSuite(
REST_CONFIG_FILE => $config_file,
LOG_FILE_PATH => $log_dir,
);
} elsif ($config_file) {
print "Parsing Config File : $config_file\n\n";
$suite = new APP::REST::RestTestSuite( REST_CONFIG_FILE => $config_file, );
} elsif ($log_dir) {
print <<HELP;
Using log dir as : $log_dir
Using the default test suite. This is just for a demo purpose.
Use below options to specify the config file and log path.
$client --configfile=<rest_config_file> --logdir=<log-directory-path>
HELP
$suite = new APP::REST::RestTestSuite( LOG_FILE_PATH => $log_dir, );
} else {
unless ( $action->{getsampleconfig} ) {
print <<HELP;
Using the default test suite. This is just for a demo purpose.
Use below options to specify the config file and log path.
$client --configfile=<rest_config_file> --logdir=<log-directory-path>
Use below option to get a sample config. Edit the config file to configure your web services
$client --get-sample-config
HELP
}
$suite = new APP::REST::RestTestSuite();
}
if ( $action->{debug} ) {
print Dumper $suite;
exit;
} elsif ( $action->{runtestsuite} ) {
$suite->execute_test_cases( $suite->get_test_cases() );
my ( $config, $total, $skip, $pass, $fail ) = $suite->get_result_summary();
print "=" x 70, "\n";
print "Summary of web service Suite \n";
print "=" x 70, "\n";
print "Total test cases configured : $config\n";
print "Total test cases executed : $total\n";
print "Total test cases skipped : $skip\n";
print "Total test cases pass : $pass\n";
print "Total test cases failed : $fail\n";
print "=" x 70, "\n";
exit;
} elsif ( $action->{testload} ) {
die "--test-load accepts only numeric argument\n"
unless ( $action->{testload} =~ /^\d+$/ );
my %test_cases = $suite->get_test_cases();
#increase the count to load your API $load times with the number of TC
my $tc_in_config = scalar keys %test_cases;
script/rest-client view on Meta::CPAN
my $tc = $test_cases{$num};
$total_tc++;
$load_test_cases{$total_tc} = $tc;
}
$load--;
}
# require Data::Dumper;
# $Data::Dumper::Indent = 1;
# print Dumper $suite;
# foreach my $num (sort { $a <=> $b } keys(%load_test_cases)) {
# print Dumper $load_test_cases{$num};
# }
# print sort{ $a <=> $b } keys %load_test_cases;
# exit;
$suite->execute_test_cases_in_parallel(%load_test_cases);
my ( $config, $total, $skip, $pass, $fail ) = $suite->get_result_summary();
print "=" x 70, "\n";
print "Summary of web service load test \n";
print "=" x 70, "\n";
print "Total test cases in config: $config\n";
print "Total test cases executed : $total\n";
print "Total test cases skipped : $skip\n";
print "=" x 70, "\n";
exit;
} elsif ( $action->{getsampleconfig} ) {
$suite->get_sample_test_suite();
print "Sample Config file to configure the web services got created\n";
print "in ", $suite->get_sample_config_file(), "\n";
print "Edit and rename this file as project specific test suite.\n\n";
exit;
} else {
print "\nUse below options to execute the test cases\n\n";
print "$client --configfile=<rest_config_file> --run-test-suite\n\n";
exit;
}
__END__
=head1 NAME
rest-client - Test automation tool for restful web services
t/00-load.t view on Meta::CPAN
#!perl -T
use 5.006;
use strict;
use warnings FATAL => 'all';
use Test::More;
plan tests => 1;
BEGIN {
use_ok( 'APP::REST::RestTestSuite' ) || print "Bail out!\n";
}
diag( "Testing APP::REST::RestTestSuite $APP::REST::RestTestSuite::VERSION, Perl $], $^X" );