Welcome, guest! Login / Register - Why register?
Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)

Paste

Pasted as Perl by Webtest ( 14 years ago )
#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use DBI;
use HTTP::WebTest;
use Switch;


my $debug = 1;
my $color = 'green';
my $numtests; 




sub create_parameters {
        my $teststring = "[";
        my $opts = {accept_cookies => 'yes', default_report => 'no' }; 


        my $url = "http://www.d4d.se";
        my $content = "Dataföreningen";

                $teststring .= "{ url => '$url',
                        text_require => [ '$content' ]},";

                $numtests++; # Count how many tests for this specific host

        $teststring .="]";
        my $parameters = eval $teststring;

        return $opts,$parameters;

}


sub run_webtest {
        my $opts = shift;
        my $parameters = shift;
        my @test_output;
        my $results;
        my $url;
        my $content;
        my $response;
        my $StatusCode;
        my $StatusCodeComment;
        my $RequiredStatus;
        my $RequiredText;
        my $msg;

        my $webtest = new HTTP::WebTest();

        $webtest->run_tests($parameters,$opts);
        @test_output = $webtest->tests;


        # Debug - Print the output. 
        if($debug!=0){  
                #print Dumper(@test_output);
                 print Dumper($test_output[0][0]->{ 'RESPONSE' }->{'_headers'});
                
        }

        #Loop through the tests and print output.                                                                 
        for(my $i=0; $i<$numtests; $i++){
                $results =  Dumper($test_output[0][$i]->{ 'RESULTS' });                                             
                $url =  $test_output[0][$i]->{ 'PARAMS' }->{'url'};                                                 
                $content =  $test_output[0][$i]->{ 'PARAMS' }->{'text_require'}[0];                                 
                $response =  $test_output[0][$i]->{ 'RESPONSE_TIME' };  

                $results =~ /.*'Status code check'.*?'OK' => (\d||''),\s*'COMMENT' => '(.*?)'\s*}/gsm;            
                $StatusCode = $1; # Code check Status
                $StatusCodeComment = $2; # Code check Comment
                $StatusCodeComment =~ s/\\\'/\'/g; # Remove the escape-chars

                $results =~ /.*'Required text'.*?'OK' => (\d||''),\s*'COMMENT' => '(.*?)'\s*}/gsm;                
                $RequiredStatus = $1; # Required Text Check Status                                          
                $RequiredText = $2; # Required Text 


                $msg .= "URL: $url\n";
                $msg .= "STATUS CODE CHECK\n";
                if($StatusCode eq "1"){ $msg .= "&green; ";} else { $msg .= "&red; ";}
                $msg .= "$StatusCodeComment \n";
                $msg .= "REQUIRED TEXT\n";
                if($RequiredStatus eq "1"){ $msg .= "&green; ";} else { $msg .= "&red; ";}
                $msg .= "$RequiredText\n";

        }

        return $msg;

}



# Loop through the servers and put together the TEST-XML.
# Run the tests and post output

        $numtests = 0;
        my ($opts,$parameters) = create_parameters();
        

        my $msg = "\nWebtest\n\n";
        $msg .= run_webtest($opts,$parameters);

        print $msg;

 

Revise this Paste

Your Name: Code Language: