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 if (!-w $targetdir) {
113 print "mkpath($targetdir)\n" if $verbose>1;
118 mkpath($targetdir)) {
121 warn "Warning: You do not have permissions to " .
122 "install into $from_to{$source_dir_or_file}"
123 unless $warn_permissions++;
129 my $tmpfile = install_rooted_file($pack{"read"});
130 $packlist->read($tmpfile) if (-f $tmpfile);
133 MOD_INSTALL: foreach my $source (sort keys %from_to) {
134 #copy the tree to the target directory without altering
135 #timestamp and permission and remember for the .packlist
136 #file. The packlist file contains the absolute paths of the
137 #install locations. AFS users may call this a bug. We'll have
138 #to reconsider how to add the means to satisfy AFS users also.
140 #October 1997: we want to install .pm files into archlib if
141 #there are any files in arch. So we depend on having ./blib/arch
144 my $targetroot = install_rooted_dir($from_to{$source});
146 my $blib_lib = File::Spec->catdir('blib', 'lib');
147 my $blib_arch = File::Spec->catdir('blib', 'arch');
148 if ($source eq $blib_lib and
149 exists $from_to{$blib_arch} and
150 directory_not_empty($blib_arch)) {
151 $targetroot = install_rooted_dir($from_to{$blib_arch});
152 print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
155 chdir $source or next;
157 my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
159 return if $_ eq ".exists";
160 my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
161 my $targetfile = File::Spec->catfile($targetdir, $_);
162 my $sourcedir = File::Spec->catdir($source, $File::Find::dir);
163 my $sourcefile = File::Spec->catfile($sourcedir, $_);
166 chdir $cwd; # in case the target is relative
167 # 5.5.3's File::Find missing no_chdir option.
170 if ( -f $targetfile && -s _ == $size) {
171 # We have a good chance, we can skip this one
172 $diff = compare($sourcefile, $targetfile);
174 print "$sourcefile differs\n" if $verbose>1;
180 forceunlink($targetfile) unless $nonono;
182 mkpath($targetdir,0,0755) unless $nonono;
183 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
185 copy($sourcefile, $targetfile) unless $nonono;
186 print "Installing $targetfile\n";
187 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
188 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
189 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
190 chmod $mode, $targetfile;
191 print "chmod($mode, $targetfile)\n" if $verbose>1;
193 print "Skipping $targetfile (unchanged)\n" if $verbose;
196 if (defined $inc_uninstall) {
197 inc_uninstall($sourcefile,$File::Find::dir,$verbose,
198 $inc_uninstall ? 0 : 1);
201 # Record the full pathname.
202 $packlist->{$targetfile}++;
204 # File::Find can get confused if you chdir in here.
207 # File::Find seems to always be Unixy except on MacPerl :(
208 }, $Is_MacPerl ? $Curdir : '.' );
209 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
211 if ($pack{'write'}) {
212 $dir = install_rooted_dir(dirname($pack{'write'}));
213 mkpath($dir,0,0755) unless $nonono;
214 print "Writing $pack{'write'}\n";
215 $packlist->write(install_rooted_file($pack{'write'})) unless $nonono;
219 sub install_rooted_file {
220 if (defined $INSTALL_ROOT) {
221 File::Spec->catfile($INSTALL_ROOT, $_[0]);
228 sub install_rooted_dir {
229 if (defined $INSTALL_ROOT) {
230 File::Spec->catdir($INSTALL_ROOT, $_[0]);
239 unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
243 sub directory_not_empty ($) {
247 return if $_ eq ".exists";
249 $File::Find::prune++;
257 =item B<install_default> I<DISCOURAGED>
260 install_default($fullext);
262 Calls install() with arguments to copy a module from blib/ to the
263 default site installation location.
265 $fullext is the name of the module converted to a directory
266 (ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it
267 will attempt to read it from @ARGV.
269 This is primarily useful for install scripts.
271 B<NOTE> This function is not really useful because of the hard-coded
272 install location with no way to control site vs core vs vendor
273 directories and the strange way in which the module name is given.
274 Consider its use discouraged.
278 sub install_default {
279 @_ < 2 or die "install_default should be called with 0 or 1 argument";
280 my $FULLEXT = @_ ? shift : $ARGV[0];
281 defined $FULLEXT or die "Do not know to where to write install log";
282 my $INST_LIB = File::Spec->catdir(File::Spec->curdir,"blib","lib");
283 my $INST_ARCHLIB = File::Spec->catdir(File::Spec->curdir,"blib","arch");
284 my $INST_BIN = File::Spec->catdir(File::Spec->curdir,'blib','bin');
285 my $INST_SCRIPT = File::Spec->catdir(File::Spec->curdir,'blib','script');
286 my $INST_MAN1DIR = File::Spec->catdir(File::Spec->curdir,'blib','man1');
287 my $INST_MAN3DIR = File::Spec->catdir(File::Spec->curdir,'blib','man3');
289 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
290 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
291 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
292 $Config{installsitearch} :
293 $Config{installsitelib},
294 $INST_ARCHLIB => $Config{installsitearch},
295 $INST_BIN => $Config{installbin} ,
296 $INST_SCRIPT => $Config{installscript},
297 $INST_MAN1DIR => $Config{installman1dir},
298 $INST_MAN3DIR => $Config{installman3dir},
305 uninstall($packlist_file);
306 uninstall($packlist_file, $verbose, $dont_execute);
308 Removes the files listed in a $packlist_file.
310 If $verbose is true, will print out each file removed. Default is
313 If $dont_execute is true it will only print what it was going to do
314 without actually doing it. Default is false.
319 use ExtUtils::Packlist;
320 my($fil,$verbose,$nonono) = @_;
324 die "no packlist file found: $fil" unless -f $fil;
325 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
326 # require $my_req; # Hairy, but for the first
327 my ($packlist) = ExtUtils::Packlist->new($fil);
328 foreach (sort(keys(%$packlist))) {
330 print "unlink $_\n" if $verbose;
331 forceunlink($_) unless $nonono;
333 print "unlink $fil\n" if $verbose;
334 forceunlink($fil) unless $nonono;
338 my($file,$libdir,$verbose,$nonono) = @_;
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 $file) {
355 # We have a good chance, we can skip this one
356 $diff = compare($file,$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) = @_;
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.
402 $filter_cmd is an optional shell command to run each .pm file through
403 prior to splitting and copying. Input is the contents of the module,
404 output the new module contents.
406 You can have an environment variable PERL_INSTALL_ROOT set which will
407 be prepended as a directory to each installed file (and directory).
412 my($fromto,$autodir,$pm_filter) = @_;
414 use File::Basename qw(dirname);
415 use File::Copy qw(copy);
416 use File::Path qw(mkpath);
417 use File::Compare qw(compare);
419 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
420 # require $my_req; # Hairy, but for the first
422 if (!ref($fromto) && -r $fromto)
424 # Win32 has severe command line length limitations, but
425 # can generate temporary files on-the-fly
426 # so we pass name of file here - eval it to get hash
427 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
428 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
433 mkpath($autodir,0,0755);
434 while(my($from, $to) = each %$fromto) {
435 if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
436 print "Skip $to (unchanged)\n";
440 # When a pm_filter is defined, we need to pre-process the source first
441 # to determine whether it has changed or not. Therefore, only perform
442 # the comparison check when there's no filter to be ran.
445 my $need_filtering = defined $pm_filter && length $pm_filter &&
448 if (!$need_filtering && 0 == compare($from,$to)) {
449 print "Skip $to (unchanged)\n";
455 mkpath(dirname($to),0,0755);
457 if ($need_filtering) {
458 run_filter($pm_filter, $from, $to);
459 print "$pm_filter <$from >$to\n";
462 print "cp $from $to\n";
464 my($mode,$atime,$mtime) = (stat $from)[2,8,9];
465 utime($atime,$mtime+$Is_VMS,$to);
466 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
467 next unless $from =~ /\.pm$/;
468 _autosplit($to,$autodir);
477 From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
478 the file being split. This causes problems on systems with mandatory
479 locking (ie. Windows). So we wrap it and close the filehandle.
486 my $retval = autosplit(@_);
487 close *AutoSplit::IN if defined *AutoSplit::IN{IO};
493 package ExtUtils::Install::Warn;
495 sub new { bless {}, shift }
498 my($self,$file,$targetfile) = @_;
499 push @{$self->{$file}}, $targetfile;
503 unless(defined $INSTALL_ROOT) {
505 my($file,$i,$plural);
506 foreach $file (sort keys %$self) {
507 $plural = @{$self->{$file}} > 1 ? "s" : "";
508 print "## Differing version$plural of $file found. You might like to\n";
509 for (0..$#{$self->{$file}}) {
510 print "rm ", $self->{$file}[$_], "\n";
514 $plural = $i>1 ? "all those files" : "this file";
515 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
526 =item B<PERL_INSTALL_ROOT>
528 Will be prepended to each install path.
534 Original author lost in the mists of time. Probably the same as Makemaker.
536 Currently maintained by Michael G Schwern <F<schwern@pobox.com>>
538 Send patches and ideas to <F<makemaker@perl.org>>.
540 Send bug reports via http://rt.cpan.org/. Please send your
541 generated Makefile along with your report.
543 For more up-to-date information, see http://www.makemaker.org.
548 This program is free software; you can redistribute it and/or
549 modify it under the same terms as Perl itself.
551 See F<http://www.perl.com/perl/misc/Artistic.html>