APP-REST-RestTestSuite
view release on metacpan or search on metacpan
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
} elsif ( ( (@_) % 2 ) == 1 ) {
$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) );
}
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
#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;
if ( defined $tc->{response_content_type} ) {
my $expected_response_content_type =
$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,
};
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
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,
};
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 = ();
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
if ( $mode =~ m/READ/i ) {
open( $fh, '<', "$file" ) or ( $err = 'yes' );
} elsif ( $mode =~ m/WRITE/i ) {
open( $fh, '>', "$file" ) or ( $err = 'yes' );
} elsif ( $mode =~ m/APPEND/i ) {
open( $fh, '>>', "$file" ) or ( $err = 'yes' );
}
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};
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];
}
return 1;
}
=head1 AUTHOR
Mithun Radhakrishnan, C<< <rkmithun at cpan.org> >>
=head1 BUGS
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc APP::REST::RestTestSuite
=head1 ACKNOWLEDGEMENTS
=head1 LICENSE AND COPYRIGHT
Copyright 2014 Mithun Radhakrishnan.
This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:
L<http://www.perlfoundation.org/artistic_license_2_0>
Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify,
or distribute the Package, if you do not accept this license.
If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.
This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.
This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
Package. If you institute patent litigation (including a cross-claim or
counterclaim) against any party alleging that the Package constitutes
direct or contributory patent infringement, then this Artistic License
to you shall terminate on the date that such litigation is filed.
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
( run in 0.826 second using v1.01-cache-2.11-cpan-39bf76dae61 )