html5/spec-ja/common.pl

use strict;

my $data_suffix = q[.dat];
my $data_dir_name = q[data/];

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

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,
      $id_variant_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;
    }
  }

  for my $p (keys %$exact_data) {
    next if $p =~ /\bhref="#/;
    my $o = $p;
    $p = quotemeta $p;
    my @oldname;
    $p =~ s{\bhref\\=\\"\\#([^"]+)"}{
      push @oldname, $1;
      'href="#([^"]+)"';
    }ge;
    $id_variant_pattern_data->{$p} = [$exact_data->{$o}, \@oldname, $o];
  }
} # 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

1;

1	use strict;
2
3	my $data_suffix = q[.dat];
4	my $data_dir_name = q[data/];
5
6	sub normalize ($) {
7	my $s = shift;
8	$s =~ s/\s+/ /g;
9	$s =~ s/^ //;
10	$s =~ s/ $//g;
11	return $s;
12	} # normalize
13
14	sub create_pattern1 ($) {
15	my $s = quotemeta shift;
16	$s =~ s/\\\*/(.+)/g;
17	return $s;
18	} # create_pattern1
19
20	sub replace_pattern2 ($@) {
21	my $s = shift;
22	my @arg = @_;
23	$s =~ s/\$(\d+)/$arg[$1 - 1]/g;
24	return $s;
25	} # replace_pattern2
26
27	sub load_data_file ($$$$) {
28	my ($data_file_name, $exact_data, $pattern_data,
29	$id_variant_pattern_data) = @_;
30
31	open my $data_file, '<:utf8', $data_file_name
32	or die "$0: $data_file_name: $!";
33	local $/ = undef;
34	my $data = <$data_file>;
35	$data =~ s/\x0D?\x0A/\n/g;
36	for (split /\n\n+(?=#)/, $data) {
37	my ($en, $ja) = split /\n#ja\n/, $_;
38	if ($en =~ s/^#en\n//) {
39	$exact_data->{normalize ($en)} = $ja;
40	} elsif ($en =~ s/^#pattern\n//) {
41	$pattern_data->{create_pattern1 (normalize ($en))} = $ja;
42	}
43	}
44
45	for my $p (keys %$exact_data) {
46	next if $p =~ /\bhref="#/;
47	my $o = $p;
48	$p = quotemeta $p;
49	my @oldname;
50	$p =~ s{\bhref\\=\\"\\#([^"]+)"}{
51	push @oldname, $1;
52	'href="#([^"]+)"';
53	}ge;
54	$id_variant_pattern_data->{$p} = [$exact_data->{$o}, \@oldname, $o];
55	}
56	} # load_data_file
57
58	sub for_each_data_file ($) {
59	my ($code) = @_;
60
61	opendir my $data_dir, $data_dir_name or die "$0: $data_dir_name: $!";
62	for (sort {$a cmp $b} readdir $data_dir) {
63	next if /^\./; # hidden files
64	next if /^_/; # editable but not-used files
65	my $data_file_name = qq[$data_dir_name$_];
66	next unless $data_file_name =~ /\Q$data_suffix\E$/;
67	$code->($data_file_name, $_);
68	}
69	} # for_each_data_file
70
71	1;
72