[metaconfig.git] / bin / manilist

#!/usr/bin/perl
	eval 'exec perl -S $0 "$@"'
		if $running_under_some_shell;

# $Id: manilist.SH 20 2008-01-04 23:14:00Z rmanfredi $
#
#  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
#  
#  You may redistribute only under the terms of the Artistic Licence,
#  as specified in the README file that comes with the distribution.
#  You may reuse parts of this distribution only within the terms of
#  that same Artistic Licence; a copy of which may be found at the root
#  of the source tree for dist 4.0.
#
# $Log: manilist.SH,v $
# Revision 3.0.1.3  1994/10/29  15:42:42  ram
# patch36: fixed open precedence problem for perl5
#
# Revision 3.0.1.2  1994/01/24  13:52:33  ram
# patch16: added ~/.dist_profile awareness
#
# Revision 3.0.1.1  1993/08/19  06:41:52  ram
# patch1: leading config.sh searching was not aborting properly
#
# Revision 3.0  1993/08/18  12:04:03  ram
# Baseline for dist 3.0 netwide release.
#

$version = '3.5';
$pl = '0';

# This script scans the MANIFEST.new file and builds some reports.

# The output can be somewhat changed to produce other kind of reports.
# The format is specified with a leading set of activation character, followed
# by a ':', and then a set of formatting macros. The leading characters tell
# when a report line shall be issued:
#  a: all files (shortcut for 'ix')
#  A: all files but the excluded ones
#  f: report for files only
#  d: report for directories only
#  m: report for files/directories found in the MANIFEST.new
#  n: report for files/directories not found in the MANIFEST.new
#  i: included files are listed
#  x: excluded files are listed
# Then a set of macros introduced by %:
#  %c: the leading one character code defined as follows:
#  		. if the file is up to date (i.e. not newer than patchlevel.h)
#  		- if the file is present in the manifest but is missing
#  		> if the file has changed since last patch.
#  		+ if the file is not present in the manifest but exists
#  		o if the file is not listed but exists and is older than patchlevel.h
#       x if the file in manifest and exists but was excluded
#       ? if the file in manifest but was excluded and does not exist
#  %n: the name of the file (its path from the top directory)
#  %t: time stamp of last modification
#  %d: description from MANIFEST.new file, if any
#  %s: size of the file, in bytes

$format = 'A:%c %n';

# By default, only the source files whith the following extensions are reported
# (but a -a option will report ALL the files, and a -i option can specify some
# other extensions as well).
#  .sh .SH .c .h .l .y .man

@include = ('.sh', '.SH', '.c', '.h', '.l', '.y', '.man');

# By default, the following extensions are excluded from the list. More
# exclusions can be added with the -x option:
#  ^core .o .bak .rej .new .old .orig ,v

@exclude = ('^core', '.o', '.bak', '.rej', '.new', '.old', '.orig', ',v');

# The column separator character (or string) is used to separate each formatted
# column on the output. Formatting is requested by adding a '|' character in
# the format string. A new separator can be specified via the -C option.
# The maximum column size is fixed by the -L.

$col_separator = ' ';
$col_size = '';

&profile;					# Read ~/.dist_profile
require 'getopts.pl';
require 'stat.pl';
&usage unless &Getopts('abcdhntVi:f:p:s:w:x:C:L:I:X:');

&usage if $opt_h;
if ($opt_V) {
	print "manilist $version PL$pl\n";
	exit 0;
}

# Go to the top of the package, and update any file name given as argument
# by prepending the needed path. The process then performs a chdir to the
# top.
unless ($opt_b) {
	chop($pwd = `pwd`) unless -f '.package';
	until (-f '.package') {
		die "No .package file!  Run packinit.\n" unless $pwd;
		chdir '..' || die "Can't cd ..\n";
		$pwd =~ s|(.*)/(.*)|$1|;
		$prefix = $2 . '/' . $prefix;
	}
	if ($prefix) {
		for (@ARGV) {
			s/^\.$/$prefix/ && next;
			s/^/$prefix/ unless m|^[-/]|;
		}
	}
}

# We now are at the top level

# Build up the file hierarchy filter in @filter
foreach $entry (@ARGV) {
	$entry =~ s|/$||;			# Remove final / in directory names
	if (-d $entry) {
		push(@filter, "d:$entry");
	} elsif (-f $entry) {
		push(@filter, "f:$entry");
	} else {
		die "$entry: No such file or directory.\n";
	}
}

$prefix = '.' unless $prefix;
($top = $prefix) =~ s|/$||;
$top = '.' if $opt_t;			# Start from top, not from original dir
@ARGV = ($top) unless @ARGV;

if ($opt_n) {		# "manifest" files are found by scanning the directory
	open(MANIFEST, "find @ARGV -print|") || die "Can't run find: $!\n";
	while (<MANIFEST>) {
		chop;
		s|^./||;
		push(@manifest, $_);
	}
	close MANIFEST;
} else {
	$MANIFEST = $opt_f;
	$MANIFEST = 'MANIFEST.new' unless $opt_f;
	open(MANIFEST, $MANIFEST) || die "Can't open $MANIFEST: $!\n";
	while (<MANIFEST>) {
		chop;
		s|^./||;
		s|^(\S+)||;
		local($name) = $1;
		push(@manifest, $name);
		m|^\s+(\d+)*\s*(.*)| && ($comment{$name} = $2);
	}
	close MANIFEST;
}

# If we have to compare the files in the MANIFEST with the actual files on
# the file system, then grab them...
if ($opt_c && !$opt_n) {
	open(FILES, "find @ARGV -print|") || die "Can't run find: $!\n";
	while (<FILES>) {
		chop;
		s|^./||;
		push(@files, $_);
	}
	close FILES;
}

# If there is a patchlevel.h file, get its time stamp.
$pl_mtime = 0;
$pl_mtime = (stat('patchlevel.h'))[$ST_MTIME] if -f 'patchlevel.h';

# Dealing with command-line options
$format = $opt_p if $opt_p;
$col_separator = $opt_C if $opt_C;
$col_size = $opt_L if $opt_L;
unless ($opt_p) {		# -p may be used as a shortcut for -w and -s
	local($which) = ($format =~ /^(\w+):/);
	local($string) = ($format =~ /^\w+:(.*)/);
	$which = $opt_w if $opt_w;
	$string = $opt_s if $opt_s;
	$format = "$which:$string";
}
@include = split(' ', $opt_I) if $opt_I;		# First reset included with -I
@exclude = split(' ', $opt_X) if $opt_X;		# and excluded with -X
push(@include, split(' ', $opt_i)) if $opt_i;	# before applying additions
push(@exclude, split(' ', $opt_x)) if $opt_x;
&mode_opt;				# Compute $mode_xxx variables
&init_functions;		# Compile &included and &excluded

# Option -d requests dumping of inclusion and exclusion lists on stderr
if ($opt_d) {
	print STDERR "Included: ", join(' ', @include), "\n";
	print STDERR "Excluded: ", join(' ', @exclude), "\n";
}

@manifest = sort @manifest;
@files = sort @files if defined(@files);

# Build up the %manifest array so that we quickly know whether a file is in the
# manifest or not.
foreach (@manifest) {
	++$manifest{$_};
}

# Now loop other the files held in @manifest and perform your job...
foreach $mani (@manifest) {
	if ($opt_c && !$opt_n) {		# Check MANIFEST with actual files on disk
		for (;;) {
			$disk = $files[0];				# Next file coming up
			last unless $disk;
			last if $disk gt $mani;			# Past the current point
			shift(@files);					# Remove the file from list
			last if $disk eq $mani;			# Reached the manifest point
			# This means the file is before the current MANIFEST point
			&report($disk);					# File exists and not in MANIFEST
		}
	}
	&report($mani);
}

&flush_report;		# Flush the @Report array if formatting is needed

# Print usage and exit with a non-zero status
sub usage {
	print STDERR <<EOH;
Usage: manilist [-abcdhnptV] [-i ext] [-f manifest] [-p format] [-s string]
       [-w which] [-x ext] [-C separator] [-I included] [-L colsize]
       [-X excluded] [files]
  -a : report for all the files, regardless of (dis)allowed extensions.
  -b : take current directory as base top (do not look for .package).
  -c : check files against those in manifest and report differences.
  -d : dump include and exclude lists on stderr.
  -f : specify an alternate MANIFEST.new file.
  -h : print this help message.
  -i : specify a new extension to be included in the list of scanned files.
  -n : do not use any MANIFEST file, rather scan directories for files.
  -p : set new printing format (default is '$format'), shortcut for -s and -w.
  -s : set string to be printed (with escapes) for each file on report.
  -t : start from top directory, regardless of current dir.
  -w : give leading letter(s) for printing format (file selection on report).
  -x : give a new extension to be excluded from the list of scanned files.
  -C : specify column separator (replaces '|' in format string).
  -I : override default include list (space separated).
  -L : specify maximum column size before truncation (',' separated).
  -V : print version number.
  -X : override default exclude list (space separated).
EOH
	exit 1;
}

# Set up $mode_xxx variables, where xxx is one of the options which may be set
# in the printing mode. For instance, $mode_i is true if and only if 'i' is
# mentionnned in the printing mode.
sub mode_opt {
	local($fmt) = $format;
	$fmt =~ s/^(\w+)://;
	local($mode) = $1;
	$mode .= 'ix' if $mode =~ /a/;
	local($mode_eval) = '';
	foreach (split(//, $mode)) {
		$mode_eval .= "\$mode_$_ = 1;"
	}
	eval $mode_eval;
	chop($@) && die "Can't set mode variables: $@.\n";
}

# Write a report about a file, either on stdout or into @Report if some
# formatting post-processing is needed (aligned on '|' characters in the
# report format string).
sub report {
	local($file) = @_;
	return unless &report_wanted($file);

	local($fmt) = $format;
	local($postproc) = 0;		# Do we need formatting post-processing ?
	$fmt =~ s/^\w+://;
	$fmt =~ s/\|/\02/g && ($postproc = 1);		# Formatted colum separator

	# If neither 'd' nor 'f' is specified, then all the files are candidate
	# for report. Specifying 'df' is the same, but is less efficient.
	if (($mode_d || $mode_f) && -e $file) {		# File exists on disk
		return if -f _ && !$mode_f;
		return if -d _ && !$mode_d;
	}

	# Mode 'm' and 'n', if present, respectively ask for a report when a file
	# is in the manifest and when a file is not in the manifest. Not specifying
	# any of those modes is the same as specifying both of them.
	local($in_mani) = defined $manifest{$file};
	if ($mode_m || $mode_n) {
		return if $in_mani && !$mode_m;
		return if !$in_mani && !$mode_n;
	}

	# Mode 'i' and 'x' are used to control included and excluded files. By
	# default all the files not excluded are reported. Specifying 'x' also asks
	# for excluded files. The 'i' restricts the report to included files.
	local($included) = $mode_i ? &included($file) : 1;
	local($excluded) = &excluded($file);
	if (!$included || $excluded) {
		return if !$mode_x && $excluded;
		return if ($mode_i && !$included) && !$excluded;
	}

	local($c_macro);
	local($mtime) = (stat($file))[$ST_MTIME];
	if ($in_mani) {							# File in MANIFEST
		if (-e $file) {						# And file exists
			$c_macro = '.' if $mtime <= $pl_mtime;
			$c_macro = '>' if $mtime > $pl_mtime;
			$c_macro = 'x' if &excluded($file);
		} else {
			$c_macro = '-';
			$c_macro = '?' if &excluded($file);
		}
	} else {								# File not in MANIFEST
		if (-e $file) {						# And file exists
			$c_macro = $mtime < $pl_mtime ? 'o' : '+';
		} else {
			return if -l $file;
			warn "$file seems to have been removed...\n";
		}
	}

	# Perform the macro substitution
	$fmt =~ s/%%/\0/g;			# Escape %%
	$fmt =~ s/%/\01/g;			# Transform %, in case substitution add some
	$fmt =~ s/\01c/$c_macro/g;	# %c is the code
	$fmt =~ s/\01n/$file/g;		# %n is the file name
	$fmt =~ s/\01t/&fstamp/ge;	# %t is the time stamp
	$fmt =~ s/\01s/&fsize/ge;	# %s is the file size, in bytes
	$fmt =~ s/\01d/&mdesc/ge;	# %d is the manifest description
	$fmt =~ s/\01/%/g;			# All other %'s are left undisturbed

	print "$fmt\n" unless $postproc;
	push(@Report, $fmt) if $postproc;
}

# Format and flush report on stdout. Columns are aligned on what was originally
# a '|' character in the format string, translated into a ^B by the reporting
# routine.
sub flush_report {
	return unless @Report;		# Early return if nothing to be done
	local(@length);				# Stores maximum length for each field
	local(@max);				# Maximum allowed column sizes
	local($i);
	local($report);
	local($len);
	local(@fields);
	@max = split(',', $col_size);
	foreach $report (@Report) { # First pass: compute fields lengths
		$i = 0;
		foreach (split(/\02/, $report)) {
			$len = length($_);
			$length[$i] = $length[$i] < $len ? $len : $length[$i];
			$i++;
		}
	}
	for ($i = 0; $i < @length; $i++) {	# Adapt to maximum specified length
		$length[$i] = $max[$i] if $max[$i] > 0 && $length[$i] > $max[$i];
	}
	foreach $report (@Report) { # Second pass: formats each line
		@fields = split(/\02/, $report);
		$i = 0;
		foreach (@fields) {
			$len = length($_);
			if ($max[$i] > 0 && $len > $max[$i]) {
				$_ = substr($_, 0, $max[$i]);		# Truncate field
			} else {
				$_ .= ' ' x ($length[$i] - $len);	# Pad with blanks
			}
			$i++;
		}
		print join($col_separator, @fields), "\n";
	}
}

# The following macro subsitution functions are called with $file set

# Return the modification time on file
sub fstamp {
	(stat($file))[$ST_MTIME];
}

# Return the file size, in bytes
sub fsize {
	(stat($file))[$ST_SIZE];
}

# Return the description from the MANIFEST file, if any
sub mdesc {
	return '' unless defined $comment{$file};
	$comment{$file};
}

# Do we have to report informations on the specified file?
sub report_wanted {
	return 1 unless @filter;
	local($file) = @_;
	local($filter);
	foreach (@filter) {
		$filter = $_;		# Work on a copy
		if ($filter =~ s/^d://) {
			return 1 if $file =~ m|^$filter(/[^/]*)*|;
		} else {
			$filter =~ s/^f://;
			return 1 if $filter eq $file;
		}
	}
	return 0;
}

# Build up the 'included' and 'excluded' functions which return true if a file
# is in the include or exclude set.
sub init_functions {
	&build_function('included', *include, 1);
	&build_function('excluded', *exclude, 0);
}

# Build a function which returns true if a given name is found in the array
# list of regular expression. Each regular expression is applied on the file
# name, anchored at the end. False is returned only if none of the expressions
# match. The purpose of building such a function dynamically is to avoid the
# costly pattern recompilation every time.
sub build_function {
	local($name) = shift(@_);	# The name of the function to be built
	local(*array) = shift(@_);	# The extension array we have to check with
	local($dflt) = shift(@_);	# Default value when -a is used
	local($fn) = &q(<<EOF);		# Function being built.
:sub $name {
:	return $dflt if \$opt_a;	# All files are included, none excluded.
:	local(\$_) = \@_;
:	study;
EOF
	foreach (@array) {
		$ext = $_;			# Work on a copy
		# Convert shell-style globbing into perl's RE meta-characters
		$ext =~ s/\./\\./g;	# Escape .
		$ext =~ s/\?/./g;	# ? turns into .
		$ext =~ s/\*/.*/g;	# And * turns into .*
	$fn .= &q(<<EOL);
:	return 1 if /$ext\$/;
EOL
	}
	$fn .= &q(<<EOF);
:	0;	# None of the extensions can be applied to the file
:}
EOF
	eval $fn;
	chop($@) && die "Can't compile '$name':\n$fn\n$@.\n";
}

# Remove ':' quotations in front of the lines
sub q {
	local($_) = @_;
	s/^://gm;
	$_;
}

# Perform ~name expansion ala ksh...
# (banish csh from your vocabulary ;-)
sub tilda_expand {
	local($path) = @_;
	return $path unless $path =~ /^~/;
	$path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;			# ~name
	$path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;	# ~
	$path;
}

# Set up profile components into %Profile, add any profile-supplied options
# into @ARGV and return the command invocation name.
sub profile {
	local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
	local($me) = $0;		# Command name
	$me =~ s|.*/(.*)|$1|;	# Keep only base name
	return $me unless -s $profile;
	local(*PROFILE);		# Local file descriptor
	local($options) = '';	# Options we get back from profile
	unless (open(PROFILE, $profile)) {
		warn "$me: cannot open $profile: $!\n";
		return;
	}
	local($_);
	local($component);
	while (<PROFILE>) {
		next if /^\s*#/;	# Skip comments
		next unless /^$me/o;
		if (s/^$me://o) {	# progname: options
			chop;
			$options .= $_;	# Merge options if more than one line
		}
		elsif (s/^$me-([^:]+)://o) {	# progname-component: value
			$component = $1;
			chop;
			s/^\s+//;		# Trim leading and trailing spaces
			s/\s+$//;
			$Profile{$component} = $_;
		}
	}
	close PROFILE;
	return unless $options;
	require 'shellwords.pl';
	local(@opts);
	eval '@opts = &shellwords($options)';	# Protect against mismatched quotes
	unshift(@ARGV, @opts);
	return $me;				# Return our invocation name
}
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