1 package ExtUtils::Install;
4 our(@ISA, @EXPORT, $VERSION);
5 $VERSION = substr q$Revision: 1.29 $, 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 File::Spec->catfile($INSTALL_ROOT, $_[0]);
33 sub install_rooted_dir {
34 if (defined $INSTALL_ROOT) {
35 File::Spec->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::Packlist;
56 use File::Basename qw(dirname);
57 use File::Copy qw(copy);
58 use File::Find qw(find);
59 use File::Path qw(mkpath);
60 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 = File::Spec->catdir($targetroot, $File::Find::dir);
123 my $targetfile = File::Spec->catfile($targetdir, $_);
126 if ( -f $targetfile && -s _ == $size) {
127 # We have a good chance, we can skip this one
128 $diff = compare($_,$targetfile);
130 print "$_ differs\n" if $verbose>1;
136 forceunlink($targetfile) unless $nonono;
138 mkpath($targetdir,0,0755) unless $nonono;
139 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
141 copy($_,$targetfile) unless $nonono;
142 print "Installing $targetfile\n";
143 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
144 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
145 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
146 chmod $mode, $targetfile;
147 print "chmod($mode, $targetfile)\n" if $verbose>1;
149 print "Skipping $targetfile (unchanged)\n" if $verbose;
152 if (! defined $inc_uninstall) { # it's called
153 } elsif ($inc_uninstall == 0){
154 inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
156 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
158 $packlist->{$targetfile}++;
161 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
163 if ($pack{'write'}) {
164 $dir = install_rooted_dir(dirname($pack{'write'}));
166 print "Writing $pack{'write'}\n";
167 $packlist->write(install_rooted_file($pack{'write'}));
171 sub directory_not_empty ($) {
175 return if $_ eq ".exists";
177 $File::Find::prune++;
184 sub install_default {
185 @_ < 2 or die "install_default should be called with 0 or 1 argument";
186 my $FULLEXT = @_ ? shift : $ARGV[0];
187 defined $FULLEXT or die "Do not know to where to write install log";
188 my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
189 my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
190 my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
191 my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
192 my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
193 my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
195 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
196 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
197 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
198 $Config{installsitearch} :
199 $Config{installsitelib},
200 $INST_ARCHLIB => $Config{installsitearch},
201 $INST_BIN => $Config{installbin} ,
202 $INST_SCRIPT => $Config{installscript},
203 $INST_MAN1DIR => $Config{installman1dir},
204 $INST_MAN3DIR => $Config{installman3dir},
209 use ExtUtils::Packlist;
210 my($fil,$verbose,$nonono) = @_;
211 die "no packlist file found: $fil" unless -f $fil;
212 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
213 # require $my_req; # Hairy, but for the first
214 my ($packlist) = ExtUtils::Packlist->new($fil);
215 foreach (sort(keys(%$packlist))) {
217 print "unlink $_\n" if $verbose;
218 forceunlink($_) unless $nonono;
220 print "unlink $fil\n" if $verbose;
221 forceunlink($fil) unless $nonono;
225 my($file,$libdir,$verbose,$nonono) = @_;
228 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
233 next if $seen_dir{$dir}++;
234 my($targetfile) = File::Spec->catfile($dir,$libdir,$file);
235 next unless -f $targetfile;
237 # The reason why we compare file's contents is, that we cannot
238 # know, which is the file we just installed (AFS). So we leave
239 # an identical file in place
241 if ( -f $targetfile && -s _ == -s $file) {
242 # We have a good chance, we can skip this one
243 $diff = compare($file,$targetfile);
245 print "#$file and $targetfile differ\n" if $verbose>1;
252 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
253 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
254 $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
256 # if not verbose, we just say nothing
258 print "Unlinking $targetfile (shadowing?)\n";
259 forceunlink($targetfile);
265 my ($cmd, $src, $dest) = @_;
266 open(my $CMD, "|$cmd >$dest") || die "Cannot fork: $!";
267 open(my $SRC, $src) || die "Cannot open $src: $!";
270 while (my $len = sysread($SRC, $buf, $sz)) {
271 syswrite($CMD, $buf, $len);
274 close $CMD or die "Filter command '$cmd' failed for $src";
278 my($fromto,$autodir,$pm_filter) = @_;
280 use File::Basename qw(dirname);
281 use File::Copy qw(copy);
282 use File::Path qw(mkpath);
283 use File::Compare qw(compare);
285 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
286 # require $my_req; # Hairy, but for the first
288 if (!ref($fromto) && -r $fromto)
290 # Win32 has severe command line length limitations, but
291 # can generate temporary files on-the-fly
292 # so we pass name of file here - eval it to get hash
293 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
294 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
299 mkpath($autodir,0,0755);
300 foreach (keys %$fromto) {
301 my $dest = $fromto->{$_};
302 next if -f $dest && -M $dest < -M $_;
304 # When a pm_filter is defined, we need to pre-process the source first
305 # to determine whether it has changed or not. Therefore, only perform
306 # the comparison check when there's no filter to be ran.
309 my $need_filtering = defined $pm_filter && length $pm_filter && /\.pm$/;
311 if (!$need_filtering && 0 == compare($_,$dest)) {
312 print "Skip $dest (unchanged)\n";
318 mkpath(dirname($dest),0,0755);
320 if ($need_filtering) {
321 run_filter($pm_filter, $_, $dest);
322 print "$pm_filter <$_ >$dest\n";
325 print "cp $_ $dest\n";
327 my($mode,$atime,$mtime) = (stat)[2,8,9];
328 utime($atime,$mtime+$Is_VMS,$dest);
329 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$dest);
331 autosplit($dest,$autodir);
335 package ExtUtils::Install::Warn;
337 sub new { bless {}, shift }
340 my($self,$file,$targetfile) = @_;
341 push @{$self->{$file}}, $targetfile;
345 unless(defined $INSTALL_ROOT) {
347 my($file,$i,$plural);
348 foreach $file (sort keys %$self) {
349 $plural = @{$self->{$file}} > 1 ? "s" : "";
350 print "## Differing version$plural of $file found. You might like to\n";
351 for (0..$#{$self->{$file}}) {
352 print "rm ", $self->{$file}[$_], "\n";
356 $plural = $i>1 ? "all those files" : "this file";
357 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
367 ExtUtils::Install - install files from here to there
371 B<use ExtUtils::Install;>
373 B<install($hashref,$verbose,$nonono);>
375 B<uninstall($packlistfile,$verbose,$nonono);>
377 B<pm_to_blib($hashref);>
381 Both install() and uninstall() are specific to the way
382 ExtUtils::MakeMaker handles the installation and deinstallation of
383 perl modules. They are not designed as general purpose tools.
385 install() takes three arguments. A reference to a hash, a verbose
386 switch and a don't-really-do-it switch. The hash ref contains a
387 mapping of directories: each key/value pair is a combination of
388 directories to be copied. Key is a directory to copy from, value is a
389 directory to copy to. The whole tree below the "from" directory will
390 be copied preserving timestamps and permissions.
392 There are two keys with a special meaning in the hash: "read" and
393 "write". After the copying is done, install will write the list of
394 target files to the file named by C<$hashref-E<gt>{write}>. If there is
395 another file named by C<$hashref-E<gt>{read}>, the contents of this file will
396 be merged into the written file. The read and the written file may be
397 identical, but on AFS it is quite likely that people are installing to a
398 different directory than the one where the files later appear.
400 install_default() takes one or less arguments. If no arguments are
401 specified, it takes $ARGV[0] as if it was specified as an argument.
402 The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
403 This function calls install() with the same arguments as the defaults
404 the MakeMaker would use.
406 The argument-less form is convenient for install scripts like
408 perl -MExtUtils::Install -e install_default Tk/Canvas
410 Assuming this command is executed in a directory with a populated F<blib>
411 directory, it will proceed as if the F<blib> was build by MakeMaker on
412 this machine. This is useful for binary distributions.
414 uninstall() takes as first argument a file containing filenames to be
415 unlinked. The second argument is a verbose switch, the third is a
416 no-don't-really-do-it-now switch.
418 pm_to_blib() takes a hashref as the first argument and copies all keys
419 of the hash to the corresponding values efficiently. Filenames with
420 the extension pm are autosplit. Second argument is the autosplit
421 directory. If third argument is not empty, it is taken as a filter command
422 to be ran on each .pm file, the output of the command being what is finally
423 copied, and the source for auto-splitting.
425 You can have an environment variable PERL_INSTALL_ROOT set which will
426 be prepended as a directory to each installed file (and directory).