X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=installman;h=360d4f34f7db36e222f24d40873a23fac7e694b3;hb=7f17c5141d7d488a184915d744f3ef35257927e7;hp=63b781d2a320900b77fb09925d890f4f6c9bdba2;hpb=e8fcf3b95839c3b33699c9d2412f7f83861908f9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/installman b/installman index 63b781d..360d4f3 100755 --- a/installman +++ b/installman @@ -9,8 +9,7 @@ use File::Path qw(mkpath); use ExtUtils::Packlist; use Pod::Man; use subs qw(unlink chmod rename link); -use vars qw($packlist @modpods); -require Cwd; +use vars qw($packlist); if ($Config{d_umask}) { umask(022); # umasks like 077 aren't that useful for installations @@ -78,18 +77,21 @@ pod2man('pod', $opts{man1dir}, $opts{man1ext}); pod2man('lib', $opts{man3dir}, $opts{man3ext}); # 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 ($where, $what) = m|^(.*?)/(\S+)|; + my ($where, $what) = m|^(\S*)/(\S+)|; pod2man($where, $opts{man1dir}, $opts{man1ext}, $what); - if (my ($where2, $what2) = m|#.*link\s*=\s*(\S+)/(\S+)|) { - my $old = "$opts{man1dir}/$what.$opts{man1ext}"; - my $new = "$opts{man1dir}/$what2.$opts{man1ext}"; - unlink($new); - link($old, $new); + 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}"; + unlink($new); + link($old, $new); + } } } @@ -97,13 +99,6 @@ sub pod2man { # @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" @@ -114,27 +109,37 @@ sub pod2man { return; } - print "chdir $poddir\n" if $opts{verbose}; - chdir $poddir || die "Unable to cd to $poddir directory!\n$!\n"; + 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 will - # always run from the lib directory and use the full pathname - # of the pod. + # 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 = @script; + %modpods = (map {+"$poddir/$_", $_} @script); } else { - @modpods = (); - File::Find::find(\&lsmodpods, '.'); + 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/!!; + $modpods{$fullname} = $_; + } + }}, + $poddir); } my @to_process; - foreach my $mod (@modpods) { - my $manpage = $mod; + 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 eq 'Pod/Functions.pm'); #### Used only by pod itself + next if ($manpage eq 'Pod/Functions.pm'); #### Used only by pod itself # Convert name from File/Basename.pm to File::Basename.3 format, # if necessary. @@ -168,17 +173,6 @@ sub pod2man { 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};