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(%from_to) = %$from_to;
95 my(%pack, $dir, $warn_permissions);
96 my($packlist) = ExtUtils::Packlist->new();
97 # -w doesn't work reliably on FAT dirs
98 $warn_permissions++ if $^O eq 'MSWin32';
100 for (qw/read write/) {
101 $pack{$_}=$from_to{$_};
104 my($source_dir_or_file);
105 foreach $source_dir_or_file (sort keys %from_to) {
106 #Check if there are files, and if yes, look if the corresponding
107 #target directory is writable for us
108 opendir DIR, $source_dir_or_file or next;
110 next if $_ eq $Curdir || $_ eq $Updir || $_ eq ".exists";
111 my $targetdir = install_rooted_dir($from_to{$source_dir_or_file});
112 mkpath($targetdir) unless $nonono;
113 if (!$nonono && !-w $targetdir) {
114 warn "Warning: You do not have permissions to " .
115 "install into $from_to{$source_dir_or_file}"
116 unless $warn_permissions++;
121 my $tmpfile = install_rooted_file($pack{"read"});
122 $packlist->read($tmpfile) if (-f $tmpfile);
125 MOD_INSTALL: foreach my $source (sort keys %from_to) {
126 #copy the tree to the target directory without altering
127 #timestamp and permission and remember for the .packlist
128 #file. The packlist file contains the absolute paths of the
129 #install locations. AFS users may call this a bug. We'll have
130 #to reconsider how to add the means to satisfy AFS users also.
132 #October 1997: we want to install .pm files into archlib if
133 #there are any files in arch. So we depend on having ./blib/arch
136 my $targetroot = install_rooted_dir($from_to{$source});
138 my $blib_lib = File::Spec->catdir('blib', 'lib');
139 my $blib_arch = File::Spec->catdir('blib', 'arch');
140 if ($source eq $blib_lib and
141 exists $from_to{$blib_arch} and
142 directory_not_empty($blib_arch)) {
143 $targetroot = install_rooted_dir($from_to{$blib_arch});
144 print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
147 chdir $source or next;
149 my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
153 return if $origfile eq ".exists";
154 my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
155 my $targetfile = File::Spec->catfile($targetdir, $origfile);
156 my $sourcedir = File::Spec->catdir($source, $File::Find::dir);
157 my $sourcefile = File::Spec->catfile($sourcedir, $origfile);
160 chdir $cwd; # in case the target is relative
161 # 5.5.3's File::Find missing no_chdir option.
164 if ( -f $targetfile && -s _ == $size) {
165 # We have a good chance, we can skip this one
166 $diff = compare($sourcefile, $targetfile);
168 print "$sourcefile differs\n" if $verbose>1;
174 forceunlink($targetfile) unless $nonono;
176 mkpath($targetdir,0,0755) unless $nonono;
177 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
179 copy($sourcefile, $targetfile) unless $nonono;
180 print "Installing $targetfile\n";
181 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
182 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
183 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
184 chmod $mode, $targetfile;
185 print "chmod($mode, $targetfile)\n" if $verbose>1;
187 print "Skipping $targetfile (unchanged)\n" if $verbose;
190 if (defined $inc_uninstall) {
191 inc_uninstall($sourcefile,$File::Find::dir,$verbose,
192 $inc_uninstall ? 0 : 1);
195 # Record the full pathname.
196 $packlist->{$targetfile}++;
198 # File::Find can get confused if you chdir in here.
201 # File::Find seems to always be Unixy except on MacPerl :(
202 }, $Is_MacPerl ? $Curdir : '.' );
203 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
205 if ($pack{'write'}) {
206 $dir = install_rooted_dir(dirname($pack{'write'}));
207 mkpath($dir,0,0755) unless $nonono;
208 print "Writing $pack{'write'}\n";
209 $packlist->write(install_rooted_file($pack{'write'})) unless $nonono;
213 sub install_rooted_file {
214 if (defined $INSTALL_ROOT) {
215 File::Spec->catfile($INSTALL_ROOT, $_[0]);
222 sub install_rooted_dir {
223 if (defined $INSTALL_ROOT) {
224 File::Spec->catdir($INSTALL_ROOT, $_[0]);
233 unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
237 sub directory_not_empty ($) {
241 return if $_ eq ".exists";
243 $File::Find::prune++;
251 =item B<install_default> I<DISCOURAGED>
254 install_default($fullext);
256 Calls install() with arguments to copy a module from blib/ to the
257 default site installation location.
259 $fullext is the name of the module converted to a directory
260 (ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it
261 will attempt to read it from @ARGV.
263 This is primarily useful for install scripts.
265 B<NOTE> This function is not really useful because of the hard-coded
266 install location with no way to control site vs core vs vendor
267 directories and the strange way in which the module name is given.
268 Consider its use discouraged.
272 sub install_default {
273 @_ < 2 or die "install_default should be called with 0 or 1 argument";
274 my $FULLEXT = @_ ? shift : $ARGV[0];
275 defined $FULLEXT or die "Do not know to where to write install log";
276 my $INST_LIB = File::Spec->catdir(File::Spec->curdir,"blib","lib");
277 my $INST_ARCHLIB = File::Spec->catdir(File::Spec->curdir,"blib","arch");
278 my $INST_BIN = File::Spec->catdir(File::Spec->curdir,'blib','bin');
279 my $INST_SCRIPT = File::Spec->catdir(File::Spec->curdir,'blib','script');
280 my $INST_MAN1DIR = File::Spec->catdir(File::Spec->curdir,'blib','man1');
281 my $INST_MAN3DIR = File::Spec->catdir(File::Spec->curdir,'blib','man3');
283 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
284 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
285 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
286 $Config{installsitearch} :
287 $Config{installsitelib},
288 $INST_ARCHLIB => $Config{installsitearch},
289 $INST_BIN => $Config{installbin} ,
290 $INST_SCRIPT => $Config{installscript},
291 $INST_MAN1DIR => $Config{installman1dir},
292 $INST_MAN3DIR => $Config{installman3dir},
299 uninstall($packlist_file);
300 uninstall($packlist_file, $verbose, $dont_execute);
302 Removes the files listed in a $packlist_file.
304 If $verbose is true, will print out each file removed. Default is
307 If $dont_execute is true it will only print what it was going to do
308 without actually doing it. Default is false.
313 use ExtUtils::Packlist;
314 my($fil,$verbose,$nonono) = @_;
318 die "no packlist file found: $fil" unless -f $fil;
319 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
320 # require $my_req; # Hairy, but for the first
321 my ($packlist) = ExtUtils::Packlist->new($fil);
322 foreach (sort(keys(%$packlist))) {
324 print "unlink $_\n" if $verbose;
325 forceunlink($_) unless $nonono;
327 print "unlink $fil\n" if $verbose;
328 forceunlink($fil) unless $nonono;
332 my($filepath,$libdir,$verbose,$nonono) = @_;
334 my $file = (File::Spec->splitpath($filepath))[2];
337 my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'}
338 ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
340 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
344 next if $dir eq $Curdir;
345 next if $seen_dir{$dir}++;
346 my($targetfile) = File::Spec->catfile($dir,$libdir,$file);
347 next unless -f $targetfile;
349 # The reason why we compare file's contents is, that we cannot
350 # know, which is the file we just installed (AFS). So we leave
351 # an identical file in place
353 if ( -f $targetfile && -s _ == -s $filepath) {
354 # We have a good chance, we can skip this one
355 $diff = compare($filepath,$targetfile);
357 print "#$file and $targetfile differ\n" if $verbose>1;
364 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
365 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
366 $Inc_uninstall_warn_handler->add(
367 File::Spec->catfile($libdir, $file),
371 # if not verbose, we just say nothing
373 print "Unlinking $targetfile (shadowing?)\n";
374 forceunlink($targetfile);
380 my ($cmd, $src, $dest) = @_;
382 open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
383 open(SRC, $src) || die "Cannot open $src: $!";
386 while (my $len = sysread(SRC, $buf, $sz)) {
387 syswrite(CMD, $buf, $len);
390 close CMD or die "Filter command '$cmd' failed for $src";
396 pm_to_blib(\%from_to, $autosplit_dir);
397 pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
399 Copies each key of %from_to to its corresponding value efficiently.
400 Filenames with the extension .pm are autosplit into the $autosplit_dir.
401 Any destination directories are created.
403 $filter_cmd is an optional shell command to run each .pm file through
404 prior to splitting and copying. Input is the contents of the module,
405 output the new module contents.
407 You can have an environment variable PERL_INSTALL_ROOT set which will
408 be prepended as a directory to each installed file (and directory).
413 my($fromto,$autodir,$pm_filter) = @_;
415 use File::Basename qw(dirname);
416 use File::Copy qw(copy);
417 use File::Path qw(mkpath);
418 use File::Compare qw(compare);
421 if (!ref($fromto) && -r $fromto)
423 # Win32 has severe command line length limitations, but
424 # can generate temporary files on-the-fly
425 # so we pass name of file here - eval it to get hash
426 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
427 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
432 mkpath($autodir,0,0755);
433 while(my($from, $to) = each %$fromto) {
434 if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
435 print "Skip $to (unchanged)\n";
439 # When a pm_filter is defined, we need to pre-process the source first
440 # to determine whether it has changed or not. Therefore, only perform
441 # the comparison check when there's no filter to be ran.
444 my $need_filtering = defined $pm_filter && length $pm_filter &&
447 if (!$need_filtering && 0 == compare($from,$to)) {
448 print "Skip $to (unchanged)\n";
454 mkpath(dirname($to),0,0755);
456 if ($need_filtering) {
457 run_filter($pm_filter, $from, $to);
458 print "$pm_filter <$from >$to\n";
461 print "cp $from $to\n";
463 my($mode,$atime,$mtime) = (stat $from)[2,8,9];
464 utime($atime,$mtime+$Is_VMS,$to);
465 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
466 next unless $from =~ /\.pm$/;
467 _autosplit($to,$autodir);
476 From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
477 the file being split. This causes problems on systems with mandatory
478 locking (ie. Windows). So we wrap it and close the filehandle.
485 my $retval = autosplit(@_);
486 close *AutoSplit::IN if defined *AutoSplit::IN{IO};
492 package ExtUtils::Install::Warn;
494 sub new { bless {}, shift }
497 my($self,$file,$targetfile) = @_;
498 push @{$self->{$file}}, $targetfile;
502 unless(defined $INSTALL_ROOT) {
504 my($file,$i,$plural);
505 foreach $file (sort keys %$self) {
506 $plural = @{$self->{$file}} > 1 ? "s" : "";
507 print "## Differing version$plural of $file found. You might like to\n";
508 for (0..$#{$self->{$file}}) {
509 print "rm ", $self->{$file}[$_], "\n";
513 $plural = $i>1 ? "all those files" : "this file";
514 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
525 =item B<PERL_INSTALL_ROOT>
527 Will be prepended to each install path.
533 Original author lost in the mists of time. Probably the same as Makemaker.
535 Currently maintained by Michael G Schwern C<schwern@pobox.com>
537 Send patches and ideas to C<makemaker@perl.org>.
539 Send bug reports via http://rt.cpan.org/. Please send your
540 generated Makefile along with your report.
542 For more up-to-date information, see L<http://www.makemaker.org>.
547 This program is free software; you can redistribute it and/or
548 modify it under the same terms as Perl itself.
550 See L<http://www.perl.com/perl/misc/Artistic.html>