test_guess_charset

   1
   2 sub charset
   3   { my( $root)= @_;
   4     #my $root= $node->root;
   5     my $charset;
   6     # get the XML declaration first (need pis to be stored)
   7     if( my $xml_decl= first { $_->{_tag} eq '~pi' } $root->content_list)
   8       { if( $xml_decl->{text}=~ m{encoding\s*=\s*(["'])(.*?)\1})
   9           { $charset->{declaration}= $2; }
  10       }
  11
  12     if( my $head= first { lc( $_->{_tag}) eq 'head' } $root->content_list)
  13       { if( my $meta= first { lc( $_->{_tag}) eq 'meta' && lc( $_->{http-equiv}) eq "content-type") }
  14                             $root->content_list
  15           )
  16           { if( $meta->{content} && lc( $meta->{content})=~ m{charset\s*=\s*([\w-]*))
  17               { charset->{meta}= $1; }
  18           }
  19
  20     return $charset;
  21   }