| #!/usr/bin/perl -w |
| |
| use strict; |
| |
| my %map; |
| |
| # sort comparison function |
| sub by_category($$) { |
| my ($a, $b) = @_; |
| |
| $a = uc $a; |
| $b = uc $b; |
| |
| # This always sorts last |
| $a =~ s/THE REST/ZZZZZZ/g; |
| $b =~ s/THE REST/ZZZZZZ/g; |
| |
| $a cmp $b; |
| } |
| |
| sub alpha_output { |
| my $key; |
| my $sort_method = \&by_category; |
| my $sep = ""; |
| |
| foreach $key (sort $sort_method keys %map) { |
| if ($key ne " ") { |
| print $sep . $key . "\n"; |
| $sep = "\n"; |
| } |
| print $map{$key}; |
| } |
| } |
| |
| sub trim { |
| my $s = shift; |
| $s =~ s/\s+$//; |
| $s =~ s/^\s+//; |
| return $s; |
| } |
| |
| sub file_input { |
| my $lastline = ""; |
| my $case = " "; |
| $map{$case} = ""; |
| |
| while (<>) { |
| my $line = $_; |
| |
| # Pattern line? |
| if ($line =~ m/^([A-Z]):\s*(.*)/) { |
| $line = $1 . ":\t" . trim($2) . "\n"; |
| if ($lastline eq "") { |
| $map{$case} = $map{$case} . $line; |
| next; |
| } |
| $case = trim($lastline); |
| exists $map{$case} and die "Header '$case' already exists"; |
| $map{$case} = $line; |
| $lastline = ""; |
| next; |
| } |
| |
| if ($case eq " ") { |
| $map{$case} = $map{$case} . $lastline; |
| $lastline = $line; |
| next; |
| } |
| trim($lastline) eq "" or die ("Odd non-pattern line '$lastline' for '$case'"); |
| $lastline = $line; |
| } |
| $map{$case} = $map{$case} . $lastline; |
| } |
| |
| &file_input; |
| &alpha_output; |
| exit(0); |