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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by wakaba, Sun Aug 10 04:16:33 2008 UTC revision 1.20 by wakaba, Sat Oct 25 11:28:27 2008 UTC
# Line 6  BEGIN { require 'common.pl' } Line 6  BEGIN { require 'common.pl' }
6  my $source_file_name = shift;  my $source_file_name = shift;
7  my $result_file_name = shift;  my $result_file_name = shift;
8  my $status_file_name = shift;  my $status_file_name = shift;
9  my $tbt_file_name = shift;  my $tbt_file_name_stem = shift;
10    
11  my %data;  my %data;
12  my %pattern;  my %pattern;
# Line 26  my $source_text; Line 26  my $source_text;
26    $source_text = <$source_file>;    $source_text = <$source_file>;
27  }  }
28    
29  open my $tbt_file, '>:utf8', $tbt_file_name or die "$0: $tbt_file_name: $!";  my $part = 'cover';
   
30  my $status = {};  my $status = {};
31    my $all_status = {};
32    my $tbt_added = {};
33    
34    open my $tbt_file, '>:utf8', $tbt_file_name_stem . '.dat' or
35        die "$0: $tbt_file_name_stem.dat: $!";
36    open my $part_tbt_file, '>:utf8', $tbt_file_name_stem . '-' . $part . '.dat' or
37        die "$0: $tbt_file_name_stem-$part.dat: $!";
38    
39  warn "Generating...\n";  warn "Generating...\n";
40  $source_text =~ s{(<(?>p(?>re)?|li|d[td]|t[dh]|h[1-6])(?>\s[^>]*)?>)((?>(?!</?(?>p(?>re)?|li|d(?>[tdl]|iv)|t(?>[dr]|h(?>ead)?|able|body|foot)|h[1-6r]|ul|ol)(?>\s[^>]*)?>).)+)}  $source_text =~ s{(<(?>p(?>re)?|li|d[td]|t[dh]|h[1-6])(?>\s[^>]*)?>)((?>(?!</?(?>p(?>re)?|li|d(?>[tdl]|iv)|t(?>[dr]|h(?>ead)?|able|body|foot)|h[1-6r]|ul|ol)(?>\s[^>]*)?>).)+)}
41  {  {
42    my ($tag, $text) = ($1, $2);    my ($tag, $text) = ($1, $2);
43    my $n_text = normalize ($text);    my $n_text = normalize ($text);
44    
45      if ($tag =~ /^<h2 id=(\w+)/) {
46        $part = $1;
47        open $part_tbt_file, '>:utf8', $tbt_file_name_stem . '-' . $part . '.dat' or
48            die "$0: $tbt_file_name_stem-$part.dat: $!";
49      }
50        
51    if (length $n_text) {    if (length $n_text) {
52      my $ja_text = $data{$n_text};      my $ja_text = $data{$n_text};
53            
54      $status->{all}++;      $status->{all}++;
55        $all_status->{$part}->{all}++;
56            
57      if (defined $ja_text) {      if (defined $ja_text) {
58        $status->{ja}++;        $status->{ja}++;
59        $tag . q[<span class=ja-translation lang=ja>] . $ja_text . q[</span>];        $all_status->{$part}->{ja}++;
60          add_class ($tag, 'has-ja-translation') .
61          q[<span class=en-original lang=en>] . escape_id ($text, 'en-') .
62          q[</span>] .
63          q[<span class=ja-translation lang=ja>] . $ja_text . q[</span>];
64      } else {      } else {
65        my $v = $tag . $text;        my $v;
       my $has_ja;  
66        for my $pattern (@pattern) {        for my $pattern (@pattern) {
67          if ($n_text =~ /^$pattern$/) {          if ($n_text =~ /^$pattern$/) {
68            $status->{ja}++;            $status->{ja}++;
69            $v = $tag . q[<span class=ja-translation lang=ja>] .            $all_status->{$part}->{ja}++;
70              $v = add_class ($tag, 'has-ja-translation') .
71                  q[<span class=en-original lang=en>] .
72                  escape_id ($text, 'en-') . q[</span>] .
73                  q[<span class=ja-translation lang=ja>] .
74                replace_pattern2 ($pattern{$pattern}, $1, $2, $3, $4, $5) .                replace_pattern2 ($pattern{$pattern}, $1, $2, $3, $4, $5) .
75                q[</span>];                q[</span>];
           $has_ja = 1;  
76            last;            last;
77          }          }
78        }        }
79    
80        unless ($has_ja) {        unless (defined $v) {
81            $v = add_class ($tag, 'no-ja-translation') . $text;
82            
83          $text =~ s/^\s+//;          $text =~ s/^\s+//;
84          $text =~ s/\s+\z//;          $text =~ s/\s+\z//;
85          $text =~ s/\x0D?\x0A(?:\x0D?\x0A)+/\n/g;          $text =~ s/\x0D?\x0A(?:\x0D?\x0A)+/\n/g;
86          print $tbt_file $text;          unless ($tbt_added->{$text}) {
87          print $tbt_file "\n\n";            print $tbt_file ($text);
88              print $tbt_file ("\n\n");
89              print $part_tbt_file ($text);
90              print $part_tbt_file ("\n\n");
91              $tbt_added->{$text} = 1;
92            }
93        }        }
94    
95        $v;        $v;
# Line 97  $source_text =~ s{\[\[([A-Z ]+):([^]]+)\ Line 123  $source_text =~ s{\[\[([A-Z ]+):([^]]+)\
123    
124  {  {
125    my $time = time;    my $time = time;
126      my @item = ($time, $status->{ja}, $status->{all});
127      for my $part (qw(cover introduction infrastructure dom semantics browsers
128                       editing comms syntax rendering no)) {
129        push @item, $all_status->{$part}->{ja};
130        push @item, $all_status->{$part}->{all};
131      }
132    
133    open my $status_file, '>>', $status_file_name    open my $status_file, '>>', $status_file_name
134        or die "$0: $status_file_name: $!";        or die "$0: $status_file_name: $!";
135    print $status_file "$time\t$status->{ja}\t$status->{all}\n";    print $status_file join "\t", @item;
136      print $status_file "\n";
137      close $status_file;
138  }  }
139    
140    sub add_class ($$) {
141      my $tag = shift;
142      my $new_class = shift; # should not contain bare & and bare "
143    
144      if ($tag =~ /^<li\b/) {
145        ## NOTE: This |p| wrapper is necessary, otherwise, if |li| element
146        ## is set to |display: table|, then no list marker is shown.
147        $tag .= qq[<p class="$new_class ja-translation-inserted">];
148      } elsif ($tag =~ /\bclass="/) {
149        $tag =~ s/\bclass="([^"]*)"/class="$1 $new_class"/;
150      } elsif ($tag =~ /\bclass=/) {
151        $tag =~ s/\bclass=([^\s>]+)/class="$1 $new_class"/g;
152      } else {
153        $tag =~ s/>/ class="$new_class">/;
154      }
155      
156      return $tag;
157    } # add_class
158    
159    sub escape_id ($$) {
160      my $content = shift;
161      my $id_prefix = shift; # should not contain bare & and bare "
162      
163      $content =~ s{<([a-zA-Z0-9-][^<>]+)>}{
164        my $tag_content = $1;
165    
166        if ($tag_content =~ /\bid="/) {
167          $tag_content =~ s/\bid="([^"]*)"/id="$id_prefix$1"/;
168        } elsif ($tag_content =~ /\bid=/) {
169          $tag_content =~ s/\bid=(\S+)/id="$id_prefix$1"/;
170        }
171    
172    #    if ($tag_content =~ /\bhref=#/) {
173    #      $tag_content =~ s/\bhref=#(\S+)/href=#$id_prefix$1/;
174    #    }
175    
176        '<' . $tag_content . '>';
177      }ge;
178    
179      return $content;
180    } # escape_id
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.20
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24