[DELTA]
3.23 - Sun Feb 23 18:54:43 UTC 2014
* Release 3.23
Yes, this is a packaging error. Mea culpa. In the future
test releases will be 3.23_01, etc.
See https://twitter.com/frioux/status/
429245594180128769
for context.
3.22_02 - Wed Feb 5 05:08:34 UTC 2014
* Add a pager that doesn't redirect stdin RT#85173
Added a special pager environment variable for use
when perldoc is in the -m mode that doesn't
redirect STDIN. Set PERLDOC_SRC_PAGER to use.
As in:
PERLDOC_SRC_PAGER=/usr/bin/vim perldoc -m File::Temp
* Teach ToTerm.pm to get terminal width RT#85467
Get a terminal width and pass it to Pod::Text::Termcap
from one of these sources (in order):
1. An explicit width set from command line with -w
2. MANWIDTH environment variable
3. stty output
4. The default width of 76 (same as Pod::Text)
3.22_01 - Sat Feb 1 05:00:13 UTC 2014
* Match =item more carefully when scanning perlfunc.
Fixes RT #86795. Previously matches could be generated
on words like 'size' and 'precision' which are not
Perl functions.
* Cleanup code related to mandoc RT #85844
Patch by Ingo Schwarze
* Re-add '-U' flag to skip attempting to drop
privileges. RT #87837
* Do not install to INSTALLDIRS after Perl 5.11 RT #89756
* Refactor search_perlop (finds operators like 'q'
'qq' 'tr' and others) RT #86506. Previously most of
the text generated was incorrect.
* Fix wrong version in DEBUG output from ToTerm.pm RT #85468
* Fix POD errors when scanning parts of perlfunc RT #86472
Patch by Shlomi Fish.
},
'Pod::Perldoc' => {
- 'DISTRIBUTION' => 'MALLEN/Pod-Perldoc-3.21.tar.gz',
+ 'DISTRIBUTION' => 'MALLEN/Pod-Perldoc-3.23.tar.gz',
'FILES' => q[cpan/Pod-Perldoc],
# Note that we use the CPAN-provided Makefile.PL, since it
'MAN1PODS' => { 'perldoc.pod' => 'blib/man1/perldoc.1' },
- ($^V >= 5.008001 ? ( 'INSTALLDIRS' => 'perl' ) : ()),
+ ($^V >= 5.008001 && $^V < 5.012 ? ( 'INSTALLDIRS' => 'perl' ) : ()),
( $EUMM_VERSION > 6.31 ? (
'LICENSE' => 'perl',
use vars qw($VERSION @Pagers $Bindir $Pod2man
$Temp_Files_Created $Temp_File_Lifetime
);
-$VERSION = '3.21';
+$VERSION = '3.23';
#..........................................................................
# such as perlfaq".
return $self->usage_brief unless @{ $self->{'args'} };
- $self->pagers_guessing;
$self->options_reading;
+ $self->pagers_guessing;
$self->aside(sprintf "$0 => %s v%s\n", ref($self), $self->VERSION);
- $self->drop_privs_maybe;
+ $self->drop_privs_maybe unless $self->opt_U;
$self->options_processing;
# Hm, we have @pages and @found, but we only really act on one
$self->not_dynamic( 1 );
my $perlop = shift @$found_things;
+ # XXX FIXME: getting filehandles should probably be done in a single place
+ # especially since we need to support UTF8 or other encoding when dealing
+ # with perlop, perlfunc, perlapi, perlfaq[1-9]
open( PERLOP, '<', $perlop ) or $self->die( "Can't open $perlop: $!" );
- my $paragraph = "";
- my $has_text_seen = 0;
my $thing = $self->opt_f;
- my $list = 0;
- while( my $line = <PERLOP> ){
- if( $paragraph and $line =~ m!^=(?:head|item)! and $paragraph =~ m!X<+\s*\Q$thing\E\s*>+! ){
- if( $list ){
- $paragraph =~ s!=back.*?\z!!s;
- }
-
- if( $paragraph =~ m!^=item! ){
- $paragraph = "=over 8\n\n" . $paragraph . "=back\n";
- }
+ my $previous_line;
+ my $push = 0;
+ my $seen_item = 0;
+ my $skip = 1;
- push @$pod, $paragraph;
- $paragraph = "";
- $has_text_seen = 0;
- $list = 0;
+ while( my $line = <PERLOP> ) {
+ # only start search after we hit the operator section
+ if ($line =~ m!^X<operator, regexp>!) {
+ $skip = 0;
}
- if( $line =~ m!^=over! ){
- $list++;
+ next if $skip;
+
+ # strategy is to capture the previous line until we get a match on X<$thingy>
+ # if the current line contains X<$thingy>, then we push "=over", the previous line,
+ # the current line and keep pushing current line until we see a ^X<some-other-thing>,
+ # then we chop off final line from @$pod and add =back
+ #
+ # At that point, Bob's your uncle.
+
+ if ( $line =~ m!X<+\s*\Q$thing\E\s*>+!) {
+ if ( $previous_line ) {
+ push @$pod, "=over 8\n\n", $previous_line;
+ $previous_line = "";
+ }
+ push @$pod, $line;
+ $push = 1;
+
}
- elsif( $line =~ m!^=back! ){
- $list--;
+ elsif ( $push and $line =~ m!^=item\s*.*$! ) {
+ $seen_item = 1;
}
-
- if( $line =~ m!^=(?:head|item)! and $has_text_seen ){
- $paragraph = "";
+ elsif ( $push and $seen_item and $line =~ m!^X<+\s*[ a-z,?-]+\s*>+!) {
+ $push = 0;
+ $seen_item = 0;
+ last;
}
- elsif( $line !~ m!^=(?:head|item)! and $line !~ m!^\s*$! and $line !~ m!^\s*X<! ){
- $has_text_seen = 1;
+ elsif ( $push ) {
+ push @$pod, $line;
}
- $paragraph .= $line;
+ else {
+ $previous_line = $line;
}
+ } #end while
+
+ # we overfilled by 1 line, so pop off final array element if we have any
+ if ( scalar @$pod ) {
+ pop @$pod;
+
+ # and add the =back
+ push @$pod, "\n\n=back\n";
+ DEBUG > 8 and print "PERLOP POD --->" . (join "", @$pod) . "<---\n";
+ }
+ else {
+ DEBUG > 4 and print "No pod from perlop\n";
+ }
+
close PERLOP;
return;
my $related_re;
while (<PFUNC>) { # "The Mothership Connection is here!"
last if( grep{ $self->opt_f eq $_ }@perlops );
- if ( m/^=item\s+$search_re\b/ ) {
+
+ if ( /^=over/ and not $found ) {
+ ++$inlist;
+ }
+ elsif ( /^=back/ and not $found and $inlist ) {
+ --$inlist;
+ }
+
+
+ if ( m/^=item\s+$search_re\b/ and $inlist < 2 ) {
$found = 1;
}
elsif (@related > 1 and /^=item/) {
$found = 1;
}
else {
- last;
+ last if $found > 1 and $inlist < 2;
}
}
elsif (/^=item/) {
- last if $found > 1 and not $inlist;
+ last if $found > 1 and $inlist < 2;
}
elsif ($found and /^X<[^>]+>/) {
push @related, m/X<([^>]+)>/g;
++$inlist;
}
elsif (/^=back/) {
- last if $found > 1 and not $inlist;
--$inlist;
}
push @$pod, $_;
$self->opt_f )
;
}
- close PFUNC or $self->die( "Can't open $perlfunc: $!" );
+ close PFUNC or $self->die( "Can't close $perlfunc: $!" );
return;
}
}
}
- unshift @pagers, "$ENV{PERLDOC_PAGER} <" if $ENV{PERLDOC_PAGER};
+ if ( $self->opt_m ) {
+ unshift @pagers, "$ENV{PERLDOC_SRC_PAGER}" if $ENV{PERLDOC_SRC_PAGER}
+ }
+ else {
+ unshift @pagers, "$ENV{PERLDOC_PAGER} <" if $ENV{PERLDOC_PAGER};
+ }
+
+ $self->aside("Pagers: ", @pagers);
return;
}
sub drop_privs_maybe {
my $self = shift;
+ DEBUG and print "Attempting to drop privs...\n";
+
# Attempt to drop privs if we should be tainting and aren't
if (!( $self->is_vms || $self->is_mswin32 || $self->is_dos
|| $self->is_os2
use warnings;
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
use Carp qw(croak carp);
use Config qw(%Config);
use strict;
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
BEGIN { # Make a DEBUG constant ASAP
*DEBUG = defined( &Pod::Perldoc::DEBUG )
use parent qw(Pod::Perldoc::BaseTo);
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
sub is_pageable { 1 }
sub write_with_binmode { 0 }
use vars qw(@ISA);
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
# Pick our superclass...
#
use parent qw(Pod::Perldoc::BaseTo);
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
use File::Spec::Functions qw(catfile);
use Pod::Man 2.18;
sub _have_mandoc_with_utf8 {
my( $self ) = @_;
- return 0 unless $self->_is_mandoc;
- my $roffer = $self->__nroffer;
-
- my $minimum_mandoc_version = '1.11';
-
- my $version_string = `$roffer -V`;
- my( $version ) = $version_string =~ /mandoc ((\d+)\.(\d+))/;
- $self->debug( "Found mandoc $version\n" );
-
- # is a string comparison good enough?
- if( $version lt $minimum_mandoc_version ) {
- $self->warn(
- "You have an older mandoc." .
- " Update to version $minimum_mandoc_version for better Unicode support.\n" .
- "If you don't upgrade, wide characters may come out oddly.\n" .
- "Your results still might be odd. If you have groff, that's even better.\n"
- );
- }
-
- $version ge $minimum_mandoc_version;
+ $self->_is_mandoc and not system 'mandoc -Tlocale -V > /dev/null 2>&1';
}
sub _collect_nroff_switches {
my( $self ) = shift;
- my @render_switches = $self->_is_mandoc ? qw(-mandoc) : qw(-man);
-
- push @render_switches, $self->_get_device_switches;
+ my @render_switches = ('-man', $self->_get_device_switches);
# Thanks to Brendan O'Dea for contributing the following block
if( $self->_is_roff and -t STDOUT and my ($cols) = $self->_get_columns ) {
if( $self->_is_nroff ) { qw() }
elsif( $self->_have_groff_with_utf8 ) { qw(-Kutf8 -Tutf8) }
elsif( $self->_is_ebcdic ) { qw(-Tcp1047) }
- elsif( $self->_have_mandoc_with_utf8 ) { qw(-Tutf8) }
+ elsif( $self->_have_mandoc_with_utf8 ) { qw(-Tlocale) }
elsif( $self->_is_mandoc ) { qw() }
else { qw(-Tlatin1) }
}
use parent qw(Pod::Perldoc::BaseTo);
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
# This is unlike ToMan.pm in that it emits the raw nroff source!
use parent qw(Pod::Perldoc::BaseTo);
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
sub is_pageable { 1 }
sub write_with_binmode { 0 }
use parent qw( Pod::Simple::RTF );
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
sub is_pageable { 0 }
sub write_with_binmode { 0 }
use warnings;
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
use parent qw(Pod::Perldoc::BaseTo);
sub loose { shift->_perldoc_elem('loose' , @_) }
sub quotes { shift->_perldoc_elem('quotes' , @_) }
sub sentence { shift->_perldoc_elem('sentence', @_) }
-sub width { shift->_perldoc_elem('width' , @_) }
+sub width {
+ my $self = shift;
+ $self->_perldoc_elem('width' , @_) ||
+ $self->_get_columns_from_manwidth ||
+ $self->_get_columns_from_stty ||
+ $self->_get_default_width;
+}
+
+sub _get_stty { `stty -a` }
+
+sub _get_columns_from_stty {
+ my $output = $_[0]->_get_stty;
+
+ if( $output =~ /\bcolumns\s+(\d+)/ ) { return $1; }
+ elsif( $output =~ /;\s*(\d+)\s+columns;/ ) { return $1; }
+ else { return 0 }
+ }
+
+sub _get_columns_from_manwidth {
+ my( $self ) = @_;
+
+ return 0 unless defined $ENV{MANWIDTH};
+
+ unless( $ENV{MANWIDTH} =~ m/\A\d+\z/ ) {
+ $self->warn( "Ignoring non-numeric MANWIDTH ($ENV{MANWIDTH})\n" );
+ return 0;
+ }
+
+ if( $ENV{MANWIDTH} == 0 ) {
+ $self->warn( "Ignoring MANWIDTH of 0. Really? Why even run the program? :)\n" );
+ return 0;
+ }
+
+ if( $ENV{MANWIDTH} =~ m/\A(\d+)\z/ ) { return $1 }
+
+ return 0;
+ }
+
+sub _get_default_width {
+ 76
+ }
+
sub new { return bless {}, ref($_[0]) || $_[0] }
sub parse_from_file {
my $self = shift;
+ $self->{width} = $self->width();
+
my @options =
map {; $_, $self->{$_} }
grep !m/^_/s,
defined(&Pod::Perldoc::DEBUG)
and Pod::Perldoc::DEBUG()
and print "About to call new Pod::Text::Termcap ",
- $Pod::Text::VERSION ? "(v$Pod::Text::VERSION) " : '',
+ $Pod::Text::VERSION ? "(v$Pod::Text::Termcap::VERSION) " : '',
"with options: ",
@options ? "[@options]" : "(nil)", "\n";
;
use warnings;
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
use parent qw(Pod::Perldoc::BaseTo);
use warnings;
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
use parent qw(Pod::Perldoc::BaseTo);
use parent qw( Pod::Simple::XMLOutStream );
use vars qw($VERSION);
-$VERSION = '3.21';
+$VERSION = '3.23';
sub is_pageable { 0 }
sub write_with_binmode { 0 }
on its own. (C<MANPAGER> is not used if C<perldoc> was told to display
plain text or unformatted pod.)
+When using perldoc in it's C<-m> mode (display module source code),
+C<perldoc> will attempt to use the pager set in C<PERLDOC_SRC_PAGER>.
+A useful setting for this command is your favorite editor as in
+C</usr/bin/nano>. (Don't judge me.)
+
One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
Having PERLDOCDEBUG set to a positive integer will make perldoc emit
projects / platform / upstream / perl.git / commitdiff