/[suikacvs]/markup/html/html5/spec-ja/make.pl
Suika

Contents of /markup/html/html5/spec-ja/make.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Tue Jun 24 14:15:43 2008 UTC (17 years, 9 months ago) by wakaba
Branch: MAIN
File MIME type: text/plain
*** empty log message ***

1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3    
4     my $source_file_name = q[.spec.en.html];
5     my $data_dir_name = q[data/];
6     my $data_suffix = q[.dat];
7     my $result_file_name = q[non-normative.ja.html.u8];
8    
9     sub normalize ($) {
10     my $s = shift;
11     $s =~ s/\s+/ /g;
12     $s =~ s/^ //;
13     $s =~ s/ $//g;
14     return $s;
15     } # normalize
16    
17     sub create_pattern1 ($) {
18     my $s = quotemeta shift;
19     $s =~ s/\\\*/([^.]+)/g;
20     return $s;
21     } # create_pattern1
22    
23     sub replace_pattern2 ($@) {
24     my $s = shift;
25     my @arg = @_;
26     $s =~ s/\$(\d+)/$arg[$1 - 1]/g;
27     return $s;
28     } # replace_pattern2
29    
30     my %data;
31     my %pattern;
32     {
33     opendir my $data_dir, $data_dir_name or die "$0: $data_dir_name: $!";
34     local $/ = undef;
35     for (readdir $data_dir) {
36     next if /^\./; # hidden files
37     my $data_file_name = qq[$data_dir_name$_];
38     next unless $data_file_name =~ /\Q$data_suffix\E$/;
39     warn "$data_file_name...\n";
40     open my $data_file, '<:utf8', $data_file_name
41     or die "$0: $data_file_name: $!";
42     for (split /\n\n+(?=#)/, scalar <$data_file>) {
43     my ($en, $ja) = split /\n#ja\n/, $_;
44     if ($en =~ s/^#en\n//) {
45     $data{normalize ($en)} = $ja;
46     } elsif ($en =~ s/^#regexp\n//) {
47     $pattern{create_pattern1 (normalize ($en))} = $ja;
48     }
49     }
50     }
51     }
52    
53     my $source_text;
54     {
55     warn "$source_file_name...\n";
56     open my $source_file, '<:utf8', $source_file_name
57     or die "$0: $source_file_name: $!";
58     local $/ = undef;
59     $source_text = <$source_file>;
60     }
61    
62     warn "Generating...\n";
63     $source_text =~ s{(<(?>p(?>re)?|li|d[td]|t[dh]|h[1-6])(?>\s[^>]*)?>)((?>(?!</?(?>p(?>re)?|li|d(?>[tdl]|iv)|t[dh]|h[1-6]|ul|ol)(?>\s[^>]*)?>).)+)}
64     {
65     my ($tag, $text) = ($1, $2);
66     my $n_text = normalize ($text);
67     my $ja_text = $data{$n_text};
68     if (defined $ja_text) {
69     $tag . q[<span class=ja-translation lang=ja>] . $ja_text . q[</span>];
70     } else {
71     my $v = $tag . $text;
72     for my $pattern (keys %pattern) {
73     if ($n_text =~ /^$pattern$/) {
74     $v = $tag . q[<span class=ja-translation lang=ja>] .
75     replace_pattern2 ($pattern{$pattern}, $1, $2, $3, $4, $5) .
76     q[</span>];
77     }
78     }
79     $v;
80     }
81     }ges;
82     $source_text =~ s{(<(?>link|img|script)\s[^>]+>)}{
83     my $tag = $1;
84     my $n_text = normalize ($tag);
85     my $ja_text = $data{$n_text};
86     if (defined $ja_text) {
87     $ja_text;
88     } else {
89     $tag;
90     }
91     }ges;
92    
93     $source_text =~ s{\[\[([A-Z]+):([^]]+)\]\]}
94     {<em class=rfc2119 title="$1">$2</em>}gs;
95    
96     #$source_text =~ s[<title>][<base href="http://www.whatwg.org/specs/web-apps/current-work/"><title>];
97    
98     {
99     warn "$result_file_name...\n";
100     open my $result_file, '>:utf8', $result_file_name
101     or die "$0: $result_file_name: $!";
102     print $result_file $source_text;
103     }

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24