From 13da53e90b8b522a7acaf59db1b6c3a4c55c81b3 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 17 Mar 2024 12:19:18 -0700 Subject: [PATCH] Convert pod2man to current coding style Restructure the code a bit to reduce the complexity of the main routine. Be more careful about avoiding sending verbose output to standard output when formatting to standard output. --- scripts/pod2man.PL | 151 +++++++++++++++++++++++++++++---------------- t/data/perl.conf | 1 - 2 files changed, 97 insertions(+), 55 deletions(-) diff --git a/scripts/pod2man.PL b/scripts/pod2man.PL index 6c052d7..df91637 100755 --- a/scripts/pod2man.PL +++ b/scripts/pod2man.PL @@ -1,10 +1,11 @@ #!/usr/bin/perl # -# Special wrapper script to generate the actual pod2man script. This is +# Special wrapper script to generate the actual pod2man script. This is # required for proper start-up code on non-UNIX platforms, and is used inside # Perl core. use 5.012; +use autodie; use warnings; use Config qw(%Config); @@ -13,31 +14,29 @@ use File::Basename qw(basename dirname); # List explicitly here the variables you want Configure to generate. # Metaconfig only looks for shell variables, so you have to mention them as if -# they were shell variables, not %Config entries. Thus you write +# they were shell variables, not %Config entries. Thus you write # $startperl # to ensure Configure will look for $Config{startperl}. # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. -chdir(dirname($0)) or die "Cannot change directories: $!\n"; +chdir(dirname($0)); my $file = basename($0, '.PL'); if ($^O eq 'VMS') { $file .= '.com'; } # Create the generated script. -## no critic (InputOutput::RequireBriefOpen) -## no critic (InputOutput::RequireCheckedSyscalls) -open(my $out, '>', $file) or die "Cannot create $file: $!\n"; -print "Extracting $file (with variable substitutions)\n"; -## use critic +open(my $out, '>', $file); +print "Extracting $file (with variable substitutions)\n" + or die "$0: cannot write to stdout: $!\n"; # In this section, Perl variables will be expanded during extraction. You can # use $Config{...} to use Configure variables. print {$out} <<"PREAMBLE" or die "Cannot write to $file: $!\n"; $Config{startperl} - eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' - if 0; # ^ Run only under a shell +eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if 0; # ^ Run only under a shell PREAMBLE # In the following, Perl variables are not expanded during extraction. @@ -56,68 +55,110 @@ use Getopt::Long qw(GetOptions); use Pod::Man (); use Pod::Usage qw(pod2usage); +# Format a single POD file. +# +# $parser - Pod::Man object to use +# $input - Input file, - or undef for standard input +# $output - Output file, - or undef for standard output +# $verbose - Whether to print each file to standard output when converted +# +# Returns: 0 on no errors, 1 if there was an error +sub format_file { + my ($parser, $input, $output, $verbose) = @_; + my $to_stdout = !defined($output) || $output eq q{-}; + if ($verbose && !$to_stdout) { + print " $output\n" or warn "$0: cannot write to stdout: $!\n"; + } + $parser->parse_from_file($input, $output); + if ($parser->{CONTENTLESS}) { + if (defined($input) && $input ne q{-}) { + warn "$0: unable to format $input\n"; + } else { + warn "$0: unable to format standard input\n"; + } + if (!$to_stdout && !-s $output) { + unlink($output); + } + return 1; + } + return 0; +} + # Clean up $0 for error reporting. -$0 =~ s%.*/%%; +$0 =~ s{ .*/ }{}xms; # Insert -- into @ARGV before any single dash argument to hide it from # Getopt::Long; we want to interpret it as meaning stdin. my $stdin; -@ARGV = map { $_ eq '-' && !$stdin++ ? ('--', $_) : $_ } @ARGV; +local @ARGV = map { $_ eq q{-} && !$stdin++ ? (q{--}, $_) : $_ } @ARGV; # Parse our options, trying to retain backward compatibility with pod2man but # allowing short forms as well. --lax is currently ignored. my %options; -Getopt::Long::config ('bundling_override'); -GetOptions (\%options, 'center|c=s', 'date|d=s', 'encoding|e=s', 'errors=s', - 'fixed=s', 'fixedbold=s', 'fixeditalic=s', 'fixedbolditalic=s', - 'guesswork=s', 'help|h', 'lax|l', 'language=s', 'lquote=s', - 'name|n=s', 'nourls', 'official|o', 'quotes|q=s', 'release|r=s', - 'rquote=s', 'section|s=s', 'stderr', 'verbose|v', 'utf8|u') - or exit 1; -pod2usage (0) if $options{help}; +Getopt::Long::config('bundling_override'); +GetOptions( + \%options, + 'center|c=s', + 'date|d=s', + 'encoding|e=s', + 'errors=s', + 'fixed=s', + 'fixedbold=s', + 'fixeditalic=s', + 'fixedbolditalic=s', + 'guesswork=s', + 'help|h', + 'lax|l', + 'language=s', + 'lquote=s', + 'name|n=s', + 'nourls', + 'official|o', + 'quotes|q=s', + 'release|r=s', + 'rquote=s', + 'section|s=s', + 'stderr', + 'verbose|v', + 'utf8|u', +) or exit 1; +if ($options{help}) { + pod2usage(0); +} # Official sets --center, but don't override things explicitly set. -if ($options{official} && !defined $options{center}) { +if ($options{official} && !defined($options{center})) { $options{center} = 'Perl Programmers Reference Guide'; } -# Verbose is only our flag, not a Pod::Man flag. +# Delete flags that are only used in pod2man, not in Pod::Man. lax is accepted +# only for backward compatibility and does nothing. my $verbose = $options{verbose}; -delete $options{verbose}; +delete @options{qw(verbose lax official)}; -# This isn't a valid Pod::Man option and is only accepted for backward -# compatibility. -delete $options{lax}; - -# If neither stderr nor errors is set, default to errors = die. -if (!defined $options{stderr} && !defined $options{errors}) { +# If neither stderr nor errors is set, default to errors = die rather than the +# Pod::Man default of pod. +if (!defined($options{stderr}) && !defined($options{errors})) { $options{errors} = 'die'; } +# If given no arguments, read from stdin and write to stdout. +if (!@ARGV) { + push(@ARGV, q{-}); +} + # Initialize and run the formatter, pulling a pair of input and output off at -# a time. For each file, we check whether the document was completely empty +# a time. For each file, we check whether the document was completely empty # and, if so, will remove the created file and exit with a non-zero exit # status. -my $parser = Pod::Man->new (%options); +my $parser = Pod::Man->new(%options); my $status = 0; -my @files; -do { - @files = splice (@ARGV, 0, 2); - print " $files[1]\n" if $verbose; - $parser->parse_from_file (@files); - if ($parser->{CONTENTLESS}) { - $status = 1; - if (defined $files[0]) { - warn "$0: unable to format $files[0]\n"; - } else { - warn "$0: unable to format standard input\n"; - } - if (defined ($files[1]) and $files[1] ne '-') { - unlink $files[1] unless (-s $files[1]); - } - } -} while (@ARGV); -exit $status; +while (@ARGV) { + my ($input, $output) = splice(@ARGV, 0, 2); + my $result = format_file($parser, $input, $output, $verbose); + $status ||= $result; +} +exit($status); __END__ @@ -380,6 +421,8 @@ recommended to set a meaningful manual page name. [2.5.0] Normally, LZ<><> formatting codes with a URL but anchor text are formatted to show both the anchor text and the URL. In other words: +=for ProhibitVerbatimMarkup allow next + L is formatted as: @@ -504,10 +547,10 @@ under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L, L, -L, L, L, L +L, L, L -The man page documenting the an macro set may be L instead of -L on your system. +The man page documenting the C macro set is usually either L or +L depending on the system. The current version of this script is always available from its web site at L. It is also part of the @@ -517,8 +560,8 @@ Perl core distribution as of 5.6.0. SCRIPT_BODY # Finish the generation of the script. -close($out) or die "Cannot close $file: $!\n"; -chmod(0755, $file) or die "Cannot reset permissions for $file: $!\n"; +close($out); +chmod(0755, $file); if ($Config{'eunicefix'} ne q{:}) { exec("$Config{'eunicefix'} $file"); } diff --git a/t/data/perl.conf b/t/data/perl.conf index 28fdc2f..26bbd47 100644 --- a/t/data/perl.conf +++ b/t/data/perl.conf @@ -9,7 +9,6 @@ blib/lib/Pod/Text/Color.pm blib/lib/Pod/Text/Overstrike.pm blib/lib/Pod/Text/Termcap.pm - blib/script/pod2man blib/script/pod2text );