X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/53fb3a93d5c9d966711a0c5ebec2652fa815e12f..d350938a5844eac31e2d27ccc158a0fe5d1be65a:/installman diff --git a/installman b/installman index 360d4f3..ff196f4 100755 --- a/installman +++ b/installman @@ -1,24 +1,23 @@ #!./perl -w -BEGIN { @INC = qw(lib) } +BEGIN { + @INC = qw(lib); + + # This needs to be at BEGIN time, before any use of Config + require './install_lib.pl'; +} use strict; -use Config; + use Getopt::Long; use File::Find; use File::Copy; use File::Path qw(mkpath); use ExtUtils::Packlist; use Pod::Man; -use subs qw(unlink chmod rename link); -use vars qw($packlist); - -if ($Config{d_umask}) { - umask(022); # umasks like 077 aren't that useful for installations -} +use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare + %opts $packlist); $ENV{SHELL} = 'sh' if $^O eq 'os2'; -my $ver = $Config{version}; # Not used presently. -my $release = substr($],0,3); # Not used presently. my $patchlevel = substr($],3,2); die "Patchlevel of perl ($patchlevel)", "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n" @@ -38,21 +37,17 @@ my $usage = --verbose (or -V) report all progress. --silent (or -S) be silent. Only report errors.\n"; -my %opts; GetOptions( \%opts, qw( man1dir=s man1ext=s man3dir=s man3ext=s batchlimit=i - notify n help silent S verbose V)) + destdir:s notify n help silent S verbose V)) || die $usage; die $usage if $opts{help}; +$opts{destdir} //= ''; -$opts{man1dir} = $Config{'installman1dir'} - unless defined($opts{man1dir}); -$opts{man1ext} = $Config{'man1ext'} - unless defined($opts{man1ext}); -$opts{man3dir} = $Config{'installman3dir'} - unless defined($opts{man3dir}); -$opts{man3ext} = $Config{'man3ext'} - unless defined($opts{man3ext}); +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}; @@ -61,13 +56,13 @@ $opts{verbose} ||= $opts{V} || $opts{notify}; -x "./perl$Config{exe_ext}" or warn "./perl$Config{exe_ext} not found! Have you run make?\n"; --d $Config{'installprivlib'} +-d "$opts{destdir}$Config{'installprivlib'}" || warn "Perl library directory $Config{'installprivlib'} not found. Have you run make install?. (Installing anyway.)\n"; -x "t/perl$Config{exe_ext}" || warn "WARNING: You've never run 'make test'!!!", " (Installing anyway.)\n"; -$packlist = ExtUtils::Packlist->new("$Config{installarchlib}/.packlist"); +$packlist = ExtUtils::Packlist->new("$opts{destdir}$Config{installarchlib}/.packlist"); # Install the main pod pages. @@ -91,6 +86,11 @@ while () { my $new = "$opts{man1dir}/$what2.$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' }; } } } @@ -139,8 +139,28 @@ sub pod2man { 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 ($manpage eq 'Pod/Functions.pm'); #### Used only by pod itself + # Skip files without pod docs + my $has_pod; + if (open T, $mod) + { + local $_; + while () + { + ++$has_pod and last if /^=(?:head\d+|item|pod)\b/; + } + + close T; + } + + unless ($has_pod) + { + warn "no documentation in $mod\n"; + next; + } + # Convert name from File/Basename.pm to File::Basename.3 format, # if necessary. $manpage =~ s#\.p(m|od)$##; @@ -155,18 +175,20 @@ sub pod2man { push @to_process, [$mod, $tmp, $manpage]; } - my $parser = Pod::Man->new( section => $manext, - official=> 1, - center => 'Perl Programmers Reference Guide' - ); foreach my $page (@to_process) { my($pod, $tmp, $manpage) = @$page; - print " $manpage\n"; + my $parser = Pod::Man->new( section => $manext, + official=> 1, + center => 'Perl Programmers Reference Guide' + ); + my $xmanpage = $manpage; + $xmanpage =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'}; + print " $xmanpage\n"; if (!$opts{notify} && $parser->parse_from_file($pod, $tmp)) { if (-s $tmp) { if (rename($tmp, $manpage)) { - $packlist->{$manpage} = { type => 'file' }; + $packlist->{$xmanpage} = { type => 'file' }; next; } } @@ -179,46 +201,6 @@ $packlist->write() unless $opts{notify}; print " Installation complete\n" if $opts{verbose}; exit 0; - - -############################################################################### -# Utility subroutines from installperl - -sub unlink { - my(@names) = @_; - my $cnt = 0; - - foreach my $name (@names) { - next unless -e $name; - chmod 0777, $name if $^O eq 'os2'; - print " unlink $name\n" if $opts{verbose}; - ( CORE::unlink($name) and ++$cnt - or warn "Couldn't unlink $name: $!\n" ) unless $opts{notify}; - } - return $cnt; -} - -sub link { - my($from,$to) = @_; - my($success) = 0; - - print " ln $from $to\n" if $opts{verbose}; - eval { - CORE::link($from, $to) - ? $success++ - : ($from =~ m#^/afs/# || $to =~ m#^/afs/#) - ? die "AFS" # okay inside eval {} - : warn "Couldn't link $from to $to: $!\n" - unless $opts{notify}; - }; - if ($@) { - File::Copy::copy($from, $to) - ? $success++ - : warn "Couldn't copy $from to $to: $!\n" - unless $opts{notify}; - } - $success; -} sub rename { my($from,$to) = @_; @@ -233,25 +215,3 @@ sub rename { link($from,$to) || return 0; unlink($from); } - -sub chmod { - my($mode,$name) = @_; - - printf " chmod %o %s\n", $mode, $name if $opts{verbose}; - CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name) - unless $opts{notify}; -} - -sub samepath { - my($p1, $p2) = @_; - my($dev1, $ino1, $dev2, $ino2); - - if ($p1 ne $p2) { - ($dev1, $ino1) = stat($p1); - ($dev2, $ino2) = stat($p2); - ($dev1 == $dev2 && $ino1 == $ino2); - } - else { - 1; - } -}