This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
This is my patch patch.1k for perl5.001.
[perl5.git] / lib / ExtUtils / Manifest.pm
CommitLineData
005c1a0e
AD
1package ExtUtils::Manifest;
2
3=head1 NAME
4
5ExtUtils::Manifest - utilities to write and check a MANIFEST file
6
7=head1 SYNOPSIS
8
9C<require ExtUtils::Manifest;>
10
11C<ExtUtils::Manifest::mkmanifest;>
12
13C<ExtUtils::Manifest::manicheck;>
14
15C<ExtUtils::Manifest::filecheck;>
16
17C<ExtUtils::Manifest::fullcheck;>
18
19C<ExtUtils::Manifest::maniread($file);>
20
21C<ExtUtils::Manifest::manicopy($read,$target);>
22
23=head1 DESCRIPTION
24
25Mkmanifest() writes all files in and below the current directory to a
26file named C<MANIFEST> in the current directory. It works similar to
27
28 find . -print
29
30but in doing so checks each line in an existing C<MANIFEST> file and
31includes any comments that are found in the existing C<MANIFEST> file
32in the new one. Anything between white space and an end of line within
33a C<MANIFEST> file is considered to be a comment. Filenames and
34comments are seperated by one or more TAB characters in the
35output. All files that match any regular expression in a file
36C<MANIFEST.SKIP> (if such a file exists) are ignored.
37
38Manicheck() checks if all the files within a C<MANIFEST> in the current
39directory really do exist.
40
41Filecheck() finds files below the current directory that are not
42mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
43will be consulted. Any file matching a regular expression in such a
44file will not be reported as missing in the C<MANIFEST> file.
45
46Fullcheck() does both a manicheck() and a filecheck().
47
48Maniread($file) reads a named C<MANIFEST> file (defaults to
49C<MANIFEST> in the current directory) and returns a HASH reference
50with files being the keys and comments being the values of the HASH.
51
52I<Manicopy($read,$target)> copies the files that are the keys in the
53HASH I<%$read> to the named target directory. The HASH reference
54I<$read> is typically returned by the maniread() function. This
55function is useful for producing a directory tree identical to the
56intended distribution tree.
57
58=head1 MANIFEST.SKIP
59
60The file MANIFEST.SKIP may contain regular expressions of files that
61should be ignored by mkmanifest() and filecheck(). The regular
62expressions should appear one on each line. A typical example:
63
64 \bRCS\b
65 ^MANIFEST\.
66 ^Makefile$
67 ~$
68 \.html$
69 \.old$
70 ^blib/
71 ^MakeMaker-\d
72
73=head1 EXPORT_OK
74
75C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
76C<&maniread>, and C<&manicopy> are exportable.
77
78=head1 DIAGNOSTICS
79
80All diagnostic output is sent to C<STDERR>.
81
82=over
83
84=item C<Not in MANIFEST:> I<file>
85is reported if a file is found, that is missing in the C<MANIFEST>
86file which is excluded by a regular expression in the file
87C<MANIFEST.SKIP>.
88
89=item C<No such file:> I<file>
90is reported if a file mentioned in a C<MANIFEST> file does not
91exist.
92
93=item C<MANIFEST:> I<$!>
94is reported if C<MANIFEST> could not be opened.
95
96=item C<Added to MANIFEST:> I<file>
97is reported by mkmanifest() if $Verbose is set and a file is added
98to MANIFEST. $Verbose is set to 1 by default.
99
100=back
101
102=head1 AUTHOR
103
104Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
105
106=cut
107
108require Exporter;
109@ISA=('Exporter');
110@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
111 'maniread', 'manicopy');
112
113use File::Find;
114use Carp;
115
116$Debug = 0;
117$Verbose = 1;
118
119($Version) = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
120$Version = $Version; #avoid warning
121
122$Quiet = 0;
123
124sub mkmanifest {
125 my $manimiss = 0;
126 my $read = maniread() or $manimiss++;
127 $read = {} if $manimiss;
128 my $matches = _maniskip();
129 my $found = manifind();
130 my($key,$val,$file,%all);
131 my %all = (%$found, %$read);
132 local *M;
133 rename "MANIFEST", "MANIFEST.bak" unless $manimiss;
134 open M, ">MANIFEST" or die "Could not open MANIFEST: $!";
135 foreach $file (sort keys %all) {
136 next if &$matches($file);
137 if ($Verbose){
138 warn "Added to MANIFEST: $file\n" unless exists $read->{$file};
139 }
140 my $tabs = (5 - (length($file)+1)/8);
141 $tabs = 1 if $tabs < 1;
142 $tabs = 0 unless $all{$file};
143 print M $file, "\t" x $tabs, $all{$file}, "\n";
144 }
145 close M;
146}
147
148sub manifind {
149 local $found = {};
150 find(sub {return if -d $_;
151 (my $name = $File::Find::name) =~ s|./||;
152 warn "Debug: diskfile $name\n" if $Debug;
153 $found->{$name} = "";}, ".");
154 $found;
155}
156
157sub fullcheck {
158 _manicheck(3);
159}
160
161sub manicheck {
162 return @{(_manicheck(1))[0]};
163}
164
165sub filecheck {
166 return @{(_manicheck(2))[1]};
167}
168
169sub _manicheck {
170 my($arg) = @_;
171 my $read = maniread();
172 my $file;
173 my(@missfile,@missentry);
174 if ($arg & 1){
175 my $found = manifind();
176 foreach $file (sort keys %$read){
177 warn "Debug: manicheck checking from MANIFEST $file\n" if $Debug;
178 unless ( exists $found->{$file} ) {
179 warn "No such file: $file\n" unless $Quiet;
180 push @missfile, $file;
181 }
182 }
183 }
184 if ($arg & 2){
185 $read ||= {};
186 my $matches = _maniskip();
187 my $found = manifind();
188 foreach $file (sort keys %$found){
189 next if &$matches($file);
190 warn "Debug: manicheck checking from disk $file\n" if $Debug;
191 unless ( exists $read->{$file} ) {
192 warn "Not in MANIFEST: $file\n" unless $Quiet;
193 push @missentry, $file;
194 }
195 }
196 }
197 (\@missfile,\@missentry);
198}
199
200sub maniread {
201 my ($mfile) = @_;
202 $mfile = "MANIFEST" unless defined $mfile;
203 my $read = {};
204 local *M;
205 unless (open M, $mfile){
206 warn "$mfile: $!";
207 return $read;
208 }
209 while (<M>){
210 chomp;
211 /^(\S+)\s*(.*)/ and $read->{$1}=$2;
212 }
213 close M;
214 $read;
215}
216
217# returns an anonymous sub that decides if an argument matches
218sub _maniskip {
219 my ($mfile) = @_;
220 my $matches = sub {0};
221 my @skip ;
222 my $mfile = "MANIFEST.SKIP" unless defined $mfile;
223 local *M;
224 return $matches unless -f $mfile;
225 open M, $mfile or return $matches;
226 while (<M>){
227 chomp;
228 next if /^\s*$/;
229 push @skip, $_;
230 }
231 close M;
232 my $sub = "\$matches = "
233 . "sub { my(\$arg)=\@_; return 1 if "
234 . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/o "} @skip), 0)
235 . " }";
236 eval $sub;
237 print "Debug: $sub\n" if $Debug;
238 $matches;
239}
240
241sub manicopy {
242 my($read,$target)=@_;
243 croak "manicopy() called without target argument" unless defined $target;
244 require File::Path;
245 require File::Basename;
246 my(%dirs,$file);
247 foreach $file (keys %$read){
248 my $dir = File::Basename::dirname($file);
249 File::Path::mkpath("$target/$dir");
250 cp_if_diff($file, "$target/$file");
251 }
252}
253
254sub cp_if_diff {
255 my($from,$to)=@_;
256 -f $from || carp "$0: $from not found";
257 system "cmp", "-s", $from, $to;
258 if ($?) {
259 unlink($to); # In case we don't have write permissions.
260 (system 'cp', $from, $to) == 0 or confess "system 'cp': $!";
261 }
262}
263
2641;