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 $Inc_uninstall_warn_handler;
18 # install relative to here
20 my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
23 my $Curdir = File::Spec->curdir;
24 my $Updir = File::Spec->updir;
29 ExtUtils::Install - install files from here to there
33 use ExtUtils::Install;
35 install({ 'blib/lib' => 'some/install/dir' } );
39 pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' });
44 Handles the installing and uninstalling of perl modules, scripts, man
47 Both install() and uninstall() are specific to the way
48 ExtUtils::MakeMaker handles the installation and deinstallation of
49 perl modules. They are not designed as general purpose tools.
58 install(\%from_to, $verbose, $dont_execute, $uninstall_shadows);
60 Copies each directory tree of %from_to to its corresponding value
61 preserving timestamps and permissions.
63 There are two keys with a special meaning in the hash: "read" and
64 "write". These contain packlist files. After the copying is done,
65 install() will write the list of target files to $from_to{write}. If
66 $from_to{read} is given the contents of this file will be merged into
67 the written file. The read and the written file may be identical, but
68 on AFS it is quite likely that people are installing to a different
69 directory than the one where the files later appear.
71 If $verbose is true, will print out each file removed. Default is
72 false. This is "make install VERBINST=1"
74 If $dont_execute is true it will only print what it was going to do
75 without actually doing it. Default is false.
77 If $uninstall_shadows is true any differing versions throughout @INC
78 will be uninstalled. This is "make install UNINST=1"
83 my($from_to,$verbose,$nonono,$inc_uninstall) = @_;
88 use ExtUtils::Packlist;
89 use File::Basename qw(dirname);
90 use File::Copy qw(copy);
91 use File::Find qw(find);
92 use File::Path qw(mkpath);
93 use File::Compare qw(compare);
95 my(%from_to) = %$from_to;
96 my(%pack, $dir, $warn_permissions);
97 my($packlist) = ExtUtils::Packlist->new();
98 # -w doesn't work reliably on FAT dirs
99 $warn_permissions++ if $^O eq 'MSWin32';
101 for (qw/read write/) {
102 $pack{$_}=$from_to{$_};
105 my($source_dir_or_file);
106 foreach $source_dir_or_file (sort keys %from_to) {
107 #Check if there are files, and if yes, look if the corresponding
108 #target directory is writable for us
109 opendir DIR, $source_dir_or_file or next;
111 next if $_ eq $Curdir || $_ eq $Updir || $_ eq ".exists";
112 my $targetdir = install_rooted_dir($from_to{$source_dir_or_file});
113 mkpath($targetdir) unless $nonono;
114 if (!$nonono && !-w $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];
154 return if $origfile eq ".exists";
155 my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
156 my $targetfile = File::Spec->catfile($targetdir, $origfile);
157 my $sourcedir = File::Spec->catdir($source, $File::Find::dir);
158 my $sourcefile = File::Spec->catfile($sourcedir, $origfile);
161 chdir $cwd; # in case the target is relative
162 # 5.5.3's File::Find missing no_chdir option.
165 if ( -f $targetfile && -s _ == $size) {
166 # We have a good chance, we can skip this one
167 $diff = compare($sourcefile, $targetfile);
169 print "$sourcefile differs\n" if $verbose>1;
175 forceunlink($targetfile) unless $nonono;
177 mkpath($targetdir,0,0755) unless $nonono;
178 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
180 copy($sourcefile, $targetfile) unless $nonono;
181 print "Installing $targetfile\n";
182 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
183 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
184 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
185 chmod $mode, $targetfile;
186 print "chmod($mode, $targetfile)\n" if $verbose>1;
188 print "Skipping $targetfile (unchanged)\n" if $verbose;
191 if (defined $inc_uninstall) {
192 inc_uninstall($sourcefile,$File::Find::dir,$verbose,
193 $inc_uninstall ? 0 : 1);
196 # Record the full pathname.
197 $packlist->{$targetfile}++;
199 # File::Find can get confused if you chdir in here.
202 # File::Find seems to always be Unixy except on MacPerl :(
203 }, $Is_MacPerl ? $Curdir : '.' );
204 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
206 if ($pack{'write'}) {
207 $dir = install_rooted_dir(dirname($pack{'write'}));
208 mkpath($dir,0,0755) unless $nonono;
209 print "Writing $pack{'write'}\n";
210 $packlist->write(install_rooted_file($pack{'write'})) unless $nonono;
214 sub install_rooted_file {
215 if (defined $INSTALL_ROOT) {
216 File::Spec->catfile($INSTALL_ROOT, $_[0]);
223 sub install_rooted_dir {
224 if (defined $INSTALL_ROOT) {
225 File::Spec->catdir($INSTALL_ROOT, $_[0]);
234 unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
238 sub directory_not_empty ($) {
242 return if $_ eq ".exists";
244 $File::Find::prune++;
252 =item B<install_default> I<DISCOURAGED>
255 install_default($fullext);
257 Calls install() with arguments to copy a module from blib/ to the
258 default site installation location.
260 $fullext is the name of the module converted to a directory
261 (ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it
262 will attempt to read it from @ARGV.
264 This is primarily useful for install scripts.
266 B<NOTE> This function is not really useful because of the hard-coded
267 install location with no way to control site vs core vs vendor
268 directories and the strange way in which the module name is given.
269 Consider its use discouraged.
273 sub install_default {
274 @_ < 2 or die "install_default should be called with 0 or 1 argument";
275 my $FULLEXT = @_ ? shift : $ARGV[0];
276 defined $FULLEXT or die "Do not know to where to write install log";
277 my $INST_LIB = File::Spec->catdir(File::Spec->curdir,"blib","lib");
278 my $INST_ARCHLIB = File::Spec->catdir(File::Spec->curdir,"blib","arch");
279 my $INST_BIN = File::Spec->catdir(File::Spec->curdir,'blib','bin');
280 my $INST_SCRIPT = File::Spec->catdir(File::Spec->curdir,'blib','script');
281 my $INST_MAN1DIR = File::Spec->catdir(File::Spec->curdir,'blib','man1');
282 my $INST_MAN3DIR = File::Spec->catdir(File::Spec->curdir,'blib','man3');
284 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
285 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
286 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
287 $Config{installsitearch} :
288 $Config{installsitelib},
289 $INST_ARCHLIB => $Config{installsitearch},
290 $INST_BIN => $Config{installbin} ,
291 $INST_SCRIPT => $Config{installscript},
292 $INST_MAN1DIR => $Config{installman1dir},
293 $INST_MAN3DIR => $Config{installman3dir},
300 uninstall($packlist_file);
301 uninstall($packlist_file, $verbose, $dont_execute);
303 Removes the files listed in a $packlist_file.
305 If $verbose is true, will print out each file removed. Default is
308 If $dont_execute is true it will only print what it was going to do
309 without actually doing it. Default is false.
314 use ExtUtils::Packlist;
315 my($fil,$verbose,$nonono) = @_;
319 die "no packlist file found: $fil" unless -f $fil;
320 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
321 # require $my_req; # Hairy, but for the first
322 my ($packlist) = ExtUtils::Packlist->new($fil);
323 foreach (sort(keys(%$packlist))) {
325 print "unlink $_\n" if $verbose;
326 forceunlink($_) unless $nonono;
328 print "unlink $fil\n" if $verbose;
329 forceunlink($fil) unless $nonono;
333 my($filepath,$libdir,$verbose,$nonono) = @_;
335 my $file = (File::Spec->splitpath($filepath))[2];
338 my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'}
339 ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
341 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
345 next if $dir eq $Curdir;
346 next if $seen_dir{$dir}++;
347 my($targetfile) = File::Spec->catfile($dir,$libdir,$file);
348 next unless -f $targetfile;
350 # The reason why we compare file's contents is, that we cannot
351 # know, which is the file we just installed (AFS). So we leave
352 # an identical file in place
354 if ( -f $targetfile && -s _ == -s $filepath) {
355 # We have a good chance, we can skip this one
356 $diff = compare($filepath,$targetfile);
358 print "#$file and $targetfile differ\n" if $verbose>1;
365 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
366 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
367 $Inc_uninstall_warn_handler->add(
368 File::Spec->catfile($libdir, $file),
372 # if not verbose, we just say nothing
374 print "Unlinking $targetfile (shadowing?)\n";
375 forceunlink($targetfile);
381 my ($cmd, $src, $dest) = @_;
383 open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
384 open(SRC, $src) || die "Cannot open $src: $!";
387 while (my $len = sysread(SRC, $buf, $sz)) {
388 syswrite(CMD, $buf, $len);
391 close CMD or die "Filter command '$cmd' failed for $src";
397 pm_to_blib(\%from_to, $autosplit_dir);
398 pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
400 Copies each key of %from_to to its corresponding value efficiently.
401 Filenames with the extension .pm are autosplit into the $autosplit_dir.
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);
420 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
421 # require $my_req; # Hairy, but for the first
423 if (!ref($fromto) && -r $fromto)
425 # Win32 has severe command line length limitations, but
426 # can generate temporary files on-the-fly
427 # so we pass name of file here - eval it to get hash
428 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
429 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
434 mkpath($autodir,0,0755);
435 while(my($from, $to) = each %$fromto) {
436 if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
437 print "Skip $to (unchanged)\n";
441 # When a pm_filter is defined, we need to pre-process the source first
442 # to determine whether it has changed or not. Therefore, only perform
443 # the comparison check when there's no filter to be ran.
446 my $need_filtering = defined $pm_filter && length $pm_filter &&
449 if (!$need_filtering && 0 == compare($from,$to)) {
450 print "Skip $to (unchanged)\n";
456 mkpath(dirname($to),0,0755);
458 if ($need_filtering) {
459 run_filter($pm_filter, $from, $to);
460 print "$pm_filter <$from >$to\n";
463 print "cp $from $to\n";
465 my($mode,$atime,$mtime) = (stat $from)[2,8,9];
466 utime($atime,$mtime+$Is_VMS,$to);
467 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
468 next unless $from =~ /\.pm$/;
469 _autosplit($to,$autodir);
478 From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
479 the file being split. This causes problems on systems with mandatory
480 locking (ie. Windows). So we wrap it and close the filehandle.
487 my $retval = autosplit(@_);
488 close *AutoSplit::IN if defined *AutoSplit::IN{IO};
494 package ExtUtils::Install::Warn;
496 sub new { bless {}, shift }
499 my($self,$file,$targetfile) = @_;
500 push @{$self->{$file}}, $targetfile;
504 unless(defined $INSTALL_ROOT) {
506 my($file,$i,$plural);
507 foreach $file (sort keys %$self) {
508 $plural = @{$self->{$file}} > 1 ? "s" : "";
509 print "## Differing version$plural of $file found. You might like to\n";
510 for (0..$#{$self->{$file}}) {
511 print "rm ", $self->{$file}[$_], "\n";
515 $plural = $i>1 ? "all those files" : "this file";
516 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
527 =item B<PERL_INSTALL_ROOT>
529 Will be prepended to each install path.
535 Original author lost in the mists of time. Probably the same as Makemaker.
537 Currently maintained by Michael G Schwern <F<schwern@pobox.com>>
539 Send patches and ideas to <F<makemaker@perl.org>>.
541 Send bug reports via http://rt.cpan.org/. Please send your
542 generated Makefile along with your report.
544 For more up-to-date information, see http://www.makemaker.org.
549 This program is free software; you can redistribute it and/or
550 modify it under the same terms as Perl itself.
552 See F<http://www.perl.com/perl/misc/Artistic.html>