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