10 use Packages::CommonCode qw(:all);
15 my $lrx = qr/[a-z]{2}(-[a-z]{2})?/;
16 my $ulrx = qr/[A-Z]{2}(-[A-Z]{2})?/;
18 while ($_ = shift @ARGV) {
22 or die "Invalid lang $_\n";
27 while ($_ = shift @ARGV) {
28 /\.slices$/ or die "Invalid file $_\n";
33 if (!@langs || !@files) {
34 die "No langs or no files\n";
37 warn "langs=@langs\nfiles=@files\n";
39 foreach my $file (@files) {
40 my ($name, $path, undef) = fileparse($file,qw(.slices));
42 warn "name=$name path=$path out=$path$name.LANG.html.new\n";
45 foreach my $lang (@langs) {
46 my $ulang = uc($lang);
47 open($out{$ulang}, '>',
48 "$path$name.$lang.html.new")
49 or die "Couldn't open $path$name.$lang.html.new\n";
52 open my $in, '<', $file
53 or die "Couldn't open $file\n";
59 /^\[($ulrx):$/o && do {
60 # warn "open slice $1";
61 die "Nested slices" if $active_lang;
62 die "Unknown lang $1" unless exists $out{$1};
66 /^:($ulrx)\]$/o && do {
67 # warn "close slice $1";
68 die "No open slice" unless $active_lang;
69 die "Overlapping slices" unless $1 eq $active_lang;
74 !$active_lang && /\[($ulrx):.*?:($ulrx)\]/o && do {
75 # warn "slices found";
77 foreach my $l (keys %out) {
80 $tmp =~ s/\[\Q$l\E:(.*?):\Q$l\E\]/$1/g;
81 $tmp =~ s/\[($ulrx):.*?:($ulrx)\]//g;
83 print {$out{$l}} $tmp;
89 print {$out{$active_lang}} $_;
91 foreach my $l (keys %out) {
97 foreach my $lang (@langs) {
98 my $ulang = uc($lang);
100 or die "Couldn't close $path$name.$lang.html.new\n";
101 activate("$path$name.$lang.html");