This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Insure that installed C header files are world-readable
[perl5.git] / lib / ExtUtils / Install.pm
CommitLineData
4b6d56d3
PP
1package ExtUtils::Install;
2
08ad6bd5
PP
3use Exporter;
4use SelfLoader;
5use Carp ();
6
4b6d56d3 7@ISA = ('Exporter');
08ad6bd5
PP
8@EXPORT = ('install','uninstall','pm_to_blib');
9$Is_VMS = $^O eq 'VMS';
10
11#use vars qw( @EXPORT @ISA $Is_VMS );
4b6d56d3
PP
12#use strict;
13
08ad6bd5
PP
141;
15
16sub ExtUtils::Install::install;
17sub ExtUtils::Install::uninstall;
18sub ExtUtils::Install::pm_to_blib;
19sub ExtUtils::Install::my_cmp;
20
21__DATA__
22
4b6d56d3
PP
23sub install {
24 my($hash,$verbose,$nonono) = @_;
25 $verbose ||= 0;
26 $nonono ||= 0;
08ad6bd5
PP
27
28 use Cwd qw(cwd);
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.
37
4b6d56d3 38 my(%hash) = %$hash;
08ad6bd5 39 my(%pack, %write, $dir);
4b6d56d3
PP
40 local(*DIR, *P);
41 for (qw/read write/) {
42 $pack{$_}=$hash{$_};
43 delete $hash{$_};
44 }
08ad6bd5
PP
45 my($source_dir_or_file);
46 foreach $source_dir_or_file (sort keys %hash) {
4b6d56d3
PP
47 #Check if there are files, and if yes, look if the corresponding
48 #target directory is writable for us
08ad6bd5 49 opendir DIR, $source_dir_or_file or next;
4b6d56d3
PP
50 while ($_ = readdir DIR) {
51 next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
08ad6bd5 52 if (-w $hash{$source_dir_or_file} || mkpath($hash{$source_dir_or_file})) {
4b6d56d3
PP
53 last;
54 } else {
08ad6bd5 55 Carp::croak("You do not have permissions to install into $hash{$source_dir_or_file}");
4b6d56d3
PP
56 }
57 }
58 closedir DIR;
59 }
60 if (-f $pack{"read"}) {
08ad6bd5 61 open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}");
4b6d56d3
PP
62 # Remember what you found
63 while (<P>) {
64 chomp;
65 $write{$_}++;
66 }
67 close P;
68 }
69 my $cwd = cwd();
08ad6bd5 70 my $umask = umask 0 unless $Is_VMS;
4b6d56d3
PP
71
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,
08ad6bd5 74 # Charles!)
4b6d56d3
PP
75 my $MY = {};
76 bless $MY, 'MY';
77 my($source);
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;
85 find(sub {
86 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
87 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
88 return unless -f _;
89 return if $_ eq ".exists";
90 my $targetdir = $MY->catdir($hash{$source},$File::Find::dir);
91 my $targetfile = $MY->catfile($targetdir,$_);
92 my $diff = 0;
93
94 if ( -f $targetfile && -s _ == $size) {
95 # We have a good chance, we can skip this one
08ad6bd5 96 $diff = my_cmp($_,$targetfile);
4b6d56d3
PP
97 } else {
98 print "$_ differs\n" if $verbose>1;
99 $diff++;
100 }
101
102 if ($diff){
08ad6bd5
PP
103 if (-f $targetfile){
104 unlink $targetfile or Carp::croak("Couldn't unlink $targetfile");
105 } else {
106 mkpath($targetdir,0,0755) unless $nonono;
107 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
108 }
4b6d56d3
PP
109 copy($_,$targetfile) unless $nonono;
110 print "Installing $targetfile\n" if $verbose;
08ad6bd5 111 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
4b6d56d3
PP
112 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
113 chmod $mode, $targetfile;
114 print "chmod($mode, $targetfile)\n" if $verbose>1;
115 } else {
116 print "Skipping $targetfile (unchanged)\n";
117 }
118
119 $write{$targetfile}++;
120
121 }, ".");
08ad6bd5 122 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
4b6d56d3 123 }
08ad6bd5 124 umask $umask unless $Is_VMS;
4b6d56d3
PP
125 if ($pack{'write'}) {
126 $dir = dirname($pack{'write'});
127 mkpath($dir,0,0755);
128 print "Writing $pack{'write'}\n";
08ad6bd5 129 open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!");
4b6d56d3
PP
130 for (sort keys %write) {
131 print P "$_\n";
132 }
133 close P;
134 }
135}
136
08ad6bd5
PP
137sub my_cmp {
138 my($one,$two) = @_;
139 local(*F,*T);
140 my $diff = 0;
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);
144 $size = 1024;
145 # print "Reading $one\n";
146 while ( $fr = read(F,$fbuf,$size)) {
147 unless (
148 $tr = read(T,$tbuf,$size) and
149 $tbuf eq $fbuf
150 ){
151 # print "diff ";
152 $diff++;
153 last;
154 }
155 # print "$fr/$tr ";
156 }
157 # print "\n";
158 close F;
159 close T;
160 $diff;
161}
162
4b6d56d3
PP
163sub uninstall {
164 my($fil,$verbose,$nonono) = @_;
165 die "no packlist file found: $fil" unless -f $fil;
166 local *P;
08ad6bd5 167 open P, $fil or Carp::croak("uninstall: Could not read packlist file $fil: $!");
4b6d56d3
PP
168 while (<P>) {
169 chomp;
170 print "unlink $_\n" if $verbose;
08ad6bd5 171 unlink($_) || Carp::carp("Couldn't unlink $_") unless $nonono;
4b6d56d3
PP
172 }
173 print "unlink $fil\n" if $verbose;
08ad6bd5
PP
174 unlink($fil) || Carp::carp("Couldn't unlink $fil") unless $nonono;
175}
176
177sub pm_to_blib {
178 my($fromto,$autodir) = @_;
179
180 use File::Basename qw(dirname);
181 use File::Copy qw(copy);
182 use File::Path qw(mkpath);
183 use AutoSplit;
184
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";
191 next;
192 }
193 if (-f $fromto->{$_}){
194 unlink $fromto->{$_} or Carp::carp("Couldn't unlink $fromto->{$_}");
195 } else {
196 mkpath(dirname($fromto->{$_}),0,0755);
197 }
198 copy($_,$fromto->{$_});
199 chmod((stat)[2],$fromto->{$_});
200 print "cp $_ $fromto->{$_}\n";
201 next unless /\.pm$/;
202 autosplit($fromto->{$_},$autodir);
203 }
204 umask $umask unless $Is_VMS;
4b6d56d3
PP
205}
206
2071;
208
209__END__
210
211=head1 NAME
212
213ExtUtils::Install - install files from here to there
214
215=head1 SYNOPSIS
216
217B<use ExtUtils::Install;>
218
219B<install($hashref,$verbose,$nonono);>
220
221B<uninstall($packlistfile,$verbose,$nonono);>
222
08ad6bd5
PP
223B<pm_to_blib($hashref);>
224
4b6d56d3
PP
225=head1 DESCRIPTION
226
08ad6bd5 227Both install() and uninstall() are specific to the way
4b6d56d3
PP
228ExtUtils::MakeMaker handles the installation and deinstallation of
229perl modules. They are not designed as general purpose tools.
230
231install() takes three arguments. A reference to a hash, a verbose
232switch and a don't-really-do-it switch. The hash ref contains a
233mapping of directories: each key/value pair is a combination of
234directories to be copied. Key is a directory to copy from, value is a
235directory to copy to. The whole tree below the "from" directory will
236be copied preserving timestamps and permissions.
237
238There 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
240target files to the file named by $hashref->{write}. If there is
241another file named by $hashref->{read}, the contents of this file will
242be merged into the written file. The read and the written file may be
243identical, but on AFS it is quite likely, people are installing to a
244different directory than the one where the files later appear.
245
246uninstall() takes as first argument a file containing filenames to be
247unlinked. The second argument is a verbose switch, the third is a
248no-don't-really-do-it-now switch.
249
08ad6bd5
PP
250pm_to_blib() takes a hashref as the first argument and copies all keys
251of the hash to the corresponding values efficiently. Filenames with
252the extension pm are autosplit. Second argument is the autosplit
253directory.
4b6d56d3 254
08ad6bd5 255=cut
4b6d56d3 256