1#!/usr/bin/perl
2# SPDX-FileCopyrightText: Amolith <amolith@secluded.site>
3#
4# SPDX-License-Identifier: GPL-3.0-or-later
5
6use strict;
7use warnings;
8
9my $WIDTH = 72;
10
11my $mode = shift @ARGV;
12unless (defined $mode && ($mode eq 'subject' || $mode eq 'message')) {
13 print STDERR "Usage: format subject \"text\" | format message < file\n";
14 exit 1;
15}
16
17if ($mode eq 'subject') {
18 my $subject = shift @ARGV;
19 unless (defined $subject) {
20 print STDERR "subject mode requires a subject argument\n";
21 exit 1;
22 }
23 if (length($subject) > 50) {
24 print STDERR "Subject exceeds 50 characters (" . length($subject) . ")\n";
25 exit 1;
26 }
27 print $subject;
28 exit 0;
29}
30
31# Message mode: read full message from stdin, format it, emit to stdout.
32my @all_lines = <STDIN>;
33chomp @all_lines;
34
35unless (@all_lines) {
36 print STDERR "Empty message\n";
37 exit 1;
38}
39
40# First line is the subject.
41my $subject = $all_lines[0];
42if (length($subject) > 50) {
43 print STDERR "Subject exceeds 50 characters (" . length($subject) . ")\n";
44 exit 1;
45}
46
47# Subject only — no body or trailers.
48if (@all_lines == 1) {
49 print "$subject\n";
50 exit 0;
51}
52
53# Skip the blank line after the subject.
54my $start = 1;
55$start++ if $start < @all_lines && $all_lines[$start] =~ /^\s*$/;
56
57# Nothing after the subject (just trailing blanks).
58if ($start >= @all_lines) {
59 print "$subject\n";
60 exit 0;
61}
62
63my @rest = @all_lines[$start .. $#all_lines];
64
65# Detect trailer block by scanning backward. Trailers are Key: value lines at
66# the end of the message (after skipping trailing blank lines). The key must
67# start with a letter and contain only letters, digits, and hyphens.
68my $scan = $#rest;
69
70# Skip trailing blank lines.
71$scan-- while $scan >= 0 && $rest[$scan] =~ /^\s*$/;
72
73my $trailer_end = $scan; # last non-blank line
74
75# Collect trailer lines.
76while ($scan >= 0 && $rest[$scan] =~ /^[A-Za-z][A-Za-z0-9-]*: ./) {
77 $scan--;
78}
79
80my $trailer_start = $scan + 1;
81my @trailers;
82if ($trailer_start <= $trailer_end) {
83 @trailers = @rest[$trailer_start .. $trailer_end];
84}
85
86# Body is everything before the trailer block, with trailing blanks trimmed.
87my @body_lines;
88if ($trailer_start > 0) {
89 my $body_end = $trailer_start - 1;
90 # Trim trailing blank lines from the body.
91 $body_end-- while $body_end >= 0 && $rest[$body_end] =~ /^\s*$/;
92 @body_lines = @rest[0 .. $body_end] if $body_end >= 0;
93}
94
95# Reflow the body.
96my $formatted_body = reflow_body(@body_lines);
97
98# Assemble output.
99print "$subject\n";
100if ($formatted_body ne '') {
101 print "\n$formatted_body\n";
102}
103if (@trailers) {
104 print "\n", join("\n", @trailers), "\n";
105}
106
107exit 0;
108
109# --- Subroutines ---
110
111sub reflow_body {
112 my @lines = @_;
113 return '' unless @lines;
114
115 my @result;
116 my @plain_buffer;
117
118 my $flush_plain = sub {
119 if (@plain_buffer) {
120 my $joined = join(' ', @plain_buffer);
121 push @result, word_wrap($joined, $WIDTH);
122 @plain_buffer = ();
123 }
124 };
125
126 for my $line (@lines) {
127 # Code blocks: 4+ leading spaces or tab — preserve as-is.
128 if ($line =~ /^(?: |\t)/) {
129 $flush_plain->();
130 push @result, $line;
131 next;
132 }
133
134 (my $trimmed = $line) =~ s/^\s+|\s+$//g;
135
136 # Blank lines.
137 if ($trimmed eq '') {
138 $flush_plain->();
139 push @result, '';
140 next;
141 }
142
143 # Bullet lists (- or *).
144 if ($trimmed =~ /^([*-] )(.*)/) {
145 $flush_plain->();
146 my ($marker, $content) = ($1, $2);
147 push @result, wrap_hanging($marker, ' ', $content, $WIDTH);
148 next;
149 }
150
151 # Numbered lists (1. , 2. , 10. , etc.).
152 if ($trimmed =~ /^(\d+\.\s)(.*)/) {
153 $flush_plain->();
154 my $marker = $1;
155 my $content = defined $2 ? $2 : '';
156 my $indent = ' ' x length($marker);
157 push @result, wrap_hanging($marker, $indent, $content, $WIDTH);
158 next;
159 }
160
161 # Plain text: buffer for paragraph reflow.
162 push @plain_buffer, $trimmed;
163 }
164
165 $flush_plain->();
166 return join("\n", @result);
167}
168
169sub word_wrap {
170 my ($text, $width) = @_;
171 my @words = split /\s+/, $text;
172 return '' unless @words;
173
174 my @lines;
175 my $current = '';
176 my $current_width = 0;
177
178 for my $word (@words) {
179 my $wlen = length($word);
180 if ($current eq '') {
181 $current = $word;
182 $current_width = $wlen;
183 } elsif ($current_width + 1 + $wlen <= $width) {
184 $current .= " $word";
185 $current_width += 1 + $wlen;
186 } else {
187 push @lines, $current;
188 $current = $word;
189 $current_width = $wlen;
190 }
191 }
192 push @lines, $current if $current ne '';
193 return join("\n", @lines);
194}
195
196sub wrap_hanging {
197 my ($first_prefix, $cont_prefix, $text, $width) = @_;
198 my $first_width = $width - length($first_prefix);
199 my $cont_width = $width - length($cont_prefix);
200
201 my @words = split /\s+/, $text;
202 return $first_prefix unless @words;
203
204 my @lines;
205 my $current = '';
206 my $current_width = 0;
207 my $is_first = 1;
208
209 for my $word (@words) {
210 my $wlen = length($word);
211 my $max = $is_first ? $first_width : $cont_width;
212
213 if ($current eq '') {
214 $current = $word;
215 $current_width = $wlen;
216 } elsif ($current_width + 1 + $wlen <= $max) {
217 $current .= " $word";
218 $current_width += 1 + $wlen;
219 } else {
220 my $prefix = $is_first ? $first_prefix : $cont_prefix;
221 push @lines, $prefix . $current;
222 $is_first = 0;
223 $current = $word;
224 $current_width = $wlen;
225 }
226 }
227
228 if ($current ne '') {
229 my $prefix = $is_first ? $first_prefix : $cont_prefix;
230 push @lines, $prefix . $current;
231 }
232
233 return join("\n", @lines);
234}