This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Also add all utilities for building from units to repo
[metaconfig.git] / bin / manilist
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