# -----------------------------------------------------------------------------------------------
# Title:  Web fetching test bot
# Author: Dean Stringer
# This Release: 29/3/2006
# Description/Purpose:
#
#   used for mechanized and repeatable testing of web applications which 
#   optionally require FORM elements to be posted. If the fetch of the
#	url of each resource is successful it then proceeds to carry out any
#	number of 'tests' on HTML elements in the page using HTML::TokeParser
#
#	each element found as a child of 'tests' in the <test>.xml file
#	is searched for by name, and its text value checked for. If an
#	'occurance' attribute is present on a test item it will find
#	the nth occurance of that tag and check its value only
#
#   if $dieOnError set the script will halt should any of the fetches
#	or tests fail, but this halt can be bypassed by setting 'expecterror'
#	with value '1' as an attribute of 'item', this migh be useful where
#	a redirect or 404 error is expected from a given test URL
# -----------------------------------------------------------------------------------------------
# Sample Test Script:
#
# <?xml version="1.0" encoding="UTF-8"?>
# <test>
# <meta>
# <description>Checks a bunch of resources, the first a simple GET fetch, the second a POST</description>
# </meta>
#	<item label='My Homepage' order='1' id='001'>
#		<url>http://mysite.com/</url>
#		<method>GET</method>
#		<tests>
#			<title>This is My site</title>
#		</tests>
#	</item>
#	<item label='Timetable' order='2' id='002'>
#		<url>http://mysite.com/perl-bin/script.pl</url>
#		<method>POST</method>
#		<tests>
#			<title>My CGI script</title>
#			<h1 occurance='2'>Search Results</h1>
#		</tests>
#		<form>
#			<term>chem3</term>
#			<by>code</by>
#		</form>
#	</item>
# </test>
# -----------------------------------------------------------------------------------------------
# Revisions:
#	2006/03/29 - DeanS
#		[2] added multiple occurance of tag support
#		[3] added support for test sequence repeats
#	2006/02/15 - DeanS
#		[1] added check for errorexpected attribute in a test
# -----------------------------------------------------------------------------------------------
use strict;
use vars qw( $parser );
use LWP::UserAgent;
use HTML::TokeParser;
use Time::HiRes;
use XML::LibXML;

my $syntax = "WebFetch: mechanized and repeatable testing of web applications and URLs" .
	"\nSyntax: $0 <testFile> [num of repeats]\n";
unless (@ARGV == 1 || @ARGV == 2) {
	print STDERR $syntax;
	exit;
}

my $dieOnFail = 0;
my $repeatSequence = $ARGV[1] || 0;    # '0' = run sequence once, 1 = repeat once etc...

my $parser = XML::LibXML->new();
my $file = $ARGV[0];
my $doc = $parser->parse_file($file);
my $root = $doc->documentElement();
my @nodes = $root->findnodes('/test/item');
unless (scalar @nodes > 0) { die "No test items found in $file"; }

my $browser = LWP::UserAgent->new();
$browser->timeout(10);
$browser->agent('MySite TestBot');    # so can grep out of logs

my $startTime = Time::HiRes::gettimeofday();

print "Running tests...";

for (my $i=0; $i <= $repeatSequence; $i++) {
	if ($i > 0) { print "\nRepeating tests..."; }
    foreach my $node (@nodes) {
        my @attributelist = $node->attributes();
        my $thisLabel = '';
		my $thisID = '';
		my $thisErrorExpected = 0;
        foreach my $attr (@attributelist) {
            if ($attr->name() eq 'label') { $thisLabel = $attr->value; }
            if ($attr->name() eq 'expecterror') { $thisErrorExpected = $attr->value; }
            if ($attr->name() eq 'id') { $thisID = $attr->value; }
        }
        my @urls = $node->findnodes( 'url' );
        my $url = $urls[0]->textContent;
        my @methods = $node->findnodes( 'method' );
        my $method = $methods[0]->textContent;

        print "\nTest $thisID: $method $thisLabel  ";
        my $response;
        if ($method =~ /POST/i) {
            my %formParams;
            foreach my $formParam ($node->findnodes('form/*')) {
                $formParams{$formParam->nodeName} = $formParam->textContent;
            }
            $response = $browser->post($url, \%formParams);
        } else {
            $response = $browser->get($url);
        }

        my $content = $response->content();
		#print $content;
		my @tests = $node->findnodes('tests/*');
		my $testFailures = 0;
		for (my $i=0; $i<(scalar @tests); $i++) {
            my $testTag = $tests[$i]->nodeName;
            my $testValue = $tests[$i]->textContent;
			my $occurance = 1;
	        foreach my $attr ($tests[$i]->attributes) {
		        if ($attr->name() eq 'occurance') { $occurance = $attr->value; }
			}
            unless (checkTagVal($content, $testTag, $testValue, $occurance, $thisID)) {
				$testFailures++;
			}
        }
        if ($response->is_error && ! $thisErrorExpected) {
			# show an error if the GET or POST failed *unless* we were expecting an error
			# (say a 401 or 403)
            my $msg = "\nERROR: Failed to fetch $url";
			if ($dieOnFail) { die $msg; exit; } else { print $msg; }
        } elsif (!$testFailures) {
			print " .. OK";
		}
    }
}
my $endTime = Time::HiRes::gettimeofday();
printf "\nTotal Time Taken: %0.3f secs", ($endTime - $startTime);
exit;

# -----------------------------------------------------------------------------------------------

sub checkTagVal {
    my $content = shift;
    my $tagName = shift;
    my $expecting = shift;
    my $occurance = shift || '1';
    my $testID = shift;
    my $thisOccurance = 1;
    my $tagVal = '';
    $parser = HTML::TokeParser->new(\$content);	# need to reparse for each test as may have passed
												# the elements we want in the previous test
    while ($parser->get_tag($tagName)) {
        if ($thisOccurance == $occurance) {
            $tagVal = $parser->get_trimmed_text('/' . $tagName);
            if ($expecting ne $tagVal) {
				my $msg = "\nERROR: Test $testID failed. <$tagName> value does not match." .
                "\nExpected: " . $expecting .
                "\nReceived: $tagVal";
				if ($dieOnFail) { die $msg; exit; } else { print $msg; return 0;}
            } else {
				return 1;	# '1' indicates check successful
			}
        }
        $thisOccurance++;
    }
}