password results from the CPAN

password

APP-REST-RestTestSuite

view release on metacpan or search on metacpan

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


    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) );
        }

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

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


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

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


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

    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} ) {
        $self->{rest_uri_base} =
          qq|http://$self->{endpoint}| . qq|$self->{base_uri}|;
        return;    #use the uri in config file and return from sub
    } elsif ( $self->{endpoint} && $self->{port} ) {
        $self->{rest_uri_base} =
          qq|http://$self->{endpoint}| . qq|:$self->{port}|;
        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};
    my $log_dir = $log_path . $separator . 'LOG';

( run in 1.335 second using v1.01-cache-2.11-cpan-39bf76dae61 )