#! /usr/bin/perl
#
# $Id$


use strict;
use warnings;
use My::ModPerlPm;
require LWP::UserAgent;
require HTTP::Status;
require LWP;
use Carp qw(confess cluck);
use Getopt::Long;
use Sys::Hostname::Long;
use URI::Escape;


#my $URL_BASE="http://".hostname_long().":7680";
my $URL_BASE="http://www.jankratochvil.net";
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;
die if @ARGV>=2;


$|=1;

my $UA=LWP::UserAgent->new();
$UA->env_proxy();

my $first_seen;
for (0,($opt_validate ? 1 : ())) {
	$first_seen=!$first_pattern;
	My::ModPerlPm->list("sub"=>sub {
		my($p)=@_;
		require $p->{"file"};
		eval 'require '.$p->{"module"}.'; 1;'
				or cluck "Error loading module ".$p->{"module"}.": $@";
		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);
				}
$url=~s{\Q/Index.pm\E$}{/};
			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 "\n";
die "Nothing seen for: $first_pattern\n" if !$first_seen;
