| #!/usr/bin/env perl |
| #*************************************************************************** |
| # _ _ ____ _ |
| # Project ___| | | | _ \| | |
| # / __| | | | |_) | | |
| # | (__| |_| | _ <| |___ |
| # \___|\___/|_| \_\_____| |
| # |
| # Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al. |
| # |
| # This software is licensed as described in the file COPYING, which |
| # you should have received as part of this distribution. The terms |
| # are also available at https://curl.se/docs/copyright.html. |
| # |
| # You may opt to use, copy, modify, merge, publish, distribute and/or sell |
| # copies of the Software, and permit persons to whom the Software is |
| # furnished to do so, under the terms of the COPYING file. |
| # |
| # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY |
| # KIND, either express or implied. |
| # |
| # SPDX-License-Identifier: curl |
| # |
| ########################################################################### |
| |
| =begin comment |
| |
| This script updates a curldown file to current/better curldown. |
| |
| Example: cd2cd [--in-place] <file.md> > <file.md> |
| |
| --in-place: if used, it replaces the original file with the cleaned up |
| version. When this is used, cd2cd accepts multiple files to work |
| on and it ignores errors on single files. |
| |
| =end comment |
| =cut |
| |
| my $cd2cd = "0.1"; # to keep check |
| my $dir; |
| my $extension; |
| my $inplace = 0; |
| |
| while(1) { |
| if($ARGV[0] eq "--in-place") { |
| shift @ARGV; |
| $inplace = 1; |
| } |
| else { |
| last; |
| } |
| } |
| |
| |
| use POSIX qw(strftime); |
| my @ts; |
| if (defined($ENV{SOURCE_DATE_EPOCH})) { |
| @ts = localtime($ENV{SOURCE_DATE_EPOCH}); |
| } else { |
| @ts = localtime; |
| } |
| my $date = strftime "%B %d %Y", @ts; |
| |
| sub outseealso { |
| my (@sa) = @_; |
| my $comma = 0; |
| my @o; |
| push @o, ".SH SEE ALSO\n"; |
| for my $s (sort @sa) { |
| push @o, sprintf "%s.BR $s", $comma ? ",\n": ""; |
| $comma = 1; |
| } |
| push @o, "\n"; |
| return @o; |
| } |
| |
| sub single { |
| my @head; |
| my @seealso; |
| my ($f)=@_; |
| my $title; |
| my $section; |
| my $source; |
| my $start = 0; |
| my $d; |
| my $line = 0; |
| open(F, "<:crlf", "$f") || |
| return 1; |
| while(<F>) { |
| $line++; |
| $d = $_; |
| if(!$start) { |
| if(/^---/) { |
| # header starts here |
| $start = 1; |
| push @head, $d; |
| } |
| next; |
| } |
| if(/^Title: *(.*)/i) { |
| $title=$1; |
| } |
| elsif(/^Section: *(.*)/i) { |
| $section=$1; |
| } |
| elsif(/^Source: *(.*)/i) { |
| $source=$1; |
| } |
| elsif(/^See-also: +(.*)/i) { |
| $salist = 0; |
| push @seealso, $1; |
| } |
| elsif(/^See-also: */i) { |
| if($seealso[0]) { |
| print STDERR "$f:$line:1:ERROR: bad See-Also, needs list\n"; |
| return 2; |
| } |
| $salist = 1; |
| } |
| elsif(/^ +- (.*)/i) { |
| # the only list we support is the see-also |
| if($salist) { |
| push @seealso, $1; |
| } |
| } |
| # REUSE-IgnoreStart |
| elsif(/^C: (.*)/i) { |
| $copyright=$1; |
| } |
| elsif(/^SPDX-License-Identifier: (.*)/i) { |
| $spdx=$1; |
| } |
| # REUSE-IgnoreEnd |
| elsif(/^---/) { |
| # end of the header section |
| if(!$title) { |
| print STDERR "ERROR: no 'Title:' in $f\n"; |
| return 1; |
| } |
| if(!$section) { |
| print STDERR "ERROR: no 'Section:' in $f\n"; |
| return 2; |
| } |
| if(!$seealso[0]) { |
| print STDERR "$f:$line:1:ERROR: no 'See-also:' present\n"; |
| return 2; |
| } |
| if(!$copyright) { |
| print STDERR "$f:$line:1:ERROR: no 'C:' field present\n"; |
| return 2; |
| } |
| if(!$spdx) { |
| print STDERR "$f:$line:1:ERROR: no 'SPDX-License-Identifier:' field present\n"; |
| return 2; |
| } |
| last; |
| } |
| else { |
| chomp; |
| print STDERR "WARN: unrecognized line in $f, ignoring:\n:'$_';" |
| } |
| } |
| |
| if(!$start) { |
| print STDERR "$f:$line:1:ERROR: no header present\n"; |
| return 2; |
| } |
| |
| my @desc; |
| |
| push @desc, sprintf <<HEAD |
| --- |
| c: Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al. |
| SPDX-License-Identifier: curl |
| Title: $title |
| Section: $section |
| Source: $source |
| HEAD |
| ; |
| push @desc, "See-also:\n"; |
| for my $s (sort @seealso) { |
| push @desc, " - $s\n" if($s); |
| } |
| push @desc, "---\n"; |
| |
| my $blankline = 0; |
| while(<F>) { |
| $d = $_; |
| $line++; |
| if($d =~ /^[ \t]*\n/) { |
| $blankline++; |
| } |
| else { |
| $blankline = 0; |
| } |
| # *italics* for curl symbol links get the asterisks removed |
| $d =~ s/\*((lib|)curl[^ ]*\(3\))\*/$1/gi; |
| |
| if(length($d) > 90) { |
| print STDERR "$f:$line:1:WARN: excessive line length\n"; |
| } |
| |
| push @desc, $d if($blankline < 2); |
| } |
| close(F); |
| |
| if($inplace) { |
| open(O, ">$f") || return 1; |
| print O @desc; |
| close(O); |
| } |
| else { |
| print @desc; |
| } |
| return 0; |
| } |
| |
| if($inplace) { |
| for my $a (@ARGV) { |
| # this ignores errors |
| single($a); |
| } |
| } |
| else { |
| exit single($ARGV[0]); |
| } |