html5/spec-ja/common.pl

use strict;

my $data_dir_name = q[data/];
my $data2_dir_name = q[data2/];
my $data2_suffix = q[.dat];
my $lock_suffix = q[.lock];

## SEE ALSO: |Makefile|.
my $fallback_file_name = $data2_dir_name . 'fallback' . $data2_suffix;

## SEE ALSO: |Makefile|.
my $patch_file_name = $data2_dir_name . 'modified.txt';

our $UseCVS //= 1;

sub normalize ($) {
  my $s = shift;
  $s =~ s/\s+/ /g;
  $s =~ s/^ //;
  $s =~ s/ $//g;
  return $s;
} # normalize

sub get_hash ($) {
  require Digest::MD5;
  require Encode;
  return Digest::MD5::md5_hex (Encode::encode ('utf8', normalize ($_[0])));
} # get_hash

sub create_pattern1 ($) {
  my $s = quotemeta shift;
  $s =~ s/\\\*/(.+)/g;
  return $s;
} # create_pattern1

sub replace_pattern2 ($@) {
  my $s = shift;
  my @arg = @_;
  $s =~ s/\$(\d+)/$arg[$1 - 1]/g;
  return $s;
} # replace_pattern2

sub read_data_file ($) {
  my $file_name = shift;
  if (-f $file_name) {
    warn "Loading $file_name...\n";
    return do $file_name;
  } else {
    warn "File $file_name not found\n";
    return {};
  }
} # read_data_file

sub write_data_file ($$) {
  my ($file_name, $data) = @_;

  require Data::Dumper;
  local $Data::Dumper::Sortkeys = 1;
  local $Data::Dumper::Useqq = 1;
  local *Data::Dumper::qquote = sub {
    my $s = shift;
    $s =~ s/([\x27\x5C])/sprintf '\x%02X', ord $1/ge;
    return q<qq'> . $s . q<'>;
  }; # Data::Dumper::qquote
  
  my $had_file = -f $file_name;
  open my $file, '>:encoding(utf8)', $file_name or die "$0: $file_name: $!";
  print $file "use utf8;\n";
  print $file Data::Dumper::Dumper ($data);
  close $file;
  unless ($had_file) {
    system_ ('cvs', 'add', $file_name) if $UseCVS;
  }
} # write_data_file

sub hash_to_file_name ($) {
  return $data2_dir_name . substr ($_[0], 0, 2) . $data2_suffix;
} # hash_to_file_name

my $Entry = {};
my $ModifiedHash = {};

sub get_entry ($) {
  my $hash = shift;
  
  my $file_name = hash_to_file_name ($hash);
  unless ($Entry->{$file_name}) {
    $Entry->{$file_name} = read_data_file ($file_name);
  }
  
  if ($Entry->{$file_name}->{exact}->{$hash}) {
    return (0, $Entry->{$file_name}->{exact}->{$hash});
  } elsif ($Entry->{$file_name}->{pattern}->{$hash}) {
    return (1, $Entry->{$file_name}->{pattern}->{$hash});
  } else {
    return (undef, undef);
  }
} # get_entry

sub set_entry ($$$) {
  my ($hash, $is_pattern, $value) = @_;
  
  my $file_name = hash_to_file_name ($hash);
  unless ($Entry->{$file_name}) {
    $Entry->{$file_name} = read_data_file ($file_name);    
  }

  unless ($value) {
    delete $Entry->{$file_name}->{exact}->{$hash};
    delete $Entry->{$file_name}->{pattern}->{$hash};
  } elsif ($is_pattern) {
    delete $Entry->{$file_name}->{exact}->{$hash};
    $Entry->{$file_name}->{pattern}->{$hash} = $value;
  } else {
    $Entry->{$file_name}->{exact}->{$hash} = $value;
    delete $Entry->{$file_name}->{pattern}->{$hash};
  }
  $Entry->{$file_name}->{modified} = 1;
  $ModifiedHash->{$hash} = 1;
} # set_entry

use Fcntl ':flock';
my $Lock;

sub lock_entry ($) {
  if ($Lock) {
    die "$0: lock_entry: Another entry is locked";
  }

  my $hash = shift;
  my $file_name = hash_to_file_name ($hash) . $lock_suffix;
  open $Lock, '>', $file_name or die "$0: $file_name: $!";
  flock $Lock, LOCK_EX;
} # lock_entry

sub commit_entries ($) {
  for my $file_name (keys %{$Entry}) {
    if ($Entry->{$file_name}->{modified}) {
      delete $Entry->{$file_name}->{modified};
      write_data_file ($file_name => $Entry->{$file_name});
    }
  }

  open my $file, '>>', $patch_file_name or die "$0: $patch_file_name: $!";
  for (keys %$ModifiedHash) {
    print $file "$_\n";
  }
  close $file;

  my $msg = shift // $0;
  system_ ('cvs', 'commit', -m => $msg, $data2_dir_name) if $UseCVS;
} # commit_entries

sub get_all_entries () {
  opendir my $dir, $data2_dir_name or die "$0: $data2_dir_name: $!";
  for (readdir $dir) {
    next unless /\Q$data2_suffix\E$/;
    my $file_name = $data2_dir_name . $_;
    next if $Entry->{$file_name};

    $Entry->{$file_name} = read_data_file ($file_name);
  }

  return $Entry;
} # get_all_entries

sub for_each_entry_set ($;$) {
  my $code = shift;
  my $on_the_fly = shift;
  
  opendir my $dir, $data2_dir_name or die "$0: $data2_dir_name: $!";
  for (readdir $dir) {
    next unless /\Q$data2_suffix\E$/;
    my $file_name = $data2_dir_name . $_;
    next if $file_name eq $fallback_file_name;

    if ($Entry->{$file_name}) {
      $code->($file_name, $Entry->{$file_name});
    } elsif ($on_the_fly) {
      $code->($file_name, read_data_file ($file_name));
    } else {
      $Entry->{$file_name} = read_data_file ($file_name);
      $code->($file_name, $Entry->{$file_name});
    }
  }
} # for_each_entry_set

my $FallbackEntry;
sub get_fallback_entry ($) {
  my $hash = shift;
  unless (defined $FallbackEntry) {
    $FallbackEntry = read_data_file ($fallback_file_name);
  }
  return $FallbackEntry->{$hash} // {};
} # get_fallback_entry

sub get_entry_or_fallback_entry ($) {
  my $hash = shift;

  my ($is_pattern, $entry) = get_entry ($hash);
  unless (defined $entry->{en}) {
    $entry = get_fallback_entry ($hash);
  }
  $entry->{tags} ||= [];
  $entry->{isPattern} = 1 if $is_pattern;

  return $entry;
} # get_entry_or_fallback_entry

sub set_fallback_entry ($$) {
  my ($hash, $value) = @_;
  unless (defined $FallbackEntry) {
    $FallbackEntry = read_data_file ($fallback_file_name);
  }
  $FallbackEntry->{$hash} = $value;
} # set_fallback_entry

sub get_fallback_entries () {
  unless (defined $FallbackEntry) {
    $FallbackEntry = read_data_file ($fallback_file_name);
  }
  
  return $FallbackEntry;
} # get_fallback_entries

sub save_fallback_entries () {
  write_data_file ($fallback_file_name => $FallbackEntry)
      if defined $FallbackEntry;
} # save_fallback_entries

sub get_modified_hashes () {
  open my $file, '<', $patch_file_name or die "$0: $patch_file_name: $!";
  return map {tr/\x0D\x0A//d; $_} <$file>;
} # get_modified_hashes

sub htescape ($) {
  my $s = shift;
  $s =~ s/&/&amp;/g;
  $s =~ s/</&lt;/g;
  $s =~ s/"/&quot;/g;
  return $s;
} # htescape

sub system_ (@) {
  (system join (' ', map {quotemeta $_} @_) . " > /dev/null") == 0
      or die "$0: $?";
} # system_

1;

## Author: Wakaba <w@suika.fam.cx>.
## License: Copyright 2008 Wakaba.  You are granted a license to use,
##     reproduce and create derivative works of this script.
## $Date: 2008/10/27 05:00:33 $
1	wakaba	1.1	use strict;
2
3	wakaba	1.7	my $data_dir_name = q[data/];
4	wakaba	1.8	my $data2_dir_name = q[data2/];
5			my $data2_suffix = q[.dat];
6			my $lock_suffix = q[.lock];
7	wakaba	1.13
8			## SEE ALSO: \|Makefile\|.
9	wakaba	1.8	my $fallback_file_name = $data2_dir_name . 'fallback' . $data2_suffix;
10	wakaba	1.12
11			## SEE ALSO: \|Makefile\|.
12	wakaba	1.11	my $patch_file_name = $data2_dir_name . 'modified.txt';
13	wakaba	1.8
14			our $UseCVS //= 1;
15	wakaba	1.1
16			sub normalize ($) {
17			my $s = shift;
18			$s =~ s/\s+/ /g;
19			$s =~ s/^ //;
20			$s =~ s/ $//g;
21			return $s;
22			} # normalize
23
24	wakaba	1.8	sub get_hash ($) {
25			require Digest::MD5;
26	wakaba	1.14	require Encode;
27			return Digest::MD5::md5_hex (Encode::encode ('utf8', normalize ($_[0])));
28	wakaba	1.8	} # get_hash
29
30	wakaba	1.1	sub create_pattern1 ($) {
31			my $s = quotemeta shift;
32			$s =~ s/\\\*/(.+)/g;
33			return $s;
34			} # create_pattern1
35
36			sub replace_pattern2 ($@) {
37			my $s = shift;
38			my @arg = @_;
39			$s =~ s/\$(\d+)/$arg[$1 - 1]/g;
40			return $s;
41			} # replace_pattern2
42
43	wakaba	1.8	sub read_data_file ($) {
44			my $file_name = shift;
45			if (-f $file_name) {
46			warn "Loading $file_name...\n";
47			return do $file_name;
48			} else {
49			warn "File $file_name not found\n";
50			return {};
51			}
52			} # read_data_file
53
54			sub write_data_file ($$) {
55			my ($file_name, $data) = @_;
56
57			require Data::Dumper;
58			local $Data::Dumper::Sortkeys = 1;
59	wakaba	1.17	local $Data::Dumper::Useqq = 1;
60			local *Data::Dumper::qquote = sub {
61			my $s = shift;
62			$s =~ s/([\x27\x5C])/sprintf '\x%02X', ord $1/ge;
63			return q<qq'> . $s . q<'>;
64			}; # Data::Dumper::qquote
65
66	wakaba	1.8	my $had_file = -f $file_name;
67			open my $file, '>:encoding(utf8)', $file_name or die "$0: $file_name: $!";
68	wakaba	1.17	print $file "use utf8;\n";
69	wakaba	1.8	print $file Data::Dumper::Dumper ($data);
70			close $file;
71			unless ($had_file) {
72	apache	1.9	system_ ('cvs', 'add', $file_name) if $UseCVS;
73	wakaba	1.8	}
74			} # write_data_file
75
76			sub hash_to_file_name ($) {
77			return $data2_dir_name . substr ($_[0], 0, 2) . $data2_suffix;
78			} # hash_to_file_name
79
80			my $Entry = {};
81	wakaba	1.11	my $ModifiedHash = {};
82	wakaba	1.8
83			sub get_entry ($) {
84			my $hash = shift;
85
86			my $file_name = hash_to_file_name ($hash);
87			unless ($Entry->{$file_name}) {
88			$Entry->{$file_name} = read_data_file ($file_name);
89			}
90
91			if ($Entry->{$file_name}->{exact}->{$hash}) {
92			return (0, $Entry->{$file_name}->{exact}->{$hash});
93			} elsif ($Entry->{$file_name}->{pattern}->{$hash}) {
94			return (1, $Entry->{$file_name}->{pattern}->{$hash});
95			} else {
96			return (undef, undef);
97			}
98			} # get_entry
99
100			sub set_entry ($$$) {
101			my ($hash, $is_pattern, $value) = @_;
102
103			my $file_name = hash_to_file_name ($hash);
104			unless ($Entry->{$file_name}) {
105			$Entry->{$file_name} = read_data_file ($file_name);
106			}
107
108			unless ($value) {
109			delete $Entry->{$file_name}->{exact}->{$hash};
110			delete $Entry->{$file_name}->{pattern}->{$hash};
111			} elsif ($is_pattern) {
112			delete $Entry->{$file_name}->{exact}->{$hash};
113			$Entry->{$file_name}->{pattern}->{$hash} = $value;
114			} else {
115			$Entry->{$file_name}->{exact}->{$hash} = $value;
116			delete $Entry->{$file_name}->{pattern}->{$hash};
117			}
118			$Entry->{$file_name}->{modified} = 1;
119	wakaba	1.11	$ModifiedHash->{$hash} = 1;
120	wakaba	1.8	} # set_entry
121
122			use Fcntl ':flock';
123			my $Lock;
124
125			sub lock_entry ($) {
126			if ($Lock) {
127			die "$0: lock_entry: Another entry is locked";
128			}
129
130			my $hash = shift;
131			my $file_name = hash_to_file_name ($hash) . $lock_suffix;
132			open $Lock, '>', $file_name or die "$0: $file_name: $!";
133			flock $Lock, LOCK_EX;
134			} # lock_entry
135
136			sub commit_entries ($) {
137			for my $file_name (keys %{$Entry}) {
138			if ($Entry->{$file_name}->{modified}) {
139	wakaba	1.11	delete $Entry->{$file_name}->{modified};
140	wakaba	1.8	write_data_file ($file_name => $Entry->{$file_name});
141			}
142			}
143
144	wakaba	1.11	open my $file, '>>', $patch_file_name or die "$0: $patch_file_name: $!";
145			for (keys %$ModifiedHash) {
146			print $file "$_\n";
147			}
148			close $file;
149
150	wakaba	1.8	my $msg = shift // $0;
151	wakaba	1.10	system_ ('cvs', 'commit', -m => $msg, $data2_dir_name) if $UseCVS;
152	wakaba	1.8	} # commit_entries
153
154			sub get_all_entries () {
155			opendir my $dir, $data2_dir_name or die "$0: $data2_dir_name: $!";
156			for (readdir $dir) {
157			next unless /\Q$data2_suffix\E$/;
158			my $file_name = $data2_dir_name . $_;
159			next if $Entry->{$file_name};
160
161			$Entry->{$file_name} = read_data_file ($file_name);
162			}
163
164			return $Entry;
165			} # get_all_entries
166
167	wakaba	1.14	sub for_each_entry_set ($;$) {
168			my $code = shift;
169			my $on_the_fly = shift;
170
171			opendir my $dir, $data2_dir_name or die "$0: $data2_dir_name: $!";
172			for (readdir $dir) {
173			next unless /\Q$data2_suffix\E$/;
174			my $file_name = $data2_dir_name . $_;
175			next if $file_name eq $fallback_file_name;
176
177			if ($Entry->{$file_name}) {
178			$code->($file_name, $Entry->{$file_name});
179			} elsif ($on_the_fly) {
180			$code->($file_name, read_data_file ($file_name));
181			} else {
182			$Entry->{$file_name} = read_data_file ($file_name);
183			$code->($file_name, $Entry->{$file_name});
184			}
185			}
186			} # for_each_entry_set
187
188	wakaba	1.8	my $FallbackEntry;
189			sub get_fallback_entry ($) {
190			my $hash = shift;
191			unless (defined $FallbackEntry) {
192			$FallbackEntry = read_data_file ($fallback_file_name);
193			}
194			return $FallbackEntry->{$hash} // {};
195			} # get_fallback_entry
196
197	wakaba	1.11	sub get_entry_or_fallback_entry ($) {
198			my $hash = shift;
199
200			my ($is_pattern, $entry) = get_entry ($hash);
201			unless (defined $entry->{en}) {
202			$entry = get_fallback_entry ($hash);
203			}
204	wakaba	1.13	$entry->{tags} \|\|= [];
205	wakaba	1.11	$entry->{isPattern} = 1 if $is_pattern;
206
207			return $entry;
208			} # get_entry_or_fallback_entry
209
210	wakaba	1.8	sub set_fallback_entry ($$) {
211			my ($hash, $value) = @_;
212			unless (defined $FallbackEntry) {
213			$FallbackEntry = read_data_file ($fallback_file_name);
214			}
215			$FallbackEntry->{$hash} = $value;
216			} # set_fallback_entry
217	wakaba	1.14
218			sub get_fallback_entries () {
219			unless (defined $FallbackEntry) {
220			$FallbackEntry = read_data_file ($fallback_file_name);
221			}
222
223			return $FallbackEntry;
224			} # get_fallback_entries
225	wakaba	1.8
226			sub save_fallback_entries () {
227			write_data_file ($fallback_file_name => $FallbackEntry)
228			if defined $FallbackEntry;
229			} # save_fallback_entries
230	wakaba	1.11
231			sub get_modified_hashes () {
232			open my $file, '<', $patch_file_name or die "$0: $patch_file_name: $!";
233			return map {tr/\x0D\x0A//d; $_} <$file>;
234			} # get_modified_hashes
235	wakaba	1.8
236			sub htescape ($) {
237			my $s = shift;
238			$s =~ s/&/&/g;
239			$s =~ s/</</g;
240			$s =~ s/"/"/g;
241			return $s;
242			} # htescape
243	apache	1.9
244			sub system_ (@) {
245	wakaba	1.10	(system join (' ', map {quotemeta $_} @_) . " > /dev/null") == 0
246			or die "$0: $?";
247	apache	1.9	} # system_
248	wakaba	1.1
249			1;
250
251	wakaba	1.16	## Author: Wakaba <w@suika.fam.cx>.
252			## License: Copyright 2008 Wakaba. You are granted a license to use,
253			## reproduce and create derivative works of this script.
254	wakaba	1.17	## $Date: 2008/10/27 05:00:33 $