/[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.3 - (hide annotations) (download)
Sat Jun 28 06:13:12 2008 UTC (17 years, 9 months ago) by wakaba
Branch: MAIN
Changes since 1.2: +1 -1 lines
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 wakaba 1.3 $s =~ s/\\\*/(.+)/g;
20 wakaba 1.1 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 wakaba 1.2 my @pattern = sort {length $b <=> length $a} keys %pattern;
53 wakaba 1.1
54     my $source_text;
55     {
56     warn "$source_file_name...\n";
57     open my $source_file, '<:utf8', $source_file_name
58     or die "$0: $source_file_name: $!";
59     local $/ = undef;
60     $source_text = <$source_file>;
61     }
62    
63     warn "Generating...\n";
64     $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[^>]*)?>).)+)}
65     {
66     my ($tag, $text) = ($1, $2);
67     my $n_text = normalize ($text);
68     my $ja_text = $data{$n_text};
69     if (defined $ja_text) {
70     $tag . q[<span class=ja-translation lang=ja>] . $ja_text . q[</span>];
71     } else {
72     my $v = $tag . $text;
73 wakaba 1.2 for my $pattern (@pattern) {
74 wakaba 1.1 if ($n_text =~ /^$pattern$/) {
75     $v = $tag . q[<span class=ja-translation lang=ja>] .
76     replace_pattern2 ($pattern{$pattern}, $1, $2, $3, $4, $5) .
77     q[</span>];
78     }
79     }
80     $v;
81     }
82     }ges;
83     $source_text =~ s{(<(?>link|img|script)\s[^>]+>)}{
84     my $tag = $1;
85     my $n_text = normalize ($tag);
86     my $ja_text = $data{$n_text};
87     if (defined $ja_text) {
88     $ja_text;
89     } else {
90     $tag;
91     }
92     }ges;
93    
94     $source_text =~ s{\[\[([A-Z]+):([^]]+)\]\]}
95     {<em class=rfc2119 title="$1">$2</em>}gs;
96    
97     #$source_text =~ s[<title>][<base href="http://www.whatwg.org/specs/web-apps/current-work/"><title>];
98    
99     {
100     warn "$result_file_name...\n";
101     open my $result_file, '>:utf8', $result_file_name
102     or die "$0: $result_file_name: $!";
103     print $result_file $source_text;
104     }

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24