html-test.pl

   1 #! /usr/bin/perl
   2 #
   3 # $Id$
   4
   5
   6 use strict;
   7 use warnings;
   8 use My::ModPerlPm;
   9 require LWP::UserAgent;
  10 require HTTP::Status;
  11 require LWP;
  12 use Carp qw(confess cluck);
  13 use Getopt::Long;
  14 use Sys::Hostname::Long;
  15 use URI::Escape;
  16
  17
  18 my $URL_BASE="http://".hostname_long().":7680";
  19 my $URL_VALIDATOR_BASE="http://validator.w3.org/check?uri=";
  20 my $URL_VALIDATOR_BASE_LOCAL="http://localhost/cgi-bin/check.cgi?uri=";
  21
  22
  23 my $opt_validate;
  24 my $opt_local;
  25 die if !GetOptions(
  26                 "validate!",\$opt_validate,
  27                 "local!",\$opt_local,
  28                 );
  29
  30 my($first_pattern)=@ARGV;
  31 die if @ARGV>=2;
  32
  33
  34 $|=1;
  35
  36 my $UA=LWP::UserAgent->new();
  37 $UA->env_proxy();
  38
  39 my $first_seen;
  40 for (0,($opt_validate ? 1 : ())) {
  41         $first_seen=!$first_pattern;
  42         My::ModPerlPm->list("sub"=>sub {
  43                 my($p)=@_;
  44                 require $p->{"file"};
  45                 eval 'require '.$p->{"module"}.'; 1;'
  46                                 or cluck "Error loading module ".$p->{"module"}.": $@";
  47                 my $HTML_TEST=eval '$'.$p->{"module"}.'::HTML_TEST;';
  48                 return if defined $HTML_TEST && !$HTML_TEST;
  49                 my $validate=$opt_validate;
  50                 $validate=0 if $HTML_TEST && $HTML_TEST eq "download";
  51                 my $HTML_TEST_QUERY_STRING=eval '$'.$p->{"module"}.'::HTML_TEST_QUERY_STRING;';
  52                 for my $query_string ("ARRAY" eq ref $HTML_TEST_QUERY_STRING ? @$HTML_TEST_QUERY_STRING : $HTML_TEST_QUERY_STRING) {
  53                         my $url=$URL_BASE.$p->{"url"}.(!$query_string ? "" : "?".$query_string);
  54                         my $url_matches=1 if $first_pattern && $url=~/$first_pattern/o;
  55                         die "Pattern amiguous on: $url\n" if $first_seen && $url_matches;
  56                         if (!$first_seen && !($first_seen=($url=~/$first_pattern/o))) {
  57                                 print "_";
  58                                 next;
  59                                 }
  60                         print ".";
  61                         if ($validate) {
  62                                 $url=($opt_local ? $URL_VALIDATOR_BASE_LOCAL : $URL_VALIDATOR_BASE).uri_escape($url);
  63                                 }
  64                         my $request=HTTP::Request->new("GET",$url);
  65                         $request->header("Cache-control"=>"no-cache");
  66                         # Do not: ...->request(...);
  67                         # as it would follow our tested 403 redirect responses.
  68                         my $response=$UA->simple_request($request);
  69                         my $HTML_TEST_RC=eval '$'.$p->{"module"}.'::HTML_TEST_RC;';
  70                         $HTML_TEST_RC=HTTP::Status::RC_OK() if !defined $HTML_TEST_RC;
  71                         if ($response->code()==$HTML_TEST_RC) {
  72                                 next if !$validate;
  73                                 local $_=$response->content();
  74                                 my   $valid=/\bclass="valid"\s*>/;
  75                                 my $invalid=/\bclass="invalid"\s*>/;
  76                                 die "\nUnexpected response: $url\n" if $valid==$invalid;
  77                                 next if $valid;
  78                                 die "\n$url\n";
  79                                 }
  80                         die "\n$url: ".$response->code()."\n";
  81                         }
  82                 });
  83         }
  84 print "\n";
  85 die "Nothing seen for: $first_pattern\n" if !$first_seen;