1 package ExtUtils::Install;
8 @EXPORT = ('install','uninstall','pm_to_blib');
9 $Is_VMS = $^O eq 'VMS';
11 #use vars qw( @EXPORT @ISA $Is_VMS );
16 sub ExtUtils::Install::install;
17 sub ExtUtils::Install::uninstall;
18 sub ExtUtils::Install::pm_to_blib;
19 sub ExtUtils::Install::my_cmp;
24 my($hash,$verbose,$nonono) = @_;
29 use ExtUtils::MakeMaker; # to implement a MY class
30 use File::Basename qw(dirname);
31 use File::Copy qw(copy);
32 use File::Find qw(find);
33 use File::Path qw(mkpath);
34 # require "auto/ExtUtils/Install/my_cmp.al"; # Hairy, but for the first
35 # time use we are in a different directory when autoload happens, so
36 # the relativ path to ./blib is ill.
39 my(%pack, %write, $dir);
41 for (qw/read write/) {
45 my($source_dir_or_file);
46 foreach $source_dir_or_file (sort keys %hash) {
47 #Check if there are files, and if yes, look if the corresponding
48 #target directory is writable for us
49 opendir DIR, $source_dir_or_file or next;
50 while ($_ = readdir DIR) {
51 next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
52 if (-w $hash{$source_dir_or_file} || mkpath($hash{$source_dir_or_file})) {
55 Carp::croak("You do not have permissions to install into $hash{$source_dir_or_file}");
60 if (-f $pack{"read"}) {
61 open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}");
62 # Remember what you found
70 my $umask = umask 0 unless $Is_VMS;
72 # This silly reference is just here to be able to call MY->catdir
73 # without a warning (Waiting for a proper path/directory module,
78 MOD_INSTALL: foreach $source (sort keys %hash) {
79 #copy the tree to the target directory without altering
80 #timestamp and permission and remember for the .packlist
81 #file. The packlist file contains the absolute paths of the
82 #install locations. AFS users may call this a bug. We'll have
83 #to reconsider how to add the means to satisfy AFS users also.
84 chdir($source) or next;
86 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
87 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
89 return if $_ eq ".exists";
90 my $targetdir = $MY->catdir($hash{$source},$File::Find::dir);
91 my $targetfile = $MY->catfile($targetdir,$_);
94 if ( -f $targetfile && -s _ == $size) {
95 # We have a good chance, we can skip this one
96 $diff = my_cmp($_,$targetfile);
98 print "$_ differs\n" if $verbose>1;
104 unlink $targetfile or Carp::croak("Couldn't unlink $targetfile");
106 mkpath($targetdir,0,0755) unless $nonono;
107 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
109 copy($_,$targetfile) unless $nonono;
110 print "Installing $targetfile\n" if $verbose;
111 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
112 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
113 chmod $mode, $targetfile;
114 print "chmod($mode, $targetfile)\n" if $verbose>1;
116 print "Skipping $targetfile (unchanged)\n";
119 $write{$targetfile}++;
122 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
124 umask $umask unless $Is_VMS;
125 if ($pack{'write'}) {
126 $dir = dirname($pack{'write'});
128 print "Writing $pack{'write'}\n";
129 open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!");
130 for (sort keys %write) {
141 open T, $two or return 1;
142 open F, $one or Carp::croak("Couldn't open $one: $!");
143 my($fr, $tr, $fbuf, $tbuf, $size);
145 # print "Reading $one\n";
146 while ( $fr = read(F,$fbuf,$size)) {
148 $tr = read(T,$tbuf,$size) and
164 my($fil,$verbose,$nonono) = @_;
165 die "no packlist file found: $fil" unless -f $fil;
167 open P, $fil or Carp::croak("uninstall: Could not read packlist file $fil: $!");
170 print "unlink $_\n" if $verbose;
171 unlink($_) || Carp::carp("Couldn't unlink $_") unless $nonono;
173 print "unlink $fil\n" if $verbose;
174 unlink($fil) || Carp::carp("Couldn't unlink $fil") unless $nonono;
178 my($fromto,$autodir) = @_;
180 use File::Basename qw(dirname);
181 use File::Copy qw(copy);
182 use File::Path qw(mkpath);
185 my $umask = umask 0022 unless $Is_VMS;
186 mkpath($autodir,0,0755);
187 foreach (keys %$fromto) {
188 next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
189 unless (my_cmp($_,$fromto->{$_})){
190 print "Skip $fromto->{$_} (unchanged)\n";
193 if (-f $fromto->{$_}){
194 unlink $fromto->{$_} or Carp::carp("Couldn't unlink $fromto->{$_}");
196 mkpath(dirname($fromto->{$_}),0,0755);
198 copy($_,$fromto->{$_});
199 chmod((stat)[2],$fromto->{$_});
200 print "cp $_ $fromto->{$_}\n";
202 autosplit($fromto->{$_},$autodir);
204 umask $umask unless $Is_VMS;
213 ExtUtils::Install - install files from here to there
217 B<use ExtUtils::Install;>
219 B<install($hashref,$verbose,$nonono);>
221 B<uninstall($packlistfile,$verbose,$nonono);>
223 B<pm_to_blib($hashref);>
227 Both install() and uninstall() are specific to the way
228 ExtUtils::MakeMaker handles the installation and deinstallation of
229 perl modules. They are not designed as general purpose tools.
231 install() takes three arguments. A reference to a hash, a verbose
232 switch and a don't-really-do-it switch. The hash ref contains a
233 mapping of directories: each key/value pair is a combination of
234 directories to be copied. Key is a directory to copy from, value is a
235 directory to copy to. The whole tree below the "from" directory will
236 be copied preserving timestamps and permissions.
238 There are two keys with a special meaning in the hash: "read" and
239 "write". After the copying is done, install will write the list of
240 target files to the file named by $hashref->{write}. If there is
241 another file named by $hashref->{read}, the contents of this file will
242 be merged into the written file. The read and the written file may be
243 identical, but on AFS it is quite likely, people are installing to a
244 different directory than the one where the files later appear.
246 uninstall() takes as first argument a file containing filenames to be
247 unlinked. The second argument is a verbose switch, the third is a
248 no-don't-really-do-it-now switch.
250 pm_to_blib() takes a hashref as the first argument and copies all keys
251 of the hash to the corresponding values efficiently. Filenames with
252 the extension pm are autosplit. Second argument is the autosplit