1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677 |
- #!/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);
|