bin/trivial_slice

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use File::Basename;
   7
   8 use lib './lib';
   9
  10 use Packages::CommonCode qw(:all);
  11
  12 my @langs;
  13 my @files;
  14
  15 my $lrx = qr/[a-z]{2}(-[a-z]{2})?/;
  16 my $ulrx = qr/[A-Z]{2}(-[A-Z]{2})?/;
  17
  18 while ($_ = shift @ARGV) {
  19     last if $_ eq '--';
  20
  21     /^$lrx$/
  22         or die "Invalid lang $_\n";
  23
  24     push @langs, $_;
  25 }
  26
  27 while ($_ = shift @ARGV) {
  28     /\.slices$/ or die "Invalid file $_\n";
  29
  30     push @files, $_;
  31 }
  32
  33 if (!@langs || !@files) {
  34     die "No langs or no files\n";
  35 }
  36
  37 warn "langs=@langs\nfiles=@files\n";
  38
  39 foreach my $file (@files) {
  40     my ($name, $path, undef) = fileparse($file,qw(.slices));
  41
  42     warn "name=$name path=$path out=$path$name.LANG.html.new\n";
  43
  44     my %out;
  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";
  50     }
  51
  52     open my $in, '<', $file
  53         or die "Couldn't open $file\n";
  54
  55     my $active_lang;
  56     while (<$in>) {
  57         /^\s*$/o && next;
  58
  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};
  63             $active_lang = $1;
  64             next;
  65         };
  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;
  70             $active_lang = undef;
  71             next;
  72         };
  73
  74         !$active_lang && /\[($ulrx):.*?:($ulrx)\]/o && do {
  75 #           warn "slices found";
  76
  77             foreach my $l (keys %out) {
  78                 my $tmp = $_;
  79
  80                 $tmp =~ s/\[\Q$l\E:(.*?):\Q$l\E\]/$1/g;
  81                 $tmp =~ s/\[($ulrx):.*?:($ulrx)\]//g;
  82
  83                 print {$out{$l}} $tmp;
  84             }
  85             next;
  86         };
  87
  88         if ($active_lang) {
  89             print {$out{$active_lang}} $_;
  90         } else {
  91             foreach my $l (keys %out) {
  92                 print {$out{$l}} $_;
  93             }
  94         }
  95     }
  96
  97     foreach my $lang (@langs) {
  98         my $ulang = uc($lang);
  99         close($out{$ulang})
 100             or die "Couldn't close $path$name.$lang.html.new\n";
 101         activate("$path$name.$lang.html");
 102     }
 103
 104 }