"Fossies" - the Fresh Open Source Software Archive

Member "perl-5.32.1/installman" (18 Dec 2020, 6015 Bytes) of package /linux/misc/perl-5.32.1.tar.xz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 #!./perl -w
    2 
    3 BEGIN {
    4     @INC = qw(lib);
    5 
    6     # This needs to be at BEGIN time, before any use of Config
    7     # install_lib itself loads and imports Config into main::
    8     require './install_lib.pl';
    9 }
   10 
   11 use strict;
   12 
   13 use Getopt::Long;
   14 use ExtUtils::Packlist;
   15 use Pod::Man;
   16 our ( %opts, $packlist );
   17 
   18 require './Porting/pod_lib.pl';
   19 my %man1 = (map {($_->[0], $_->[1])} @{get_pod_metadata()->{master}});
   20 
   21 $ENV{SHELL} = 'sh' if $^O eq 'os2';
   22 
   23 my $patchlevel = substr($],3,2);
   24 die "Patchlevel of perl ($patchlevel)",
   25     "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n"
   26 	if $patchlevel != $Config{'PERL_VERSION'};
   27 
   28 my $usage =
   29 "Usage:  installman --man1dir=/usr/wherever --man1ext=1
   30                    --man3dir=/usr/wherever --man3ext=3
   31 	           --notify --verbose --silent --help
   32 	Defaults are:
   33 	man1dir = $Config{'installman1dir'};
   34 	man1ext = $Config{'man1ext'};
   35 	man3dir = $Config{'installman3dir'};
   36 	man3ext = $Config{'man3ext'};
   37 	--notify  (or -n) just lists commands that would be executed.
   38         --verbose (or -V) report all progress.
   39         --silent  (or -S) be silent. Only report errors.\n";
   40 
   41 # --strip intentionally does nothing. By permitting installman to accept it
   42 # without error, the Makefile can pass the same options to installperl and
   43 # installman, which permits more simplification there than this comment costs.
   44 GetOptions( \%opts,
   45             qw( man1dir=s man1ext=s man3dir=s man3ext=s
   46                 destdir:s notify|n help|h|? silent|S verbose|V strip))
   47 	|| die $usage;
   48 die $usage if $opts{help};
   49 $opts{destdir} //= '';
   50 
   51 foreach my $pre (qw(man1 man3)) {
   52     $opts{"${pre}dir"} //= $opts{destdir} . $Config{"install${pre}dir"};
   53     $opts{"${pre}ext"} //= $Config{"${pre}ext"};
   54 }
   55 $opts{verbose} ||= $opts{notify};
   56 
   57 # Explicitly disabled installation of man pages
   58 if ($opts{man1dir} eq '' && $opts{man3dir} eq '') {
   59     warn "Manual page installation was disabled by Configure\n";
   60     exit 0;
   61 }
   62 
   63 #Sanity checks
   64 
   65 -x  "./perl$Config{exe_ext}"
   66   or warn "./perl$Config{exe_ext} not found!  Have you run make?\n";
   67 -d  "$opts{destdir}$Config{'installprivlib'}"
   68 	|| warn "Perl library directory $Config{'installprivlib'} not found.
   69 		Have you run make install?.  (Installing anyway.)\n";
   70 -x "t/perl$Config{exe_ext}"		|| warn "WARNING: You've never run 'make test'!!!",
   71 	"  (Installing anyway.)\n";
   72 
   73 $packlist = ExtUtils::Packlist->new("$opts{destdir}$Config{installarchlib}/.packlist");
   74 
   75 # Install the main pod pages.
   76 pod2man(\%man1, $opts{man1dir}, $opts{man1ext}, 'pod');
   77 
   78 # Install the pods for library modules.
   79 if ($opts{man3dir} ne '') {
   80     my $found = pods_to_install();
   81     pod2man($found->{$_}, $opts{man3dir}, $opts{man3ext}, 'lib')
   82         foreach qw(MODULE PRAGMA);
   83 }
   84 
   85 # Install the pods embedded in the installed scripts
   86 if ($opts{man1dir} ne '') {
   87     my $has_man1dir = -d $opts{man1dir};
   88     my $fh = open_or_die('utils.lst');
   89     while (<$fh>) {
   90 	next if /^#/;
   91 	chomp;
   92 	my ($path, $leaf) = m|^(\S*/(\S+))|;
   93 	# Have we already installed the manpage for this? (eg perldoc)
   94 	next if $man1{$leaf};
   95 	pod2man({$leaf, $path}, $opts{man1dir}, $opts{man1ext});
   96 	if ($has_man1dir) {
   97 	    if (my ($link) = m|#.*link\s*=\s*\S+/(\S+)|) {
   98 		my $old = "$opts{man1dir}/$leaf.$opts{man1ext}";
   99 		my $new = "$opts{man1dir}/$link.$opts{man1ext}";
  100 		unlink($new);
  101 		link($old, $new);
  102 		$old =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
  103 		$new =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
  104 		$packlist->{$new} = { from => $old, type => 'link' };
  105 	    }
  106 	}
  107     }
  108     close $fh or my_die("close 'utils.lst': $!");
  109 }
  110 
  111 sub pod2man {
  112     my($modpods, $mandir, $manext, $where) = @_;
  113     if ($mandir eq ' ' or $mandir eq '') {
  114         if ($where) {
  115             warn "Skipping installation of $where man pages.\n"
  116         } else {
  117             warn "Skipping installation of $_ man page.\n"
  118                 foreach values %$modpods;
  119         }
  120         return;
  121     }
  122 
  123     if ($opts{verbose}) {
  124         if ($where) {
  125             print "installing from $where\n";
  126         } else {
  127             print "installing $_\n"
  128                 foreach sort keys %$modpods;
  129         }
  130     }
  131 
  132     mkpath($mandir);
  133 
  134     foreach my $manpage (sort keys %$modpods) {
  135         my $mod = $modpods->{$manpage};
  136 
  137 	# Skip files without pod docs
  138 	my $has_pod;
  139         my $fh = open_or_die($mod);
  140         while (my $line = <$fh>) {
  141             if ($line =~ /^=head1\b/) {
  142                 ++$has_pod;
  143                 last;
  144             }
  145         }
  146 	close $fh or my_die("close '$mod': $!");
  147         # Sadly it doesn't seem possible to re-use this handle for the call
  148         # to parse_from_file() below, as Pod::Man relies on source_filename(),
  149         # which Pod::Simple only sets accurately if it opens the file itself.
  150 
  151 	unless ($has_pod)
  152 	{
  153 	    print "no documentation in $mod\n" if $opts{verbose};
  154 	    next;
  155 	}
  156 
  157 	if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin' || $^O eq 'cygwin') {
  158             $manpage =~ s#::#.#g;
  159 	}
  160         my $tmp = "${mandir}/${manpage}.tmp";
  161 	$manpage = "${mandir}/${manpage}.${manext}";
  162 
  163         my $parser = Pod::Man->new( section => $manext,
  164                                     official=> 1,
  165                                     center  => 'Perl Programmers Reference Guide'
  166                                   );
  167 	my $xmanpage = $manpage;
  168 	$xmanpage =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'};
  169         print "  $xmanpage\n" unless $opts{silent};
  170         if (!$opts{notify} && $parser->parse_from_file($mod, $tmp)) {
  171             if (-s $tmp) {
  172                 # We've already emitted a progress message for this file, if
  173                 # needed, so ensure safe_rename() doesn't emit another one.
  174                 local $opts{silent} = 1;
  175                 if (safe_rename($tmp, $manpage)) {
  176                     $packlist->{$xmanpage} = { type => 'file' };
  177                     next;
  178                 }
  179             }
  180             unlink($tmp);
  181 	}
  182     }
  183 }
  184 
  185 $packlist->write() unless $opts{notify};
  186 print "  Installation complete\n" if $opts{verbose};
  187 
  188 # ex: set ts=8 sts=4 sw=4 et: