File Coverage

blib/lib/ExtUtils/Manifest.pm
Criterion Covered Total %
statement 261 345 75.6
branch 108 204 52.9
condition 20 46 43.4
subroutine 32 38 84.2
pod 10 15 66.6
total 431 648 66.5


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