diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Man.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Pod/Man.pm | 325 |
1 files changed, 220 insertions, 105 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Man.pm b/Master/tlpkg/tlperl/lib/Pod/Man.pm index 72ca9ff1da9..b739559551d 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Man.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Man.pm @@ -11,9 +11,10 @@ # me any patches at the address above in addition to sending them to the # standard Perl mailing lists. # -# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, -# 2010, 2012, 2013 Russ Allbery <rra@stanford.edu> +# Written by Russ Allbery <rra@cpan.org> # Substantial contributions by Sean Burke <sburke@cpan.org> +# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +# 2010, 2012, 2013, 2014, 2015, 2016 Russ Allbery <rra@cpan.org> # # This program is free software; you may redistribute it and/or modify it # under the same terms as Perl itself. @@ -24,19 +25,25 @@ package Pod::Man; -require 5.005; - +use 5.006; use strict; +use warnings; + use subs qw(makespace); use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION); -use Carp qw(croak); -use Encode qw(encode); +use Carp qw(carp croak); use Pod::Simple (); +# Conditionally import Encode and set $HAS_ENCODE if it is available. +our $HAS_ENCODE; +BEGIN { + $HAS_ENCODE = eval { require Encode }; +} + @ISA = qw(Pod::Simple); -$VERSION = '2.28'; +$VERSION = '4.07'; # Set the debugging level. If someone has inserted a debug function into this # class already, use that. Otherwise, use any Pod::Simple debug function @@ -139,6 +146,22 @@ sub new { } delete $$self{errors}; + # Degrade back to non-utf8 if Encode is not available. + # + # Suppress the warning message when PERL_CORE is set, indicating this is + # running as part of the core Perl build. Perl builds podlators (and all + # pure Perl modules) before Encode and other XS modules, so Encode won't + # yet be available. Rely on the Perl core build to generate man pages + # later, after all the modules are available, so that UTF-8 handling will + # be correct. + if ($$self{utf8} and !$HAS_ENCODE) { + if (!$ENV{PERL_CORE}) { + carp ('utf8 mode requested but Encode module not available,' + . ' falling back to non-utf8'); + } + delete $$self{utf8}; + } + # Initialize various other internal constants based on our arguments. $self->init_fonts; $self->init_quotes; @@ -204,10 +227,10 @@ sub init_quotes { $$self{LQUOTE} = $$self{RQUOTE} = ''; } elsif (length ($$self{quotes}) == 1) { $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes}; - } elsif ($$self{quotes} =~ /^(.)(.)$/ - || $$self{quotes} =~ /^(..)(..)$/) { - $$self{LQUOTE} = $1; - $$self{RQUOTE} = $2; + } elsif (length ($$self{quotes}) % 2 == 0) { + my $length = length ($$self{quotes}) / 2; + $$self{LQUOTE} = substr ($$self{quotes}, 0, $length); + $$self{RQUOTE} = substr ($$self{quotes}, $length); } else { croak(qq(Invalid quote specification "$$self{quotes}")) } @@ -662,10 +685,11 @@ sub switchquotes { # to Roman rather than the actual previous font when used in headings. # troff output may still be broken, but at least we can fix nroff by # just switching the font changes to the non-fixed versions. - $nroff =~ s/\Q$$self{FONTS}{100}\E(.*?)\\f[PR]/$1/g; - $nroff =~ s/\Q$$self{FONTS}{101}\E(.*?)\\f([PR])/\\fI$1\\f$2/g; - $nroff =~ s/\Q$$self{FONTS}{110}\E(.*?)\\f([PR])/\\fB$1\\f$2/g; - $nroff =~ s/\Q$$self{FONTS}{111}\E(.*?)\\f([PR])/\\f\(BI$1\\f$2/g; + my $font_end = "(?:\\f[PR]|\Q$$self{FONTS}{100}\E)"; + $nroff =~ s/\Q$$self{FONTS}{100}\E(.*?)\\f([PR])/$1/g; + $nroff =~ s/\Q$$self{FONTS}{101}\E(.*?)$font_end/\\fI$1\\fP/g; + $nroff =~ s/\Q$$self{FONTS}{110}\E(.*?)$font_end/\\fB$1\\fP/g; + $nroff =~ s/\Q$$self{FONTS}{111}\E(.*?)$font_end/\\f\(BI$1\\fP/g; # Now finally output the command. Bother with .ie only if the nroff # and troff output aren't the same. @@ -741,7 +765,7 @@ sub outindex { sub output { my ($self, @text) = @_; if ($$self{ENCODE}) { - print { $$self{output_fh} } encode ('UTF-8', join ('', @text)); + print { $$self{output_fh} } Encode::encode ('UTF-8', join ('', @text)); } else { print { $$self{output_fh} } @text; } @@ -788,7 +812,7 @@ sub start_document { } else { ($name, $section) = $self->devise_title; } - my $date = $$self{date} || $self->devise_date; + my $date = defined($$self{date}) ? $$self{date} : $self->devise_date; $self->preamble ($name, $section, $date) unless $self->bare_output or DEBUG > 9; } @@ -828,45 +852,61 @@ sub devise_title { $section = 3 if (!$$self{section} && $name =~ /\.pm\z/i); $name =~ s/\.p(od|[lm])\z//i; + # If Pod::Parser gave us an IO::File reference as the source file name, + # convert that to the empty string as well. Then, if we don't have a + # valid name, emit a warning and convert it to STDIN. + if ($name =~ /^IO::File(?:=\w+)\(0x[\da-f]+\)$/i) { + $name = ''; + } + if ($name eq '') { + $self->whine (1, 'No name given for document'); + $name = 'STDIN'; + } + # If the section isn't 3, then the name defaults to just the basename of - # the file. Otherwise, assume we're dealing with a module. We want to - # figure out the full module name from the path to the file, but we don't - # want to include too much of the path into the module name. Lose - # anything up to the first off: - # - # */lib/*perl*/ standard or site_perl module - # */*perl*/lib/ from -Dprefix=/opt/perl - # */*perl*/ random module hierarchy - # - # which works. Also strip off a leading site, site_perl, or vendor_perl - # component, any OS-specific component, and any version number component, - # and strip off an initial component of "lib" or "blib/lib" since that's - # what ExtUtils::MakeMaker creates. splitdir requires at least File::Spec - # 0.8. + # the file. if ($section !~ /^3/) { require File::Basename; $name = uc File::Basename::basename ($name); } else { require File::Spec; my ($volume, $dirs, $file) = File::Spec->splitpath ($name); + + # Otherwise, assume we're dealing with a module. We want to figure + # out the full module name from the path to the file, but we don't + # want to include too much of the path into the module name. Lose + # anything up to the first of: + # + # */lib/*perl*/ standard or site_perl module + # */*perl*/lib/ from -Dprefix=/opt/perl + # */*perl*/ random module hierarchy + # + # Also strip off a leading site, site_perl, or vendor_perl component, + # any OS-specific component, and any version number component, and + # strip off an initial component of "lib" or "blib/lib" since that's + # what ExtUtils::MakeMaker creates. + # + # splitdir requires at least File::Spec 0.8. my @dirs = File::Spec->splitdir ($dirs); - my $cut = 0; - my $i; - for ($i = 0; $i < @dirs; $i++) { - if ($dirs[$i] =~ /perl/) { - $cut = $i + 1; - $cut++ if ($dirs[$i + 1] && $dirs[$i + 1] eq 'lib'); - last; + if (@dirs) { + my $cut = 0; + my $i; + for ($i = 0; $i < @dirs; $i++) { + if ($dirs[$i] =~ /perl/) { + $cut = $i + 1; + $cut++ if ($dirs[$i + 1] && $dirs[$i + 1] eq 'lib'); + last; + } } + if ($cut > 0) { + splice (@dirs, 0, $cut); + shift @dirs if ($dirs[0] =~ /^(site|vendor)(_perl)?$/); + shift @dirs if ($dirs[0] =~ /^[\d.]+$/); + shift @dirs if ($dirs[0] =~ /^(.*-$^O|$^O-.*|$^O)$/); + } + shift @dirs if $dirs[0] eq 'lib'; + splice (@dirs, 0, 2) if ($dirs[0] eq 'blib' && $dirs[1] eq 'lib'); } - if ($cut > 0) { - splice (@dirs, 0, $cut); - shift @dirs if ($dirs[0] =~ /^(site|vendor)(_perl)?$/); - shift @dirs if ($dirs[0] =~ /^[\d.]+$/); - shift @dirs if ($dirs[0] =~ /^(.*-$^O|$^O-.*|$^O)$/); - } - shift @dirs if $dirs[0] eq 'lib'; - splice (@dirs, 0, 2) if ($dirs[0] eq 'blib' && $dirs[1] eq 'lib'); # Remove empty directories when building the module name; they # occur too easily on Unix by doubling slashes. @@ -876,25 +916,55 @@ sub devise_title { } # Determine the modification date and return that, properly formatted in ISO -# format. If we can't get the modification date of the input, instead use the -# current time. Pod::Simple returns a completely unuseful stringified file -# handle as the source_filename for input from a file handle, so we have to -# deal with that as well. +# format. +# +# If POD_MAN_DATE is set, that overrides anything else. This can be used for +# reproducible generation of the same file even if the input file timestamps +# are unpredictable or the POD coms from standard input. +# +# Otherwise, if SOURCE_DATE_EPOCH is set and can be parsed as seconds since +# the UNIX epoch, base the timestamp on that. See +# <https://reproducible-builds.org/specs/source-date-epoch/> +# +# Otherwise, use the modification date of the input if we can stat it. Be +# aware that Pod::Simple returns the stringification of the file handle as +# source_filename for input from a file handle, so we'll stat some random ref +# string in that case. If that fails, instead use the current time. +# +# $self - Pod::Man object, used to get the source file +# +# Returns: YYYY-MM-DD date suitable for the left-hand footer sub devise_date { my ($self) = @_; - my $input = $self->source_filename; + + # If POD_MAN_DATE is set, always use it. + if (defined($ENV{POD_MAN_DATE})) { + return $ENV{POD_MAN_DATE}; + } + + # If SOURCE_DATE_EPOCH is set and can be parsed, use that. my $time; - if ($input) { - $time = (stat $input)[9] || time; - } else { - $time = time; + if (defined($ENV{SOURCE_DATE_EPOCH}) && $ENV{SOURCE_DATE_EPOCH} !~ /\D/) { + $time = $ENV{SOURCE_DATE_EPOCH}; } - # Can't use POSIX::strftime(), which uses Fcntl, because MakeMaker - # uses this and it has to work in the core which can't load dynamic - # libraries. - my ($year, $month, $day) = (localtime $time)[5,4,3]; - return sprintf ("%04d-%02d-%02d", $year + 1900, $month + 1, $day); + # Otherwise, get the input filename and try to stat it. If that fails, + # use the current time. + if (!defined $time) { + my $input = $self->source_filename; + if ($input) { + $time = (stat($input))[9] || time(); + } else { + $time = time(); + } + } + + # Can't use POSIX::strftime(), which uses Fcntl, because MakeMaker uses + # this and it has to work in the core which can't load dynamic libraries. + # Use gmtime instead of localtime so that the generated man page does not + # depend on the local time zone setting and is more reproducible + my ($year, $month, $day) = (gmtime($time))[5,4,3]; + return sprintf("%04d-%02d-%02d", $year + 1900, $month + 1, $day); } # Print out the preamble and the title. The meaning of the arguments to .TH @@ -1461,7 +1531,7 @@ sub preamble_template { .ie \n(.g .ds Aq \(aq .el .ds Aq ' .\" -.\" If the F register is turned on, we'll generate index entries on stderr for +.\" If the F register is >0, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. @@ -1469,20 +1539,16 @@ sub preamble_template { .\" Avoid warning from groff about undefined register 'F'. .de IX .. -.nr rF 0 -.if \n(.g .if rF .nr rF 1 -.if (\n(rF:(\n(.g==0)) \{ -. if \nF \{ -. de IX -. tm Index:\\$1\t\\n%\t"\\$2" +.if !\nF .nr F 0 +.if \nF>0 \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" .. -. if !\nF==2 \{ -. nr % 0 -. nr F 2 -. \} +. if !\nF==2 \{\ +. nr % 0 +. nr F 2 . \} .\} -.rr rF ----END OF PREAMBLE---- #'# for cperl-mode @@ -1566,7 +1632,7 @@ __END__ =for stopwords en em ALLCAPS teeny fixedbold fixeditalic fixedbolditalic stderr utf8 UTF-8 Allbery Sean Burke Ossanna Solaris formatters troff uppercased -Christiansen nourls parsers +Christiansen nourls parsers Kernighan =head1 NAME @@ -1629,8 +1695,19 @@ argument. =item center -Sets the centered page header to use instead of "User Contributed Perl -Documentation". +Sets the centered page header for the C<.TH> macro. The default, if this +option is not specified, is "User Contributed Perl Documentation". + +=item date + +Sets the left-hand footer for the C<.TH> macro. If this option is not set, +the contents of the environment variable POD_MAN_DATE, if set, will be used. +Failing that, the value of SOURCE_DATE_EPOCH, the modification date of the +input file, or the current time if stat() can't find that file (which will be +the case if the input is from C<STDIN>) will be used. If obtained from the +file modification date or the current time, the date will be formatted as +C<YYYY-MM-DD> and will be based on UTC (so that the output will be +reproducible regardless of local time zone). =item errors @@ -1642,13 +1719,6 @@ POD errors entirely, as much as possible. The default is C<pod>. -=item date - -Sets the left-hand footer. By default, the modification date of the input -file will be used, or the current date if stat() can't find that file (the -case if the input is from C<STDIN>), and the date will be formatted as -C<YYYY-MM-DD>. - =item fixed The fixed-width font to use for verbatim text and code. Defaults to @@ -1675,12 +1745,16 @@ for B<troff> output. =item name -Set the name of the manual page. Without this option, the manual name is -set to the uppercased base name of the file being converted unless the -manual section is 3, in which case the path is parsed to see if it is a Perl -module path. If it is, a path like C<.../lib/Pod/Man.pm> is converted into -a name like C<Pod::Man>. This option, if given, overrides any automatic -determination of the name. +Set the name of the manual page for the C<.TH> macro. Without this +option, the manual name is set to the uppercased base name of the file +being converted unless the manual section is 3, in which case the path is +parsed to see if it is a Perl module path. If it is, a path like +C<.../lib/Pod/Man.pm> is converted into a name like C<Pod::Man>. This +option, if given, overrides any automatic determination of the name. + +If generating a manual page from standard input, this option is required, +since there's otherwise no way for Pod::Man to know what to use for the +manual page name. =item nourls @@ -1701,10 +1775,9 @@ important. =item quotes Sets the quote marks used to surround CE<lt>> text. If the value is a -single character, it is used as both the left and right quote; if it is two -characters, the first character is used as the left quote and the second as -the right quoted; and if it is four characters, the first two are used as -the left quote and the second two as the right quote. +single character, it is used as both the left and right quote. Otherwise, +it is split in half, and the first half of the string is used as the left +quote and the second is used as the right quote. This may also be set to the special value C<none>, in which case no quote marks are added around CE<lt>> text (but the font is still changed for troff @@ -1712,11 +1785,16 @@ output). =item release -Set the centered footer. By default, this is the version of Perl you run -Pod::Man under. Note that some system an macro sets assume that the -centered footer will be a modification date and will prepend something like -"Last modified: "; if this is the case, you may want to set C<release> to -the last modified date and C<date> to the version number. +Set the centered footer for the C<.TH> macro. By default, this is set to +the version of Perl you run Pod::Man under. Setting this to the empty +string will cause some *roff implementations to use the system default +value. + +Note that some system C<an> macro sets assume that the centered footer +will be a modification date and will prepend something like "Last +modified: ". If this is the case for your target system, you may want to +set C<release> to the last modified date and C<date> to the version +number. =item section @@ -1756,10 +1834,10 @@ by many implementations and may even result in segfaults and other bad behavior. Be aware that, when using this option, the input encoding of your POD -source must be properly declared unless it is US-ASCII or Latin-1. POD -input without an C<=encoding> command will be assumed to be in Latin-1, -and if it's actually in UTF-8, the output will be double-encoded. See -L<perlpod(1)> for more information on the C<=encoding> command. +source should be properly declared unless it's US-ASCII. Pod::Simple will +attempt to guess the encoding and may be successful if it's Latin-1 or +UTF-8, but it will produce warnings. Use the C<=encoding> command to +declare the encoding. See L<perlpod(1)> for more information. =back @@ -1800,8 +1878,8 @@ canonical versions of B<nroff> and B<troff> don't either). =item Invalid quote specification "%s" (F) The quote specification given (the C<quotes> option to the -constructor) was invalid. A quote specification must be one, two, or four -characters long. +constructor) was invalid. A quote specification must be either one +character long or an even number (greater than one) characters long. =item POD document had syntax errors @@ -1810,6 +1888,43 @@ option was set to C<die>. =back +=head1 ENVIRONMENT + +=over 4 + +=item PERL_CORE + +If set and Encode is not available, silently fall back to non-UTF-8 mode +without complaining to standard error. This environment variable is set +during Perl core builds, which build Encode after podlators. Encode is +expected to not (yet) be available in that case. + +=item POD_MAN_DATE + +If set, this will be used as the value of the left-hand footer unless the +C<date> option is explicitly set, overriding the timestamp of the input +file or the current time. This is primarily useful to ensure reproducible +builds of the same output file given the same source and Pod::Man version, +even when file timestamps may not be consistent. + +=item SOURCE_DATE_EPOCH + +If set, and POD_MAN_DATE and the C<date> options are not set, this will be +used as the modification time of the source file, overriding the timestamp of +the input file or the current time. It should be set to the desired time in +seconds since UNIX epoch. This is primarily useful to ensure reproducible +builds of the same output file given the same source and Pod::Man version, +even when file timestamps may not be consistent. See +L<https://reproducible-builds.org/specs/source-date-epoch/> for the full +specification. + +(Arguably, according to the specification, this variable should be used only +if the timestamp of the input file is not available and Pod::Man uses the +current time. However, for reproducible builds in Debian, results were more +reliable if this variable overrode the timestamp of the input file.) + +=back + =head1 BUGS Encoding handling assumes that PerlIO is available and does not work @@ -1860,7 +1975,7 @@ only matters for troff output. =head1 AUTHOR -Russ Allbery <rra@stanford.edu>, based I<very> heavily on the original +Russ Allbery <rra@cpan.org>, based I<very> heavily on the original B<pod2man> by Tom Christiansen <tchrist@mox.perl.com>. The modifications to work with Pod::Simple instead of Pod::Parser were originally contributed by Sean Burke (but I've since hacked them beyond recognition and all bugs are @@ -1869,7 +1984,7 @@ mine). =head1 COPYRIGHT AND LICENSE Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, -2009, 2010, 2012, 2013 Russ Allbery <rra@stanford.edu>. +2009, 2010, 2012, 2013, 2014, 2015, 2016 Russ Allbery <rra@cpan.org> This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. |