286 lines
8.5 KiB
Perl
Executable File
286 lines
8.5 KiB
Perl
Executable File
#!./perl -w
|
|
BEGIN { @INC = ('lib') }
|
|
use strict;
|
|
use Config;
|
|
use Getopt::Long;
|
|
use File::Find;
|
|
use File::Copy;
|
|
use File::Path qw(mkpath);
|
|
use ExtUtils::Packlist;
|
|
use subs qw(unlink chmod rename link);
|
|
use vars qw($packlist @modpods);
|
|
require Cwd;
|
|
|
|
$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"
|
|
if $patchlevel != $Config{'PERL_VERSION'};
|
|
|
|
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'};
|
|
man1ext = $Config{'man1ext'};
|
|
man3dir = $Config{'installman3dir'};
|
|
man3ext = $Config{'man3ext'};
|
|
batchlimit is maximum number of pod files per invocation of pod2man
|
|
--notify (or -n) just lists commands that would be executed.
|
|
--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))
|
|
|| die $usage;
|
|
die $usage if $opts{help};
|
|
|
|
$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});
|
|
$opts{batchlimit} ||= 40;
|
|
$opts{silent} ||= $opts{S};
|
|
$opts{notify} ||= $opts{n};
|
|
$opts{verbose} ||= $opts{V} || $opts{notify};
|
|
|
|
#Sanity checks
|
|
|
|
-x "./perl$Config{exe_ext}"
|
|
or warn "./perl$Config{exe_ext} not found! Have you run make?\n";
|
|
-d $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");
|
|
|
|
# Install the main pod pages.
|
|
runpod2man('pod', $opts{man1dir}, $opts{man1ext});
|
|
|
|
# Install the pods for library modules.
|
|
runpod2man('lib', $opts{man3dir}, $opts{man3ext});
|
|
|
|
# Install the pods embedded in the installed scripts
|
|
runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'c2ph', 'h2ph', 'h2xs',
|
|
'perlcc', 'perldoc', 'perlbug', 'pl2pm', 'splain', 'dprofpp');
|
|
runpod2man('x2p', $opts{man1dir}, $opts{man1ext}, 's2p', 'a2p.pod',
|
|
'find2perl');
|
|
runpod2man('pod', $opts{man1dir}, $opts{man1ext}, 'pod2man', 'pod2html',
|
|
'pod2text', 'pod2usage', 'podchecker', 'podselect');
|
|
|
|
# It would probably be better to have this page linked
|
|
# to the c2ph man page. Or, this one could say ".so man1/c2ph.1",
|
|
# but then it would have to pay attention to $opts{man1dir} and $opts{man1ext}.
|
|
runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'pstruct');
|
|
|
|
runpod2man('lib/ExtUtils', $opts{man1dir}, $opts{man1ext}, 'xsubpp');
|
|
|
|
sub runpod2man {
|
|
# @script is scripts names if we are installing manpages embedded
|
|
# in scripts, () otherwise
|
|
my($poddir, $mandir, $manext, @script) = @_;
|
|
|
|
my($downdir); # can't just use .. when installing xsubpp manpage
|
|
|
|
$downdir = $poddir;
|
|
$downdir =~ s:[^/]+:..:g;
|
|
my($builddir) = Cwd::getcwd();
|
|
|
|
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;
|
|
}
|
|
|
|
print "chdir $poddir\n" if $opts{verbose};
|
|
chdir $poddir || die "Unable to cd to $poddir directory!\n$!\n";
|
|
|
|
# We insist on using the current version of pod2man in case there
|
|
# are enhancements or changes from previous installed versions.
|
|
# The error message doesn't include the '..' because the user
|
|
# won't be aware that we've chdir to $poddir.
|
|
-r "$downdir/pod/pod2man" || die "Executable pod/pod2man not found.\n";
|
|
|
|
# We want to be sure to use the current perl. We can't rely on
|
|
# the installed perl because it might not be actually installed
|
|
# yet. (The user may have set the $install* Configure variables
|
|
# to point to some temporary home, from which the executable gets
|
|
# installed by occult means.)
|
|
my $pod2man = "$downdir/perl -I $downdir/lib $downdir/pod/pod2man --section=$manext --official";
|
|
|
|
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 will
|
|
# always run pod2man from the lib directory and feed it the full pathname
|
|
# of the pod. This might be useful for pod2man someday.
|
|
if (@script) {
|
|
@modpods = @script;
|
|
}
|
|
else {
|
|
@modpods = ();
|
|
File::Find::find(\&lsmodpods, '.');
|
|
}
|
|
my @to_process;
|
|
foreach my $mod (@modpods) {
|
|
my $manpage = $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 eq 'Pod/Functions.pm'); #### Used only by pod itself
|
|
|
|
# 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;
|
|
}
|
|
$tmp = "${mandir}/${manpage}.tmp";
|
|
$manpage = "${mandir}/${manpage}.${manext}";
|
|
push @to_process, [$mod, $tmp, $manpage];
|
|
}
|
|
# Don't do all pods in same command to avoid busting command line limits
|
|
while (my @this_batch = splice @to_process, 0, $opts{batchlimit}) {
|
|
my $cmd = join " ", $pod2man, map "$$_[0] $$_[1]", @this_batch;
|
|
if (&cmd($cmd) == 0 && !$opts{notify}) {
|
|
foreach (@this_batch) {
|
|
my (undef, $tmp, $manpage) = @$_;
|
|
if (-s $tmp) {
|
|
if (rename($tmp, $manpage)) {
|
|
$packlist->{$manpage} = { type => 'file' };
|
|
next;
|
|
}
|
|
}
|
|
unless ($opts{notify}) {
|
|
unlink($tmp);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
chdir "$builddir" || die "Unable to cd back to $builddir directory!\n$!\n";
|
|
print " chdir $builddir\n" if $opts{verbose};
|
|
}
|
|
|
|
sub lsmodpods {
|
|
my $dir = $File::Find::dir;
|
|
my $name = $File::Find::name;
|
|
if (-f $_) {
|
|
$name =~ s#^\./##;
|
|
push(@modpods, $name) if ($name =~ /\.p(m|od)$/);
|
|
}
|
|
}
|
|
|
|
$packlist->write() unless $opts{notify};
|
|
print " Installation complete\n" if $opts{verbose};
|
|
|
|
exit 0;
|
|
|
|
|
|
###############################################################################
|
|
# Utility subroutines from installperl
|
|
|
|
sub cmd {
|
|
my ($cmd) = @_;
|
|
print " $cmd\n" if $opts{verbose};
|
|
unless ($opts{notify}) {
|
|
if ($Config{d_fork}) {
|
|
fork ? wait : exec $cmd; # Allow user to ^C out of command.
|
|
}
|
|
else {
|
|
system $cmd;
|
|
}
|
|
warn "Command failed!!\n" if $?;
|
|
}
|
|
return $? != 0;
|
|
}
|
|
|
|
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 $opts{verbose} ? " ln $from $to\n" : " $to\n" unless $opts{silent};
|
|
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) = @_;
|
|
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);
|
|
}
|
|
|
|
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;
|
|
}
|
|
}
|