]>
Commit | Line | Data |
---|---|---|
7683e9e5 LT |
1 | #!/usr/bin/perl -w |
2 | ||
3 | use strict; | |
4 | ||
5 | my %map; | |
6 | ||
7 | # sort comparison function | |
8 | sub by_category($$) { | |
9 | my ($a, $b) = @_; | |
10 | ||
11 | $a = uc $a; | |
12 | $b = uc $b; | |
13 | ||
14 | # This always sorts last | |
15 | $a =~ s/THE REST/ZZZZZZ/g; | |
16 | $b =~ s/THE REST/ZZZZZZ/g; | |
17 | ||
18 | $a cmp $b; | |
19 | } | |
20 | ||
21 | sub alpha_output { | |
22 | my $key; | |
23 | my $sort_method = \&by_category; | |
24 | my $sep = ""; | |
25 | ||
26 | foreach $key (sort $sort_method keys %map) { | |
27 | if ($key ne " ") { | |
28 | print $sep . $key . "\n"; | |
29 | $sep = "\n"; | |
30 | } | |
31 | print $map{$key}; | |
32 | } | |
33 | } | |
34 | ||
35 | sub trim { | |
36 | my $s = shift; | |
37 | $s =~ s/\s+$//; | |
38 | $s =~ s/^\s+//; | |
39 | return $s; | |
40 | } | |
41 | ||
42 | sub file_input { | |
43 | my $lastline = ""; | |
44 | my $case = " "; | |
45 | $map{$case} = ""; | |
46 | ||
47 | while (<>) { | |
48 | my $line = $_; | |
49 | ||
50 | # Pattern line? | |
51 | if ($line =~ m/^([A-Z]):\s*(.*)/) { | |
52 | $line = $1 . ":\t" . trim($2) . "\n"; | |
53 | if ($lastline eq "") { | |
54 | $map{$case} = $map{$case} . $line; | |
55 | next; | |
56 | } | |
57 | $case = trim($lastline); | |
58 | exists $map{$case} and die "Header '$case' already exists"; | |
59 | $map{$case} = $line; | |
60 | $lastline = ""; | |
61 | next; | |
62 | } | |
63 | ||
64 | if ($case eq " ") { | |
65 | $map{$case} = $map{$case} . $lastline; | |
66 | $lastline = $line; | |
67 | next; | |
68 | } | |
69 | trim($lastline) eq "" or die ("Odd non-pattern line '$lastline' for '$case'"); | |
70 | $lastline = $line; | |
71 | } | |
72 | $map{$case} = $map{$case} . $lastline; | |
73 | } | |
74 | ||
75 | &file_input; | |
76 | &alpha_output; | |
77 | exit(0); |