Support ARRAY as: $HTML_TEST_QUERY_STRING

[www.jankratochvil.net.git] / html-test.pl

diff --git a/html-test.pl b/html-test.pl
index aa09b81..ce68887 100755 (executable)
--- 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;