xref: /openbsd-src/gnu/usr.bin/perl/cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1*3d61058aSafresh1package ExtUtils::Manifest; # git description: 1.74-10-g1bddbb0
2b8851fccSafresh1
3b8851fccSafresh1require Exporter;
4b8851fccSafresh1use Config;
5b8851fccSafresh1use File::Basename;
6b8851fccSafresh1use File::Copy 'copy';
7b8851fccSafresh1use File::Find;
8b8851fccSafresh1use File::Spec 0.8;
9b8851fccSafresh1use Carp;
10b8851fccSafresh1use strict;
11b8851fccSafresh1use warnings;
12b8851fccSafresh1
13*3d61058aSafresh1our $VERSION = '1.75';
14b8851fccSafresh1our @ISA = ('Exporter');
15b8851fccSafresh1our @EXPORT_OK = qw(mkmanifest
16b8851fccSafresh1                manicheck  filecheck  fullcheck  skipcheck
17b8851fccSafresh1                manifind   maniread   manicopy   maniadd
18b8851fccSafresh1                maniskip
19b8851fccSafresh1               );
20b8851fccSafresh1
21b8851fccSafresh1our $Is_VMS   = $^O eq 'VMS';
22b8851fccSafresh1our $Is_VMS_mode = 0;
23b8851fccSafresh1our $Is_VMS_lc = 0;
24b8851fccSafresh1our $Is_VMS_nodot = 0;  # No dots in dir names or double dots in files
25b8851fccSafresh1
26b8851fccSafresh1if ($Is_VMS) {
27b8851fccSafresh1    require VMS::Filespec if $Is_VMS;
28b8851fccSafresh1    my $vms_unix_rpt;
29b8851fccSafresh1    my $vms_efs;
30b8851fccSafresh1    my $vms_case;
31b8851fccSafresh1
32b8851fccSafresh1    $Is_VMS_mode = 1;
33b8851fccSafresh1    $Is_VMS_lc = 1;
34b8851fccSafresh1    $Is_VMS_nodot = 1;
35b8851fccSafresh1    if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
36b8851fccSafresh1        $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
37b8851fccSafresh1        $vms_efs = VMS::Feature::current("efs_charset");
38b8851fccSafresh1        $vms_case = VMS::Feature::current("efs_case_preserve");
39b8851fccSafresh1    } else {
40b8851fccSafresh1        my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
41b8851fccSafresh1        my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
42b8851fccSafresh1        my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
43b8851fccSafresh1        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
44b8851fccSafresh1        $vms_efs = $efs_charset =~ /^[ET1]/i;
45b8851fccSafresh1        $vms_case = $efs_case =~ /^[ET1]/i;
46b8851fccSafresh1    }
47b8851fccSafresh1    $Is_VMS_lc = 0 if ($vms_case);
48b8851fccSafresh1    $Is_VMS_mode = 0 if ($vms_unix_rpt);
49b8851fccSafresh1    $Is_VMS_nodot = 0 if ($vms_efs);
50b8851fccSafresh1}
51b8851fccSafresh1
52b8851fccSafresh1our $Debug   = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
53b8851fccSafresh1our $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
54b8851fccSafresh1                   $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
55b8851fccSafresh1our $Quiet = 0;
56b8851fccSafresh1our $MANIFEST = 'MANIFEST';
57b8851fccSafresh1
58eac174f2Safresh1our $DEFAULT_MSKIP = File::Spec->rel2abs(File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" ));
59b8851fccSafresh1
60b8851fccSafresh1
61b8851fccSafresh1=head1 NAME
62b8851fccSafresh1
63b46d8ef2Safresh1ExtUtils::Manifest - Utilities to write and check a MANIFEST file
64b8851fccSafresh1
65b8851fccSafresh1=head1 VERSION
66b8851fccSafresh1
67*3d61058aSafresh1version 1.75
68b8851fccSafresh1
69b8851fccSafresh1=head1 SYNOPSIS
70b8851fccSafresh1
71b8851fccSafresh1    use ExtUtils::Manifest qw(...funcs to import...);
72b8851fccSafresh1
73b8851fccSafresh1    mkmanifest();
74b8851fccSafresh1
75b8851fccSafresh1    my @missing_files    = manicheck;
76b8851fccSafresh1    my @skipped          = skipcheck;
77b8851fccSafresh1    my @extra_files      = filecheck;
78b8851fccSafresh1    my($missing, $extra) = fullcheck;
79b8851fccSafresh1
80b8851fccSafresh1    my $found    = manifind();
81b8851fccSafresh1
82b8851fccSafresh1    my $manifest = maniread();
83b8851fccSafresh1
84b8851fccSafresh1    manicopy($read,$target);
85b8851fccSafresh1
86b8851fccSafresh1    maniadd({$file => $comment, ...});
87b8851fccSafresh1
88b8851fccSafresh1
89b8851fccSafresh1=head1 DESCRIPTION
90b8851fccSafresh1
91b46d8ef2Safresh1...
92b46d8ef2Safresh1
93b46d8ef2Safresh1=head1 FUNCTIONS
94b8851fccSafresh1
95b8851fccSafresh1ExtUtils::Manifest exports no functions by default.  The following are
96b46d8ef2Safresh1exported on request:
97b8851fccSafresh1
98b46d8ef2Safresh1=head2 mkmanifest
99b8851fccSafresh1
100b8851fccSafresh1    mkmanifest();
101b8851fccSafresh1
102b8851fccSafresh1Writes all files in and below the current directory to your F<MANIFEST>.
103b8851fccSafresh1It works similar to the result of the Unix command
104b8851fccSafresh1
105b8851fccSafresh1    find . > MANIFEST
106b8851fccSafresh1
107b8851fccSafresh1All files that match any regular expression in a file F<MANIFEST.SKIP>
108b8851fccSafresh1(if it exists) are ignored.
109b8851fccSafresh1
110b8851fccSafresh1Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>.
111b8851fccSafresh1
112b8851fccSafresh1=cut
113b8851fccSafresh1
114b8851fccSafresh1sub _sort {
115b8851fccSafresh1    return sort { lc $a cmp lc $b } @_;
116b8851fccSafresh1}
117b8851fccSafresh1
118b8851fccSafresh1sub mkmanifest {
119b8851fccSafresh1    my $manimiss = 0;
120b8851fccSafresh1    my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
121b8851fccSafresh1    $read = {} if $manimiss;
122b8851fccSafresh1    my $bakbase = $MANIFEST;
123b8851fccSafresh1    $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots
124b8851fccSafresh1    rename $MANIFEST, "$bakbase.bak" unless $manimiss;
125*3d61058aSafresh1    open my $fh, '>', $MANIFEST or die "Could not open $MANIFEST: $!";
126*3d61058aSafresh1    binmode $fh, ':raw';
127b8851fccSafresh1    my $skip = maniskip();
128b8851fccSafresh1    my $found = manifind();
129b8851fccSafresh1    my($key,$val,$file,%all);
130b8851fccSafresh1    %all = (%$found, %$read);
131b8851fccSafresh1    $all{$MANIFEST} = ($Is_VMS_mode ? "$MANIFEST\t\t" : '') .
132b8851fccSafresh1                     'This list of files'
133b8851fccSafresh1        if $manimiss; # add new MANIFEST to known file list
134b8851fccSafresh1    foreach $file (_sort keys %all) {
135b8851fccSafresh1        if ($skip->($file)) {
136b8851fccSafresh1            # Policy: only remove files if they're listed in MANIFEST.SKIP.
137b8851fccSafresh1            # Don't remove files just because they don't exist.
138b8851fccSafresh1            warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file};
139b8851fccSafresh1            next;
140b8851fccSafresh1        }
141b8851fccSafresh1        if ($Verbose){
142b8851fccSafresh1            warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
143b8851fccSafresh1        }
144b8851fccSafresh1        my $text = $all{$file};
145b8851fccSafresh1        my $tabs = (5 - (length($file)+1)/8);
146b8851fccSafresh1        $tabs = 1 if $tabs < 1;
147b8851fccSafresh1        $tabs = 0 unless $text;
148b8851fccSafresh1        if ($file =~ /\s/) {
149b8851fccSafresh1            $file =~ s/([\\'])/\\$1/g;
150b8851fccSafresh1            $file = "'$file'";
151b8851fccSafresh1        }
152*3d61058aSafresh1        print $fh $file, "\t" x $tabs, $text, "\n";
153b8851fccSafresh1    }
154b8851fccSafresh1}
155b8851fccSafresh1
156b8851fccSafresh1# Geez, shouldn't this use File::Spec or File::Basename or something?
157b8851fccSafresh1# Why so careful about dependencies?
158b8851fccSafresh1sub clean_up_filename {
159b8851fccSafresh1  my $filename = shift;
160b8851fccSafresh1  $filename =~ s|^\./||;
161b8851fccSafresh1  if ( $Is_VMS ) {
162b8851fccSafresh1      $filename =~ s/\.$//;                           # trim trailing dot
163b8851fccSafresh1      $filename = VMS::Filespec::unixify($filename);  # unescape spaces, etc.
164b8851fccSafresh1      if( $Is_VMS_lc ) {
165b8851fccSafresh1          $filename = lc($filename);
166b8851fccSafresh1          $filename = uc($filename) if $filename =~ /^MANIFEST(\.SKIP)?$/i;
167b8851fccSafresh1      }
168b8851fccSafresh1  }
169b8851fccSafresh1  return $filename;
170b8851fccSafresh1}
171b8851fccSafresh1
172b8851fccSafresh1
173b46d8ef2Safresh1=head2 manifind
174b8851fccSafresh1
175b8851fccSafresh1    my $found = manifind();
176b8851fccSafresh1
177b8851fccSafresh1returns a hash reference. The keys of the hash are the files found
178b8851fccSafresh1below the current directory.
179b8851fccSafresh1
180b8851fccSafresh1=cut
181b8851fccSafresh1
182b8851fccSafresh1sub manifind {
183b8851fccSafresh1    my $p = shift || {};
184b8851fccSafresh1    my $found = {};
185b8851fccSafresh1
186b8851fccSafresh1    my $wanted = sub {
187b8851fccSafresh1        my $name = clean_up_filename($File::Find::name);
188b8851fccSafresh1        warn "Debug: diskfile $name\n" if $Debug;
189b8851fccSafresh1        return if -d $_;
190b8851fccSafresh1        $found->{$name} = "";
191b8851fccSafresh1    };
192b8851fccSafresh1
193b8851fccSafresh1    # We have to use "$File::Find::dir/$_" in preprocess, because
194b8851fccSafresh1    # $File::Find::name is unavailable.
195b8851fccSafresh1    # Also, it's okay to use / here, because MANIFEST files use Unix-style
196b8851fccSafresh1    # paths.
197*3d61058aSafresh1    find({wanted => $wanted, follow_fast => 1}, ".");
198b8851fccSafresh1
199b8851fccSafresh1    return $found;
200b8851fccSafresh1}
201b8851fccSafresh1
202b8851fccSafresh1
203b46d8ef2Safresh1=head2 manicheck
204b8851fccSafresh1
205b8851fccSafresh1    my @missing_files = manicheck();
206b8851fccSafresh1
207b8851fccSafresh1checks if all the files within a C<MANIFEST> in the current directory
208b8851fccSafresh1really do exist. If C<MANIFEST> and the tree below the current
209b8851fccSafresh1directory are in sync it silently returns an empty list.
210b8851fccSafresh1Otherwise it returns a list of files which are listed in the
211b8851fccSafresh1C<MANIFEST> but missing from the directory, and by default also
212b8851fccSafresh1outputs these names to STDERR.
213b8851fccSafresh1
214b8851fccSafresh1=cut
215b8851fccSafresh1
216b8851fccSafresh1sub manicheck {
217b8851fccSafresh1    return _check_files();
218b8851fccSafresh1}
219b8851fccSafresh1
220b8851fccSafresh1
221b46d8ef2Safresh1=head2 filecheck
222b8851fccSafresh1
223b8851fccSafresh1    my @extra_files = filecheck();
224b8851fccSafresh1
225b8851fccSafresh1finds files below the current directory that are not mentioned in the
226b8851fccSafresh1C<MANIFEST> file. An optional file C<MANIFEST.SKIP> will be
227b8851fccSafresh1consulted. Any file matching a regular expression in such a file will
228b8851fccSafresh1not be reported as missing in the C<MANIFEST> file. The list of any
229b8851fccSafresh1extraneous files found is returned, and by default also reported to
230b8851fccSafresh1STDERR.
231b8851fccSafresh1
232b8851fccSafresh1=cut
233b8851fccSafresh1
234b8851fccSafresh1sub filecheck {
235b8851fccSafresh1    return _check_manifest();
236b8851fccSafresh1}
237b8851fccSafresh1
238b8851fccSafresh1
239b46d8ef2Safresh1=head2 fullcheck
240b8851fccSafresh1
241b8851fccSafresh1    my($missing, $extra) = fullcheck();
242b8851fccSafresh1
243b8851fccSafresh1does both a manicheck() and a filecheck(), returning then as two array
244b8851fccSafresh1refs.
245b8851fccSafresh1
246b8851fccSafresh1=cut
247b8851fccSafresh1
248b8851fccSafresh1sub fullcheck {
249b8851fccSafresh1    return [_check_files()], [_check_manifest()];
250b8851fccSafresh1}
251b8851fccSafresh1
252b8851fccSafresh1
253b46d8ef2Safresh1=head2 skipcheck
254b8851fccSafresh1
255b8851fccSafresh1    my @skipped = skipcheck();
256b8851fccSafresh1
257b8851fccSafresh1lists all the files that are skipped due to your C<MANIFEST.SKIP>
258b8851fccSafresh1file.
259b8851fccSafresh1
260b8851fccSafresh1=cut
261b8851fccSafresh1
262b8851fccSafresh1sub skipcheck {
263b8851fccSafresh1    my($p) = @_;
264b8851fccSafresh1    my $found = manifind();
265b8851fccSafresh1    my $matches = maniskip();
266b8851fccSafresh1
267b8851fccSafresh1    my @skipped = ();
268b8851fccSafresh1    foreach my $file (_sort keys %$found){
269b8851fccSafresh1        if (&$matches($file)){
270b8851fccSafresh1            warn "Skipping $file\n" unless $Quiet;
271b8851fccSafresh1            push @skipped, $file;
272b8851fccSafresh1            next;
273b8851fccSafresh1        }
274b8851fccSafresh1    }
275b8851fccSafresh1
276b8851fccSafresh1    return @skipped;
277b8851fccSafresh1}
278b8851fccSafresh1
279b8851fccSafresh1
280b8851fccSafresh1sub _check_files {
281b8851fccSafresh1    my $p = shift;
282b8851fccSafresh1    my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
283b8851fccSafresh1    my $read = maniread() || {};
284b8851fccSafresh1    my $found = manifind($p);
285b8851fccSafresh1
286b8851fccSafresh1    my(@missfile) = ();
287b8851fccSafresh1    foreach my $file (_sort keys %$read){
288b8851fccSafresh1        warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
289b8851fccSafresh1        if ($dosnames){
290b8851fccSafresh1            $file = lc $file;
291b8851fccSafresh1            $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
292b8851fccSafresh1            $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
293b8851fccSafresh1        }
294b8851fccSafresh1        unless ( exists $found->{$file} ) {
295b8851fccSafresh1            warn "No such file: $file\n" unless $Quiet;
296b8851fccSafresh1            push @missfile, $file;
297b8851fccSafresh1        }
298b8851fccSafresh1    }
299b8851fccSafresh1
300b8851fccSafresh1    return @missfile;
301b8851fccSafresh1}
302b8851fccSafresh1
303b8851fccSafresh1
304b8851fccSafresh1sub _check_manifest {
305b8851fccSafresh1    my($p) = @_;
306b8851fccSafresh1    my $read = maniread() || {};
307b8851fccSafresh1    my $found = manifind($p);
308b8851fccSafresh1    my $skip  = maniskip();
309b8851fccSafresh1
310b8851fccSafresh1    my @missentry = ();
311b8851fccSafresh1    foreach my $file (_sort keys %$found){
312b8851fccSafresh1        next if $skip->($file);
313b8851fccSafresh1        warn "Debug: manicheck checking from disk $file\n" if $Debug;
314b8851fccSafresh1        unless ( exists $read->{$file} ) {
315*3d61058aSafresh1            warn "Not in $MANIFEST: $file\n" unless $Quiet;
316b8851fccSafresh1            push @missentry, $file;
317b8851fccSafresh1        }
318b8851fccSafresh1    }
319b8851fccSafresh1
320b8851fccSafresh1    return @missentry;
321b8851fccSafresh1}
322b8851fccSafresh1
323b8851fccSafresh1
324b46d8ef2Safresh1=head2 maniread
325b8851fccSafresh1
326b8851fccSafresh1    my $manifest = maniread();
327b8851fccSafresh1    my $manifest = maniread($manifest_file);
328b8851fccSafresh1
329b8851fccSafresh1reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current
330b8851fccSafresh1directory) and returns a HASH reference with files being the keys and
331b8851fccSafresh1comments being the values of the HASH.  Blank lines and lines which
332b8851fccSafresh1start with C<#> in the C<MANIFEST> file are discarded.
333b8851fccSafresh1
334b8851fccSafresh1=cut
335b8851fccSafresh1
336b8851fccSafresh1sub maniread {
337b8851fccSafresh1    my ($mfile) = @_;
338b8851fccSafresh1    $mfile ||= $MANIFEST;
339b8851fccSafresh1    my $read = {};
340*3d61058aSafresh1    my $fh;
341*3d61058aSafresh1    unless (open $fh, '<', $mfile){
342b8851fccSafresh1        warn "Problem opening $mfile: $!";
343b8851fccSafresh1        return $read;
344b8851fccSafresh1    }
345b8851fccSafresh1    local $_;
346*3d61058aSafresh1    while (<$fh>){
347b8851fccSafresh1        chomp;
348b8851fccSafresh1        next if /^\s*#/;
349b8851fccSafresh1
350b8851fccSafresh1        my($file, $comment);
351b8851fccSafresh1
352b8851fccSafresh1        # filename may contain spaces if enclosed in ''
353b8851fccSafresh1        # (in which case, \\ and \' are escapes)
354b8851fccSafresh1        if (($file, $comment) = /^'((?:\\[\\']|.+)+)'\s*(.*)/) {
355b8851fccSafresh1            $file =~ s/\\([\\'])/$1/g;
356b8851fccSafresh1        }
357b8851fccSafresh1        else {
358b8851fccSafresh1            ($file, $comment) = /^(\S+)\s*(.*)/;
359b8851fccSafresh1        }
360b8851fccSafresh1        next unless $file;
361b8851fccSafresh1
362*3d61058aSafresh1        if ($Is_VMS_mode) {
363b8851fccSafresh1            require File::Basename;
364b8851fccSafresh1            my($base,$dir) = File::Basename::fileparse($file);
365b8851fccSafresh1            # Resolve illegal file specifications in the same way as tar
366b8851fccSafresh1            if ($Is_VMS_nodot) {
367b8851fccSafresh1                $dir =~ tr/./_/;
368b8851fccSafresh1                my(@pieces) = split(/\./,$base);
369b8851fccSafresh1                if (@pieces > 2)
370b8851fccSafresh1                    { $base = shift(@pieces) . '.' . join('_',@pieces); }
371b8851fccSafresh1                my $okfile = "$dir$base";
372b8851fccSafresh1                warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
373b8851fccSafresh1                $file = $okfile;
374b8851fccSafresh1            }
375b8851fccSafresh1            if( $Is_VMS_lc ) {
376b8851fccSafresh1                $file = lc($file);
377b8851fccSafresh1                $file = uc($file) if $file =~ /^MANIFEST(\.SKIP)?$/i;
378b8851fccSafresh1            }
379b8851fccSafresh1        }
380b8851fccSafresh1
381b8851fccSafresh1        $read->{$file} = $comment;
382b8851fccSafresh1    }
383b8851fccSafresh1    $read;
384b8851fccSafresh1}
385b8851fccSafresh1
386b46d8ef2Safresh1=head2 maniskip
387b8851fccSafresh1
388b8851fccSafresh1    my $skipchk = maniskip();
389b8851fccSafresh1    my $skipchk = maniskip($manifest_skip_file);
390b8851fccSafresh1
391b8851fccSafresh1    if ($skipchk->($file)) { .. }
392b8851fccSafresh1
393b8851fccSafresh1reads a named C<MANIFEST.SKIP> file (defaults to C<MANIFEST.SKIP> in
394b8851fccSafresh1the current directory) and returns a CODE reference that tests whether
395b8851fccSafresh1a given filename should be skipped.
396b8851fccSafresh1
397b8851fccSafresh1=cut
398b8851fccSafresh1
399*3d61058aSafresh1sub _process_skipline {
400*3d61058aSafresh1    local $_ = shift;
401b8851fccSafresh1    chomp;
402b8851fccSafresh1    s/\r//;
403b8851fccSafresh1    $_ =~ qr{^\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$};
404b8851fccSafresh1    #my $comment = $3;
405b8851fccSafresh1    my $filename = $2;
406b8851fccSafresh1    if ( defined($1) ) {
407b8851fccSafresh1      $filename = $1;
408b8851fccSafresh1      $filename =~ s/\\(['\\])/$1/g;
409b8851fccSafresh1    }
410*3d61058aSafresh1    $filename;
411b8851fccSafresh1}
412*3d61058aSafresh1
413*3d61058aSafresh1# returns an anonymous sub that decides if an argument matches
414*3d61058aSafresh1sub maniskip {
415*3d61058aSafresh1    my @skip ;
416*3d61058aSafresh1    my $mfile = shift || "$MANIFEST.SKIP";
417*3d61058aSafresh1    _check_mskip_directives($mfile) if -f $mfile;
418*3d61058aSafresh1    local $_;
419*3d61058aSafresh1    my $fh;
420*3d61058aSafresh1    open $fh, '<', $mfile or open $fh, '<', $DEFAULT_MSKIP or return sub {0};
421*3d61058aSafresh1    while (<$fh>){
422*3d61058aSafresh1        if (/^#!include_default\s*$/) {
423*3d61058aSafresh1            if (my @default = _include_mskip_file()) {
424*3d61058aSafresh1                warn "Debug: Including default MANIFEST.SKIP\n" if $Debug;
425*3d61058aSafresh1                push @skip, grep $_, map _process_skipline($_), @default;
426*3d61058aSafresh1            }
427*3d61058aSafresh1            next;
428*3d61058aSafresh1        }
429*3d61058aSafresh1        next unless my $filename = _process_skipline($_);
430*3d61058aSafresh1        push @skip, $filename;
431*3d61058aSafresh1    }
432b8851fccSafresh1    return sub {0} unless (scalar @skip > 0);
433b8851fccSafresh1
434b8851fccSafresh1    my $opts = $Is_VMS_mode ? '(?i)' : '';
435b8851fccSafresh1
436b8851fccSafresh1    # Make sure each entry is isolated in its own parentheses, in case
437b8851fccSafresh1    # any of them contain alternations
438b8851fccSafresh1    my $regex = join '|', map "(?:$_)", @skip;
439b8851fccSafresh1
440b8851fccSafresh1    return sub { $_[0] =~ qr{$opts$regex} };
441b8851fccSafresh1}
442b8851fccSafresh1
443*3d61058aSafresh1sub _get_homedir {
444*3d61058aSafresh1    $^O eq 'MSWin32' && "$]" < 5.016 ? $ENV{HOME} || $ENV{USERPROFILE} : (glob('~'))[0];
445*3d61058aSafresh1}
446*3d61058aSafresh1
447b8851fccSafresh1# checks for the special directives
448b8851fccSafresh1#   #!include_default
449b8851fccSafresh1#   #!include /path/to/some/manifest.skip
450b8851fccSafresh1# in a custom MANIFEST.SKIP for, for including
451b8851fccSafresh1# the content of, respectively, the default MANIFEST.SKIP
452b8851fccSafresh1# and an external manifest.skip file
453b8851fccSafresh1sub _check_mskip_directives {
454b8851fccSafresh1    my $mfile = shift;
455*3d61058aSafresh1    local $_;
456*3d61058aSafresh1    my $fh;
457b8851fccSafresh1    my @lines = ();
458b8851fccSafresh1    my $flag = 0;
459*3d61058aSafresh1    unless (open $fh, '<', $mfile) {
460b8851fccSafresh1        warn "Problem opening $mfile: $!";
461b8851fccSafresh1        return;
462b8851fccSafresh1    }
463*3d61058aSafresh1    while (<$fh>) {
464b8851fccSafresh1        if (/^#!include\s+(.*)\s*$/) {
465b8851fccSafresh1            my $external_file = $1;
466*3d61058aSafresh1            $external_file =~ s{^~/}{_get_homedir().'/'}e;
467b8851fccSafresh1            if (my @external = _include_mskip_file($external_file)) {
468b8851fccSafresh1                push @lines, @external;
469b8851fccSafresh1                warn "Debug: Including external $external_file\n" if $Debug;
470b8851fccSafresh1                $flag++;
471b8851fccSafresh1            }
472b8851fccSafresh1            next;
473b8851fccSafresh1        }
474b8851fccSafresh1        push @lines, $_;
475b8851fccSafresh1    }
476*3d61058aSafresh1    close $fh;
477b8851fccSafresh1    return unless $flag;
478b8851fccSafresh1    my $bakbase = $mfile;
479b8851fccSafresh1    $bakbase =~ s/\./_/g if $Is_VMS_nodot;  # avoid double dots
480b8851fccSafresh1    rename $mfile, "$bakbase.bak";
481b8851fccSafresh1    warn "Debug: Saving original $mfile as $bakbase.bak\n" if $Debug;
482*3d61058aSafresh1    unless (open $fh, '>', $mfile) {
483b8851fccSafresh1        warn "Problem opening $mfile: $!";
484b8851fccSafresh1        return;
485b8851fccSafresh1    }
486*3d61058aSafresh1    binmode $fh, ':raw';
487*3d61058aSafresh1    print $fh $_ for (@lines);
488b8851fccSafresh1    return;
489b8851fccSafresh1}
490b8851fccSafresh1
491b8851fccSafresh1# returns an array containing the lines of an external
492b8851fccSafresh1# manifest.skip file, if given, or $DEFAULT_MSKIP
493b8851fccSafresh1sub _include_mskip_file {
494b8851fccSafresh1    my $mskip = shift || $DEFAULT_MSKIP;
495b8851fccSafresh1    unless (-f $mskip) {
496b8851fccSafresh1        warn qq{Included file "$mskip" not found - skipping};
497b8851fccSafresh1        return;
498b8851fccSafresh1    }
499*3d61058aSafresh1    local $_;
500*3d61058aSafresh1    my $fh;
501*3d61058aSafresh1    unless (open $fh, '<', $mskip) {
502b8851fccSafresh1        warn "Problem opening $mskip: $!";
503b8851fccSafresh1        return;
504b8851fccSafresh1    }
505b8851fccSafresh1    my @lines = ();
506b8851fccSafresh1    push @lines, "\n#!start included $mskip\n";
507*3d61058aSafresh1    push @lines, $_ while <$fh>;
508b8851fccSafresh1    push @lines, "#!end included $mskip\n\n";
509b8851fccSafresh1    return @lines;
510b8851fccSafresh1}
511b8851fccSafresh1
512b46d8ef2Safresh1=head2 manicopy
513b8851fccSafresh1
514b8851fccSafresh1    manicopy(\%src, $dest_dir);
515b8851fccSafresh1    manicopy(\%src, $dest_dir, $how);
516b8851fccSafresh1
517b8851fccSafresh1Copies the files that are the keys in %src to the $dest_dir.  %src is
518b8851fccSafresh1typically returned by the maniread() function.
519b8851fccSafresh1
520b8851fccSafresh1    manicopy( maniread(), $dest_dir );
521b8851fccSafresh1
522b8851fccSafresh1This function is useful for producing a directory tree identical to the
523b8851fccSafresh1intended distribution tree.
524b8851fccSafresh1
525b8851fccSafresh1$how can be used to specify a different methods of "copying".  Valid
526b8851fccSafresh1values are C<cp>, which actually copies the files, C<ln> which creates
527b8851fccSafresh1hard links, and C<best> which mostly links the files but copies any
528b8851fccSafresh1symbolic link to make a tree without any symbolic link.  C<cp> is the
529b8851fccSafresh1default.
530b8851fccSafresh1
531b8851fccSafresh1=cut
532b8851fccSafresh1
533b8851fccSafresh1sub manicopy {
534b8851fccSafresh1    my($read,$target,$how)=@_;
535b8851fccSafresh1    croak "manicopy() called without target argument" unless defined $target;
536b8851fccSafresh1    $how ||= 'cp';
537b8851fccSafresh1    require File::Path;
538b8851fccSafresh1    require File::Basename;
539b8851fccSafresh1
540b8851fccSafresh1    $target = VMS::Filespec::unixify($target) if $Is_VMS_mode;
541b8851fccSafresh1    File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
542b8851fccSafresh1    foreach my $file (keys %$read){
543b8851fccSafresh1        $file = VMS::Filespec::unixify($file) if $Is_VMS_mode;
544b8851fccSafresh1        if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
545b8851fccSafresh1            my $dir = File::Basename::dirname($file);
546b8851fccSafresh1            $dir = VMS::Filespec::unixify($dir) if $Is_VMS_mode;
547b8851fccSafresh1            File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
548b8851fccSafresh1        }
549b8851fccSafresh1        cp_if_diff($file, "$target/$file", $how);
550b8851fccSafresh1    }
551b8851fccSafresh1}
552b8851fccSafresh1
553b8851fccSafresh1sub cp_if_diff {
554b8851fccSafresh1    my($from, $to, $how)=@_;
555b8851fccSafresh1    if (! -f $from) {
556b8851fccSafresh1        carp "$from not found";
557b8851fccSafresh1        return;
558b8851fccSafresh1    }
559b8851fccSafresh1    my($diff) = 0;
560*3d61058aSafresh1    my ($fromfh, $tofh);
561*3d61058aSafresh1    open($fromfh, '<', $from) or die "Can't read $from: $!\n";
562*3d61058aSafresh1    if (open($tofh, '<', $to)) {
563b8851fccSafresh1        local $_;
564*3d61058aSafresh1        while (<$fromfh>) { $diff++,last if $_ ne <$tofh>; }
565*3d61058aSafresh1        $diff++ unless eof($tofh);
566*3d61058aSafresh1        close $tofh;
567b8851fccSafresh1    }
568b8851fccSafresh1    else { $diff++; }
569*3d61058aSafresh1    close $fromfh;
570b8851fccSafresh1    if ($diff) {
571b8851fccSafresh1        if (-e $to) {
572b8851fccSafresh1            unlink($to) or confess "unlink $to: $!";
573b8851fccSafresh1        }
574b8851fccSafresh1        STRICT_SWITCH: {
575b8851fccSafresh1            best($from,$to), last STRICT_SWITCH if $how eq 'best';
576b8851fccSafresh1            cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
577b8851fccSafresh1            ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
578b8851fccSafresh1            croak("ExtUtils::Manifest::cp_if_diff " .
579b8851fccSafresh1              "called with illegal how argument [$how]. " .
580b8851fccSafresh1              "Legal values are 'best', 'cp', and 'ln'.");
581b8851fccSafresh1        }
582b8851fccSafresh1    }
583b8851fccSafresh1}
584b8851fccSafresh1
585b8851fccSafresh1sub cp {
586b8851fccSafresh1    my ($srcFile, $dstFile) = @_;
587b8851fccSafresh1    my ($access,$mod) = (stat $srcFile)[8,9];
588b8851fccSafresh1
589b8851fccSafresh1    copy($srcFile,$dstFile);
590b8851fccSafresh1    utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
591b8851fccSafresh1    _manicopy_chmod($srcFile, $dstFile);
592b8851fccSafresh1}
593b8851fccSafresh1
594b8851fccSafresh1
595b8851fccSafresh1sub ln {
596b8851fccSafresh1    my ($srcFile, $dstFile) = @_;
597b8851fccSafresh1    # Fix-me - VMS can support links.
598b8851fccSafresh1    return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
599b8851fccSafresh1    link($srcFile, $dstFile);
600b8851fccSafresh1
601b8851fccSafresh1    unless( _manicopy_chmod($srcFile, $dstFile) ) {
602b8851fccSafresh1        unlink $dstFile;
603b8851fccSafresh1        return;
604b8851fccSafresh1    }
605b8851fccSafresh1    1;
606b8851fccSafresh1}
607b8851fccSafresh1
608b8851fccSafresh1# 1) Strip off all group and world permissions.
609b8851fccSafresh1# 2) Let everyone read it.
610b8851fccSafresh1# 3) If the owner can execute it, everyone can.
611b8851fccSafresh1sub _manicopy_chmod {
612b8851fccSafresh1    my($srcFile, $dstFile) = @_;
613b8851fccSafresh1
614b8851fccSafresh1    my $perm = 0444 | (stat $srcFile)[2] & 0700;
615b8851fccSafresh1    chmod( $perm | ( $perm & 0100 ? 0111 : 0 ), $dstFile );
616b8851fccSafresh1}
617b8851fccSafresh1
618b8851fccSafresh1# Files that are often modified in the distdir.  Don't hard link them.
619b8851fccSafresh1my @Exceptions = qw(MANIFEST META.yml SIGNATURE);
620b8851fccSafresh1sub best {
621b8851fccSafresh1    my ($srcFile, $dstFile) = @_;
622b8851fccSafresh1
623b8851fccSafresh1    my $is_exception = grep $srcFile =~ /$_/, @Exceptions;
624b8851fccSafresh1    if ($is_exception or !$Config{d_link} or -l $srcFile) {
625b8851fccSafresh1        cp($srcFile, $dstFile);
626b8851fccSafresh1    } else {
627b8851fccSafresh1        ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
628b8851fccSafresh1    }
629b8851fccSafresh1}
630b8851fccSafresh1
631b46d8ef2Safresh1=head2 maniadd
632b8851fccSafresh1
633b8851fccSafresh1  maniadd({ $file => $comment, ...});
634b8851fccSafresh1
635b8851fccSafresh1Adds an entry to an existing F<MANIFEST> unless its already there.
636b8851fccSafresh1
637b8851fccSafresh1$file will be normalized (ie. Unixified).  B<UNIMPLEMENTED>
638b8851fccSafresh1
639b8851fccSafresh1=cut
640b8851fccSafresh1
641b8851fccSafresh1sub maniadd {
642b8851fccSafresh1    my($additions) = shift;
643b8851fccSafresh1
644b8851fccSafresh1    _normalize($additions);
645b8851fccSafresh1    _fix_manifest($MANIFEST);
646b8851fccSafresh1
647b8851fccSafresh1    my $manifest = maniread();
648b46d8ef2Safresh1    my @needed = grep !exists $manifest->{$_}, keys %$additions;
649b8851fccSafresh1    return 1 unless @needed;
650b8851fccSafresh1
651*3d61058aSafresh1    open(my $fh, '>>', $MANIFEST) or
652b8851fccSafresh1      die "maniadd() could not open $MANIFEST: $!";
653*3d61058aSafresh1    binmode $fh, ':raw';
654b8851fccSafresh1
655b8851fccSafresh1    foreach my $file (_sort @needed) {
656b8851fccSafresh1        my $comment = $additions->{$file} || '';
657b8851fccSafresh1        if ($file =~ /\s/) {
658b8851fccSafresh1            $file =~ s/([\\'])/\\$1/g;
659b8851fccSafresh1            $file = "'$file'";
660b8851fccSafresh1        }
661*3d61058aSafresh1        printf $fh "%-40s %s\n", $file, $comment;
662b8851fccSafresh1    }
663*3d61058aSafresh1    close $fh or die "Error closing $MANIFEST: $!";
664b8851fccSafresh1
665b8851fccSafresh1    return 1;
666b8851fccSafresh1}
667b8851fccSafresh1
668b8851fccSafresh1
669b8851fccSafresh1# Make sure this MANIFEST is consistently written with native
670b8851fccSafresh1# newlines and has a terminal newline.
671b8851fccSafresh1sub _fix_manifest {
672b8851fccSafresh1    my $manifest_file = shift;
673b8851fccSafresh1
674*3d61058aSafresh1    open my $fh, '<', $MANIFEST or die "Could not open $MANIFEST: $!";
675b8851fccSafresh1    local $/;
676*3d61058aSafresh1    my @manifest = split /(\015\012|\012|\015)/, <$fh>, -1;
677*3d61058aSafresh1    close $fh;
678b8851fccSafresh1    my $must_rewrite = "";
679b8851fccSafresh1    if ($manifest[-1] eq ""){
680b8851fccSafresh1        # sane case: last line had a terminal newline
681b8851fccSafresh1        pop @manifest;
682b8851fccSafresh1        for (my $i=1; $i<=$#manifest; $i+=2) {
683b8851fccSafresh1            unless ($manifest[$i] eq "\n") {
684b8851fccSafresh1                $must_rewrite = "not a newline at pos $i";
685b8851fccSafresh1                last;
686b8851fccSafresh1            }
687b8851fccSafresh1        }
688b8851fccSafresh1    } else {
689b8851fccSafresh1        $must_rewrite = "last line without newline";
690b8851fccSafresh1    }
691b8851fccSafresh1
692b8851fccSafresh1    if ( $must_rewrite ) {
693b8851fccSafresh1        1 while unlink $MANIFEST; # avoid multiple versions on VMS
694*3d61058aSafresh1        open $fh, ">", $MANIFEST or die "(must_rewrite=$must_rewrite) Could not open >$MANIFEST: $!";
695*3d61058aSafresh1        binmode $fh, ':raw';
696b8851fccSafresh1        for (my $i=0; $i<=$#manifest; $i+=2) {
697*3d61058aSafresh1            print $fh "$manifest[$i]\n";
698b8851fccSafresh1        }
699*3d61058aSafresh1        close $fh or die "could not write $MANIFEST: $!";
700b8851fccSafresh1    }
701b8851fccSafresh1}
702b8851fccSafresh1
703b8851fccSafresh1
704b8851fccSafresh1# UNIMPLEMENTED
705b8851fccSafresh1sub _normalize {
706b8851fccSafresh1    return;
707b8851fccSafresh1}
708b8851fccSafresh1
709b8851fccSafresh1=head2 MANIFEST
710b8851fccSafresh1
711b8851fccSafresh1A list of files in the distribution, one file per line.  The MANIFEST
712b8851fccSafresh1always uses Unix filepath conventions even if you're not on Unix.  This
713b8851fccSafresh1means F<foo/bar> style not F<foo\bar>.
714b8851fccSafresh1
715b8851fccSafresh1Anything between white space and an end of line within a C<MANIFEST>
716b8851fccSafresh1file is considered to be a comment.  Any line beginning with # is also
717b8851fccSafresh1a comment. Beginning with ExtUtils::Manifest 1.52, a filename may
718b8851fccSafresh1contain whitespace characters if it is enclosed in single quotes; single
719b8851fccSafresh1quotes or backslashes in that filename must be backslash-escaped.
720b8851fccSafresh1
721b8851fccSafresh1    # this a comment
722b8851fccSafresh1    some/file
723b8851fccSafresh1    some/other/file            comment about some/file
724b8851fccSafresh1    'some/third file'          comment
725b8851fccSafresh1
726b8851fccSafresh1
727b8851fccSafresh1=head2 MANIFEST.SKIP
728b8851fccSafresh1
729b8851fccSafresh1The file MANIFEST.SKIP may contain regular expressions of files that
730b8851fccSafresh1should be ignored by mkmanifest() and filecheck(). The regular
731b8851fccSafresh1expressions should appear one on each line. Blank lines and lines
732b8851fccSafresh1which start with C<#> are skipped.  Use C<\#> if you need a regular
733b8851fccSafresh1expression to start with a C<#>.
734b8851fccSafresh1
735b8851fccSafresh1For example:
736b8851fccSafresh1
737b8851fccSafresh1    # Version control files and dirs.
738b8851fccSafresh1    \bRCS\b
739b8851fccSafresh1    \bCVS\b
740b8851fccSafresh1    ,v$
741b8851fccSafresh1    \B\.svn\b
742b8851fccSafresh1
743b8851fccSafresh1    # Makemaker generated files and dirs.
744b8851fccSafresh1    ^MANIFEST\.
745b8851fccSafresh1    ^Makefile$
746b8851fccSafresh1    ^blib/
747b8851fccSafresh1    ^MakeMaker-\d
748b8851fccSafresh1
749b8851fccSafresh1    # Temp, old and emacs backup files.
750b8851fccSafresh1    ~$
751b8851fccSafresh1    \.old$
752b8851fccSafresh1    ^#.*#$
753b8851fccSafresh1    ^\.#
754b8851fccSafresh1
755b8851fccSafresh1If no MANIFEST.SKIP file is found, a default set of skips will be
756b8851fccSafresh1used, similar to the example above.  If you want nothing skipped,
757b8851fccSafresh1simply make an empty MANIFEST.SKIP file.
758b8851fccSafresh1
759b8851fccSafresh1In one's own MANIFEST.SKIP file, certain directives
760b8851fccSafresh1can be used to include the contents of other MANIFEST.SKIP
761b8851fccSafresh1files. At present two such directives are recognized.
762b8851fccSafresh1
763b8851fccSafresh1=over 4
764b8851fccSafresh1
765b8851fccSafresh1=item #!include_default
766b8851fccSafresh1
767*3d61058aSafresh1This tells ExtUtils::Manifest to read the default F<MANIFEST.SKIP>
768*3d61058aSafresh1file and skip files accordingly, but I<not> to include it in the local
769*3d61058aSafresh1F<MANIFEST.SKIP>. This is intended to skip files according to a system
770*3d61058aSafresh1default, which can change over time without requiring further changes
771*3d61058aSafresh1to the distribution's F<MANIFEST.SKIP>.
772b8851fccSafresh1
773b8851fccSafresh1=item #!include /Path/to/another/manifest.skip
774b8851fccSafresh1
775*3d61058aSafresh1This inserts the contents of the specified external file in the local
776*3d61058aSafresh1F<MANIFEST.SKIP>. This is intended for authors to have a central
777*3d61058aSafresh1F<MANIFEST.SKIP> file, and to include it with their various distributions.
778b8851fccSafresh1
779b8851fccSafresh1=back
780b8851fccSafresh1
781b8851fccSafresh1The included contents will be inserted into the MANIFEST.SKIP
782b8851fccSafresh1file in between I<#!start included /path/to/manifest.skip>
783b8851fccSafresh1and I<#!end included /path/to/manifest.skip> markers.
784b8851fccSafresh1The original MANIFEST.SKIP is saved as MANIFEST.SKIP.bak.
785b8851fccSafresh1
786b8851fccSafresh1=head2 EXPORT_OK
787b8851fccSafresh1
788b8851fccSafresh1C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
789b8851fccSafresh1C<&maniread>, and C<&manicopy> are exportable.
790b8851fccSafresh1
791b8851fccSafresh1=head2 GLOBAL VARIABLES
792b8851fccSafresh1
793b8851fccSafresh1C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
794b8851fccSafresh1results in both a different C<MANIFEST> and a different
795b8851fccSafresh1C<MANIFEST.SKIP> file. This is useful if you want to maintain
796b8851fccSafresh1different distributions for different audiences (say a user version
797b8851fccSafresh1and a developer version including RCS).
798b8851fccSafresh1
799b8851fccSafresh1C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
800b8851fccSafresh1all functions act silently.
801b8851fccSafresh1
802b8851fccSafresh1C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
803b8851fccSafresh1or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
804b8851fccSafresh1produced.
805b8851fccSafresh1
806b8851fccSafresh1=head1 DIAGNOSTICS
807b8851fccSafresh1
808b8851fccSafresh1All diagnostic output is sent to C<STDERR>.
809b8851fccSafresh1
810b8851fccSafresh1=over 4
811b8851fccSafresh1
812b8851fccSafresh1=item C<Not in MANIFEST:> I<file>
813b8851fccSafresh1
814b8851fccSafresh1is reported if a file is found which is not in C<MANIFEST>.
815b8851fccSafresh1
816b8851fccSafresh1=item C<Skipping> I<file>
817b8851fccSafresh1
818b8851fccSafresh1is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
819b8851fccSafresh1
820b8851fccSafresh1=item C<No such file:> I<file>
821b8851fccSafresh1
822b8851fccSafresh1is reported if a file mentioned in a C<MANIFEST> file does not
823b8851fccSafresh1exist.
824b8851fccSafresh1
825b8851fccSafresh1=item C<MANIFEST:> I<$!>
826b8851fccSafresh1
827b8851fccSafresh1is reported if C<MANIFEST> could not be opened.
828b8851fccSafresh1
829b8851fccSafresh1=item C<Added to MANIFEST:> I<file>
830b8851fccSafresh1
831b8851fccSafresh1is reported by mkmanifest() if $Verbose is set and a file is added
832b8851fccSafresh1to MANIFEST. $Verbose is set to 1 by default.
833b8851fccSafresh1
834b8851fccSafresh1=back
835b8851fccSafresh1
836b8851fccSafresh1=head1 ENVIRONMENT
837b8851fccSafresh1
838b8851fccSafresh1=over 4
839b8851fccSafresh1
840b8851fccSafresh1=item B<PERL_MM_MANIFEST_DEBUG>
841b8851fccSafresh1
842b8851fccSafresh1Turns on debugging
843b8851fccSafresh1
844b8851fccSafresh1=back
845b8851fccSafresh1
846b8851fccSafresh1=head1 SEE ALSO
847b8851fccSafresh1
848b8851fccSafresh1L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
849b8851fccSafresh1
850b8851fccSafresh1=head1 AUTHOR
851b8851fccSafresh1
852b8851fccSafresh1Andreas Koenig C<andreas.koenig@anima.de>
853b8851fccSafresh1
854b8851fccSafresh1Currently maintained by the Perl Toolchain Gang.
855b8851fccSafresh1
856b8851fccSafresh1=head1 COPYRIGHT AND LICENSE
857b8851fccSafresh1
858b8851fccSafresh1This software is copyright (c) 1996- by Andreas Koenig.
859b8851fccSafresh1
860b8851fccSafresh1This is free software; you can redistribute it and/or modify it under
861b8851fccSafresh1the same terms as the Perl 5 programming language system itself.
862b8851fccSafresh1
863b8851fccSafresh1=cut
864b8851fccSafresh1
865b8851fccSafresh11;
866