installman

   1 #!./perl -w
   2 BEGIN { @INC = ('lib') }
   3 use strict;
   4 use Config;
   5 use Getopt::Long;
   6 use File::Find;
   7 use File::Copy;
   8 use File::Path qw(mkpath);
   9 use ExtUtils::Packlist;
  10 use subs qw(unlink chmod rename link);
  11 use vars qw($packlist @modpods);
  12 require Cwd;
  13
  14 $ENV{SHELL} = 'sh' if $^O eq 'os2';
  15
  16 my $ver = $Config{version};     # Not used presently.
  17 my $release = substr($],0,3);   # Not used presently.
  18 my $patchlevel = substr($],3,2);
  19 die "Patchlevel of perl ($patchlevel)",
  20     "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n"
  21         if $patchlevel != $Config{'PERL_VERSION'};
  22
  23 my $usage =
  24 "Usage:  installman --man1dir=/usr/wherever --man1ext=1
  25                    --man3dir=/usr/wherever --man3ext=3
  26                    --notify --verbose --silent --help
  27         Defaults are:
  28         man1dir = $Config{'installman1dir'};
  29         man1ext = $Config{'man1ext'};
  30         man3dir = $Config{'installman3dir'};
  31         man3ext = $Config{'man3ext'};
  32         --notify  (or -n) just lists commands that would be executed.
  33         --verbose (or -V) report all progress.
  34         --silent  (or -S) be silent. Only report errors.\n";
  35
  36 my %opts;
  37 GetOptions( \%opts,
  38             qw( man1dir=s man1ext=s man3dir=s man3ext=s
  39                 notify n help silent S verbose V))
  40         || die $usage;
  41 die $usage if $opts{help};
  42
  43 $opts{man1dir} = $Config{'installman1dir'}
  44     unless defined($opts{man1dir});
  45 $opts{man1ext} = $Config{'man1ext'}
  46     unless defined($opts{man1ext});
  47 $opts{man3dir} = $Config{'installman3dir'}
  48     unless defined($opts{man3dir});
  49 $opts{man3ext} = $Config{'man3ext'}
  50     unless defined($opts{man3ext});
  51 $opts{silent} ||= $opts{S};
  52 $opts{verbose} ||= $opts{V};
  53
  54 $opts{notify} ||= $opts{n};
  55
  56 #Sanity checks
  57
  58 -x  "./perl$Config{exe_ext}"
  59   or warn "./perl$Config{exe_ext} not found!  Have you run make?\n";
  60 -d  $Config{'installprivlib'}
  61         || warn "Perl library directory $Config{'installprivlib'} not found.
  62                 Have you run make install?.  (Installing anyway.)\n";
  63 -x "t/perl$Config{exe_ext}"             || warn "WARNING: You've never run 'make test'!!!",
  64         "  (Installing anyway.)\n";
  65
  66 $packlist = ExtUtils::Packlist->new("$Config{installarchlib}/.packlist");
  67
  68 # Install the main pod pages.
  69 runpod2man('pod', $opts{man1dir}, $opts{man1ext});
  70
  71 # Install the pods for library modules.
  72 runpod2man('lib', $opts{man3dir}, $opts{man3ext});
  73
  74 # Install the pods embedded in the installed scripts
  75 runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'c2ph');
  76 runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'h2ph');
  77 runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'h2xs');
  78 runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'perlcc');
  79 runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'perldoc');
  80 runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'perlbug');
  81 runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'pl2pm');
  82 runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'splain');
  83 runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'dprofpp');
  84 runpod2man('x2p', $opts{man1dir}, $opts{man1ext}, 's2p');
  85 runpod2man('x2p', $opts{man1dir}, $opts{man1ext}, 'a2p.pod');
  86 runpod2man('x2p', $opts{man1dir}, $opts{man1ext}, 'find2perl');
  87 runpod2man('pod', $opts{man1dir}, $opts{man1ext}, 'pod2man');
  88 runpod2man('pod', $opts{man1dir}, $opts{man1ext}, 'pod2html');
  89 runpod2man('pod', $opts{man1dir}, $opts{man1ext}, 'pod2text');
  90 runpod2man('pod', $opts{man1dir}, $opts{man1ext}, 'pod2usage');
  91 runpod2man('pod', $opts{man1dir}, $opts{man1ext}, 'podchecker');
  92 runpod2man('pod', $opts{man1dir}, $opts{man1ext}, 'podselect');
  93
  94 # It would probably be better to have this page linked
  95 # to the c2ph man page.  Or, this one could say ".so man1/c2ph.1",
  96 # but then it would have to pay attention to $opts{man1dir} and $opts{man1ext}.
  97 runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'pstruct');
  98
  99 runpod2man('lib/ExtUtils', $opts{man1dir}, $opts{man1ext}, 'xsubpp');
 100
 101 sub runpod2man {
 102     # $script is script name if we are installing a manpage embedded
 103     # in a script, undef otherwise
 104     my($poddir, $mandir, $manext, $script) = @_;
 105
 106     my($downdir); # can't just use .. when installing xsubpp manpage
 107
 108     $downdir = $poddir;
 109     $downdir =~ s:[^/]+:..:g;
 110     my($builddir) = Cwd::getcwd();
 111
 112     if ($mandir eq ' ' or $mandir eq '') {
 113         warn "Skipping installation of ",
 114             ($script ? "$poddir/$script man page" : "$poddir man pages"), ".\n";
 115         return;
 116     }
 117
 118     print "chdir $poddir\n" if $opts{verbose};
 119     chdir $poddir || die "Unable to cd to $poddir directory!\n$!\n";
 120
 121     # We insist on using the current version of pod2man in case there
 122     # are enhancements or changes from previous installed versions.
 123     # The error message doesn't include the '..' because the user
 124     # won't be aware that we've chdir to $poddir.
 125     -r  "$downdir/pod/pod2man" || die "Executable pod/pod2man not found.\n";
 126
 127     # We want to be sure to use the current perl.  We can't rely on
 128     # the installed perl because it might not be actually installed
 129     # yet. (The user may have set the $install* Configure variables
 130     # to point to some temporary home, from which the executable gets
 131     # installed by occult means.)
 132     my $pod2man = "$downdir/perl -I $downdir/lib $downdir/pod/pod2man --section=$manext --official";
 133
 134     mkpath($mandir, 1, 0777) unless $opts{notify};  # In File::Path
 135     # Make a list of all the .pm and .pod files in the directory.  We will
 136     # always run pod2man from the lib directory and feed it the full pathname
 137     # of the pod.  This might be useful for pod2man someday.
 138     if ($script) {
 139         @modpods = ($script);
 140     }
 141     else {
 142         @modpods = ();
 143         File::Find::find(\&lsmodpods, '.');
 144     }
 145     foreach my $mod (@modpods) {
 146         my $manpage = $mod;
 147         my $tmp;
 148         # Skip .pm files that have corresponding .pod files, and Functions.pm.
 149         next if (($tmp = $mod) =~ s/\.pm$/.pod/ && -f $tmp);
 150         next if ($mod eq 'Pod/Functions.pm');   #### Used only by pod itself
 151
 152         # Convert name from  File/Basename.pm to File::Basename.3 format,
 153         # if necessary.
 154         $manpage =~ s#\.p(m|od)$##;
 155         if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin' || $^O eq 'cygwin') {
 156           $manpage =~ s#/#.#g;
 157         }
 158         else {
 159           $manpage =~ s#/#::#g;
 160         }
 161         $tmp = "${mandir}/${manpage}.tmp";
 162         $manpage = "${mandir}/${manpage}.${manext}";
 163         if (&cmd("$pod2man $mod > $tmp") == 0 && !$opts{notify} && -s $tmp) {
 164             if (rename($tmp, $manpage)) {
 165                 $packlist->{$manpage} = { type => 'file' };
 166                 next;
 167             }
 168         }
 169         unless ($opts{notify}) {
 170             unlink($tmp);
 171         }
 172     }
 173     chdir "$builddir" || die "Unable to cd back to $builddir directory!\n$!\n";
 174     print "  chdir $builddir\n" if $opts{verbose};
 175 }
 176
 177 sub lsmodpods {
 178     my $dir  = $File::Find::dir;
 179     my $name = $File::Find::name;
 180     if (-f $_) {
 181         $name =~ s#^\./##;
 182         push(@modpods, $name) if ($name =~ /\.p(m|od)$/);
 183     }
 184 }
 185
 186 $packlist->write() unless $opts{notify};
 187 print "  Installation complete\n" if $opts{verbose};
 188
 189 exit 0;
 190
 191
 192 ###############################################################################
 193 # Utility subroutines from installperl
 194
 195 sub cmd {
 196     my ($cmd) = @_;
 197     print "  $cmd\n" if $opts{verbose};
 198     unless ($opts{notify}) {
 199         if ($Config{d_fork}) {
 200             fork ? wait : exec $cmd;  # Allow user to ^C out of command.
 201         }
 202         else {
 203             system $cmd;
 204         }
 205         warn "Command failed!!\n" if $?;
 206     }
 207     return $? != 0;
 208 }
 209
 210 sub unlink {
 211     my(@names) = @_;
 212     my $cnt = 0;
 213
 214     foreach my $name (@names) {
 215         next unless -e $name;
 216         chmod 0777, $name if $^O eq 'os2';
 217         print "  unlink $name\n" if $opts{verbose};
 218         ( CORE::unlink($name) and ++$cnt
 219             or warn "Couldn't unlink $name: $!\n" ) unless $opts{notify};
 220     }
 221     return $cnt;
 222 }
 223
 224 sub link {
 225     my($from,$to) = @_;
 226     my($success) = 0;
 227
 228     print $opts{verbose} ? "  ln $from $to\n" : "  $to\n" unless $opts{silent};
 229     eval {
 230         CORE::link($from, $to)
 231             ? $success++
 232             : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
 233               ? die "AFS"  # okay inside eval {}
 234               : warn "Couldn't link $from to $to: $!\n"
 235           unless $opts{notify};
 236     };
 237     if ($@) {
 238         File::Copy::copy($from, $to)
 239             ? $success++
 240             : warn "Couldn't copy $from to $to: $!\n"
 241           unless $opts{notify};
 242     }
 243     $success;
 244 }
 245
 246 sub rename {
 247     my($from,$to) = @_;
 248     if (-f $to and not unlink($to)) {
 249         my($i);
 250         for ($i = 1; $i < 50; $i++) {
 251             last if CORE::rename($to, "$to.$i");
 252         }
 253         warn("Cannot rename to `$to.$i': $!"), return 0
 254             if $i >= 50;        # Give up!
 255     }
 256     link($from,$to) || return 0;
 257     unlink($from);
 258 }
 259
 260 sub chmod {
 261     my($mode,$name) = @_;
 262
 263     printf "  chmod %o %s\n", $mode, $name if $opts{verbose};
 264     CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name)
 265         unless $opts{notify};
 266 }
 267
 268 sub samepath {
 269     my($p1, $p2) = @_;
 270     my($dev1, $ino1, $dev2, $ino2);
 271
 272     if ($p1 ne $p2) {
 273         ($dev1, $ino1) = stat($p1);
 274         ($dev2, $ino2) = stat($p2);
 275         ($dev1 == $dev2 && $ino1 == $ino2);
 276     }
 277     else {
 278         1;
 279     }
 280 }