blob: 4b47efe300df995304928a1c5e69062ce2a111bb [file] [log] [blame]
Yegor Timoshenkoc2e49412018-10-07 01:58:27 +00001#!/usr/bin/env perl
Martin Rothbe08c1d2024-02-16 09:12:33 -07002# SPDX-License-Identifier: GPL-2.0-only
Paul Menzel44ad86a2017-07-24 13:43:05 +02003
4use strict;
Yegor Timoshenkoc2e49412018-10-07 01:58:27 +00005use warnings;
Paul Menzel44ad86a2017-07-24 13:43:05 +02006
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);