Commit | Line | Data |
---|---|---|
459d3fb5 MBT |
1 | #!/usr/bin/perl |
2 | eval 'exec perl -S $0 "$@"' | |
3 | if $running_under_some_shell; | |
4 | ||
5 | # $Id: manilist.SH 20 2008-01-04 23:14:00Z rmanfredi $ | |
6 | # | |
7 | # Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi | |
8 | # | |
9 | # You may redistribute only under the terms of the Artistic Licence, | |
10 | # as specified in the README file that comes with the distribution. | |
11 | # You may reuse parts of this distribution only within the terms of | |
12 | # that same Artistic Licence; a copy of which may be found at the root | |
13 | # of the source tree for dist 4.0. | |
14 | # | |
15 | # $Log: manilist.SH,v $ | |
16 | # Revision 3.0.1.3 1994/10/29 15:42:42 ram | |
17 | # patch36: fixed open precedence problem for perl5 | |
18 | # | |
19 | # Revision 3.0.1.2 1994/01/24 13:52:33 ram | |
20 | # patch16: added ~/.dist_profile awareness | |
21 | # | |
22 | # Revision 3.0.1.1 1993/08/19 06:41:52 ram | |
23 | # patch1: leading config.sh searching was not aborting properly | |
24 | # | |
25 | # Revision 3.0 1993/08/18 12:04:03 ram | |
26 | # Baseline for dist 3.0 netwide release. | |
27 | # | |
28 | ||
29 | $version = '3.5'; | |
30 | $pl = '0'; | |
31 | ||
32 | # This script scans the MANIFEST.new file and builds some reports. | |
33 | ||
34 | # The output can be somewhat changed to produce other kind of reports. | |
35 | # The format is specified with a leading set of activation character, followed | |
36 | # by a ':', and then a set of formatting macros. The leading characters tell | |
37 | # when a report line shall be issued: | |
38 | # a: all files (shortcut for 'ix') | |
39 | # A: all files but the excluded ones | |
40 | # f: report for files only | |
41 | # d: report for directories only | |
42 | # m: report for files/directories found in the MANIFEST.new | |
43 | # n: report for files/directories not found in the MANIFEST.new | |
44 | # i: included files are listed | |
45 | # x: excluded files are listed | |
46 | # Then a set of macros introduced by %: | |
47 | # %c: the leading one character code defined as follows: | |
48 | # . if the file is up to date (i.e. not newer than patchlevel.h) | |
49 | # - if the file is present in the manifest but is missing | |
50 | # > if the file has changed since last patch. | |
51 | # + if the file is not present in the manifest but exists | |
52 | # o if the file is not listed but exists and is older than patchlevel.h | |
53 | # x if the file in manifest and exists but was excluded | |
54 | # ? if the file in manifest but was excluded and does not exist | |
55 | # %n: the name of the file (its path from the top directory) | |
56 | # %t: time stamp of last modification | |
57 | # %d: description from MANIFEST.new file, if any | |
58 | # %s: size of the file, in bytes | |
59 | ||
60 | $format = 'A:%c %n'; | |
61 | ||
62 | # By default, only the source files whith the following extensions are reported | |
63 | # (but a -a option will report ALL the files, and a -i option can specify some | |
64 | # other extensions as well). | |
65 | # .sh .SH .c .h .l .y .man | |
66 | ||
67 | @include = ('.sh', '.SH', '.c', '.h', '.l', '.y', '.man'); | |
68 | ||
69 | # By default, the following extensions are excluded from the list. More | |
70 | # exclusions can be added with the -x option: | |
71 | # ^core .o .bak .rej .new .old .orig ,v | |
72 | ||
73 | @exclude = ('^core', '.o', '.bak', '.rej', '.new', '.old', '.orig', ',v'); | |
74 | ||
75 | # The column separator character (or string) is used to separate each formatted | |
76 | # column on the output. Formatting is requested by adding a '|' character in | |
77 | # the format string. A new separator can be specified via the -C option. | |
78 | # The maximum column size is fixed by the -L. | |
79 | ||
80 | $col_separator = ' '; | |
81 | $col_size = ''; | |
82 | ||
83 | &profile; # Read ~/.dist_profile | |
84 | require 'getopts.pl'; | |
85 | require 'stat.pl'; | |
86 | &usage unless &Getopts('abcdhntVi:f:p:s:w:x:C:L:I:X:'); | |
87 | ||
88 | &usage if $opt_h; | |
89 | if ($opt_V) { | |
90 | print "manilist $version PL$pl\n"; | |
91 | exit 0; | |
92 | } | |
93 | ||
94 | # Go to the top of the package, and update any file name given as argument | |
95 | # by prepending the needed path. The process then performs a chdir to the | |
96 | # top. | |
97 | unless ($opt_b) { | |
98 | chop($pwd = `pwd`) unless -f '.package'; | |
99 | until (-f '.package') { | |
100 | die "No .package file! Run packinit.\n" unless $pwd; | |
101 | chdir '..' || die "Can't cd ..\n"; | |
102 | $pwd =~ s|(.*)/(.*)|$1|; | |
103 | $prefix = $2 . '/' . $prefix; | |
104 | } | |
105 | if ($prefix) { | |
106 | for (@ARGV) { | |
107 | s/^\.$/$prefix/ && next; | |
108 | s/^/$prefix/ unless m|^[-/]|; | |
109 | } | |
110 | } | |
111 | } | |
112 | ||
113 | # We now are at the top level | |
114 | ||
115 | # Build up the file hierarchy filter in @filter | |
116 | foreach $entry (@ARGV) { | |
117 | $entry =~ s|/$||; # Remove final / in directory names | |
118 | if (-d $entry) { | |
119 | push(@filter, "d:$entry"); | |
120 | } elsif (-f $entry) { | |
121 | push(@filter, "f:$entry"); | |
122 | } else { | |
123 | die "$entry: No such file or directory.\n"; | |
124 | } | |
125 | } | |
126 | ||
127 | $prefix = '.' unless $prefix; | |
128 | ($top = $prefix) =~ s|/$||; | |
129 | $top = '.' if $opt_t; # Start from top, not from original dir | |
130 | @ARGV = ($top) unless @ARGV; | |
131 | ||
132 | if ($opt_n) { # "manifest" files are found by scanning the directory | |
133 | open(MANIFEST, "find @ARGV -print|") || die "Can't run find: $!\n"; | |
134 | while (<MANIFEST>) { | |
135 | chop; | |
136 | s|^./||; | |
137 | push(@manifest, $_); | |
138 | } | |
139 | close MANIFEST; | |
140 | } else { | |
141 | $MANIFEST = $opt_f; | |
142 | $MANIFEST = 'MANIFEST.new' unless $opt_f; | |
143 | open(MANIFEST, $MANIFEST) || die "Can't open $MANIFEST: $!\n"; | |
144 | while (<MANIFEST>) { | |
145 | chop; | |
146 | s|^./||; | |
147 | s|^(\S+)||; | |
148 | local($name) = $1; | |
149 | push(@manifest, $name); | |
150 | m|^\s+(\d+)*\s*(.*)| && ($comment{$name} = $2); | |
151 | } | |
152 | close MANIFEST; | |
153 | } | |
154 | ||
155 | # If we have to compare the files in the MANIFEST with the actual files on | |
156 | # the file system, then grab them... | |
157 | if ($opt_c && !$opt_n) { | |
158 | open(FILES, "find @ARGV -print|") || die "Can't run find: $!\n"; | |
159 | while (<FILES>) { | |
160 | chop; | |
161 | s|^./||; | |
162 | push(@files, $_); | |
163 | } | |
164 | close FILES; | |
165 | } | |
166 | ||
167 | # If there is a patchlevel.h file, get its time stamp. | |
168 | $pl_mtime = 0; | |
169 | $pl_mtime = (stat('patchlevel.h'))[$ST_MTIME] if -f 'patchlevel.h'; | |
170 | ||
171 | # Dealing with command-line options | |
172 | $format = $opt_p if $opt_p; | |
173 | $col_separator = $opt_C if $opt_C; | |
174 | $col_size = $opt_L if $opt_L; | |
175 | unless ($opt_p) { # -p may be used as a shortcut for -w and -s | |
176 | local($which) = ($format =~ /^(\w+):/); | |
177 | local($string) = ($format =~ /^\w+:(.*)/); | |
178 | $which = $opt_w if $opt_w; | |
179 | $string = $opt_s if $opt_s; | |
180 | $format = "$which:$string"; | |
181 | } | |
182 | @include = split(' ', $opt_I) if $opt_I; # First reset included with -I | |
183 | @exclude = split(' ', $opt_X) if $opt_X; # and excluded with -X | |
184 | push(@include, split(' ', $opt_i)) if $opt_i; # before applying additions | |
185 | push(@exclude, split(' ', $opt_x)) if $opt_x; | |
186 | &mode_opt; # Compute $mode_xxx variables | |
187 | &init_functions; # Compile &included and &excluded | |
188 | ||
189 | # Option -d requests dumping of inclusion and exclusion lists on stderr | |
190 | if ($opt_d) { | |
191 | print STDERR "Included: ", join(' ', @include), "\n"; | |
192 | print STDERR "Excluded: ", join(' ', @exclude), "\n"; | |
193 | } | |
194 | ||
195 | @manifest = sort @manifest; | |
196 | @files = sort @files if defined(@files); | |
197 | ||
198 | # Build up the %manifest array so that we quickly know whether a file is in the | |
199 | # manifest or not. | |
200 | foreach (@manifest) { | |
201 | ++$manifest{$_}; | |
202 | } | |
203 | ||
204 | # Now loop other the files held in @manifest and perform your job... | |
205 | foreach $mani (@manifest) { | |
206 | if ($opt_c && !$opt_n) { # Check MANIFEST with actual files on disk | |
207 | for (;;) { | |
208 | $disk = $files[0]; # Next file coming up | |
209 | last unless $disk; | |
210 | last if $disk gt $mani; # Past the current point | |
211 | shift(@files); # Remove the file from list | |
212 | last if $disk eq $mani; # Reached the manifest point | |
213 | # This means the file is before the current MANIFEST point | |
214 | &report($disk); # File exists and not in MANIFEST | |
215 | } | |
216 | } | |
217 | &report($mani); | |
218 | } | |
219 | ||
220 | &flush_report; # Flush the @Report array if formatting is needed | |
221 | ||
222 | # Print usage and exit with a non-zero status | |
223 | sub usage { | |
224 | print STDERR <<EOH; | |
225 | Usage: manilist [-abcdhnptV] [-i ext] [-f manifest] [-p format] [-s string] | |
226 | [-w which] [-x ext] [-C separator] [-I included] [-L colsize] | |
227 | [-X excluded] [files] | |
228 | -a : report for all the files, regardless of (dis)allowed extensions. | |
229 | -b : take current directory as base top (do not look for .package). | |
230 | -c : check files against those in manifest and report differences. | |
231 | -d : dump include and exclude lists on stderr. | |
232 | -f : specify an alternate MANIFEST.new file. | |
233 | -h : print this help message. | |
234 | -i : specify a new extension to be included in the list of scanned files. | |
235 | -n : do not use any MANIFEST file, rather scan directories for files. | |
236 | -p : set new printing format (default is '$format'), shortcut for -s and -w. | |
237 | -s : set string to be printed (with escapes) for each file on report. | |
238 | -t : start from top directory, regardless of current dir. | |
239 | -w : give leading letter(s) for printing format (file selection on report). | |
240 | -x : give a new extension to be excluded from the list of scanned files. | |
241 | -C : specify column separator (replaces '|' in format string). | |
242 | -I : override default include list (space separated). | |
243 | -L : specify maximum column size before truncation (',' separated). | |
244 | -V : print version number. | |
245 | -X : override default exclude list (space separated). | |
246 | EOH | |
247 | exit 1; | |
248 | } | |
249 | ||
250 | # Set up $mode_xxx variables, where xxx is one of the options which may be set | |
251 | # in the printing mode. For instance, $mode_i is true if and only if 'i' is | |
252 | # mentionnned in the printing mode. | |
253 | sub mode_opt { | |
254 | local($fmt) = $format; | |
255 | $fmt =~ s/^(\w+)://; | |
256 | local($mode) = $1; | |
257 | $mode .= 'ix' if $mode =~ /a/; | |
258 | local($mode_eval) = ''; | |
259 | foreach (split(//, $mode)) { | |
260 | $mode_eval .= "\$mode_$_ = 1;" | |
261 | } | |
262 | eval $mode_eval; | |
263 | chop($@) && die "Can't set mode variables: $@.\n"; | |
264 | } | |
265 | ||
266 | # Write a report about a file, either on stdout or into @Report if some | |
267 | # formatting post-processing is needed (aligned on '|' characters in the | |
268 | # report format string). | |
269 | sub report { | |
270 | local($file) = @_; | |
271 | return unless &report_wanted($file); | |
272 | ||
273 | local($fmt) = $format; | |
274 | local($postproc) = 0; # Do we need formatting post-processing ? | |
275 | $fmt =~ s/^\w+://; | |
276 | $fmt =~ s/\|/\02/g && ($postproc = 1); # Formatted colum separator | |
277 | ||
278 | # If neither 'd' nor 'f' is specified, then all the files are candidate | |
279 | # for report. Specifying 'df' is the same, but is less efficient. | |
280 | if (($mode_d || $mode_f) && -e $file) { # File exists on disk | |
281 | return if -f _ && !$mode_f; | |
282 | return if -d _ && !$mode_d; | |
283 | } | |
284 | ||
285 | # Mode 'm' and 'n', if present, respectively ask for a report when a file | |
286 | # is in the manifest and when a file is not in the manifest. Not specifying | |
287 | # any of those modes is the same as specifying both of them. | |
288 | local($in_mani) = defined $manifest{$file}; | |
289 | if ($mode_m || $mode_n) { | |
290 | return if $in_mani && !$mode_m; | |
291 | return if !$in_mani && !$mode_n; | |
292 | } | |
293 | ||
294 | # Mode 'i' and 'x' are used to control included and excluded files. By | |
295 | # default all the files not excluded are reported. Specifying 'x' also asks | |
296 | # for excluded files. The 'i' restricts the report to included files. | |
297 | local($included) = $mode_i ? &included($file) : 1; | |
298 | local($excluded) = &excluded($file); | |
299 | if (!$included || $excluded) { | |
300 | return if !$mode_x && $excluded; | |
301 | return if ($mode_i && !$included) && !$excluded; | |
302 | } | |
303 | ||
304 | local($c_macro); | |
305 | local($mtime) = (stat($file))[$ST_MTIME]; | |
306 | if ($in_mani) { # File in MANIFEST | |
307 | if (-e $file) { # And file exists | |
308 | $c_macro = '.' if $mtime <= $pl_mtime; | |
309 | $c_macro = '>' if $mtime > $pl_mtime; | |
310 | $c_macro = 'x' if &excluded($file); | |
311 | } else { | |
312 | $c_macro = '-'; | |
313 | $c_macro = '?' if &excluded($file); | |
314 | } | |
315 | } else { # File not in MANIFEST | |
316 | if (-e $file) { # And file exists | |
317 | $c_macro = $mtime < $pl_mtime ? 'o' : '+'; | |
318 | } else { | |
319 | return if -l $file; | |
320 | warn "$file seems to have been removed...\n"; | |
321 | } | |
322 | } | |
323 | ||
324 | # Perform the macro substitution | |
325 | $fmt =~ s/%%/\0/g; # Escape %% | |
326 | $fmt =~ s/%/\01/g; # Transform %, in case substitution add some | |
327 | $fmt =~ s/\01c/$c_macro/g; # %c is the code | |
328 | $fmt =~ s/\01n/$file/g; # %n is the file name | |
329 | $fmt =~ s/\01t/&fstamp/ge; # %t is the time stamp | |
330 | $fmt =~ s/\01s/&fsize/ge; # %s is the file size, in bytes | |
331 | $fmt =~ s/\01d/&mdesc/ge; # %d is the manifest description | |
332 | $fmt =~ s/\01/%/g; # All other %'s are left undisturbed | |
333 | ||
334 | print "$fmt\n" unless $postproc; | |
335 | push(@Report, $fmt) if $postproc; | |
336 | } | |
337 | ||
338 | # Format and flush report on stdout. Columns are aligned on what was originally | |
339 | # a '|' character in the format string, translated into a ^B by the reporting | |
340 | # routine. | |
341 | sub flush_report { | |
342 | return unless @Report; # Early return if nothing to be done | |
343 | local(@length); # Stores maximum length for each field | |
344 | local(@max); # Maximum allowed column sizes | |
345 | local($i); | |
346 | local($report); | |
347 | local($len); | |
348 | local(@fields); | |
349 | @max = split(',', $col_size); | |
350 | foreach $report (@Report) { # First pass: compute fields lengths | |
351 | $i = 0; | |
352 | foreach (split(/\02/, $report)) { | |
353 | $len = length($_); | |
354 | $length[$i] = $length[$i] < $len ? $len : $length[$i]; | |
355 | $i++; | |
356 | } | |
357 | } | |
358 | for ($i = 0; $i < @length; $i++) { # Adapt to maximum specified length | |
359 | $length[$i] = $max[$i] if $max[$i] > 0 && $length[$i] > $max[$i]; | |
360 | } | |
361 | foreach $report (@Report) { # Second pass: formats each line | |
362 | @fields = split(/\02/, $report); | |
363 | $i = 0; | |
364 | foreach (@fields) { | |
365 | $len = length($_); | |
366 | if ($max[$i] > 0 && $len > $max[$i]) { | |
367 | $_ = substr($_, 0, $max[$i]); # Truncate field | |
368 | } else { | |
369 | $_ .= ' ' x ($length[$i] - $len); # Pad with blanks | |
370 | } | |
371 | $i++; | |
372 | } | |
373 | print join($col_separator, @fields), "\n"; | |
374 | } | |
375 | } | |
376 | ||
377 | # The following macro subsitution functions are called with $file set | |
378 | ||
379 | # Return the modification time on file | |
380 | sub fstamp { | |
381 | (stat($file))[$ST_MTIME]; | |
382 | } | |
383 | ||
384 | # Return the file size, in bytes | |
385 | sub fsize { | |
386 | (stat($file))[$ST_SIZE]; | |
387 | } | |
388 | ||
389 | # Return the description from the MANIFEST file, if any | |
390 | sub mdesc { | |
391 | return '' unless defined $comment{$file}; | |
392 | $comment{$file}; | |
393 | } | |
394 | ||
395 | # Do we have to report informations on the specified file? | |
396 | sub report_wanted { | |
397 | return 1 unless @filter; | |
398 | local($file) = @_; | |
399 | local($filter); | |
400 | foreach (@filter) { | |
401 | $filter = $_; # Work on a copy | |
402 | if ($filter =~ s/^d://) { | |
403 | return 1 if $file =~ m|^$filter(/[^/]*)*|; | |
404 | } else { | |
405 | $filter =~ s/^f://; | |
406 | return 1 if $filter eq $file; | |
407 | } | |
408 | } | |
409 | return 0; | |
410 | } | |
411 | ||
412 | # Build up the 'included' and 'excluded' functions which return true if a file | |
413 | # is in the include or exclude set. | |
414 | sub init_functions { | |
415 | &build_function('included', *include, 1); | |
416 | &build_function('excluded', *exclude, 0); | |
417 | } | |
418 | ||
419 | # Build a function which returns true if a given name is found in the array | |
420 | # list of regular expression. Each regular expression is applied on the file | |
421 | # name, anchored at the end. False is returned only if none of the expressions | |
422 | # match. The purpose of building such a function dynamically is to avoid the | |
423 | # costly pattern recompilation every time. | |
424 | sub build_function { | |
425 | local($name) = shift(@_); # The name of the function to be built | |
426 | local(*array) = shift(@_); # The extension array we have to check with | |
427 | local($dflt) = shift(@_); # Default value when -a is used | |
428 | local($fn) = &q(<<EOF); # Function being built. | |
429 | :sub $name { | |
430 | : return $dflt if \$opt_a; # All files are included, none excluded. | |
431 | : local(\$_) = \@_; | |
432 | : study; | |
433 | EOF | |
434 | foreach (@array) { | |
435 | $ext = $_; # Work on a copy | |
436 | # Convert shell-style globbing into perl's RE meta-characters | |
437 | $ext =~ s/\./\\./g; # Escape . | |
438 | $ext =~ s/\?/./g; # ? turns into . | |
439 | $ext =~ s/\*/.*/g; # And * turns into .* | |
440 | $fn .= &q(<<EOL); | |
441 | : return 1 if /$ext\$/; | |
442 | EOL | |
443 | } | |
444 | $fn .= &q(<<EOF); | |
445 | : 0; # None of the extensions can be applied to the file | |
446 | :} | |
447 | EOF | |
448 | eval $fn; | |
449 | chop($@) && die "Can't compile '$name':\n$fn\n$@.\n"; | |
450 | } | |
451 | ||
452 | # Remove ':' quotations in front of the lines | |
453 | sub q { | |
454 | local($_) = @_; | |
455 | s/^://gm; | |
456 | $_; | |
457 | } | |
458 | ||
459 | # Perform ~name expansion ala ksh... | |
460 | # (banish csh from your vocabulary ;-) | |
461 | sub tilda_expand { | |
462 | local($path) = @_; | |
463 | return $path unless $path =~ /^~/; | |
464 | $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name | |
465 | $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~ | |
466 | $path; | |
467 | } | |
468 | ||
469 | # Set up profile components into %Profile, add any profile-supplied options | |
470 | # into @ARGV and return the command invocation name. | |
471 | sub profile { | |
472 | local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile'); | |
473 | local($me) = $0; # Command name | |
474 | $me =~ s|.*/(.*)|$1|; # Keep only base name | |
475 | return $me unless -s $profile; | |
476 | local(*PROFILE); # Local file descriptor | |
477 | local($options) = ''; # Options we get back from profile | |
478 | unless (open(PROFILE, $profile)) { | |
479 | warn "$me: cannot open $profile: $!\n"; | |
480 | return; | |
481 | } | |
482 | local($_); | |
483 | local($component); | |
484 | while (<PROFILE>) { | |
485 | next if /^\s*#/; # Skip comments | |
486 | next unless /^$me/o; | |
487 | if (s/^$me://o) { # progname: options | |
488 | chop; | |
489 | $options .= $_; # Merge options if more than one line | |
490 | } | |
491 | elsif (s/^$me-([^:]+)://o) { # progname-component: value | |
492 | $component = $1; | |
493 | chop; | |
494 | s/^\s+//; # Trim leading and trailing spaces | |
495 | s/\s+$//; | |
496 | $Profile{$component} = $_; | |
497 | } | |
498 | } | |
499 | close PROFILE; | |
500 | return unless $options; | |
501 | require 'shellwords.pl'; | |
502 | local(@opts); | |
503 | eval '@opts = &shellwords($options)'; # Protect against mismatched quotes | |
504 | unshift(@ARGV, @opts); | |
505 | return $me; # Return our invocation name | |
506 | } | |
507 |