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