X-Git-Url: http://git.jankratochvil.net/?a=blobdiff_plain;f=html-test.pl;h=ce68887164b4e79f161f5a286cbb6dab4faa9491;hb=b8064e5c72fdab932814494f9e5267074db806c1;hp=aa09b81d596eea741879915a5039b341af407203;hpb=19c5ad8e26ac320516b8427c416a9195ce4fea48;p=www.jankratochvil.net.git

diff --git a/html-test.pl b/html-test.pl
index aa09b81..ce68887 100755
--- a/html-test.pl
+++ b/html-test.pl
@@ -17,11 +17,14 @@ use URI::Escape;
 
 my $URL_BASE="http://".hostname_long().":7680";
 my $URL_VALIDATOR_BASE="http://validator.w3.org/check?uri=";
+my $URL_VALIDATOR_BASE_LOCAL="http://localhost/cgi-bin/check.cgi?uri=";
 
 
 my $opt_validate;
+my $opt_local;
 die if !GetOptions(
 		"validate!",\$opt_validate,
+		"local!",\$opt_local,
 		);
 
 my($first_pattern)=@ARGV;
@@ -39,32 +42,41 @@ My::ModPerlPm->list("sub"=>sub {
 	require $p->{"file"};
 	eval 'require '.$p->{"module"}.'; 1;'
 			or cluck "Error loading module ".$p->{"module"}.": $@";
-	my $result=eval '$'.$p->{"module"}.'::HTML_TEST;';
-	return if defined $result && !$result;
-	my $url=$URL_BASE.$p->{"url"};
-	my $url_matches=1 if $first_pattern && $url=~/$first_pattern/o;
-	die "Pattern amiguous on: $url\n" if $first_seen && $url_matches;
-	if (!$first_seen && !($first_seen=($url=~/$first_pattern/o))) {
-		print "_";
-		return;
+	my $HTML_TEST=eval '$'.$p->{"module"}.'::HTML_TEST;';
+	return if defined $HTML_TEST && !$HTML_TEST;
+	my $validate=$opt_validate;
+	$validate=0 if $HTML_TEST && $HTML_TEST eq "download";
+	my $HTML_TEST_QUERY_STRING=eval '$'.$p->{"module"}.'::HTML_TEST_QUERY_STRING;';
+	for my $query_string ("ARRAY" eq ref $HTML_TEST_QUERY_STRING ? @$HTML_TEST_QUERY_STRING : $HTML_TEST_QUERY_STRING) {
+		my $url=$URL_BASE.$p->{"url"}.(!$query_string ? "" : "?".$query_string);
+		my $url_matches=1 if $first_pattern && $url=~/$first_pattern/o;
+		die "Pattern amiguous on: $url\n" if $first_seen && $url_matches;
+		if (!$first_seen && !($first_seen=($url=~/$first_pattern/o))) {
+			print "_";
+			next;
+			}
+		print ".";
+		if ($validate) {
+			$url=($opt_local ? $URL_VALIDATOR_BASE_LOCAL : $URL_VALIDATOR_BASE).uri_escape($url);
+			}
+		my $request=HTTP::Request->new("GET",$url);
+		$request->header("Cache-control"=>"no-cache");
+		# Do not: ...->request(...);
+		# as it would follow our tested 403 redirect responses.
+		my $response=$UA->simple_request($request);
+		my $HTML_TEST_RC=eval '$'.$p->{"module"}.'::HTML_TEST_RC;';
+		$HTML_TEST_RC=HTTP::Status::RC_OK() if !defined $HTML_TEST_RC;
+		if ($response->code()==$HTML_TEST_RC) {
+			next if !$validate;
+			local $_=$response->content();
+			my   $valid=/\bclass="valid"\s*>/;
+			my $invalid=/\bclass="invalid"\s*>/;
+			die "\nUnexpected response: $url\n" if $valid==$invalid;
+			next if $valid;
+			die "\n$url\n";
+			}
+		die "\n$url: ".$response->code()."\n";
 		}
-	print ".";
-	if ($opt_validate) {
-		$url=$URL_VALIDATOR_BASE.uri_escape($url);
-		}
-	my $request=HTTP::Request->new("GET",$url);
-	$request->header("Cache-control"=>"no-cache");
-	my $response=$UA->request($request);
-	if ($response->code()==HTTP::Status::RC_OK()) {
-		return if !$opt_validate;
-		local $_=$response->content();
-		my   $valid=/\bclass="valid"\s*>/;
-		my $invalid=/\bclass="invalid"\s*>/;
-		die "\nUnexpected response: $url\n" if $valid==$invalid;
-		return if $valid;
-		die "\n$url\n";
-		}
-	die "\n$url: ".$response->code()."\n";
-	});
+	}) for (0,($opt_validate ? 1 : ()));
 print "\n";
 die "Nothing seen for: $first_pattern\n" if !$first_seen;