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