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
1 package ExtUtils::Manifest;
2
3 =head1 NAME
4
5 ExtUtils::Manifest - utilities to write and check a MANIFEST file
6
7 =head1 SYNOPSIS
8
9 C<require ExtUtils::Manifest;>
10
11 C<ExtUtils::Manifest::mkmanifest;>
12
13 C<ExtUtils::Manifest::manicheck;>
14
15 C<ExtUtils::Manifest::filecheck;>
16
17 C<ExtUtils::Manifest::fullcheck;>
18
19 C<ExtUtils::Manifest::maniread($file);>
20
21 C<ExtUtils::Manifest::manicopy($read,$target);>
22
23 =head1 DESCRIPTION
24
25 Mkmanifest() writes all files in and below the current directory to a
26 file named C<MANIFEST> in the current directory. It works similar to
27
28     find . -print
29
30 but in doing so checks each line in an existing C<MANIFEST> file and
31 includes any comments that are found in the existing C<MANIFEST> file
32 in the new one. Anything between white space and an end of line within
33 a C<MANIFEST> file is considered to be a comment. Filenames and
34 comments are seperated by one or more TAB characters in the
35 output. All files that match any regular expression in a file
36 C<MANIFEST.SKIP> (if such a file exists) are ignored.
37
38 Manicheck() checks if all the files within a C<MANIFEST> in the current
39 directory really do exist.
40
41 Filecheck() finds files below the current directory that are not
42 mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
43 will be consulted. Any file matching a regular expression in such a
44 file will not be reported as missing in the C<MANIFEST> file.
45
46 Fullcheck() does both a manicheck() and a filecheck().
47
48 Maniread($file) reads a named C<MANIFEST> file (defaults to
49 C<MANIFEST> in the current directory) and returns a HASH reference
50 with files being the keys and comments being the values of the HASH.
51
52 I<Manicopy($read,$target)> copies the files that are the keys in the
53 HASH I<%$read> to the named target directory. The HASH reference
54 I<$read> is typically returned by the maniread() function. This
55 function is useful for producing a directory tree identical to the
56 intended distribution tree.
57
58 =head1 MANIFEST.SKIP
59
60 The file MANIFEST.SKIP may contain regular expressions of files that
61 should be ignored by mkmanifest() and filecheck(). The regular
62 expressions 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
75 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
76 C<&maniread>, and C<&manicopy> are exportable.
77
78 =head1 DIAGNOSTICS
79
80 All diagnostic output is sent to C<STDERR>.
81
82 =over
83     
84 =item C<Not in MANIFEST:> I<file>
85 is reported if a file is found, that is missing in the C<MANIFEST>
86 file which is excluded by a regular expression in the file
87 C<MANIFEST.SKIP>.
88
89 =item C<No such file:> I<file>
90 is reported if a file mentioned in a C<MANIFEST> file does not
91 exist.
92
93 =item C<MANIFEST:> I<$!>
94 is reported if C<MANIFEST> could not be opened.
95
96 =item C<Added to MANIFEST:> I<file>
97 is reported by mkmanifest() if $Verbose is set and a file is added
98 to MANIFEST. $Verbose is set to 1 by default.
99
100 =back
101
102 =head1 AUTHOR
103
104 Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
105
106 =cut
107
108 require Exporter;
109 @ISA=('Exporter');
110 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
111               'maniread', 'manicopy');
112
113 use File::Find;
114 use 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
124 sub 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
148 sub 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
157 sub fullcheck {
158     _manicheck(3);
159 }
160
161 sub manicheck {
162     return @{(_manicheck(1))[0]};
163 }
164
165 sub filecheck {
166     return @{(_manicheck(2))[1]};
167 }
168
169 sub _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
200 sub 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
218 sub _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
241 sub 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
254 sub 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
264 1;