blob: a4de2f8757f410516e7b52758d0d816671c79e15 [file] [log] [blame]
Daniel Stenbergeefcc1b2024-01-17 11:32:44 +01001#!/usr/bin/env perl
2#***************************************************************************
3# _ _ ____ _
4# Project ___| | | | _ \| |
5# / __| | | | |_) | |
6# | (__| |_| | _ <| |___
7# \___|\___/|_| \_\_____|
8#
9# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
10#
11# This software is licensed as described in the file COPYING, which
12# you should have received as part of this distribution. The terms
13# are also available at https://curl.se/docs/copyright.html.
14#
15# You may opt to use, copy, modify, merge, publish, distribute and/or sell
16# copies of the Software, and permit persons to whom the Software is
17# furnished to do so, under the terms of the COPYING file.
18#
19# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
20# KIND, either express or implied.
21#
22# SPDX-License-Identifier: curl
23#
24###########################################################################
25
26=begin comment
27
28This script updates a curldown file to current/better curldown.
29
30Example: cd2cd [--in-place] <file.md> > <file.md>
31
32--in-place: if used, it replaces the original file with the cleaned up
33 version. When this is used, cd2cd accepts multiple files to work
34 on and it ignores errors on single files.
35
36=end comment
37=cut
38
39my $cd2cd = "0.1"; # to keep check
40my $dir;
41my $extension;
42my $inplace = 0;
43
44while(1) {
45 if($ARGV[0] eq "--in-place") {
46 shift @ARGV;
47 $inplace = 1;
48 }
49 else {
50 last;
51 }
52}
53
54
55use POSIX qw(strftime);
56my @ts;
57if (defined($ENV{SOURCE_DATE_EPOCH})) {
58 @ts = localtime($ENV{SOURCE_DATE_EPOCH});
59} else {
60 @ts = localtime;
61}
62my $date = strftime "%B %d %Y", @ts;
63
64sub outseealso {
65 my (@sa) = @_;
66 my $comma = 0;
67 my @o;
68 push @o, ".SH SEE ALSO\n";
69 for my $s (sort @sa) {
70 push @o, sprintf "%s.BR $s", $comma ? ",\n": "";
71 $comma = 1;
72 }
73 push @o, "\n";
74 return @o;
75}
76
77sub single {
78 my @head;
79 my @seealso;
80 my ($f)=@_;
81 my $title;
82 my $section;
83 my $source;
84 my $start = 0;
85 my $d;
86 my $line = 0;
87 open(F, "<:crlf", "$f") ||
88 return 1;
89 while(<F>) {
90 $line++;
91 $d = $_;
92 if(!$start) {
93 if(/^---/) {
94 # header starts here
95 $start = 1;
96 push @head, $d;
97 }
98 next;
99 }
100 if(/^Title: *(.*)/i) {
101 $title=$1;
102 }
103 elsif(/^Section: *(.*)/i) {
104 $section=$1;
105 }
106 elsif(/^Source: *(.*)/i) {
107 $source=$1;
108 }
109 elsif(/^See-also: +(.*)/i) {
110 $salist = 0;
111 push @seealso, $1;
112 }
113 elsif(/^See-also: */i) {
114 if($seealso[0]) {
115 print STDERR "$f:$line:1:ERROR: bad See-Also, needs list\n";
116 return 2;
117 }
118 $salist = 1;
119 }
120 elsif(/^ +- (.*)/i) {
121 # the only list we support is the see-also
122 if($salist) {
123 push @seealso, $1;
124 }
125 }
126 # REUSE-IgnoreStart
127 elsif(/^C: (.*)/i) {
128 $copyright=$1;
129 }
130 elsif(/^SPDX-License-Identifier: (.*)/i) {
131 $spdx=$1;
132 }
133 # REUSE-IgnoreEnd
134 elsif(/^---/) {
135 # end of the header section
136 if(!$title) {
137 print STDERR "ERROR: no 'Title:' in $f\n";
138 return 1;
139 }
140 if(!$section) {
141 print STDERR "ERROR: no 'Section:' in $f\n";
142 return 2;
143 }
144 if(!$seealso[0]) {
145 print STDERR "$f:$line:1:ERROR: no 'See-also:' present\n";
146 return 2;
147 }
148 if(!$copyright) {
149 print STDERR "$f:$line:1:ERROR: no 'C:' field present\n";
150 return 2;
151 }
152 if(!$spdx) {
153 print STDERR "$f:$line:1:ERROR: no 'SPDX-License-Identifier:' field present\n";
154 return 2;
155 }
156 last;
157 }
158 else {
159 chomp;
160 print STDERR "WARN: unrecognized line in $f, ignoring:\n:'$_';"
161 }
162 }
163
164 if(!$start) {
165 print STDERR "$f:$line:1:ERROR: no header present\n";
166 return 2;
167 }
168
169 my @desc;
170
171 push @desc, sprintf <<HEAD
172---
173c: Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
174SPDX-License-Identifier: curl
175Title: $title
176Section: $section
177Source: $source
178HEAD
179 ;
180 push @desc, "See-also:\n";
181 for my $s (sort @seealso) {
182 push @desc, " - $s\n" if($s);
183 }
184 push @desc, "---\n";
185
186 my $blankline = 0;
187 while(<F>) {
188 $d = $_;
189 $line++;
190 if($d =~ /^[ \t]*\n/) {
191 $blankline++;
192 }
193 else {
194 $blankline = 0;
195 }
196 # *italics* for curl symbol links get the asterisks removed
197 $d =~ s/\*((lib|)curl[^ ]*\(3\))\*/$1/gi;
198
199 if(length($d) > 90) {
200 print STDERR "$f:$line:1:WARN: excessive line length\n";
201 }
202
203 push @desc, $d if($blankline < 2);
204 }
205 close(F);
206
207 if($inplace) {
208 open(O, ">$f") || return 1;
209 print O @desc;
210 close(O);
211 }
212 else {
213 print @desc;
214 }
215 return 0;
216}
217
218if($inplace) {
219 for my $a (@ARGV) {
220 # this ignores errors
221 single($a);
222 }
223}
224else {
225 exit single($ARGV[0]);
226}