validator/httpd/cgi-bin check,1.746,1.747

Update of /sources/public/validator/httpd/cgi-bin
In directory hutz:/tmp/cvs-serv12934/httpd/cgi-bin

Modified Files:
	check 
Log Message:
Add support for <meta charset="..."> in HTML5 documents (#5992).

Index: check
===================================================================
RCS file: /sources/public/validator/httpd/cgi-bin/check,v
retrieving revision 1.746
retrieving revision 1.747
diff -u -d -r1.746 -r1.747
--- check	10 Dec 2009 19:28:13 -0000	1.746
+++ check	11 Dec 2009 18:40:24 -0000	1.747
@@ -3069,8 +3069,47 @@
         $metah{lc($meta)}++ if defined $meta and length $meta;
     }
 
-    my @meta = sort { $metah{$b} <=> $metah{$a} } keys %metah;
-    $File->{Charset}->{META} = $meta[0] if @meta;
+    if (!%metah) {
+
+        # HTML::Encoding doesn't support HTML5 <meta charset> as of 0.60,
+        # check it ourselves.  HTML::HeadParser >= 3.60 is required for this.
+
+        if (eval {
+                local $SIG{__DIE__} = undef;
+                require HTML::HeadParser;
+                HTML::HeadParser->VERSION(3.60);
+            }
+            )
+        {
+            my $hp           = HTML::HeadParser->new();
+            my $seen_doctype = FALSE;
+            my $is_html5     = FALSE;
+            $hp->handler(
+                declaration => sub {
+                    my ($tag, $text) = @_;
+                    return if ($seen_doctype || uc($tag) ne '!DOCTYPE');
+                    $seen_doctype = TRUE;
+                    $is_html5     = TRUE
+                        if (
+                        $text =~ /<!DOCTYPE\s+html
+                                    (\s+SYSTEM\s+(['"])about:legacy-compat\2)?
+                                    \s*>/six
+                        );
+                },
+                'tag,text'
+            );
+            $hp->parse($File->{Bytes});
+            if ($is_html5) {
+                my $cs = $hp->header('X-Meta-Charset');
+                $metah{lc($cs)}++ if (defined($cs) && length($cs));
+            }
+        }
+    }
+
+    if (%metah) {
+        my @meta = sort { $metah{$b} <=> $metah{$a} } keys %metah;
+        $File->{Charset}->{META} = $meta[0];
+    }
 
     return $File;
 }

Received on Friday, 11 December 2009 18:40:28 UTC