1#!/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} 227