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	wakaba	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	wakaba	1.4	sub load_data_file ($$$$) {
28			my ($data_file_name, $exact_data, $pattern_data,
29			$id_variant_pattern_data) = @_;
30	wakaba	1.1
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	wakaba	1.4	}
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	wakaba	1.1	}
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	wakaba	1.2	next if /^_/; # editable but not-used files
65	wakaba	1.1	my $data_file_name = qq[$data_dir_name$_];
66			next unless $data_file_name =~ /\Q$data_suffix\E$/;
67	wakaba	1.3	$code->($data_file_name, $_);
68	wakaba	1.1	}
69			} # for_each_data_file
70
71			1;
72