1 | #!/usr/bin/perl |
---|
2 | |
---|
3 | use strict; |
---|
4 | use warnings; |
---|
5 | |
---|
6 | my $debug_matching = 0; # set to 1 to view file matching and decision |
---|
7 | my $ignore_unknown = 0; |
---|
8 | |
---|
9 | # ------------------------------------------------------------ |
---|
10 | # override checks below and save strictly as checked-in in SVN |
---|
11 | |
---|
12 | my @strictly_as_in_svn_when_matchesDir = ( |
---|
13 | qr/\/GDE\/MAFFT\/mafft-[0-9\.]+-with[out]*-extensions/o, |
---|
14 | qr/\/GDE\/SINA/o, |
---|
15 | ); |
---|
16 | |
---|
17 | # ------------------------------------------------------------ |
---|
18 | # skipped_directories and files inside are never examined: |
---|
19 | |
---|
20 | my @skipped_directories = ( |
---|
21 | qr/\/.+\/bin$/o, |
---|
22 | qr/\/.+\/build$/o, |
---|
23 | qr/\/lib\/sativa$/o, |
---|
24 | qr/\/HELP_SOURCE\/Xml$/o, |
---|
25 | qr/\/GDE\/MUSCLE\/obj$/o, |
---|
26 | qr/\/GDE\/PHYML20130708\/phyml\/autom4te.cache$/o, |
---|
27 | qr/\/GDE\/RAxML8\/builddir/o, |
---|
28 | qr/\/GDE\/SATIVA\/builddir/o, |
---|
29 | qr/\/ignore\./o, |
---|
30 | qr/\/PERL2ARB\/blib$/o, |
---|
31 | qr/\/HEADERLIBS\/[^\/]+/o, |
---|
32 | qr/\/UNIT_TESTER\/logs$/o, |
---|
33 | qr/\/UNIT_TESTER\/tests$/o, |
---|
34 | qr/\/UNIT_TESTER\/tests\.slow$/o, |
---|
35 | qr/\/UNIT_TESTER\/run\/homefake\/.arb_prop\/(macros|cfgSave)$/o, |
---|
36 | qr/^\.\/ARB_SOURCE_DOC/o, |
---|
37 | qr/^\.\/dep_graphs/o, |
---|
38 | qr/^\.\/INCLUDE$/o, |
---|
39 | qr/^\.\/lib\/help$/o, |
---|
40 | qr/^\.\/lib\/help_html$/o, |
---|
41 | qr/^\.\/lib\/pts$/o, |
---|
42 | qr/^\.\/lib\/mafft$/o, |
---|
43 | qr/^\.\/patches.arb$/o, |
---|
44 | qr/^\.\/PERL5$/o, |
---|
45 | qr/_COM\/DUMP$/o, |
---|
46 | qr/_COM\/GEN[CH]$/o, |
---|
47 | qr/_COM\/O$/o, |
---|
48 | qr/_GEN$/o, |
---|
49 | qr/nbproject/o, |
---|
50 | # needed by ralf: |
---|
51 | qr/^\.\/test_arb_make_targets_logs/o, |
---|
52 | qr/\.dSYM$/o, |
---|
53 | ); |
---|
54 | |
---|
55 | # first used/skipped match wins (exception see @3 below) |
---|
56 | |
---|
57 | my %used_files = map { $_ => 1; } ( |
---|
58 | '!BRANCH_STATE', |
---|
59 | 'AUTHORS', |
---|
60 | 'COPYING', |
---|
61 | 'demo.arb', |
---|
62 | 'Doxyfile', |
---|
63 | 'export2sub', |
---|
64 | 'Makefile', |
---|
65 | 'Makefile.org', |
---|
66 | 'Makefile.setup.include', |
---|
67 | 'Makefile.setup.template', |
---|
68 | 'Makefile.suite', |
---|
69 | 'Makefile.test', |
---|
70 | 'needs_libs', |
---|
71 | ); |
---|
72 | |
---|
73 | my %skipped_files = map { $_ => 1; } ( |
---|
74 | '.build.lst', |
---|
75 | '.cvsignore', |
---|
76 | '.gitignore', |
---|
77 | '.depends', |
---|
78 | 'ChangeLog', |
---|
79 | 'config.makefile', |
---|
80 | 'helpfiles.lst', |
---|
81 | 'Makefile.setup.local', |
---|
82 | 'makeloc.here', |
---|
83 | 'makeloc.here', |
---|
84 | 'nt_date.h', |
---|
85 | 'postcompile.sav', |
---|
86 | 'TAGS', |
---|
87 | '.DS_Store', |
---|
88 | ); |
---|
89 | |
---|
90 | my %used_extensions = map { $_ => 1; } ( # matches part behind last '.' in filename |
---|
91 | 'c', 'cpp', 'cxx', 'cc', |
---|
92 | 'h', 'hpp', 'hxx', |
---|
93 | |
---|
94 | 'aisc', 'pa', |
---|
95 | 'bitmap', |
---|
96 | 'dtd', 'xsl', |
---|
97 | 'f', |
---|
98 | 'footer', |
---|
99 | 'head', 'header', |
---|
100 | 'i', # swig input |
---|
101 | 'inc', |
---|
102 | 'java', 'manifest', |
---|
103 | 'makefile', |
---|
104 | 'pl', 'pm', 'PL', 'cgi', 'xs', |
---|
105 | 'awk', |
---|
106 | 'py', |
---|
107 | 'script', |
---|
108 | 'sh', |
---|
109 | 'source', 'menu', |
---|
110 | 'template', 'default', |
---|
111 | 'txt', 'doc', 'ps', 'pdf', |
---|
112 | 'tgz', 'gz', |
---|
113 | 'svg', 'png', |
---|
114 | 'xpc', |
---|
115 | ); |
---|
116 | |
---|
117 | my %skipped_extensions = map { $_ => 1; } ( # matches part behind last '.' in filename |
---|
118 | 'a', |
---|
119 | 'bak', |
---|
120 | 'class', |
---|
121 | 'bundle', # Some file from XCode |
---|
122 | 'gcno', |
---|
123 | 'genmenu', |
---|
124 | 'jar', |
---|
125 | 'last_gcc', |
---|
126 | 'last_compiler', |
---|
127 | 'list', |
---|
128 | 'log', |
---|
129 | 'o', |
---|
130 | 'old', |
---|
131 | 'patch', |
---|
132 | 'rej', |
---|
133 | 'so', |
---|
134 | 'stamp', |
---|
135 | 'swp', |
---|
136 | 'tmp', |
---|
137 | 'yml', 'json', # perl2arb |
---|
138 | ); |
---|
139 | |
---|
140 | |
---|
141 | # used_when_matches, skipped_when_matches and used_when_matchesFull are only tested, |
---|
142 | # if above filters did not match: |
---|
143 | |
---|
144 | my @used_when_matches = ( |
---|
145 | qr/^arb_.*\.txt$/o, |
---|
146 | qr/disclaimer/io, |
---|
147 | qr/license/io, |
---|
148 | qr/needs_libs\..*/io, |
---|
149 | qr/readme$/io, |
---|
150 | qr/typemap$/io, |
---|
151 | ); |
---|
152 | |
---|
153 | my @skipped_when_matches = ( |
---|
154 | qr/.*~$/o, # backups |
---|
155 | qr/\#.*\#$/o, |
---|
156 | qr/\.\#.*$/o, |
---|
157 | qr/^arbsrc.*\.tgz$/o, |
---|
158 | qr/^arbsrc\.lst$/o, |
---|
159 | qr/^arbsrc\.lst\.tmp$/o, |
---|
160 | qr/^callgrind\./o, |
---|
161 | ); |
---|
162 | |
---|
163 | my @used_when_matchesFull = ( |
---|
164 | qr/\/AISC_COM\/AISC\/magic.lst$/o, |
---|
165 | qr/\/CLUSTALW\/.*$/o, |
---|
166 | qr/\/EISPACK\/rg\.html$/o, |
---|
167 | qr/\/GDE\/.*\.html$/o, |
---|
168 | qr/\/GDEHELP\/FASTA/o, |
---|
169 | qr/\/GDEHELP\/GDE.*/o, |
---|
170 | qr/\/GDEHELP\/HELP_PLAIN/o, |
---|
171 | qr/\/GDEHELP\/HELP_WRITTEN/o, |
---|
172 | qr/\/GDEHELP\/Makefile\.helpfiles/o, |
---|
173 | qr/\/HEADERLIBS\/.*COPYING$/o, |
---|
174 | qr/\/HELP_SOURCE\/.*\.gif$/o, |
---|
175 | qr/\/HELP_SOURCE\/source\/.*\.(ps|pdf)\.gz$/o, |
---|
176 | qr/\/HELP_SOURCE\/source\/.*\.hlp$/o, |
---|
177 | qr/\/HGL_SRC\/plot\.icon$/o, |
---|
178 | qr/\/PERL2ARB\/.*\.html$/o, |
---|
179 | qr/\/PERL2ARB\/Makefile.main$/o, |
---|
180 | qr/\/PHYLIP\/doc\//o, |
---|
181 | qr/\/PROBE_SERVER\/.*\.conf$/o, |
---|
182 | qr/\/READSEQ\/.*\.help$/o, |
---|
183 | qr/\/READSEQ\/Formats$/o, |
---|
184 | qr/\/SH\/[^\/\.]*$/o, |
---|
185 | qr/\/SOURCE_TOOLS\//o, |
---|
186 | qr/\/TREEPUZZLE\/.*\.gif$/o, |
---|
187 | qr/\/UNIT_TESTER\/run\/.*\.a00$/o, |
---|
188 | qr/\/UNIT_TESTER\/run\/.*\.arb$/o, |
---|
189 | qr/\/UNIT_TESTER\/run\/.*\.amc$/o, |
---|
190 | qr/\/UNIT_TESTER\/run\/.*\.expected$/o, |
---|
191 | qr/\/UNIT_TESTER\/run\/.*\.fig$/o, |
---|
192 | qr/\/UNIT_TESTER\/run\/.*\.in$/o, |
---|
193 | qr/\/UNIT_TESTER\/run\/.*\.inp$/o, |
---|
194 | qr/\/UNIT_TESTER\/run\/.*\.input$/o, |
---|
195 | qr/\/UNIT_TESTER\/run\/.*\.out$/o, |
---|
196 | qr/\/UNIT_TESTER\/run\/.*\.tree$/o, |
---|
197 | qr/\/UNIT_TESTER\/run\/help\//o, |
---|
198 | qr/\/UNIT_TESTER\/run\/impexp\/.*\.(exported|fts)$/o, |
---|
199 | qr/\/UNIT_TESTER\/valgrind\/arb_valgrind_logged$/o, |
---|
200 | qr/^\.\/etc\//o, |
---|
201 | qr/^\.\/lib\/arb_default\/.*\.arb$/o, |
---|
202 | qr/^\.\/lib\/arb_tcp_org\.dat$/o, |
---|
203 | qr/^\.\/lib\/config\.[^\.]+$/io, |
---|
204 | qr/^\.\/lib\/desktop\/.*$/o, |
---|
205 | qr/^\.\/lib\/export\/.*\.eft$/o, |
---|
206 | qr/^\.\/lib\/import\/.*\.ift2?$/o, |
---|
207 | qr/^\.\/lib\/inputMasks\/.*\.mask$/o, |
---|
208 | qr/^\.\/lib\/macros\/.*\.amc$/o, |
---|
209 | qr/^\.\/lib\/macros\/.checks\/.*\.expected$/o, |
---|
210 | qr/^\.\/lib\/nas\/names\.dat\.template$/o, |
---|
211 | qr/^\.\/lib\/pictures\/.*\.(fig|vfont)$/o, |
---|
212 | qr/^\.\/lib\/pixmaps\/.*\.xpm$/o, |
---|
213 | qr/^\.\/lib\/protein_2nd_structure\/.*\.dat$/o, |
---|
214 | qr/^\.\/lib\/rna3d\/.*\.(pdb|data)$/o, |
---|
215 | qr/^\.\/lib\/rna3d\/images\/.*\.png$/o, |
---|
216 | qr/^\.\/lib\/sellists\/.*\.sellst$/o, |
---|
217 | qr/^\.\/lib\/submit\//o, |
---|
218 | qr/^\.\/lib\/BUGS\//o, |
---|
219 | qr/^\.\/util\/arb_.*$/o, |
---|
220 | qr/^\.\/util\/config\..*$/o, |
---|
221 | qr/\/GDE\/.*\/Makefile\.[^\/]+$/io, |
---|
222 | qr/\/GDE\/PHYML[^\/]+\/phyml\//o, |
---|
223 | qr/\/GDE\/SATIVA\/sativa\//o, |
---|
224 | ); |
---|
225 | |
---|
226 | # skipped_when_matchesFull and forced_when_matchesFull are always tested! (@3) |
---|
227 | |
---|
228 | my @skipped_when_matchesFull = ( |
---|
229 | qr/\/genhelp\/.*\.hlp$/o, |
---|
230 | qr/\/lib\/addlibs\/(lib.*\.so\..*)$/o, |
---|
231 | qr/^\.\/arb.*\.tgz$/o, |
---|
232 | qr/^\.\/bin\//o, |
---|
233 | qr/^\.\/GDE\/CORE\/functions.h$/o, |
---|
234 | qr/^\.\/GDE\/PHYML[^\/]+\/phyml\/(configure|config.h.in)$/o, |
---|
235 | qr/\/HELP_SOURCE\/help_map\.gif$/o, |
---|
236 | qr/^\.\/lib\/ARB\.pm$/o, |
---|
237 | qr/^\.\/lib\/arb_tcp\.dat$/o, |
---|
238 | qr/^\.\/lib\/gde\/.*\.menu$/o, |
---|
239 | qr/^\.\/lib\/nas\/names.*\.dat$/o, |
---|
240 | qr/^\.\/lib\/macros\/\.checks\/.*\.ids$/o, |
---|
241 | qr/^\.\/lib\/motifHack\/pixmaps\/.*$/o, |
---|
242 | qr/^\.\/PERL2ARB\/.*\.h$/o, |
---|
243 | qr/^\.\/PERL2ARB\/ARB\.bs$/o, |
---|
244 | qr/^\.\/PERL2ARB\/ARB\.c$/o, |
---|
245 | qr/^\.\/PERL2ARB\/ARB\.xs$/o, |
---|
246 | qr/^\.\/PERL2ARB\/Makefile$/o, |
---|
247 | qr/^\.\/PERL2ARB\/Makefile.PL$/o, |
---|
248 | qr/^\.\/PERL2ARB\/perl-interface-function-list.txt$/o, |
---|
249 | qr/^\.\/PERL2ARB\/perlmain.c$/o, |
---|
250 | qr/^\.\/PERL2ARB\/pm_to_blib$/o, |
---|
251 | qr/^\.\/SOURCE_TOOLS\/valgrind2grep\.lst$/o, |
---|
252 | qr/^\.\/SOURCE_TOOLS\/stamp\./o, |
---|
253 | qr/^\.\/TEMPLATES\/arb_build\.h$/o, |
---|
254 | qr/^\.\/UNIT_TESTER\/run\/TEST_g?pt\.arb$/o, |
---|
255 | qr/^\.\/UNIT_TESTER\/run\/.*\.ARM$/o, |
---|
256 | qr/^\.\/UNIT_TESTER\/run\/.*\.ARF$/o, |
---|
257 | qr/^\.\/UNIT_TESTER\/Makefile\.setup\.local\.last$/o, |
---|
258 | qr/^\.\/TAGS\./o, # avoid failure while 'make tags' is running |
---|
259 | qr/date\.xsl$/o, |
---|
260 | ); |
---|
261 | |
---|
262 | my @forced_when_matchesFull = ( |
---|
263 | qr/^\.\/bin\/Makefile/o, |
---|
264 | qr/\/PROBE_WEB\/SERVER\/.*\.jar$/o, |
---|
265 | qr/\/GDE\/PHYML[^\/]+\/phyml\/.*\.log$/o, |
---|
266 | qr/\/UNIT_TESTER\/run\/.*\.list$/o, |
---|
267 | qr/\/HEADERLIBS\/.*\.patch$/o, |
---|
268 | ); |
---|
269 | |
---|
270 | # files that are even packed when generated and not in VC |
---|
271 | my @pack_fullGenerated = ( |
---|
272 | qr/\/TEMPLATES\/svn_revision\.h$/o, |
---|
273 | qr/\/lib\/revision_info\.txt$/o, |
---|
274 | ); |
---|
275 | |
---|
276 | # files that are not expexted to be packed when in VC |
---|
277 | my %unpackedCVSmember = map { $_ => 1; } ( |
---|
278 | '.cvsignore', |
---|
279 | '.gitignore', |
---|
280 | 'ChangeLog', |
---|
281 | ); |
---|
282 | |
---|
283 | # ------------------------------------------------------------ |
---|
284 | # sanity checks |
---|
285 | |
---|
286 | foreach (keys %used_extensions) { |
---|
287 | if (exists $skipped_extensions{$_}) { die "'$_' in \$used_extensions and \$skipped_extensions"; } |
---|
288 | } |
---|
289 | foreach (keys %used_files) { |
---|
290 | if (exists $skipped_files{$_}) { die "'$_' in \$used_files and \$skipped_files"; } |
---|
291 | } |
---|
292 | |
---|
293 | # ------------------------------------------------------------ |
---|
294 | |
---|
295 | sub useDir($) { |
---|
296 | my ($dir) = @_; |
---|
297 | |
---|
298 | if ($dir =~ /.svn$/o) { return 0; } |
---|
299 | if ($dir =~ /.git$/o) { return 0; } |
---|
300 | if ($dir =~ /CVS$/o) { return 0; } |
---|
301 | |
---|
302 | foreach (@skipped_directories) { |
---|
303 | if ($dir =~ $_) { return 0; } |
---|
304 | } |
---|
305 | return 1; |
---|
306 | } |
---|
307 | |
---|
308 | sub matchingExpr($\@) { |
---|
309 | # return 0 if no regexp matched, return index+1 otherwise |
---|
310 | my ($str,$regexp_arr_r) = @_; |
---|
311 | |
---|
312 | my $regexps = scalar(@$regexp_arr_r); |
---|
313 | for (my $r=0; $r<$regexps; $r++) { |
---|
314 | my $reg = $$regexp_arr_r[$r]; |
---|
315 | if ($str =~ $reg) { |
---|
316 | return $r+1; |
---|
317 | } |
---|
318 | } |
---|
319 | return 0; |
---|
320 | } |
---|
321 | |
---|
322 | sub useIfMatching($\@\$) { |
---|
323 | my ($str,$regexp_arr_r,$use_r) = @_; |
---|
324 | my $matches = matchingExpr($str,@$regexp_arr_r); |
---|
325 | if ($matches>0) { |
---|
326 | if ($debug_matching!=0) { print STDERR "'$str' matches '".$$regexp_arr_r[$matches-1]."' => use!\n"; } |
---|
327 | $$use_r = 1; |
---|
328 | } |
---|
329 | } |
---|
330 | sub dontUseIfMatching($\@\$) { |
---|
331 | my ($str,$regexp_arr_r,$use_r) = @_; |
---|
332 | my $matches = matchingExpr($str,@$regexp_arr_r); |
---|
333 | if ($matches>0) { |
---|
334 | if ($debug_matching!=0) { print STDERR "'$str' matches '".$$regexp_arr_r[$matches-1]."' => don't use!\n"; } |
---|
335 | $$use_r = 0; |
---|
336 | } |
---|
337 | } |
---|
338 | |
---|
339 | sub useFile($$) { |
---|
340 | my ($dir,$file) = @_; |
---|
341 | |
---|
342 | my $use = undef; |
---|
343 | if (exists $used_files{$file}) { $use = 1; } |
---|
344 | elsif (exists $skipped_files{$file}) { $use = 0; } |
---|
345 | |
---|
346 | my $hasExt = 0; |
---|
347 | if (not defined $use) { |
---|
348 | if ($file =~ /\.([^\.]+)$/o) { |
---|
349 | my $ext = $1; |
---|
350 | $hasExt = 1; |
---|
351 | if (exists $used_extensions{$ext}) { |
---|
352 | if ($debug_matching!=0) { print STDERR "'$file' matches extension '".$ext."' => use!\n"; } |
---|
353 | $use = 1; |
---|
354 | } |
---|
355 | elsif (exists $skipped_extensions{$ext}) { |
---|
356 | if ($debug_matching!=0) { print STDERR "'$file' matches extension '".$ext."' => don't use!\n"; } |
---|
357 | $use = 0; |
---|
358 | } |
---|
359 | } |
---|
360 | } |
---|
361 | |
---|
362 | if (not defined $use) { |
---|
363 | useIfMatching($file,@used_when_matches, $use); |
---|
364 | } |
---|
365 | |
---|
366 | if (not defined $use) { |
---|
367 | dontUseIfMatching($file,@skipped_when_matches, $use); |
---|
368 | } |
---|
369 | |
---|
370 | my $full; |
---|
371 | if (not defined $use) { |
---|
372 | $full = $dir.'/'.$file; |
---|
373 | |
---|
374 | useIfMatching($full,@used_when_matchesFull, $use); |
---|
375 | if (not defined $use) { |
---|
376 | if (-X $full and $hasExt==0) { $use = 0; } # exclude binaries by default (wrong for scripts) |
---|
377 | } |
---|
378 | } |
---|
379 | |
---|
380 | if (not defined $use or $use==1) { |
---|
381 | if (not defined $full) { $full = $dir.'/'.$file; } |
---|
382 | |
---|
383 | dontUseIfMatching($full,@skipped_when_matchesFull, $use); |
---|
384 | } |
---|
385 | if (not defined $use or $use==0) { |
---|
386 | if (not defined $full) { $full = $dir.'/'.$file; } |
---|
387 | useIfMatching($full,@forced_when_matchesFull, $use); |
---|
388 | } |
---|
389 | |
---|
390 | if (not defined $use) { |
---|
391 | if ($ignore_unknown==0) { |
---|
392 | die "Don't know whether to use or skip '$file' (in $dir)"; |
---|
393 | } |
---|
394 | $use = 1; |
---|
395 | } |
---|
396 | |
---|
397 | return $use; |
---|
398 | } |
---|
399 | |
---|
400 | # ------------------------------------------------------------ |
---|
401 | |
---|
402 | my $VC_FILE = 1; |
---|
403 | my $VC_DIR = 2; |
---|
404 | my $VC_UNKNOWN = 3; # in SVN, but unknown whether dir or file |
---|
405 | |
---|
406 | my $svn_entries_read = 0; |
---|
407 | my %all_svn_entries = (); |
---|
408 | |
---|
409 | sub isSVNcheckout($) { |
---|
410 | my ($dir) = @_; |
---|
411 | if (-f $dir.'/.svn/entries') { return 1; } |
---|
412 | if (-f $dir.'/.svn/wc.db') { return 1; } |
---|
413 | return 0; |
---|
414 | } |
---|
415 | |
---|
416 | sub getSVNEntries($\%) { |
---|
417 | my ($dir,$SVN_r) = @_; |
---|
418 | |
---|
419 | if ($svn_entries_read==0) { # first call |
---|
420 | if (isSVNcheckout($dir)==0) { return 0; } |
---|
421 | |
---|
422 | my $cmd = "svn status -v $dir"; |
---|
423 | open(SVNSTATUS, "$cmd|") || die "failed to execute '$cmd' (Reason: $!)"; |
---|
424 | |
---|
425 | eval { |
---|
426 | my $reg_status_line = qr/^(.*)\s+([0-9]+|\-)\s+([0-9]+|\?)\s+([^\s]+)\s+([^\s]+)$/; |
---|
427 | |
---|
428 | my $line; |
---|
429 | while (defined($line=<SVNSTATUS>)) { |
---|
430 | chomp($line); |
---|
431 | if ($line =~ $reg_status_line) { |
---|
432 | my ($flags,$revLast,$revFirst,$author,$name) = ($1,$2,$3,$4,$5); |
---|
433 | |
---|
434 | my $inSVN = 1; |
---|
435 | if ($flags =~ /D/) { $inSVN = 0; } |
---|
436 | |
---|
437 | if ($inSVN==1) { |
---|
438 | if (-f $name) { |
---|
439 | $all_svn_entries{$name} = $VC_FILE; |
---|
440 | } |
---|
441 | elsif (-d $name) { |
---|
442 | $all_svn_entries{$name} = $VC_DIR; |
---|
443 | } |
---|
444 | else { |
---|
445 | $all_svn_entries{$name} = $VC_UNKNOWN; |
---|
446 | } |
---|
447 | } |
---|
448 | } |
---|
449 | else { |
---|
450 | if ($line =~ /^?/) { |
---|
451 | ; # silently ignore unknown files |
---|
452 | # print STDERR "Silently ignores '$line'\n"; |
---|
453 | } |
---|
454 | else { |
---|
455 | die "Cant parse line '$line'"; |
---|
456 | } |
---|
457 | } |
---|
458 | } |
---|
459 | }; |
---|
460 | if ($@) { |
---|
461 | die "Failed to read svn status: $@"; |
---|
462 | } |
---|
463 | |
---|
464 | close(SVNSTATUS); |
---|
465 | $svn_entries_read = 1; |
---|
466 | } |
---|
467 | |
---|
468 | if ($dir eq '.') { |
---|
469 | foreach (keys %all_svn_entries) { |
---|
470 | if (not /\//) { # root entry |
---|
471 | $$SVN_r{$_} = $all_svn_entries{$_}; |
---|
472 | } |
---|
473 | } |
---|
474 | } |
---|
475 | else { |
---|
476 | if (not $dir =~ /^\.\//) { die "expected '$dir' to start with './'"; } |
---|
477 | my $sdir = $'; |
---|
478 | my $reg_matchdir = qr/^$sdir\//; |
---|
479 | foreach (keys %all_svn_entries) { |
---|
480 | if ($_ =~ $reg_matchdir) { |
---|
481 | my $rest = $'; |
---|
482 | if (not $rest =~ /\//) { # in $dir (not below) |
---|
483 | $$SVN_r{$rest} = $all_svn_entries{$_}; |
---|
484 | } |
---|
485 | } |
---|
486 | } |
---|
487 | } |
---|
488 | |
---|
489 | return 1; |
---|
490 | } |
---|
491 | |
---|
492 | sub getCVSEntries($\%) { |
---|
493 | my ($dir,$CVS_r) = @_; |
---|
494 | |
---|
495 | my $cvsentries = $dir.'/CVS/Entries'; |
---|
496 | if (-f $cvsentries) { |
---|
497 | open(CVS,'<'.$cvsentries) || die "can't read '$cvsentries' (Reason: $!)"; |
---|
498 | eval { |
---|
499 | foreach (<CVS>) { |
---|
500 | chomp; |
---|
501 | if (/^D\/([^\/]+)\//o) { # directory |
---|
502 | $$CVS_r{$1} = $VC_DIR; |
---|
503 | } |
---|
504 | elsif (/^\/([^\/]+)\//o) { # file |
---|
505 | $$CVS_r{$1} = $VC_FILE; |
---|
506 | } |
---|
507 | elsif (/^D$/o) { |
---|
508 | ; |
---|
509 | } |
---|
510 | else { |
---|
511 | die "can't parse line '$_'"; |
---|
512 | } |
---|
513 | } |
---|
514 | }; |
---|
515 | if ($@) { die "$@ while reading $cvsentries"; } |
---|
516 | close(CVS); |
---|
517 | return 1; |
---|
518 | } |
---|
519 | return 0; |
---|
520 | } |
---|
521 | |
---|
522 | my $VC = '<no VC>'; |
---|
523 | |
---|
524 | sub getVCEntries($\%) { |
---|
525 | my ($dir,$VC_r) = @_; |
---|
526 | |
---|
527 | my $res = 1; |
---|
528 | if (getSVNEntries($dir,%$VC_r)==0) { |
---|
529 | if (getCVSEntries($dir,%$VC_r)==0) { |
---|
530 | $VC = '<no VC>'; |
---|
531 | $res = 0; |
---|
532 | } |
---|
533 | else { |
---|
534 | $VC = 'CVS'; |
---|
535 | } |
---|
536 | } |
---|
537 | else { |
---|
538 | $VC = 'SVN'; |
---|
539 | } |
---|
540 | |
---|
541 | if (0) { |
---|
542 | print STDERR "$VC entries for $dir:\n"; |
---|
543 | foreach (sort keys %$VC_r) { |
---|
544 | print STDERR " ".$$VC_r{$_}.": $_\n"; |
---|
545 | } |
---|
546 | } |
---|
547 | |
---|
548 | return $res; |
---|
549 | } |
---|
550 | |
---|
551 | my $is_plain_svn_WC = (not -d '.git'); |
---|
552 | |
---|
553 | sub die_plain_svn_WC($) { |
---|
554 | my ($reason) = @_; |
---|
555 | if ($is_plain_svn_WC) { |
---|
556 | die $reason; |
---|
557 | } |
---|
558 | else { |
---|
559 | print STDERR "[in plain svn this would die with] $reason\n"; |
---|
560 | } |
---|
561 | } |
---|
562 | |
---|
563 | # ------------------------------------------------------------ |
---|
564 | |
---|
565 | sub expectVCmember($$\%) { |
---|
566 | my ($full,$item,$VC_r) = @_; |
---|
567 | if ((not defined $$VC_r{$item}) and ($ignore_unknown==0)) { |
---|
568 | if (not matchingExpr($full,@pack_fullGenerated)) { |
---|
569 | die_plain_svn_WC "'$full' ($_) included, but not in $VC (seems to be generated)"; |
---|
570 | } |
---|
571 | } |
---|
572 | } |
---|
573 | |
---|
574 | sub unexpectVCmember($$\%) { |
---|
575 | my ($full,$item,$VC_r) = @_; |
---|
576 | if (defined $$VC_r{$item}) { |
---|
577 | if ((not exists $unpackedCVSmember{$item}) and ($ignore_unknown==0)) { |
---|
578 | die_plain_svn_WC "'$full' excluded, but in $VC"; |
---|
579 | } |
---|
580 | } |
---|
581 | } |
---|
582 | |
---|
583 | sub is_version_controlled($\%) { |
---|
584 | my ($item,$VC_r) = @_; |
---|
585 | if (defined $$VC_r{$item}) { |
---|
586 | return 1; |
---|
587 | } |
---|
588 | return 0; |
---|
589 | } |
---|
590 | |
---|
591 | sub saveAsInSVNforDir($) { |
---|
592 | my ($dir) = @_; |
---|
593 | foreach my $reg (@strictly_as_in_svn_when_matchesDir) { |
---|
594 | if ($dir =~ $reg) { |
---|
595 | return 1; |
---|
596 | } |
---|
597 | } |
---|
598 | return 0; |
---|
599 | } |
---|
600 | |
---|
601 | sub dumpFiles($); |
---|
602 | sub dumpFiles($) { |
---|
603 | my ($dir) = @_; |
---|
604 | |
---|
605 | eval { |
---|
606 | my @subdirs; |
---|
607 | my @files; |
---|
608 | |
---|
609 | my %CVS; |
---|
610 | if (!getVCEntries($dir,%CVS)) { |
---|
611 | die "arb_srclst.pl only works in a SVN checkout"; |
---|
612 | } |
---|
613 | |
---|
614 | my $as_in_svn = saveAsInSVNforDir($dir); |
---|
615 | |
---|
616 | opendir(DIR,$dir) || die "can't read directory '$dir' (Reason: $!)"; |
---|
617 | foreach (readdir(DIR)) { |
---|
618 | if ($_ ne '.' and $_ ne '..') { |
---|
619 | my $full = $dir.'/'.$_; |
---|
620 | |
---|
621 | # print STDERR "full='$full' (as_in_svn=$as_in_svn)\n"; |
---|
622 | |
---|
623 | if (not -l $full) { |
---|
624 | if (-d $full) { |
---|
625 | if ($as_in_svn==1) { |
---|
626 | if (is_version_controlled($_,%CVS)==1) { |
---|
627 | push @subdirs, $full; |
---|
628 | } |
---|
629 | } |
---|
630 | else { |
---|
631 | if (useDir($full)==1) { |
---|
632 | expectVCmember($full,$_,%CVS); |
---|
633 | push @subdirs, $full; |
---|
634 | } |
---|
635 | else { unexpectVCmember($full,$_,%CVS); } |
---|
636 | } |
---|
637 | } |
---|
638 | elsif (-f $full) { |
---|
639 | if ($as_in_svn==1) { |
---|
640 | if (is_version_controlled($_,%CVS)==1) { |
---|
641 | push @files, $full; |
---|
642 | } |
---|
643 | } |
---|
644 | else { |
---|
645 | if (useFile($dir,$_)==1) { |
---|
646 | expectVCmember($full,$_,%CVS); |
---|
647 | push @files, $full; |
---|
648 | } |
---|
649 | else { unexpectVCmember($full,$_,%CVS); } |
---|
650 | } |
---|
651 | } |
---|
652 | else { die "Unknown (neither link nor file nor directory): '$full'"; } |
---|
653 | } |
---|
654 | } |
---|
655 | } |
---|
656 | closedir(DIR); |
---|
657 | |
---|
658 | foreach (@files) { print $_."\n"; } |
---|
659 | foreach (@subdirs) { dumpFiles($_); } |
---|
660 | }; |
---|
661 | if ($@) { |
---|
662 | my $err = $@; |
---|
663 | if ($err =~ /at\s(.*\.pl)\sline\s([0-9]+)/) { |
---|
664 | $err = "$1:$2: Error: $`"; |
---|
665 | } |
---|
666 | $err =~ s/\n//g; |
---|
667 | die "$err\n"; |
---|
668 | } |
---|
669 | } |
---|
670 | |
---|
671 | my $args = scalar(@ARGV); |
---|
672 | if ($args==0) { |
---|
673 | dumpFiles('.'); |
---|
674 | } |
---|
675 | else { |
---|
676 | my $arg = $ARGV[0]; |
---|
677 | if ($arg eq 'ignore') { |
---|
678 | $ignore_unknown = 1; |
---|
679 | dumpFiles('.'); |
---|
680 | } |
---|
681 | elsif ($arg eq 'matching') { |
---|
682 | $debug_matching = 1; |
---|
683 | dumpFiles('.'); |
---|
684 | } |
---|
685 | else { |
---|
686 | die "Usage: arb_srclst.pl [ignore|matching]\n"; |
---|
687 | } |
---|
688 | } |
---|