1 package ExtUtils::Install;
4 our(@ISA, @EXPORT, $VERSION);
5 $VERSION = substr q$Revision: 1.28 $, 10;
6 # $Date: 1998/01/25 07:08:24 $
10 use Config qw(%Config);
12 @EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
13 $Is_VMS = $^O eq 'VMS';
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};
25 sub install_rooted_file {
26 if (defined $INSTALL_ROOT) {
27 MY->catfile($INSTALL_ROOT, $_[0]);
33 sub install_rooted_dir {
34 if (defined $INSTALL_ROOT) {
35 MY->catdir($INSTALL_ROOT, $_[0]);
41 #our(@EXPORT, @ISA, $Is_VMS);
46 unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
50 my($hash,$verbose,$nonono,$inc_uninstall) = @_;
55 use ExtUtils::MakeMaker; # to implement a MY class
56 use ExtUtils::Packlist;
57 use File::Basename qw(dirname);
58 use File::Copy qw(copy);
59 use File::Find qw(find);
60 use File::Path qw(mkpath);
61 use File::Compare qw(compare);
64 my(%pack, $dir, $warn_permissions);
65 my($packlist) = ExtUtils::Packlist->new();
66 # -w doesn't work reliably on FAT dirs
67 $warn_permissions++ if $^O eq 'MSWin32';
69 for (qw/read write/) {
73 my($source_dir_or_file);
74 foreach $source_dir_or_file (sort keys %hash) {
75 #Check if there are files, and if yes, look if the corresponding
76 #target directory is writable for us
77 opendir DIR, $source_dir_or_file or next;
79 next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
80 my $targetdir = install_rooted_dir($hash{$source_dir_or_file});
85 warn "Warning: You do not have permissions to " .
86 "install into $hash{$source_dir_or_file}"
87 unless $warn_permissions++;
92 my $tmpfile = install_rooted_file($pack{"read"});
93 $packlist->read($tmpfile) if (-f $tmpfile);
97 MOD_INSTALL: foreach $source (sort keys %hash) {
98 #copy the tree to the target directory without altering
99 #timestamp and permission and remember for the .packlist
100 #file. The packlist file contains the absolute paths of the
101 #install locations. AFS users may call this a bug. We'll have
102 #to reconsider how to add the means to satisfy AFS users also.
104 #October 1997: we want to install .pm files into archlib if
105 #there are any files in arch. So we depend on having ./blib/arch
108 my $targetroot = install_rooted_dir($hash{$source});
110 if ($source eq "blib/lib" and
111 exists $hash{"blib/arch"} and
112 directory_not_empty("blib/arch")) {
113 $targetroot = install_rooted_dir($hash{"blib/arch"});
114 print "Files found in blib/arch: installing files in blib/lib into architecture dependent library tree\n";
116 chdir($source) or next;
118 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
119 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
121 return if $_ eq ".exists";
122 my $targetdir = MY->catdir($targetroot, $File::Find::dir);
124 my $targetfile = MY->catfile($targetdir, $_);
127 if ( -f $targetfile && -s _ == $size) {
128 # We have a good chance, we can skip this one
129 $diff = compare($_,$targetfile);
131 print "$_ differs\n" if $verbose>1;
137 forceunlink($targetfile) unless $nonono;
139 mkpath($targetdir,0,0755) unless $nonono;
140 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
142 copy($_,$targetfile) unless $nonono;
143 print "Installing $targetfile\n";
144 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
145 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
146 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
147 chmod $mode, $targetfile;
148 print "chmod($mode, $targetfile)\n" if $verbose>1;
150 print "Skipping $targetfile (unchanged)\n" if $verbose;
153 if (! defined $inc_uninstall) { # it's called
154 } elsif ($inc_uninstall == 0){
155 inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
157 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
159 $packlist->{$origfile}++;
162 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
164 if ($pack{'write'}) {
165 $dir = install_rooted_dir(dirname($pack{'write'}));
167 print "Writing $pack{'write'}\n";
168 $packlist->write(install_rooted_file($pack{'write'}));
172 sub directory_not_empty ($) {
176 return if $_ eq ".exists";
178 $File::Find::prune++;
185 sub install_default {
186 @_ < 2 or die "install_default should be called with 0 or 1 argument";
187 my $FULLEXT = @_ ? shift : $ARGV[0];
188 defined $FULLEXT or die "Do not know to where to write install log";
189 my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
190 my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
191 my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
192 my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
193 my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
194 my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
196 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
197 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
198 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
199 $Config{installsitearch} :
200 $Config{installsitelib},
201 $INST_ARCHLIB => $Config{installsitearch},
202 $INST_BIN => $Config{installbin} ,
203 $INST_SCRIPT => $Config{installscript},
204 $INST_MAN1DIR => $Config{installman1dir},
205 $INST_MAN3DIR => $Config{installman3dir},
210 use ExtUtils::Packlist;
211 my($fil,$verbose,$nonono) = @_;
212 die "no packlist file found: $fil" unless -f $fil;
213 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
214 # require $my_req; # Hairy, but for the first
215 my ($packlist) = ExtUtils::Packlist->new($fil);
216 foreach (sort(keys(%$packlist))) {
218 print "unlink $_\n" if $verbose;
219 forceunlink($_) unless $nonono;
221 print "unlink $fil\n" if $verbose;
222 forceunlink($fil) unless $nonono;
226 my($file,$libdir,$verbose,$nonono) = @_;
229 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
234 next if $seen_dir{$dir}++;
235 my($targetfile) = MY->catfile($dir,$libdir,$file);
236 next unless -f $targetfile;
238 # The reason why we compare file's contents is, that we cannot
239 # know, which is the file we just installed (AFS). So we leave
240 # an identical file in place
242 if ( -f $targetfile && -s _ == -s $file) {
243 # We have a good chance, we can skip this one
244 $diff = compare($file,$targetfile);
246 print "#$file and $targetfile differ\n" if $verbose>1;
253 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
254 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
255 $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
257 # if not verbose, we just say nothing
259 print "Unlinking $targetfile (shadowing?)\n";
260 forceunlink($targetfile);
266 my($fromto,$autodir) = @_;
268 use File::Basename qw(dirname);
269 use File::Copy qw(copy);
270 use File::Path qw(mkpath);
271 use File::Compare qw(compare);
273 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
274 # require $my_req; # Hairy, but for the first
276 if (!ref($fromto) && -r $fromto)
278 # Win32 has severe command line length limitations, but
279 # can generate temporary files on-the-fly
280 # so we pass name of file here - eval it to get hash
281 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
282 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
287 mkpath($autodir,0,0755);
288 foreach (keys %$fromto) {
289 next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
290 unless (compare($_,$fromto->{$_})){
291 print "Skip $fromto->{$_} (unchanged)\n";
294 if (-f $fromto->{$_}){
295 forceunlink($fromto->{$_});
297 mkpath(dirname($fromto->{$_}),0,0755);
299 copy($_,$fromto->{$_});
300 my($mode,$atime,$mtime) = (stat)[2,8,9];
301 utime($atime,$mtime+$Is_VMS,$fromto->{$_});
302 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
303 print "cp $_ $fromto->{$_}\n";
304 next unless /\.pm\z/;
305 autosplit($fromto->{$_},$autodir);
309 package ExtUtils::Install::Warn;
311 sub new { bless {}, shift }
314 my($self,$file,$targetfile) = @_;
315 push @{$self->{$file}}, $targetfile;
319 unless(defined $INSTALL_ROOT) {
321 my($file,$i,$plural);
322 foreach $file (sort keys %$self) {
323 $plural = @{$self->{$file}} > 1 ? "s" : "";
324 print "## Differing version$plural of $file found. You might like to\n";
325 for (0..$#{$self->{$file}}) {
326 print "rm ", $self->{$file}[$_], "\n";
330 $plural = $i>1 ? "all those files" : "this file";
331 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
341 ExtUtils::Install - install files from here to there
345 B<use ExtUtils::Install;>
347 B<install($hashref,$verbose,$nonono);>
349 B<uninstall($packlistfile,$verbose,$nonono);>
351 B<pm_to_blib($hashref);>
355 Both install() and uninstall() are specific to the way
356 ExtUtils::MakeMaker handles the installation and deinstallation of
357 perl modules. They are not designed as general purpose tools.
359 install() takes three arguments. A reference to a hash, a verbose
360 switch and a don't-really-do-it switch. The hash ref contains a
361 mapping of directories: each key/value pair is a combination of
362 directories to be copied. Key is a directory to copy from, value is a
363 directory to copy to. The whole tree below the "from" directory will
364 be copied preserving timestamps and permissions.
366 There are two keys with a special meaning in the hash: "read" and
367 "write". After the copying is done, install will write the list of
368 target files to the file named by C<$hashref-E<gt>{write}>. If there is
369 another file named by C<$hashref-E<gt>{read}>, the contents of this file will
370 be merged into the written file. The read and the written file may be
371 identical, but on AFS it is quite likely that people are installing to a
372 different directory than the one where the files later appear.
374 install_default() takes one or less arguments. If no arguments are
375 specified, it takes $ARGV[0] as if it was specified as an argument.
376 The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
377 This function calls install() with the same arguments as the defaults
378 the MakeMaker would use.
380 The argument-less form is convenient for install scripts like
382 perl -MExtUtils::Install -e install_default Tk/Canvas
384 Assuming this command is executed in a directory with a populated F<blib>
385 directory, it will proceed as if the F<blib> was build by MakeMaker on
386 this machine. This is useful for binary distributions.
388 uninstall() takes as first argument a file containing filenames to be
389 unlinked. The second argument is a verbose switch, the third is a
390 no-don't-really-do-it-now switch.
392 pm_to_blib() takes a hashref as the first argument and copies all keys
393 of the hash to the corresponding values efficiently. Filenames with
394 the extension pm are autosplit. Second argument is the autosplit
397 You can have an environment variable PERL_INSTALL_ROOT set which will
398 be prepended as a directory to each installed file (and directory).