| #!/usr/bin/env perl | |
| # SPDX-License-Identifier: GPL-2.0-only | |
| use strict; | |
| use warnings; | |
| 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); |