1 package ExtUtils::Install;
4 our(@ISA, @EXPORT, $VERSION);
5 $VERSION = substr q$Revision: 1.28 $, 10;
6 # $Date: 1998/01/25 07:08:24 $
10 use Config qw(%Config);
12 @EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
13 $Is_VMS = $^O eq 'VMS';
15 my $splitchar = $^O eq 'VMS' ? '|' : ($^O eq 'os2' || $^O eq 'dos') ? ';' : ':';
16 my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
17 my $Inc_uninstall_warn_handler;
19 # install relative to here
21 my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
25 sub install_rooted_file {
26 if (defined $INSTALL_ROOT) {
27 MY->catfile($INSTALL_ROOT, $_[0]);
33 sub install_rooted_dir {
34 if (defined $INSTALL_ROOT) {
35 MY->catdir($INSTALL_ROOT, $_[0]);
41 #our(@EXPORT, @ISA, $Is_VMS);
46 unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
50 my($hash,$verbose,$nonono,$inc_uninstall) = @_;
55 use ExtUtils::MakeMaker; # to implement a MY class
56 use ExtUtils::Packlist;
57 use File::Basename qw(dirname);
58 use File::Copy qw(copy);
59 use File::Find qw(find);
60 use File::Path qw(mkpath);
61 use File::Compare qw(compare);
64 my(%pack, $dir, $warn_permissions);
65 my($packlist) = ExtUtils::Packlist->new();
66 # -w doesn't work reliably on FAT dirs
67 $warn_permissions++ if $^O eq 'MSWin32';
69 for (qw/read write/) {
73 my($source_dir_or_file);
74 foreach $source_dir_or_file (sort keys %hash) {
75 #Check if there are files, and if yes, look if the corresponding
76 #target directory is writable for us
77 opendir DIR, $source_dir_or_file or next;
79 next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
80 my $targetdir = install_rooted_dir($hash{$source_dir_or_file});
85 warn "Warning: You do not have permissions to " .
86 "install into $hash{$source_dir_or_file}"
87 unless $warn_permissions++;
92 my $tmpfile = install_rooted_file($pack{"read"});
93 $packlist->read($tmpfile) if (-f $tmpfile);
97 MOD_INSTALL: foreach $source (sort keys %hash) {
98 #copy the tree to the target directory without altering
99 #timestamp and permission and remember for the .packlist
100 #file. The packlist file contains the absolute paths of the
101 #install locations. AFS users may call this a bug. We'll have
102 #to reconsider how to add the means to satisfy AFS users also.
104 #October 1997: we want to install .pm files into archlib if
105 #there are any files in arch. So we depend on having ./blib/arch
108 my $targetroot = install_rooted_dir($hash{$source});
110 if ($source eq "blib/lib" and
111 exists $hash{"blib/arch"} and
112 directory_not_empty("blib/arch")) {
113 $targetroot = install_rooted_dir($hash{"blib/arch"});
114 print "Files found in blib/arch: installing files in blib/lib into architecture dependent library tree\n";
116 chdir($source) or next;
118 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
119 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
121 return if $_ eq ".exists";
122 my $targetdir = MY->catdir($targetroot, $File::Find::dir);
124 my $targetfile = MY->catfile($targetdir, $_);
127 if ( -f $targetfile && -s _ == $size) {
128 # We have a good chance, we can skip this one
129 $diff = compare($_,$targetfile);
131 print "$_ differs\n" if $verbose>1;
137 forceunlink($targetfile) unless $nonono;
139 mkpath($targetdir,0,0755) unless $nonono;
140 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
142 copy($_,$targetfile) unless $nonono;
143 print "Installing $targetfile\n";
144 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
145 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
146 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
147 chmod $mode, $targetfile;
148 print "chmod($mode, $targetfile)\n" if $verbose>1;
150 print "Skipping $targetfile (unchanged)\n" if $verbose;
153 if (! defined $inc_uninstall) { # it's called
154 } elsif ($inc_uninstall == 0){
155 inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
157 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
159 $packlist->{$origfile}++;
162 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
164 if ($pack{'write'}) {
165 $dir = install_rooted_dir(dirname($pack{'write'}));
167 print "Writing $pack{'write'}\n";
168 $packlist->write(install_rooted_file($pack{'write'}));
172 sub directory_not_empty ($) {
176 return if $_ eq ".exists";
178 $File::Find::prune++;
185 sub install_default {
186 @_ < 2 or die "install_default should be called with 0 or 1 argument";
187 my $FULLEXT = @_ ? shift : $ARGV[0];
188 defined $FULLEXT or die "Do not know to where to write install log";
189 my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
190 my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
191 my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
192 my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
193 my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
194 my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
196 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
197 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
198 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
199 $Config{installsitearch} :
200 $Config{installsitelib},
201 $INST_ARCHLIB => $Config{installsitearch},
202 $INST_BIN => $Config{installbin} ,
203 $INST_SCRIPT => $Config{installscript},
204 $INST_MAN1DIR => $Config{installman1dir},
205 $INST_MAN3DIR => $Config{installman3dir},
210 use ExtUtils::Packlist;
211 my($fil,$verbose,$nonono) = @_;
212 die "no packlist file found: $fil" unless -f $fil;
213 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
214 # require $my_req; # Hairy, but for the first
215 my ($packlist) = ExtUtils::Packlist->new($fil);
216 foreach (sort(keys(%$packlist))) {
218 print "unlink $_\n" if $verbose;
219 forceunlink($_) unless $nonono;
221 print "unlink $fil\n" if $verbose;
222 forceunlink($fil) unless $nonono;
226 my($file,$libdir,$verbose,$nonono) = @_;
229 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
234 next if $seen_dir{$dir}++;
235 my($targetfile) = MY->catfile($dir,$libdir,$file);
236 next unless -f $targetfile;
238 # The reason why we compare file's contents is, that we cannot
239 # know, which is the file we just installed (AFS). So we leave
240 # an identical file in place
242 if ( -f $targetfile && -s _ == -s $file) {
243 # We have a good chance, we can skip this one
244 $diff = compare($file,$targetfile);
246 print "#$file and $targetfile differ\n" if $verbose>1;
253 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
254 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
255 $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
257 # if not verbose, we just say nothing
259 print "Unlinking $targetfile (shadowing?)\n";
260 forceunlink($targetfile);
266 my ($cmd, $src, $dest) = @_;
268 open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
269 open(SRC, $src) || die "Cannot open $src: $!";
272 while (my $len = sysread(SRC, $buf, $sz)) {
273 syswrite(CMD, $buf, $len);
276 close CMD or die "Filter command '$cmd' failed for $src";
280 my($fromto,$autodir,$pm_filter) = @_;
282 use File::Basename qw(dirname);
283 use File::Copy qw(copy);
284 use File::Path qw(mkpath);
285 use File::Compare qw(compare);
287 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
288 # require $my_req; # Hairy, but for the first
290 if (!ref($fromto) && -r $fromto)
292 # Win32 has severe command line length limitations, but
293 # can generate temporary files on-the-fly
294 # so we pass name of file here - eval it to get hash
295 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
296 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
301 mkpath($autodir,0,0755);
302 foreach (keys %$fromto) {
303 my $dest = $fromto->{$_};
304 next if -f $dest && -M $dest < -M $_;
306 # When a pm_filter is defined, we need to pre-process the source first
307 # to determine whether it has changed or not. Therefore, only perform
308 # the comparison check when there's no filter to be ran.
311 my $need_filtering = defined $pm_filter && length $pm_filter && /\.pm$/;
313 if (!$need_filtering && 0 == compare($_,$dest)) {
314 print "Skip $dest (unchanged)\n";
320 mkpath(dirname($dest),0,0755);
322 if ($need_filtering) {
323 run_filter($pm_filter, $_, $dest);
324 print "$pm_filter <$_ >$dest\n";
327 print "cp $_ $dest\n";
329 my($mode,$atime,$mtime) = (stat)[2,8,9];
330 utime($atime,$mtime+$Is_VMS,$dest);
331 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$dest);
333 autosplit($dest,$autodir);
337 package ExtUtils::Install::Warn;
339 sub new { bless {}, shift }
342 my($self,$file,$targetfile) = @_;
343 push @{$self->{$file}}, $targetfile;
347 unless(defined $INSTALL_ROOT) {
349 my($file,$i,$plural);
350 foreach $file (sort keys %$self) {
351 $plural = @{$self->{$file}} > 1 ? "s" : "";
352 print "## Differing version$plural of $file found. You might like to\n";
353 for (0..$#{$self->{$file}}) {
354 print "rm ", $self->{$file}[$_], "\n";
358 $plural = $i>1 ? "all those files" : "this file";
359 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
369 ExtUtils::Install - install files from here to there
373 B<use ExtUtils::Install;>
375 B<install($hashref,$verbose,$nonono);>
377 B<uninstall($packlistfile,$verbose,$nonono);>
379 B<pm_to_blib($hashref);>
383 Both install() and uninstall() are specific to the way
384 ExtUtils::MakeMaker handles the installation and deinstallation of
385 perl modules. They are not designed as general purpose tools.
387 install() takes three arguments. A reference to a hash, a verbose
388 switch and a don't-really-do-it switch. The hash ref contains a
389 mapping of directories: each key/value pair is a combination of
390 directories to be copied. Key is a directory to copy from, value is a
391 directory to copy to. The whole tree below the "from" directory will
392 be copied preserving timestamps and permissions.
394 There are two keys with a special meaning in the hash: "read" and
395 "write". After the copying is done, install will write the list of
396 target files to the file named by C<$hashref-E<gt>{write}>. If there is
397 another file named by C<$hashref-E<gt>{read}>, the contents of this file will
398 be merged into the written file. The read and the written file may be
399 identical, but on AFS it is quite likely that people are installing to a
400 different directory than the one where the files later appear.
402 install_default() takes one or less arguments. If no arguments are
403 specified, it takes $ARGV[0] as if it was specified as an argument.
404 The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
405 This function calls install() with the same arguments as the defaults
406 the MakeMaker would use.
408 The argument-less form is convenient for install scripts like
410 perl -MExtUtils::Install -e install_default Tk/Canvas
412 Assuming this command is executed in a directory with a populated F<blib>
413 directory, it will proceed as if the F<blib> was build by MakeMaker on
414 this machine. This is useful for binary distributions.
416 uninstall() takes as first argument a file containing filenames to be
417 unlinked. The second argument is a verbose switch, the third is a
418 no-don't-really-do-it-now switch.
420 pm_to_blib() takes a hashref as the first argument and copies all keys
421 of the hash to the corresponding values efficiently. Filenames with
422 the extension pm are autosplit. Second argument is the autosplit
423 directory. If third argument is not empty, it is taken as a filter command
424 to be ran on each .pm file, the output of the command being what is finally
425 copied, and the source for auto-splitting.
427 You can have an environment variable PERL_INSTALL_ROOT set which will
428 be prepended as a directory to each installed file (and directory).