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 $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};
24 my $Curdir = File::Spec->curdir;
25 my $Updir = File::Spec->updir;
30 ExtUtils::Install - install files from here to there
34 use ExtUtils::Install;
36 install({ 'blib/lib' => 'some/install/dir' } );
40 pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' });
45 Handles the installing and uninstalling of perl modules, scripts, man
48 Both install() and uninstall() are specific to the way
49 ExtUtils::MakeMaker handles the installation and deinstallation of
50 perl modules. They are not designed as general purpose tools.
59 install(\%from_to, $verbose, $dont_execute);
61 Copies each directory tree of %from_to to its corresponding value
62 preserving timestamps and permissions.
64 There are two keys with a special meaning in the hash: "read" and
65 "write". These contain packlist files. After the copying is done,
66 install() will write the list of target files to $from_to{write}. If
67 $from_to{read} is given the contents of this file will be merged into
68 the written file. The read and the written file may be identical, but
69 on AFS it is quite likely that people are installing to a different
70 directory than the one where the files later appear.
72 If $verbose is true, will print out each file removed. Default is
75 If $dont_execute is true it will only print what it was going to do
76 without actually doing it. Default is false.
81 my($from_to,$verbose,$nonono,$inc_uninstall) = @_;
86 use ExtUtils::Packlist;
87 use File::Basename qw(dirname);
88 use File::Copy qw(copy);
89 use File::Find qw(find);
90 use File::Path qw(mkpath);
91 use File::Compare qw(compare);
93 my(%from_to) = %$from_to;
94 my(%pack, $dir, $warn_permissions);
95 my($packlist) = ExtUtils::Packlist->new();
96 # -w doesn't work reliably on FAT dirs
97 $warn_permissions++ if $^O eq 'MSWin32';
99 for (qw/read write/) {
100 $pack{$_}=$from_to{$_};
103 my($source_dir_or_file);
104 foreach $source_dir_or_file (sort keys %from_to) {
105 #Check if there are files, and if yes, look if the corresponding
106 #target directory is writable for us
107 opendir DIR, $source_dir_or_file or next;
109 next if $_ eq $Curdir || $_ eq $Updir || $_ eq ".exists";
110 my $targetdir = install_rooted_dir($from_to{$source_dir_or_file});
112 mkpath($targetdir)) {
115 warn "Warning: You do not have permissions to " .
116 "install into $from_to{$source_dir_or_file}"
117 unless $warn_permissions++;
122 my $tmpfile = install_rooted_file($pack{"read"});
123 $packlist->read($tmpfile) if (-f $tmpfile);
126 MOD_INSTALL: foreach my $source (sort keys %from_to) {
127 #copy the tree to the target directory without altering
128 #timestamp and permission and remember for the .packlist
129 #file. The packlist file contains the absolute paths of the
130 #install locations. AFS users may call this a bug. We'll have
131 #to reconsider how to add the means to satisfy AFS users also.
133 #October 1997: we want to install .pm files into archlib if
134 #there are any files in arch. So we depend on having ./blib/arch
137 my $targetroot = install_rooted_dir($from_to{$source});
139 my $blib_lib = File::Spec->catdir('blib', 'lib');
140 my $blib_arch = File::Spec->catdir('blib', 'arch');
141 if ($source eq $blib_lib and
142 exists $from_to{$blib_arch} and
143 directory_not_empty($blib_arch)) {
144 $targetroot = install_rooted_dir($from_to{$blib_arch});
145 print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
148 chdir $source or next;
150 my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
152 return if $_ eq ".exists";
153 my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
154 my $targetfile = File::Spec->catfile($targetdir, $_);
155 my $sourcedir = File::Spec->catdir($source, $File::Find::dir);
156 my $sourcefile = File::Spec->catfile($sourcedir, $_);
159 chdir $cwd; # in case the target is relative
160 # 5.5.3's File::Find missing no_chdir option.
163 if ( -f $targetfile && -s _ == $size) {
164 # We have a good chance, we can skip this one
165 $diff = compare($sourcefile, $targetfile);
167 print "$sourcefile differs\n" if $verbose>1;
173 forceunlink($targetfile) unless $nonono;
175 mkpath($targetdir,0,0755) unless $nonono;
176 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
178 copy($sourcefile, $targetfile) unless $nonono;
179 print "Installing $targetfile\n";
180 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
181 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
182 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
183 chmod $mode, $targetfile;
184 print "chmod($mode, $targetfile)\n" if $verbose>1;
186 print "Skipping $targetfile (unchanged)\n" if $verbose;
189 if (defined $inc_uninstall) {
190 inc_uninstall($sourcefile,$File::Find::dir,$verbose,
191 $inc_uninstall ? 0 : 1);
194 # Record the full pathname.
195 $packlist->{$targetfile}++;
197 # File::Find can get confused if you chdir in here.
200 # File::Find seems to always be Unixy except on MacPerl :(
201 }, $Is_MacPerl ? $Curdir : '.' );
202 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
204 if ($pack{'write'}) {
205 $dir = install_rooted_dir(dirname($pack{'write'}));
207 print "Writing $pack{'write'}\n";
208 $packlist->write(install_rooted_file($pack{'write'}));
212 sub install_rooted_file {
213 if (defined $INSTALL_ROOT) {
214 File::Spec->catfile($INSTALL_ROOT, $_[0]);
221 sub install_rooted_dir {
222 if (defined $INSTALL_ROOT) {
223 File::Spec->catdir($INSTALL_ROOT, $_[0]);
232 unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
236 sub directory_not_empty ($) {
240 return if $_ eq ".exists";
242 $File::Find::prune++;
250 =item B<install_default> I<DISCOURAGED>
253 install_default($fullext);
255 Calls install() with arguments to copy a module from blib/ to the
256 default site installation location.
258 $fullext is the name of the module converted to a directory
259 (ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it
260 will attempt to read it from @ARGV.
262 This is primarily useful for install scripts.
264 B<NOTE> This function is not really useful because of the hard-coded
265 install location with no way to control site vs core vs vendor
266 directories and the strange way in which the module name is given.
267 Consider its use discouraged.
271 sub install_default {
272 @_ < 2 or die "install_default should be called with 0 or 1 argument";
273 my $FULLEXT = @_ ? shift : $ARGV[0];
274 defined $FULLEXT or die "Do not know to where to write install log";
275 my $INST_LIB = File::Spec->catdir(File::Spec->curdir,"blib","lib");
276 my $INST_ARCHLIB = File::Spec->catdir(File::Spec->curdir,"blib","arch");
277 my $INST_BIN = File::Spec->catdir(File::Spec->curdir,'blib','bin');
278 my $INST_SCRIPT = File::Spec->catdir(File::Spec->curdir,'blib','script');
279 my $INST_MAN1DIR = File::Spec->catdir(File::Spec->curdir,'blib','man1');
280 my $INST_MAN3DIR = File::Spec->catdir(File::Spec->curdir,'blib','man3');
282 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
283 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
284 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
285 $Config{installsitearch} :
286 $Config{installsitelib},
287 $INST_ARCHLIB => $Config{installsitearch},
288 $INST_BIN => $Config{installbin} ,
289 $INST_SCRIPT => $Config{installscript},
290 $INST_MAN1DIR => $Config{installman1dir},
291 $INST_MAN3DIR => $Config{installman3dir},
298 uninstall($packlist_file);
299 uninstall($packlist_file, $verbose, $dont_execute);
301 Removes the files listed in a $packlist_file.
303 If $verbose is true, will print out each file removed. Default is
306 If $dont_execute is true it will only print what it was going to do
307 without actually doing it. Default is false.
312 use ExtUtils::Packlist;
313 my($fil,$verbose,$nonono) = @_;
317 die "no packlist file found: $fil" unless -f $fil;
318 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
319 # require $my_req; # Hairy, but for the first
320 my ($packlist) = ExtUtils::Packlist->new($fil);
321 foreach (sort(keys(%$packlist))) {
323 print "unlink $_\n" if $verbose;
324 forceunlink($_) unless $nonono;
326 print "unlink $fil\n" if $verbose;
327 forceunlink($fil) unless $nonono;
331 my($file,$libdir,$verbose,$nonono) = @_;
334 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
338 next if $dir eq $Curdir;
339 next if $seen_dir{$dir}++;
340 my($targetfile) = File::Spec->catfile($dir,$libdir,$file);
341 next unless -f $targetfile;
343 # The reason why we compare file's contents is, that we cannot
344 # know, which is the file we just installed (AFS). So we leave
345 # an identical file in place
347 if ( -f $targetfile && -s _ == -s $file) {
348 # We have a good chance, we can skip this one
349 $diff = compare($file,$targetfile);
351 print "#$file and $targetfile differ\n" if $verbose>1;
358 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
359 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
360 $Inc_uninstall_warn_handler->add(
361 File::Spec->catfile($libdir, $file),
365 # if not verbose, we just say nothing
367 print "Unlinking $targetfile (shadowing?)\n";
368 forceunlink($targetfile);
374 my ($cmd, $src, $dest) = @_;
375 open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
376 open(SRC, $src) || die "Cannot open $src: $!";
379 while (my $len = sysread(SRC, $buf, $sz)) {
380 syswrite(CMD, $buf, $len);
383 close CMD or die "Filter command '$cmd' failed for $src";
389 pm_to_blib(\%from_to, $autosplit_dir);
390 pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
392 Copies each key of %from_to to its corresponding value efficiently.
393 Filenames with the extension .pm are autosplit into the $autosplit_dir.
395 $filter_cmd is an optional shell command to run each .pm file through
396 prior to splitting and copying. Input is the contents of the module,
397 output the new module contents.
399 You can have an environment variable PERL_INSTALL_ROOT set which will
400 be prepended as a directory to each installed file (and directory).
405 my($fromto,$autodir,$pm_filter) = @_;
407 use File::Basename qw(dirname);
408 use File::Copy qw(copy);
409 use File::Path qw(mkpath);
410 use File::Compare qw(compare);
412 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
413 # require $my_req; # Hairy, but for the first
415 if (!ref($fromto) && -r $fromto)
417 # Win32 has severe command line length limitations, but
418 # can generate temporary files on-the-fly
419 # so we pass name of file here - eval it to get hash
420 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
421 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
426 mkpath($autodir,0,0755);
427 while(my($from, $to) = each %$fromto) {
428 next if -f $to && -M $to < -M $from;
430 # When a pm_filter is defined, we need to pre-process the source first
431 # to determine whether it has changed or not. Therefore, only perform
432 # the comparison check when there's no filter to be ran.
435 my $need_filtering = defined $pm_filter && length $pm_filter &&
438 if (!$need_filtering && 0 == compare($from,$to)) {
439 print "Skip $to (unchanged)\n";
445 mkpath(dirname($to),0,0755);
447 if ($need_filtering) {
448 run_filter($pm_filter, $from, $to);
449 print "$pm_filter <$from >$to\n";
452 print "cp $from $to\n";
454 my($mode,$atime,$mtime) = (stat $from)[2,8,9];
455 utime($atime,$mtime+$Is_VMS,$to);
456 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
457 next unless $from =~ /\.pm$/;
458 _autosplit($to,$autodir);
467 From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
468 the file being split. This causes problems on systems with mandatory
469 locking (ie. Windows). So we wrap it and close the filehandle.
476 my $retval = autosplit(@_);
477 close *AutoSplit::IN if defined *AutoSplit::IN{IO};
483 package ExtUtils::Install::Warn;
485 sub new { bless {}, shift }
488 my($self,$file,$targetfile) = @_;
489 push @{$self->{$file}}, $targetfile;
493 unless(defined $INSTALL_ROOT) {
495 my($file,$i,$plural);
496 foreach $file (sort keys %$self) {
497 $plural = @{$self->{$file}} > 1 ? "s" : "";
498 print "## Differing version$plural of $file found. You might like to\n";
499 for (0..$#{$self->{$file}}) {
500 print "rm ", $self->{$file}[$_], "\n";
504 $plural = $i>1 ? "all those files" : "this file";
505 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
516 =item B<PERL_INSTALL_ROOT>
518 Will be prepended to each install path.
524 Original author lost in the mists of time. Probably the same as Makemaker.
526 Currently maintained by Michael G Schwern <F<schwern@pobox.com>>
528 Send patches and ideas to <F<makemaker@perl.org>>.
530 Send bug reports via http://rt.cpan.org/. Please send your
531 generated Makefile along with your report.
533 For more up-to-date information, see http://www.makemaker.org.
538 This program is free software; you can redistribute it and/or
539 modify it under the same terms as Perl itself.
541 See F<http://www.perl.com/perl/misc/Artistic.html>