Complete rewrite of create_index_pages

[deb/packages.git] / bin / trivial_slice

diff --git a/bin/trivial_slice b/bin/trivial_slice
new file mode 100755 (executable)
index 0000000..63c6a2e
--- /dev/null
+++ b/bin/trivial_slice
@@ -0,0 +1,103 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Basename;
+
+use lib './lib';
+
+use Packages::CommonCode qw(:all);
+
+my @langs;
+my @files;
+
+my $lrx = qr/[a-z]{2}(-[a-z]{2})?/;
+my $ulrx = qr/[A-Z]{2}(-[A-Z]{2})?/;
+
+while ($_ = shift @ARGV) {
+    last if $_ eq '--';
+
+    /^$lrx$/
+       or die "Invalid lang $_\n";
+
+    push @langs, $_;
+}
+
+while ($_ = shift @ARGV) {
+    /\.slices$/ or die "Invalid file $_\n";
+
+    push @files, $_;
+}
+
+if (!@langs || !@files) {
+    die "No langs or no files\n";
+}
+
+warn "langs=@langs\nfiles=@files\n";
+
+foreach my $file (@files) {
+    my ($name, $path, undef) = fileparse($file,qw(.slices));
+
+    warn "name=$name path=$path out=$path$name.LANG.html.tmp\n";
+
+    my %out;
+    foreach my $lang (@langs) {
+       my $ulang = uc($lang);
+       open($out{$ulang}, '>',
+            "$path$name.$lang.html.tmp")
+           or die "Couldn't open $path$name.$lang.html.tmp\n";
+    }
+
+    open my $in, '<', $file
+       or die "Couldn't open $file\n";
+
+    my $active_lang;
+    while (<$in>) {
+       /^\s*$/o && next;
+
+       /^\[($ulrx):$/o && do {
+#          warn "open slice $1";
+           die "Nested slices" if $active_lang;
+           die "Unknown lang $1" unless exists $out{$1};
+           $active_lang = $1;
+           next;
+       };
+       /^:($ulrx)\]$/o && do {
+#          warn "close slice $1";
+           die "No open slice" unless $active_lang;
+           die "Overlapping slices" unless $1 eq $active_lang;
+           $active_lang = undef;
+           next;
+       };
+
+       !$active_lang && /\[($ulrx):.*?:($ulrx)\]/o && do {
+#          warn "slices found";
+
+           foreach my $l (keys %out) {
+               my $tmp = $_;
+
+               $tmp =~ s/\[\Q$l\E:(.*?):\Q$l\E\]/$1/g;
+               $tmp =~ s/\[($ulrx):.*?:($ulrx)\]//g;
+
+               print {$out{$l}} $tmp;
+           }
+           next;
+       };
+
+       if ($active_lang) {
+           print {$out{$active_lang}} $_;
+       } else {
+           foreach my $l (keys %out) {
+               print {$out{$l}} $_;
+           }
+       }
+    }
+
+    foreach my $lang (keys %out) {
+       close($out{$lang})
+           or die "Couldn't close $path$name.$lang.html.tmp\n";
+       activate("$path$name.$lang.html");
+    }
+
+}