X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/2ce3647c0f381c639a29f710db854a3f5953ed55..ae4370caa7bb8b584eca0d31d18215c616ba75ac:/installman diff --git a/installman b/installman index fb43e85..0154be4 100755 --- a/installman +++ b/installman @@ -1,21 +1,22 @@ #!./perl -w + BEGIN { @INC = qw(lib); # This needs to be at BEGIN time, before any use of Config + # install_lib itself loads and imports Config into main:: require './install_lib.pl'; } + use strict; use Getopt::Long; -use File::Find; -use File::Path qw(mkpath); use ExtUtils::Packlist; use Pod::Man; -use vars qw(%opts $packlist); +our ( %opts, $packlist ); require './Porting/pod_lib.pl'; -my $state = get_pod_metadata(); +my %man1 = (map {($_->[0], $_->[1])} @{get_pod_metadata()->{master}}); $ENV{SHELL} = 'sh' if $^O eq 'os2'; @@ -37,9 +38,12 @@ my $usage = --verbose (or -V) report all progress. --silent (or -S) be silent. Only report errors.\n"; +# --strip intentionally does nothing. By permitting installman to accept it +# without error, the Makefile can pass the same options to installperl and +# installman, which permits more simplification there than this comment costs. GetOptions( \%opts, qw( man1dir=s man1ext=s man3dir=s man3ext=s - destdir:s notify n help silent S verbose V)) + destdir:s notify|n help|h|? silent|S verbose|V strip)) || die $usage; die $usage if $opts{help}; $opts{destdir} //= ''; @@ -48,9 +52,13 @@ foreach my $pre (qw(man1 man3)) { $opts{"${pre}dir"} //= $opts{destdir} . $Config{"install${pre}dir"}; $opts{"${pre}ext"} //= $Config{"${pre}ext"}; } -$opts{silent} ||= $opts{S}; -$opts{notify} ||= $opts{n}; -$opts{verbose} ||= $opts{V} || $opts{notify}; +$opts{verbose} ||= $opts{notify}; + +# Explicitly disabled installation of man pages +if ($opts{man1dir} eq '' && $opts{man3dir} eq '') { + warn "Manual page installation was disabled by Configure\n"; + exit 0; +} #Sanity checks @@ -64,123 +72,90 @@ $opts{verbose} ||= $opts{V} || $opts{notify}; $packlist = ExtUtils::Packlist->new("$opts{destdir}$Config{installarchlib}/.packlist"); -# manpages not to be installed -my %do_not_install = map { ($_ => 1) } qw( - Pod/Functions.pm - XS/APItest.pm - XS/Typemap.pm -); - # Install the main pod pages. -pod2man({ - map { - ($_->[0], $_->[1]) - } @{$state->{master}} - }, $opts{man1dir}, $opts{man1ext}); +pod2man(\%man1, $opts{man1dir}, $opts{man1ext}, 'pod'); # Install the pods for library modules. -pod2man('lib', $opts{man3dir}, $opts{man3ext}); +if ($opts{man3dir} ne '') { + my $found = pods_to_install(); + pod2man($found->{$_}, $opts{man3dir}, $opts{man3ext}, 'lib') + foreach qw(MODULE PRAGMA); +} # Install the pods embedded in the installed scripts -my $has_man1dir = $opts{man1dir} ne '' && -d $opts{man1dir}; -open UTILS, "utils.lst" or die "Can't open 'utils.lst': $!"; -while () { - next if /^#/; - chomp; - $_ = $1 if /#.*pod\s*=\s*(\S+)/; - my ($path, $leaf) = m|^(\S*/(\S+))|; - pod2man({$leaf, $path}, $opts{man1dir}, $opts{man1ext}); - if ($has_man1dir) { - if (my ($link) = m|#.*link\s*=\s*\S+/(\S+)|) { - my $old = "$opts{man1dir}/$leaf.$opts{man1ext}"; - my $new = "$opts{man1dir}/$link.$opts{man1ext}"; - unlink($new); - link($old, $new); - my $xold = $old; - $xold =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'}; - my $xnew = $new; - $xnew =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'}; - $packlist->{$xnew} = { from => $xold, type => 'link' }; +if ($opts{man1dir} ne '') { + my $has_man1dir = -d $opts{man1dir}; + my $fh = open_or_die('utils.lst'); + while (<$fh>) { + next if /^#/; + chomp; + my ($path, $leaf) = m|^(\S*/(\S+))|; + # Have we already installed the manpage for this? (eg perldoc) + next if $man1{$leaf}; + pod2man({$leaf, $path}, $opts{man1dir}, $opts{man1ext}); + if ($has_man1dir) { + if (my ($link) = m|#.*link\s*=\s*\S+/(\S+)|) { + my $old = "$opts{man1dir}/$leaf.$opts{man1ext}"; + my $new = "$opts{man1dir}/$link.$opts{man1ext}"; + unlink($new); + link($old, $new); + $old =~ s/^\Q$opts{destdir}\E// if $opts{destdir}; + $new =~ s/^\Q$opts{destdir}\E// if $opts{destdir}; + $packlist->{$new} = { from => $old, type => 'link' }; + } } } + close $fh or my_die("close 'utils.lst': $!"); } sub pod2man { - my($what, $mandir, $manext) = @_; + my($modpods, $mandir, $manext, $where) = @_; if ($mandir eq ' ' or $mandir eq '') { - if (ref $what) { + if ($where) { + warn "Skipping installation of $where man pages.\n" + } else { warn "Skipping installation of $_ man page.\n" - foreach values %$what; - } else { - warn "Skipping installation of $what man pages.\n" - } - return; + foreach values %$modpods; + } + return; } if ($opts{verbose}) { - if (ref $what) { - print "installing $_\n" - foreach sort keys %$what; + if ($where) { + print "installing from $where\n"; } else { - print "installing from $what\n"; + print "installing $_\n" + foreach sort keys %$modpods; } } - mkpath($mandir, $opts{verbose}, 0777) unless $opts{notify}; # In File::Path - - my $modpods; - if (ref $what) { - $modpods = $what; - } - else { - # Make a list of all the .pm and .pod files in the directory. - File::Find::find({no_chdir=>1, - wanted => sub { - # $_ is $File::Find::name when using no_chdir - if (-f $_ and /\.p(?:m|od)$/) { - my $pod = $_; - # Skip .pm files that have corresponding .pod files - return if $pod =~ s/\.pm$/.pod/ && -f $pod; - return if m!(?:^|/)t/!; - s!^\Q$what\E/!!; - return if $do_not_install{$_}; - return if is_duplicate_pod($File::Find::name); - $modpods->{$_} = $File::Find::name; - } - }}, - $what); - } + mkpath($mandir); foreach my $manpage (sort keys %$modpods) { my $mod = $modpods->{$manpage}; # Skip files without pod docs my $has_pod; - if (open T, $mod) - { - local $_; - while () - { - ++$has_pod and last if /^=head1\b/; - } - - close T; - } + my $fh = open_or_die($mod); + while (my $line = <$fh>) { + if ($line =~ /^=head1\b/) { + ++$has_pod; + last; + } + } + close $fh or my_die("close '$mod': $!"); + # Sadly it doesn't seem possible to re-use this handle for the call + # to parse_from_file() below, as Pod::Man relies on source_filename(), + # which Pod::Simple only sets accurately if it opens the file itself. unless ($has_pod) { - warn "no documentation in $mod\n"; + print "no documentation in $mod\n" if $opts{verbose}; next; } - # Convert name from File/Basename.pm to File::Basename.3 format, - # if necessary. - $manpage =~ s#\.p(m|od)$##; if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin' || $^O eq 'cygwin') { - $manpage =~ s#/#.#g; - } - else { - $manpage =~ s#/#::#g; + $manpage =~ s#::#.#g; } my $tmp = "${mandir}/${manpage}.tmp"; $manpage = "${mandir}/${manpage}.${manext}"; @@ -191,10 +166,13 @@ sub pod2man { ); my $xmanpage = $manpage; $xmanpage =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'}; - print " $xmanpage\n"; + print " $xmanpage\n" unless $opts{silent}; if (!$opts{notify} && $parser->parse_from_file($mod, $tmp)) { if (-s $tmp) { - if (rename($tmp, $manpage)) { + # We've already emitted a progress message for this file, if + # needed, so ensure safe_rename() doesn't emit another one. + local $opts{silent} = 1; + if (safe_rename($tmp, $manpage)) { $packlist->{$xmanpage} = { type => 'file' }; next; } @@ -207,25 +185,4 @@ sub pod2man { $packlist->write() unless $opts{notify}; print " Installation complete\n" if $opts{verbose}; -exit 0; - -sub rename { - my($from,$to) = @_; - if (-f $to and not unlink($to)) { - my($i); - for ($i = 1; $i < 50; $i++) { - last if CORE::rename($to, "$to.$i"); - } - warn("Cannot rename to '$to.$i': $!"), return 0 - if $i >= 50; # Give up! - } - link($from,$to) || return 0; - unlink($from); -} - -# Local variables: -# cperl-indent-level: 4 -# indent-tabs-mode: nil -# End: -# # ex: set ts=8 sts=4 sw=4 et: