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; |