1 package ExtUtils::Install;
4 use vars qw(@ISA @EXPORT $VERSION);
9 use Config qw(%Config);
11 @EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
12 $Is_VMS = $^O eq 'VMS';
13 $Is_MacPerl = $^O eq 'MacOS';
15 my $Inc_uninstall_warn_handler;
17 # install relative to here
19 my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
22 my $Curdir = File::Spec->curdir;
23 my $Updir = File::Spec->updir;
28 ExtUtils::Install - install files from here to there
32 use ExtUtils::Install;
34 install({ 'blib/lib' => 'some/install/dir' } );
38 pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' });
43 Handles the installing and uninstalling of perl modules, scripts, man
46 Both install() and uninstall() are specific to the way
47 ExtUtils::MakeMaker handles the installation and deinstallation of
48 perl modules. They are not designed as general purpose tools.
57 install(\%from_to, $verbose, $dont_execute, $uninstall_shadows);
59 Copies each directory tree of %from_to to its corresponding value
60 preserving timestamps and permissions.
62 There are two keys with a special meaning in the hash: "read" and
63 "write". These contain packlist files. After the copying is done,
64 install() will write the list of target files to $from_to{write}. If
65 $from_to{read} is given the contents of this file will be merged into
66 the written file. The read and the written file may be identical, but
67 on AFS it is quite likely that people are installing to a different
68 directory than the one where the files later appear.
70 If $verbose is true, will print out each file removed. Default is
71 false. This is "make install VERBINST=1"
73 If $dont_execute is true it will only print what it was going to do
74 without actually doing it. Default is false.
76 If $uninstall_shadows is true any differing versions throughout @INC
77 will be uninstalled. This is "make install UNINST=1"
82 my($from_to,$verbose,$nonono,$inc_uninstall) = @_;
87 use ExtUtils::Packlist;
88 use File::Basename qw(dirname);
89 use File::Copy qw(copy);
90 use File::Find qw(find);
91 use File::Path qw(mkpath);
92 use File::Compare qw(compare);
94 my $win32_special=!$nonono &&
96 eval { require Win32API::File; 1 };
97 my(%from_to) = %$from_to;
98 my(%pack, $dir, $warn_permissions);
99 my($packlist) = ExtUtils::Packlist->new();
100 # -w doesn't work reliably on FAT dirs
101 $warn_permissions++ if $^O eq 'MSWin32';
103 for (qw/read write/) {
104 $pack{$_}=$from_to{$_};
107 my($source_dir_or_file);
108 foreach $source_dir_or_file (sort keys %from_to) {
109 #Check if there are files, and if yes, look if the corresponding
110 #target directory is writable for us
111 opendir DIR, $source_dir_or_file or next;
113 next if $_ eq $Curdir || $_ eq $Updir || $_ eq ".exists";
114 my $targetdir = install_rooted_dir($from_to{$source_dir_or_file});
115 mkpath($targetdir) unless $nonono;
116 if (!$nonono && !-w $targetdir) {
117 warn "Warning: You do not have permissions to " .
118 "install into $from_to{$source_dir_or_file}"
119 unless $warn_permissions++;
124 my $tmpfile = install_rooted_file($pack{"read"});
125 $packlist->read($tmpfile) if (-f $tmpfile);
128 MOD_INSTALL: foreach my $source (sort keys %from_to) {
129 #copy the tree to the target directory without altering
130 #timestamp and permission and remember for the .packlist
131 #file. The packlist file contains the absolute paths of the
132 #install locations. AFS users may call this a bug. We'll have
133 #to reconsider how to add the means to satisfy AFS users also.
135 #October 1997: we want to install .pm files into archlib if
136 #there are any files in arch. So we depend on having ./blib/arch
139 my $targetroot = install_rooted_dir($from_to{$source});
141 my $blib_lib = File::Spec->catdir('blib', 'lib');
142 my $blib_arch = File::Spec->catdir('blib', 'arch');
143 if ($source eq $blib_lib and
144 exists $from_to{$blib_arch} and
145 directory_not_empty($blib_arch)) {
146 $targetroot = install_rooted_dir($from_to{$blib_arch});
147 print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
150 chdir $source or next;
152 my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
156 return if $origfile eq ".exists";
157 my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
158 my $targetfile = File::Spec->catfile($targetdir, $origfile);
159 my $sourcedir = File::Spec->catdir($source, $File::Find::dir);
160 my $sourcefile = File::Spec->catfile($sourcedir, $origfile);
163 chdir $cwd; # in case the target is relative
164 # 5.5.3's File::Find missing no_chdir option.
167 if ( -f $targetfile && -s _ == $size) {
168 # We have a good chance, we can skip this one
169 $diff = compare($sourcefile, $targetfile);
171 print "$sourcefile differs\n" if $verbose>1;
176 if ($win32_special && -f $targetfile && !unlink $targetfile) {
177 print "Can't remove existing '$targetfile': $!\n";
179 ++$tmp while -e "$targetfile.$tmp";
180 $tmp= "$targetfile.$tmp";
181 if ( rename $targetfile, $tmp ) {
182 print "However it has been renamed as '$tmp' which ".
183 "will be removed at next reboot.\n";
184 Win32API::File::MoveFileEx( $tmp, [],
185 Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT() )
186 or die "MoveFileEx/Delete '$tmp' failed: $^E\n";
188 print "Installation cannot be completed until you reboot.\n",
189 "Until then using '$tmp' as the install filename.\n";
190 Win32API::File::MoveFileEx( $tmp, $targetfile,
191 Win32API::File::MOVEFILE_REPLACE_EXISTING() |
192 Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT() )
193 or die "MoveFileEx/Replace '$tmp' failed: $^E\n";
196 } elsif (-f $targetfile) {
197 forceunlink($targetfile) unless $nonono;
199 mkpath($targetdir,0,0755) unless $nonono;
200 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
202 copy($sourcefile, $targetfile) unless $nonono;
203 print "Installing $targetfile\n";
204 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
205 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
206 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
207 chmod $mode, $targetfile;
208 print "chmod($mode, $targetfile)\n" if $verbose>1;
210 print "Skipping $targetfile (unchanged)\n" if $verbose;
213 if (defined $inc_uninstall) {
214 inc_uninstall($sourcefile,$File::Find::dir,$verbose,
215 $inc_uninstall ? 0 : 1);
218 # Record the full pathname.
219 $packlist->{$targetfile}++;
221 # File::Find can get confused if you chdir in here.
224 # File::Find seems to always be Unixy except on MacPerl :(
225 }, $Is_MacPerl ? $Curdir : '.' );
226 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
228 if ($pack{'write'}) {
229 $dir = install_rooted_dir(dirname($pack{'write'}));
230 mkpath($dir,0,0755) unless $nonono;
231 print "Writing $pack{'write'}\n";
232 $packlist->write(install_rooted_file($pack{'write'})) unless $nonono;
236 sub install_rooted_file {
237 if (defined $INSTALL_ROOT) {
238 File::Spec->catfile($INSTALL_ROOT, $_[0]);
245 sub install_rooted_dir {
246 if (defined $INSTALL_ROOT) {
247 File::Spec->catdir($INSTALL_ROOT, $_[0]);
256 unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
260 sub directory_not_empty ($) {
264 return if $_ eq ".exists";
266 $File::Find::prune++;
274 =item B<install_default> I<DISCOURAGED>
277 install_default($fullext);
279 Calls install() with arguments to copy a module from blib/ to the
280 default site installation location.
282 $fullext is the name of the module converted to a directory
283 (ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it
284 will attempt to read it from @ARGV.
286 This is primarily useful for install scripts.
288 B<NOTE> This function is not really useful because of the hard-coded
289 install location with no way to control site vs core vs vendor
290 directories and the strange way in which the module name is given.
291 Consider its use discouraged.
295 sub install_default {
296 @_ < 2 or die "install_default should be called with 0 or 1 argument";
297 my $FULLEXT = @_ ? shift : $ARGV[0];
298 defined $FULLEXT or die "Do not know to where to write install log";
299 my $INST_LIB = File::Spec->catdir($Curdir,"blib","lib");
300 my $INST_ARCHLIB = File::Spec->catdir($Curdir,"blib","arch");
301 my $INST_BIN = File::Spec->catdir($Curdir,'blib','bin');
302 my $INST_SCRIPT = File::Spec->catdir($Curdir,'blib','script');
303 my $INST_MAN1DIR = File::Spec->catdir($Curdir,'blib','man1');
304 my $INST_MAN3DIR = File::Spec->catdir($Curdir,'blib','man3');
306 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
307 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
308 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
309 $Config{installsitearch} :
310 $Config{installsitelib},
311 $INST_ARCHLIB => $Config{installsitearch},
312 $INST_BIN => $Config{installbin} ,
313 $INST_SCRIPT => $Config{installscript},
314 $INST_MAN1DIR => $Config{installman1dir},
315 $INST_MAN3DIR => $Config{installman3dir},
322 uninstall($packlist_file);
323 uninstall($packlist_file, $verbose, $dont_execute);
325 Removes the files listed in a $packlist_file.
327 If $verbose is true, will print out each file removed. Default is
330 If $dont_execute is true it will only print what it was going to do
331 without actually doing it. Default is false.
336 use ExtUtils::Packlist;
337 my($fil,$verbose,$nonono) = @_;
341 die "no packlist file found: $fil" unless -f $fil;
342 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
343 # require $my_req; # Hairy, but for the first
344 my ($packlist) = ExtUtils::Packlist->new($fil);
345 foreach (sort(keys(%$packlist))) {
347 print "unlink $_\n" if $verbose;
348 forceunlink($_) unless $nonono;
350 print "unlink $fil\n" if $verbose;
351 forceunlink($fil) unless $nonono;
355 my($filepath,$libdir,$verbose,$nonono) = @_;
357 my $file = (File::Spec->splitpath($filepath))[2];
360 my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'}
361 ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
363 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
367 next if $dir eq $Curdir;
368 next if $seen_dir{$dir}++;
369 my($targetfile) = File::Spec->catfile($dir,$libdir,$file);
370 next unless -f $targetfile;
372 # The reason why we compare file's contents is, that we cannot
373 # know, which is the file we just installed (AFS). So we leave
374 # an identical file in place
376 if ( -f $targetfile && -s _ == -s $filepath) {
377 # We have a good chance, we can skip this one
378 $diff = compare($filepath,$targetfile);
380 print "#$file and $targetfile differ\n" if $verbose>1;
387 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
388 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
389 $Inc_uninstall_warn_handler->add(
390 File::Spec->catfile($libdir, $file),
394 # if not verbose, we just say nothing
396 print "Unlinking $targetfile (shadowing?)\n";
397 forceunlink($targetfile);
403 my ($cmd, $src, $dest) = @_;
405 open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
406 open(SRC, $src) || die "Cannot open $src: $!";
409 while (my $len = sysread(SRC, $buf, $sz)) {
410 syswrite(CMD, $buf, $len);
413 close CMD or die "Filter command '$cmd' failed for $src";
419 pm_to_blib(\%from_to, $autosplit_dir);
420 pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
422 Copies each key of %from_to to its corresponding value efficiently.
423 Filenames with the extension .pm are autosplit into the $autosplit_dir.
424 Any destination directories are created.
426 $filter_cmd is an optional shell command to run each .pm file through
427 prior to splitting and copying. Input is the contents of the module,
428 output the new module contents.
430 You can have an environment variable PERL_INSTALL_ROOT set which will
431 be prepended as a directory to each installed file (and directory).
436 my($fromto,$autodir,$pm_filter) = @_;
438 use File::Basename qw(dirname);
439 use File::Copy qw(copy);
440 use File::Path qw(mkpath);
441 use File::Compare qw(compare);
444 mkpath($autodir,0,0755);
445 while(my($from, $to) = each %$fromto) {
446 if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
447 print "Skip $to (unchanged)\n";
451 # When a pm_filter is defined, we need to pre-process the source first
452 # to determine whether it has changed or not. Therefore, only perform
453 # the comparison check when there's no filter to be ran.
456 my $need_filtering = defined $pm_filter && length $pm_filter &&
459 if (!$need_filtering && 0 == compare($from,$to)) {
460 print "Skip $to (unchanged)\n";
466 mkpath(dirname($to),0,0755);
468 if ($need_filtering) {
469 run_filter($pm_filter, $from, $to);
470 print "$pm_filter <$from >$to\n";
473 print "cp $from $to\n";
475 my($mode,$atime,$mtime) = (stat $from)[2,8,9];
476 utime($atime,$mtime+$Is_VMS,$to);
477 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
478 next unless $from =~ /\.pm$/;
479 _autosplit($to,$autodir);
488 From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
489 the file being split. This causes problems on systems with mandatory
490 locking (ie. Windows). So we wrap it and close the filehandle.
497 my $retval = autosplit(@_);
498 close *AutoSplit::IN if defined *AutoSplit::IN{IO};
504 package ExtUtils::Install::Warn;
506 sub new { bless {}, shift }
509 my($self,$file,$targetfile) = @_;
510 push @{$self->{$file}}, $targetfile;
514 unless(defined $INSTALL_ROOT) {
516 my($file,$i,$plural);
517 foreach $file (sort keys %$self) {
518 $plural = @{$self->{$file}} > 1 ? "s" : "";
519 print "## Differing version$plural of $file found. You might like to\n";
520 for (0..$#{$self->{$file}}) {
521 print "rm ", $self->{$file}[$_], "\n";
525 $plural = $i>1 ? "all those files" : "this file";
526 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
537 =item B<PERL_INSTALL_ROOT>
539 Will be prepended to each install path.
545 Original author lost in the mists of time. Probably the same as Makemaker.
547 Currently maintained by Michael G Schwern C<schwern@pobox.com>
549 Send patches and ideas to C<makemaker@perl.org>.
551 Send bug reports via http://rt.cpan.org/. Please send your
552 generated Makefile along with your report.
554 For more up-to-date information, see L<http://www.makemaker.org>.
559 This program is free software; you can redistribute it and/or
560 modify it under the same terms as Perl itself.
562 See L<http://www.perl.com/perl/misc/Artistic.html>