Support downloads-only non-validating tests.

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

diff --git a/html-test.pl b/html-test.pl
index e5a4c4d..67dfe60 100755 (executable)
--- a/html-test.pl
+++ b/html-test.pl
@@ -42,9 +42,12 @@ 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 $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;';
+       my $url=$URL_BASE.$p->{"url"}.(!$HTML_TEST_QUERY_STRING ? "" : "?".$HTML_TEST_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))) {
@@ -52,14 +55,18 @@ My::ModPerlPm->list("sub"=>sub {
                return;
                }
        print ".";
-       if ($opt_validate) {
+       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");
-       my $response=$UA->request($request);
-       if ($response->code()==HTTP::Status::RC_OK()) {
-               return if !$opt_validate;
+       # 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) {
+               return if !$validate;
                local $_=$response->content();
                my   $valid=/\bclass="valid"\s*>/;
                my $invalid=/\bclass="invalid"\s*>/;
@@ -68,6 +75,6 @@ My::ModPerlPm->list("sub"=>sub {
                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;