html5/spec-ja/common.pl

use strict;

my $data_suffix = q[.dat];
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 load_data_file ($$$) {
  my ($data_file_name, $exact_data, $pattern_data) = @_;

  open my $data_file, '<:utf8', $data_file_name
      or die "$0: $data_file_name: $!";
  local $/ = undef;
  my $data = <$data_file>;
  $data =~ s/\x0D?\x0A/\n/g;
  for (split /\n\n+(?=#)/, $data) {
    my ($en, $ja) = split /\n#ja\n/, $_;
    if ($en =~ s/^#en\n//) {
      $exact_data->{normalize ($en)} = $ja;
    } elsif ($en =~ s/^#pattern\n//) {
      $pattern_data->{create_pattern1 (normalize ($en))} = $ja;
    }
  }
} # load_data_file

sub for_each_data_file ($) {
  my ($code) = @_;

  opendir my $data_dir, $data_dir_name or die "$0: $data_dir_name: $!";
  for (sort {$a cmp $b} readdir $data_dir) {
    next if /^\./; # hidden files
    next if /^_/; # editable but not-used files
    my $data_file_name = qq[$data_dir_name$_];
    next unless $data_file_name =~ /\Q$data_suffix\E$/;
    $code->($data_file_name, $_);
  }
} # for_each_data_file

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;

  my $had_file = -f $file_name;
  open my $file, '>:encoding(utf8)', $file_name or die "$0: $file_name: $!";
  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 clear_fallback_entries () {
  $FallbackEntry = {};
} # clear_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 clear_modified_hashes () {
  open my $file, '>', $patch_file_name;
  close $file;
} # clear_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;

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