1#!/usr/bin/perl -w
2
3use strict;
4
5my %map;
6
7# sort comparison function
8sub 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
21sub 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
35sub trim {
36    my $s = shift;
37    $s =~ s/\s+$//;
38    $s =~ s/^\s+//;
39    return $s;
40}
41
42sub 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;
77exit(0);
78