X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/5a6ebf5f1bade18766ab23840c650c33987032be..7b0c33a2fa8735e15cef345b0dda437d9679124e:/installman diff --git a/installman b/installman index ef1470a..ce4b7f3 100755 --- a/installman +++ b/installman @@ -1,20 +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::Copy; -use File::Path qw(mkpath); use ExtUtils::Packlist; use Pod::Man; -use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare - %opts $packlist); +use vars qw(%opts $packlist); + +require './Porting/pod_lib.pl'; +my %man1 = (map {($_->[0], $_->[1])} @{get_pod_metadata()->{master}}); $ENV{SHELL} = 'sh' if $^O eq 'os2'; @@ -26,7 +28,6 @@ die "Patchlevel of perl ($patchlevel)", my $usage = "Usage: installman --man1dir=/usr/wherever --man1ext=1 --man3dir=/usr/wherever --man3ext=3 - --batchlimit=40 --notify --verbose --silent --help Defaults are: man1dir = $Config{'installman1dir'}; @@ -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 batchlimit=i - destdir:s notify n help silent S verbose V)) + qw( man1dir=s man1ext=s man3dir=s man3ext=s + destdir:s notify|n help|h|? silent|S verbose|V strip)) || die $usage; die $usage if $opts{help}; $opts{destdir} //= ''; @@ -48,9 +52,7 @@ 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}; #Sanity checks @@ -64,127 +66,91 @@ $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 -); - # Install the main pod pages. -pod2man('pod', $opts{man1dir}, $opts{man1ext}); +pod2man(\%man1, $opts{man1dir}, $opts{man1ext}, 'pod'); # Install the pods for library modules. -pod2man('lib', $opts{man3dir}, $opts{man3ext}); +{ + 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 () { +my $fh = open_or_die('utils.lst'); +while (<$fh>) { next if /^#/; chomp; - $_ = $1 if /#.*pod\s*=\s*(\S+)/; - my ($where, $what) = m|^(\S*)/(\S+)|; - pod2man($where, $opts{man1dir}, $opts{man1ext}, $what); + 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 ($where2, $what2) = m|#.*link\s*=\s*(\S+)/(\S+)|) { - my $old = "$opts{man1dir}/$what.$opts{man1ext}"; - my $new = "$opts{man1dir}/$what2.$opts{man1ext}"; + 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' }; + $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 { - # @script is scripts names if we are installing manpages embedded - # in scripts, () otherwise - my($poddir, $mandir, $manext, @script) = @_; + my($modpods, $mandir, $manext, $where) = @_; if ($mandir eq ' ' or $mandir eq '') { - if (@script) { - warn "Skipping installation of $poddir/$_ man page.\n" - foreach @script; - } else { - warn "Skipping installation of $poddir man pages.\n"; - } - return; + if ($where) { + warn "Skipping installation of $where man pages.\n" + } else { + warn "Skipping installation of $_ man page.\n" + foreach values %$modpods; + } + return; } - print "installing from $poddir\n" if $opts{verbose}; - - mkpath($mandir, $opts{verbose}, 0777) unless $opts{notify}; # In File::Path - # Make a list of all the .pm and .pod files in the directory. We avoid - # chdir because we are running with @INC = '../lib', and modules may wish - # to dynamically require Carp::Heavy or other diagnostics warnings. - # Hash the names of files we find, keys are names relative to perl build - # dir ('.'), values are names relative to $poddir. - my %modpods; - if (@script) { - %modpods = (map {+"$poddir/$_", $_} @script); + if ($opts{verbose}) { + if ($where) { + print "installing from $where\n"; + } else { + print "installing $_\n" + foreach sort keys %$modpods; + } } - else { - File::Find::find({no_chdir=>1, - wanted => sub { - # $_ is $File::Find::name when using no_chdir - if (-f $_ and /\.p(?:m|od)$/) { - my $fullname = $_; - s!^\Q$poddir\E/!!; - # perlfaq manpages are installed in section 1, - # so skip when searching files for section 3 - return if m(perlfaq.?\.pod|perlglossary.pod); - $modpods{$fullname} = $_; - } - }}, - $poddir); - } - my @to_process; - foreach my $mod (sort keys %modpods) { - my $manpage = $modpods{$mod}; - my $tmp; - # Skip .pm files that have corresponding .pod files, and Functions.pm. - next if (($tmp = $mod) =~ s/\.pm$/.pod/ && -f $tmp); - next if $mod =~ m:/t/:; # no pods from test directories - next if $do_not_install{$manpage}; + + 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"; + warn "no documentation in $mod\n" unless $opts{silent}; 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; } - $tmp = "${mandir}/${manpage}.tmp"; + my $tmp = "${mandir}/${manpage}.tmp"; $manpage = "${mandir}/${manpage}.${manext}"; - push @to_process, [$mod, $tmp, $manpage]; - } - - foreach my $page (@to_process) { - my($pod, $tmp, $manpage) = @$page; my $parser = Pod::Man->new( section => $manext, official=> 1, @@ -192,10 +158,10 @@ sub pod2man { ); my $xmanpage = $manpage; $xmanpage =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'}; - print " $xmanpage\n"; - if (!$opts{notify} && $parser->parse_from_file($pod, $tmp)) { + print " $xmanpage\n" unless $opts{silent}; + if (!$opts{notify} && $parser->parse_from_file($mod, $tmp)) { if (-s $tmp) { - if (rename($tmp, $manpage)) { + if (safe_rename($tmp, $manpage)) { $packlist->{$xmanpage} = { type => 'file' }; next; } @@ -208,25 +174,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: