#!/usr/bin/perl -T ## ## Generates HTML documentation of error messages and explanations ## for W3C Markup Validation Service ## $Id: docs_errors.pl,v 1.6 2007-10-10 07:05:32 ot Exp $ ## Pragmas. use strict; use warnings; ## Modules. See also the BEGIN block further down below. use HTML::Template 2.6 qw(); use Config::General 2.19 qw(); # Need 2.19 for -AutoLaunder use vars qw($DEBUG $CFG $RSRC $VERSION $HAVE_IPC_RUN); # Define global constants use constant TRUE => 1; use constant FALSE => 0; BEGIN { # Launder data for -T; -AutoLaunder doesn't catch this one. if (exists $ENV{W3C_VALIDATOR_HOME}) { $ENV{W3C_VALIDATOR_HOME} =~ /^(.*)$/; $ENV{W3C_VALIDATOR_HOME} = $1; } # # Read Config Files. eval { my %config_opts = ( -ConfigFile => ($ENV{W3C_VALIDATOR_CFG} || '/etc/w3c/validator.conf'), -MergeDuplicateOptions => TRUE, -MergeDuplicateBlocks => TRUE, -SplitPolicy => 'equalsign', -UseApacheInclude => TRUE, -IncludeRelative => TRUE, -InterPolateVars => TRUE, -AutoLaunder => TRUE, -AutoTrue => TRUE, -DefaultConfig => { Protocols => {Allow => 'http,https'}, Paths => { Base => ($ENV{W3C_VALIDATOR_HOME} || '/usr/local/validator'), SGML => {Parser => '/usr/bin/onsgmls'}, }, }, ); my %cfg = Config::General->new(%config_opts)->getall(); $CFG = \%cfg; }; if ($@) { die <<".EOF."; Could not read configuration. Set the W3C_VALIDATOR_CFG environment variable or copy conf/* to /etc/w3c/. Make sure that the configuration file and all included files are readable by the web server user. The error was:\n'$@' .EOF. } } # end of BEGIN block. # # Get rid of (possibly insecure) $PATH. delete $ENV{PATH}; our $lang = 'en_US'; # @@@ TODO: conneg # Read error message + explanations file our $error_messages_file = File::Spec->catfile($CFG->{Paths}->{Templates}, $lang, 'error_messages.cfg'); our %config_errs = ( -MergeDuplicateBlocks => 1, -ConfigFile => $error_messages_file); our %rsrc = Config::General->new(%config_errs)->getall(); # Config::General workarounds for issues: # http://lists.w3.org/Archives/Public/public-qa-dev/2006Feb/0022.html # http://lists.w3.org/Archives/Public/public-qa-dev/2006Feb/0025.html # https://rt.cpan.org/Public/Bug/Display.html?id=17852 $rsrc{msg}{0} ||= delete($rsrc{'msg 0'}) || # < 2.31 { original => delete($rsrc{msg}{original}), # 2.31 verbose => delete($rsrc{msg}{verbose}), }; $RSRC = \%rsrc; our $T = HTML::Template->new( filename => File::Spec->catfile($CFG->{Paths}->{Templates}, $lang, 'docs_errors.tmpl'), die_on_bad_params => FALSE, ); $T->param(list_errors_hasverbose => &list_errors_hasverbose($RSRC)); $T->param(list_errors_noverbose => &list_errors_noverbose($RSRC)); print $T->output; sub list_errors_hasverbose{ my $RSRC = shift; my $errors = []; my $error_id; my $max_error_id=500; # where to stop for ($error_id=0;$error_id<$max_error_id;$error_id++) { my %single_error; if ($RSRC->{msg}->{$error_id}) { my $verbose = $RSRC->{msg}->{$error_id}->{verbose}; if ($verbose) { my $original = $RSRC->{msg}->{$error_id}->{original}; $original = &de_template_explanation($original); $single_error{original} = $original; $single_error{id} = $error_id; $single_error{verbose} = $RSRC->{msg}->{$error_id}->{verbose}; $single_error{verbose} =~ s//$CFG->{'Home Page'}/g; push @{$errors}, \%single_error; # Fix up relative paths (/check vs /docs/errors.html) s/href="docs\//href="/ for $single_error{original}, $single_error{verbose}; } } } return $errors; } sub list_errors_noverbose{ my $RSRC = shift; my $errors = []; my $error_id; my $max_error_id=500; # where to stop for ($error_id=0;$error_id<$max_error_id;$error_id++) { my %single_error; if ($RSRC->{msg}->{$error_id}) { my $verbose = $RSRC->{msg}->{$error_id}->{verbose}; if (! $verbose) { my $original = $RSRC->{msg}->{$error_id}->{original}; $original = &de_template_explanation($original); $single_error{original} = $original; $single_error{id} = $error_id; $single_error{verbose} = $RSRC->{msg}->{$error_id}->{verbose}; push @{$errors}, \%single_error; } } } return $errors; } sub de_template_explanation { # takes the error message template, and replace "template keywords" with real life keywords my $explanation = shift; if ($explanation){ $explanation =~ s/\%1/X/; $explanation =~ s/\%2/Y/; $explanation =~ s/\%3/Z/; $explanation =~ s/\%4/a/; $explanation =~ s/\%5/b/; $explanation =~ s/\%6/c/; } return $explanation; }