Support downloads-only non-validating tests.

Support non-empty URL-specific 'QUERY_STRING' specifications.
Run the test in two passes to test the caching for: --validate
Run the tests in simple-download LWP mode to be able to test redirects.

diff --git a/Index.pm b/Index.pm
index d9a1a16..6a82f5b 100644 (file)
--- a/Index.pm
+++ b/Index.pm
@@ -27,7 +27,8 @@ use My::Web;
 use Apache2::Const qw(HTTP_MOVED_PERMANENTLY);
 
 
-our $HTML_TEST=0;
+our $HTML_TEST="download";
+our $HTML_TEST_RC=HTTP_MOVED_PERMANENTLY;
 
 sub handler
 {

diff --git a/Mailman.pm b/Mailman.pm
index 1479a3d..964fa93 100644 (file)
--- a/Mailman.pm
+++ b/Mailman.pm
@@ -29,7 +29,8 @@ use URI::Escape;
 require LWP::Simple;
 
 
-our $HTML_TEST=0;
+our $HTML_TEST=0;      # TODO: Provide some real URLs for download/translation.
+our $HTML_TEST_QUERY_STRING="list=html_test";
 
 sub handler
 {
@@ -43,6 +44,7 @@ my $W=My::Web->init(
                                "list"=>['^[-\w]+$'],
                                "back"=>'',
                                },
+               "http_safe"=>0, # LWP downloads.
                );
 My::Web->heading();
 

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;

diff --git a/project/ChangeLog.pm b/project/ChangeLog.pm
index dbed17e..cfef9a5 100755 (executable)
--- a/project/ChangeLog.pm
+++ b/project/ChangeLog.pm
@@ -26,7 +26,8 @@ use warnings;
 use My::Web;
 
 
-our $HTML_TEST=0;
+our $HTML_TEST="download";
+our $HTML_TEST_QUERY_STRING="cvs=MyWeb";
 
 sub handler
 {
@@ -35,9 +36,10 @@ my $W=My::Web->init(
                "args_check"=>{
                                "cvs"=>'^[\w\d][\w\d/.]*$',
                                },
+               "content_type"=>"text/plain",
+               "http_safe"=>0, # cvs(1) downloads.
                );
 My::Web->heading();
-$W->{"r"}->content_type("text/plain");
 
 
 local *F;

diff --git a/project/Pod2Html.pm b/project/Pod2Html.pm
index 365c66e..dbcedd5 100755 (executable)
--- a/project/Pod2Html.pm
+++ b/project/Pod2Html.pm
@@ -26,20 +26,27 @@ use warnings;
 use My::Web;
 
 
-our $HTML_TEST=0;
+our $HTML_TEST="download";     # FIXME: See below!
+our $HTML_TEST_QUERY_STRING="cvs=captive/src/libcaptive/ke/captivesym.pl";
 
 sub handler
 {
 my $W=My::Web->init(
-               "header_only"=>1,
                "args_check"=>{
                                "cvs"=>'^[\w\d][\w\d/.]*$',
                                },
+               # FIXME:
+               # Do not: # Do not: "content_type"=>"text/html",
+               #         # or whatever as pod2html(1) already produces XHTML.
+               #         "header_only"=>"xml",
+               # as currently pod2html(1) produces invalid XHTML for: .../captivesym.pl
+               "content_type"=>"text/html",
+               "header_only"=>1,
+               "http_safe"=>0, # lynx(1) downloads.
                );
 My::Web->heading();
 
 
-$W->{"r"}->content_type("text/html");
 local *F;
 open F,"lynx -source ".$W->{"project_viewcvs"}."*checkout*/".$W->{"args"}{"cvs"}."?rev=HEAD"
                ." |pod2html -"

diff --git a/project/Rel.pm b/project/Rel.pm
index 65b51a6..fbe9d39 100755 (executable)
--- a/project/Rel.pm
+++ b/project/Rel.pm
@@ -28,7 +28,9 @@ use Apache2::Const qw(HTTP_MOVED_PERMANENTLY);
 Wrequire 'project::Lib';
 
 
-our $HTML_TEST=0;
+our $HTML_TEST="download";
+our $HTML_TEST_RC=HTTP_MOVED_PERMANENTLY;
+our $HTML_TEST_QUERY_STRING='project=MyWeb&rel=next';
 
 sub handler
 {