APP-REST-RestTestSuite

 view release on metacpan or  search on metacpan

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

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!

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

              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,

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

    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,

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

=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 ) ) {

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

    $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;
    my ( $start_tag, $lines_between, $end_tag ) = (undef) x 3;

    my $separator = ":";    # separator used in config file for key/value pair
    my %start_end_hash;

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

    while (<$fh>) {

        push (@{$file->{config_file_content}} , $_);
        _trim( chomp($_) );
        next if ( $_ =~ m/^#+$/ || $_ =~ m/^\s*$/ || $_ =~ m/^#\s+/ );
        last if ( $_ =~ m/^#END_OF_CONFIG_FILE\s*$/ );

        ## Process common configuration for all test cases
        if ( $_ =~ m/^#START_COMMON_CONFIG\s*$/ ) {
            $start_common = 1;
            next;
        }
        $end_common = 1 if ( $_ =~ m/^#END_COMMON_CONFIG\s*$/ );
        push( @buffer, $_ ) if ( $start_common && !$end_common );

        if ( $start_common && $end_common ) {
            foreach my $line (@buffer) {
                my @val = split( $separator, $line );
                $self->{ _trim( $val[0] ) } = _trim( $val[1] );
            }

            @buffer       = ();
            $start_common = 0;
            $end_common   = 0;
        } elsif ( !$start_common && $end_common ) {
            die "ERROR in config file format\n";
        }

        ## Process test cases
        if ( $_ =~ m/^#START_TEST_CASE\s*$/ ) {
            $start_case = 1;
            next;
        }
        $end_case = 1 if ( $_ =~ m/^#END_TEST_CASE\s*$/ );

        push( @buffer, $_ ) if ( $start_case && !$end_case );

        ## Process [START] and [END] tag for any keys
        $start_tag = 1 if ( $_ =~ m/^\s*\[START\]\s*$/ );
        $end_tag   = 1 if ( $_ =~ m/^\s*\[END\]\s*$/ );

        if ( $start_tag && !$end_tag ) {
            $lines_between++;
            push( @start_end_buffer, $_ );
        }

        if ( $start_tag && $end_tag ) {

            my $req_body = '';
            $req_body .= _trim($_) foreach (@start_end_buffer);
            $req_body =~ s/\[START\]//g;
            $req_body =~ s/\[END\]//g;

            while ( $lines_between >= 0 ) {
                $lines_between--;
                pop @buffer;
            }

            my $line = pop @buffer;
            $line =~ s/\s+://g;
            $line =~ s/^\s+//g;

            ## create the key with the values given in between [START] and [END] tag
            $start_end_hash{$line} = $req_body;

            @start_end_buffer = ();
            $start_tag        = 0;
            $end_tag          = 0;
            $lines_between    = 0;
        }

        if ( $start_case && $end_case ) {
            $test_no++;
            foreach my $line (@buffer) {
                my @val = split( $separator, $line );
                $self->{test_cases}->{$test_no}->{ _trim( $val[0] ) } =
                  _trim( $val[1] );
            }

         # add all those in between [START] and [END] tage to the respective key
            while ( my ( $key, $value ) = each %start_end_hash ) {
                $self->{test_cases}->{$test_no}->{$key} = $value;
            }

            %start_end_hash = ();
            @buffer         = ();
            $start_case     = 0;
            $end_case       = 0;
        } elsif ( !$start_case && $end_case ) {
            die "ERROR in config file format\n";
        }

        ## Process HTTP status codes
        if ( $_ =~ m/^#START_HTTP_CODE_DEF\s*$/ ) {
            $start_http_code = 1;
            next;
        }
        $end_http_code = 1 if ( $_ =~ m/^#END_HTTP_CODE_DEF\s*$/ );
        push( @buffer, $_ ) if ( $start_http_code && !$end_http_code );

        if ( $start_http_code && $end_http_code ) {
            foreach my $line (@buffer) {
                my @val = split( $separator, $line );
                $self->{http_status_code}->{ _trim( $val[0] ) } =
                  _trim( $val[1] );
            }

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