diff options
| -rwxr-xr-x | htdocs/whatsnew.html | 5 | ||||
| -rwxr-xr-x | httpd/cgi-bin/check | 18 | ||||
| -rw-r--r-- | misc/bundle/Makefile.PL | 1 | ||||
| -rw-r--r-- | misc/bundle/lib/Bundle/W3C/Validator.pm | 1 |
4 files changed, 20 insertions, 5 deletions
diff --git a/htdocs/whatsnew.html b/htdocs/whatsnew.html index 3a576fd..7a04eeb 100755 --- a/htdocs/whatsnew.html +++ b/htdocs/whatsnew.html @@ -49,6 +49,11 @@ it clearer</a> whether the error occurred in the validated document or an external resource related to it. </li> + <li> + Enhancement: improved + <a href="http://search.cpan.org/dist/URI/URI/Heuristic.pm">heuristics</a> + for incomplete input URLs. + </li> </ul> </dd> diff --git a/httpd/cgi-bin/check b/httpd/cgi-bin/check index a33072e..f048268 100755 --- a/httpd/cgi-bin/check +++ b/httpd/cgi-bin/check @@ -62,6 +62,7 @@ use SGML::Parser::OpenSP 0.991 qw(); use URI qw(); use URI::Escape qw(uri_escape); use URI::file; +use URI::Heuristic qw(); ############################################################################### #### Constant definitions. #################################################### @@ -1742,10 +1743,21 @@ sub handle_uri my $q = shift; # The CGI object. my $File = shift; # The master datastructure. + my $ua = W3C::Validator::UserAgent->new($CFG, $File); + my $uri = URI->new(ref $q ? $q->param('uri') : $q)->canonical(); $uri->fragment(undef); - my $ua = W3C::Validator::UserAgent->new($CFG, $File); + if (!$uri->scheme()) { + local $ENV{URL_GUESS_PATTERN} = ''; + my $guess = URI::Heuristic::uf_uri($uri); + if ($guess->scheme() && $ua->is_protocol_supported($guess)) { + $uri = $guess; + } + else { + $uri = URI->new("http://$uri"); + } + } unless ($ua->is_protocol_supported($uri)) { $File->{'Error Flagged'} = TRUE; @@ -2812,10 +2824,6 @@ sub prepCGI $q->param('uri', $q->param('url')); } - # Munge the URL to include commonly omitted prefix. - my $u = $q->param('uri'); - $q->param('uri', "http://$u") if $u && $u =~ m(^www)i; - # Set output mode; needed in get_error_template if we end up there. $File->{Opt}->{Output} = $q->param('output') || 'html'; diff --git a/misc/bundle/Makefile.PL b/misc/bundle/Makefile.PL index 270965e..eefde56 100644 --- a/misc/bundle/Makefile.PL +++ b/misc/bundle/Makefile.PL @@ -39,6 +39,7 @@ WriteMakefile( "URI" => 0, "URI::Escape" => 0, "URI::file" => 0, + "URI::Heuristic" => 0, "XML::LibXML" => "1.70", # Optional: diff --git a/misc/bundle/lib/Bundle/W3C/Validator.pm b/misc/bundle/lib/Bundle/W3C/Validator.pm index 7a4a138..a0d0013 100644 --- a/misc/bundle/lib/Bundle/W3C/Validator.pm +++ b/misc/bundle/lib/Bundle/W3C/Validator.pm @@ -49,6 +49,7 @@ C<perl -MCPAN -e "install Bundle::W3C::Validator"> URI URI::Escape URI::file + URI::Heuristic XML::LibXML 1.70 =head1 DESCRIPTION |