whatpm/Whatpm/mkentitylist.pl

#!/usr/bin/perl
use strict;

use lib qw[../];
my $EntitiesFileName = 'Entities.html';
my $Entity = {};

require Whatpm::NanoDOM;
require Whatpm::HTML;
my $doc = Whatpm::NanoDOM::Document->new;
{
  open my $file, '<:encoding(utf8)', $EntitiesFileName
    or die "$0: $EntitiesFileName: $!";
  local $/ = undef;
  Whatpm::HTML->parse_string (scalar <$file> => $doc);
}

my $table;
my @node = @{$doc->child_nodes};
while (@node) {
  my $node = shift @node;
  if ($node->node_type == 1 and
      $node->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
      $node->manakai_local_name eq 'table') {
    $table = $node;
    last;
  } else {
    push @node, @{$node->child_nodes};
  }
}
unless (defined $table) {
  warn "$0: No <table> in $EntitiesFileName\n";
}

my @row;
@node = @{$table->child_nodes};
while (@node) {
  my $node = shift @node;
  if ($node->node_type == 1) {
    if ($node->namespace_uri eq q<http://www.w3.org/1999/xhtml>) {
      if ($node->manakai_local_name eq 'tr') {
        push @row, $node;
      } elsif ({thead => 1, tbody => 1, tfoot => 1}
               ->{$node->manakai_local_name}) {
        unshift @node, @{$node->child_nodes};
      }
    }
  }
}
shift @row; # heading rows

my $n = sub { my $s = shift; $s =~ s/\s+/ /g; $s =~ s/^ //; $s =~ s/ $//; $s };
for my $tr (@row) {
  my @td = grep {
    $_->node_type == 1 and
      $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
        $_->manakai_local_name eq 'td'
  } @{$tr->child_nodes};
  my $name = $n->($td[0]->text_content);
  my $value = $n->($td[1]->text_content);
  $Entity->{$name} = chr hex substr $value, 2; # U+HHHH
}

use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Useqq = 1;
my $value = Dumper $Entity;
$value =~ s/\$VAR1\b/\$Whatpm::HTML::EntityChar/;

print $value;
print "1;\n";
print '__DATA__

=head1 NAME

mkentitylist.pl - Generate a named entity list for HTML parser

_NamedEntityList.pm - A named entity list for HTML parser

=head1 DESCRIPTION

The C<_NamedEntityList.pm> file contains a list of named entities
used in HTML documents, both conforming and non-conforming.
It is referenced by C<ContentHTML.pm>.  For more
information, see L<Whatpm::HTML>.

The C<mkentitylist.pl> script is used to generate
the C<_NamedEntityList.pm> file from the table in the HTML5
specification.

=head1 SEE ALSO

L<Whatpm::HTML>.

HTML 5 - Entities
<http://www.whatwg.org/specs/web-apps/current-work/#entities>

=head1 LICENSE

(C) Copyright 2004-2007 Apple Computer, Inc., Mozilla Foundation,
and Opera Software ASA.

Copyright 2007 Wakaba <[email protected]>.

You are granted a license to use, reproduce and create derivative works 
of this document.

=cut

';
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3
4			use lib qw[../];
5			my $EntitiesFileName = 'Entities.html';
6			my $Entity = {};
7
8			require Whatpm::NanoDOM;
9			require Whatpm::HTML;
10			my $doc = Whatpm::NanoDOM::Document->new;
11			{
12			open my $file, '<:encoding(utf8)', $EntitiesFileName
13			or die "$0: $EntitiesFileName: $!";
14			local $/ = undef;
15			Whatpm::HTML->parse_string (scalar <$file> => $doc);
16			}
17
18			my $table;
19			my @node = @{$doc->child_nodes};
20			while (@node) {
21			my $node = shift @node;
22			if ($node->node_type == 1 and
23			$node->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
24			$node->manakai_local_name eq 'table') {
25			$table = $node;
26			last;
27			} else {
28			push @node, @{$node->child_nodes};
29			}
30			}
31			unless (defined $table) {
32			warn "$0: No <table> in $EntitiesFileName\n";
33			}
34
35			my @row;
36			@node = @{$table->child_nodes};
37			while (@node) {
38			my $node = shift @node;
39			if ($node->node_type == 1) {
40			if ($node->namespace_uri eq q<http://www.w3.org/1999/xhtml>) {
41			if ($node->manakai_local_name eq 'tr') {
42			push @row, $node;
43			} elsif ({thead => 1, tbody => 1, tfoot => 1}
44			->{$node->manakai_local_name}) {
45			unshift @node, @{$node->child_nodes};
46			}
47			}
48			}
49			}
50			shift @row; # heading rows
51
52			my $n = sub { my $s = shift; $s =~ s/\s+/ /g; $s =~ s/^ //; $s =~ s/ $//; $s };
53			for my $tr (@row) {
54			my @td = grep {
55			$_->node_type == 1 and
56			$_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
57			$_->manakai_local_name eq 'td'
58			} @{$tr->child_nodes};
59			my $name = $n->($td[0]->text_content);
60			my $value = $n->($td[1]->text_content);
61			$Entity->{$name} = chr hex substr $value, 2; # U+HHHH
62			}
63
64			use Data::Dumper;
65			$Data::Dumper::Sortkeys = 1;
66			$Data::Dumper::Useqq = 1;
67			my $value = Dumper $Entity;
68			$value =~ s/\$VAR1\b/\$Whatpm::HTML::EntityChar/;
69
70			print $value;
71			print "1;\n";
72			print '__DATA__
73
74			=head1 NAME
75
76			mkentitylist.pl - Generate a named entity list for HTML parser
77
78			_NamedEntityList.pm - A named entity list for HTML parser
79
80			=head1 DESCRIPTION
81
82			The C<_NamedEntityList.pm> file contains a list of named entities
83			used in HTML documents, both conforming and non-conforming.
84			It is referenced by C<ContentHTML.pm>. For more
85			information, see L<Whatpm::HTML>.
86
87			The C<mkentitylist.pl> script is used to generate
88			the C<_NamedEntityList.pm> file from the table in the HTML5
89			specification.
90
91			=head1 SEE ALSO
92
93			L<Whatpm::HTML>.
94
95			HTML 5 - Entities
96			<http://www.whatwg.org/specs/web-apps/current-work/#entities>
97
98			=head1 LICENSE
99
100			(C) Copyright 2004-2007 Apple Computer, Inc., Mozilla Foundation,
101			and Opera Software ASA.
102
103			Copyright 2007 Wakaba <[email protected]>.
104
105			You are granted a license to use, reproduce and create derivative works
106			of this document.
107
108			=cut
109
110			';