Complete rewrite of create_index_pages
[deb/packages.git] / 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.tmp\n";
43
44     my %out;
45     foreach my $lang (@langs) {
46         my $ulang = uc($lang);
47         open($out{$ulang}, '>',
48              "$path$name.$lang.html.tmp")
49             or die "Couldn't open $path$name.$lang.html.tmp\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 (keys %out) {
98         close($out{$lang})
99             or die "Couldn't close $path$name.$lang.html.tmp\n";
100         activate("$path$name.$lang.html");
101     }
102
103 }