[metaconfig.git] / bin / patdiff

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

# $Id: patdiff.SH 1 2006-08-24 12:32:52Z 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.
#
# Original Author: Larry Wall <lwall@netlabs.com>
#
# $Log: patdiff.SH,v $
# Revision 3.0.1.2  1994/01/24  14:30:36  ram
# patch16: now prefix error messages with program's name
# patch16: added ~/.dist_profile awareness
#
# Revision 3.0.1.1  1993/08/19  06:42:35  ram
# patch1: leading config.sh searching was not aborting properly
#
# Revision 3.0  1993/08/18  12:10:43  ram
# Baseline for dist 3.0 netwide release.
#

$version = '3.5';
$patchlevel = '0';

$RCSEXT = ',v' unless $RCSEXT;
$TOPDIR = '';			# We are at top-level directory

$progname = &profile;	# Read ~/.dist_profile
require 'getopts.pl';
&usage unless $#ARGV >= 0;
&usage unless &Getopts("ahnV");

if ($opt_V) {
	print STDERR "$progname $version PL$patchlevel\n";
	exit 0;
} elsif ($opt_h) {
	&usage;
}

&readpackage;
&copyright'init($copyright) if -f $copyright;

system 'mkdir', 'bugs' unless -d 'bugs';

if (-f 'patchlevel.h') {
	open(PL,"patchlevel.h") || die "$progname: can't open patchlevel.h: $!\n";
	while (<PL>) {
		$bnum = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/;
	}
	die "$progname: malformed patchlevel.h file.\n" if $bnum eq '';
	++$bnum;
} else {
	$bnum=1;
}

if ($opt_a) {
	open(MANI,"MANIFEST.new") || die "$progname: can't read MANIFEST.new: $!\n";
	@ARGV = ();
	while (<MANI>) {
		chop;
		($_) = split(' ');
		next if -d;
		push(@ARGV,$_);
	}
	close MANI;
}

foreach $file (@ARGV) {
	next if ($file =~ /^patchlevel.h$/);		# Skip patchlevel.h
	if (! -f $file) {
		print "$progname: $file not found.\n";
		next;
	}
	$files = &rcsargs($file);
	@files = split(' ',$files);
	$new='';
	$revs=0;
	$rlog = `rlog -rlastpat- $files 2>&1`;
	($lastpat) = ($rlog =~ /lastpat: ([\d.]+)/);
	($revs) = ($rlog =~ /selected revisions: (\d+)/);
	if (!$revs) {
		print "$progname: no cil has been done on $file.\n" ;;
	} elsif ($revs == 1) {
		($base) = ($rlog =~ /.*\nrevision\s+(\S+)/);
		($a,$b,$c,$d) = split(/\./,$base);
		if ($d ne '') {
			if (!$opt_n) {
				print
	"$progname: no changes in $file since last patch.  (Did you cil it?)\n";
				next;		# Skip file with no changes
			} else {
				$new='foo';
			}
		} else {
			$revs=0;
			$rlog = `rlog -r$revbranch- $files 2>&1`;
			($revs) = ($rlog =~ /selected revisions: (\d+)/);
			if (!$revs) {
				print
	"$progname: no changes in $file since base version.  (Did you cil it?)\n";
				next;		# Skip file with no changes
			} else {
				($new) = ($rlog =~ /\nrevision\s*(\d+\.\d+\.\d+\.\d+)/);
			}
		}
	} else {
		($new) = ($rlog =~ /\nrevision\s*(\d+\.\d+\.\d+\.\d+)/);
	}
	if ($new ne '') {
		($fname = $file) =~ s|.*/||;
		$fname = substr($fname, 0, 11);		# For filsystems with short names
		open(PATCH,">>bugs/$fname.$bnum") || die "Can't make patch";
		print PATCH "\nIndex: $file\n";
		open(CO,"co -p -rlastpat $files 2>/dev/null |");
		while (<CO>) {
			if (/\$Header/ || /\$Id/) {
				print PATCH "Prereq: $lastpat\n";
				last;
			}
		}
		close CO;
		if (!$opt_n) {
			if ($mydiff eq '') {
				open(DIFF,"rcsdiff -c -rlastpat -r$new $files |") ||
				die "$progname: can't fork rcsdiff: $!\n";
				while (<DIFF>) {
					if ($. == 1) {s|\*\*\* \S+	|*** $file.old	|;}
					if ($. == 2) {s|--- \S+	|--- $file	|;}
					s|Lock[e]r:.*\$|\$|;	# Use [e] to make it safe on itself
					print PATCH;
				}
				close DIFF;
				system 'rcs', "-Nlastpat:$new", @files;
			} else {
				&copyright'expand("co -p -rlastpat $file", "/tmp/pdo$$");
				&copyright'expand("co -p -r$new $file", "/tmp/pdn$$");
				open(DIFF, "$mydiff /tmp/pdo$$ /tmp/pdn$$ |") ||
				die "Can't run $mydiff";
				while (<DIFF>) {			# Contextual or unified diff
					if ($. == 1) {
						s|\*\*\* \S+	|*** $file.old	| ||
						s|--- \S+	|--- $file.old	|;
					}
					if ($. == 2) {
						s|--- \S+	|--- $file	| ||
						s|\+\+\+ \S+	|+++ $file	|;
					}
					s|Lock[e]r:.*\$|\$|;	# Remove locker mark
					print PATCH;
				}
				close DIFF;
				system 'rcs', "-Nlastpat:$new", @files;
				unlink "/tmp/pdn$$", "/tmp/pdo$$";
			}
		} else {
			if ($mydiff eq '') {
				open(DIFF,"rcsdiff -c -rlastpat $files |") ||
				die "Can't run rcsdiff";
				while (<DIFF>) {
					if ($. == 1) {s|\*\*\* \S+	|*** $file.old	|;}
					if ($. == 2) {s|--- \S+	|--- $file	|;}
					s|Lock[e]r:.*\$|\$|;	# Remove locker mark
					print PATCH;
				}
				close DIFF;
			} else {
				system "co -p -rlastpat $files >/tmp/pdo$$";
				system "cp $file /tmp/pdn$$";
				open(DIFF, "$mydiff /tmp/pdo$$ /tmp/pdn$$ |") ||
				die "$progname: can't fork $mydiff: $!\n";
				while (<DIFF>) {
					# Contextual or unified diff
					if ($. == 1) {
						s|\*\*\* \S+	|*** $file.old	|;
						s|--- \S+	|--- $file.old	|;
					}
					if ($. == 2) {
						s|--- \S+	|--- $file	|;
						s|\+\+\+ \S+	|+++ $file	|;
					}
					s|Lock[e]r:.*\$|\$|;	# Remove locker mark
					print PATCH;
				}
				close DIFF;
				unlink "/tmp/pdn$$", "/tmp/pdo$$";
			}
		}
	}
}

sub usage {
	print STDERR <<EOM;
Usage: $progname [-ahnV] [filelist]
  -a : all the files in MANIFEST.new
  -h : print this message and exit
  -n : non update mode
  -V : print version number and exit
EOM
	exit 1;
}

sub readpackage {
	if (! -f '.package') {
		if (
			-f '../.package' ||
			-f '../../.package' ||
			-f '../../../.package' ||
			-f '../../../../.package'
		) {
			die "Run in top level directory only.\n";
		} else {
			die "No .package file!  Run packinit.\n";
		}
	}
	open(PACKAGE,'.package');
	while (<PACKAGE>) {
		next if /^:/;
		next if /^#/;
		if (($var,$val) = /^\s*(\w+)=(.*)/) {
			$val = "\"$val\"" unless $val =~ /^['"]/;
			eval "\$$var = $val;";
		}
	}
	close PACKAGE;
}

sub rcsargs {
	local($result) = '';
	local($_);
	while ($_ = shift(@_)) {
		if ($_ =~ /^-/) {
			$result .= $_ . ' ';
		} elsif ($#_ >= 0 && do equiv($_,$_[0])) {
			$result .= $_ . ' ' . $_[0] . ' ';
			shift(@_);
		} else {
			$result .= $_ . ' ' . do other($_) . ' ';
		}
	}
	$result;
}

sub equiv {
	local($s1, $s2) = @_;
	$s1 =~ s|.*/||;
	$s2 =~ s|.*/||;
	if ($s1 eq $s2) {
		0;
	} elsif ($s1 =~ s/$RCSEXT$// || $s2 =~ s/$RCSEXT$//) {
		$s1 eq $s2;
	} else {
		0;
	}
}

sub other {
	local($s1) = @_;
	($dir,$file) = ('./',$s1) unless local($dir,$file) = ($s1 =~ m|(.*/)(.*)|);
	$dir = $TOPDIR . $dir if -d $TOPDIR . "$dir/RCS";
	local($wasrcs) = ($file =~ s/$RCSEXT$//);
	if ($wasrcs) {
		`mkdir $dir` unless -d $dir;
		$dir =~ s|RCS/||;
	} else {
		$dir .= 'RCS/';
		`mkdir $dir` unless -d $dir;
		$file .= $RCSEXT;
	}
	"$dir$file";
}

package copyright;

# Read in copyright file
sub init {
	local($file) = @_;		# Copyright file
	undef @copyright;
	open(COPYRIGHT, $file) || die "Can't open $file: $!\n";
	chop(@copyright = <COPYRIGHT>);
	close COPYRIGHT;
}

# Reset the automaton for a new file.
sub reset {
	$copyright_seen = @copyright ? 0 : 1;
	$marker_seen = 0;
}

# Filter file, line by line, and expand the copyright string. The @COPYRIGHT@
# symbol may be preceded by some random comment. A leader can be defined and
# will be pre-pended to all the input lines.
sub filter {
	local($line, $leader) = @_;		# Leader is optional
	return $leader . $line if $copyright_seen || $marker_seen;
	$marker_seen = 1 if $line =~ /\$Log[:\$]/;
	$copyright_seen = 1 if $line =~ /\@COPYRIGHT\@/;
	return $leader . $line unless $copyright_seen;
	local($comment, $trailer) = $line =~ /^(.*)\@COPYRIGHT\@\s*(.*)/;
	$comment = $leader . $comment;
	$comment . join("\n$comment", @copyright) . "\n";
}

# Filter output of $cmd redirected into $file by expanding copyright, if any.
sub expand {
	local($cmd, $file) = @_;
	if (@copyright) {
		open(CMD,"$cmd|") || die "Can't start '$cmd': $!\n";
		open(OUT, ">$file") || die "Can't create $file: $!\n";
		&reset;
		local($_);
		while (<CMD>) {
			print OUT &filter($_);
		}
		close OUT;
		close CMD;
	} else {
		system "$cmd > $file";
		die "Command '$cmd' failed!" if $?;
	}
}

package main;

# 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: patdiff.SH 1 2006-08-24 12:32:52Z 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	# Original Author: Larry Wall <lwall@netlabs.com>
	16	#
	17	# $Log: patdiff.SH,v $
	18	# Revision 3.0.1.2 1994/01/24 14:30:36 ram
	19	# patch16: now prefix error messages with program's name
	20	# patch16: added ~/.dist_profile awareness
	21	#
	22	# Revision 3.0.1.1 1993/08/19 06:42:35 ram
	23	# patch1: leading config.sh searching was not aborting properly
	24	#
	25	# Revision 3.0 1993/08/18 12:10:43 ram
	26	# Baseline for dist 3.0 netwide release.
	27	#
	28
	29	$version = '3.5';
	30	$patchlevel = '0';
	31
	32	$RCSEXT = ',v' unless $RCSEXT;
	33	$TOPDIR = ''; # We are at top-level directory
	34
	35	$progname = &profile; # Read ~/.dist_profile
	36	require 'getopts.pl';
	37	&usage unless $#ARGV >= 0;
	38	&usage unless &Getopts("ahnV");
	39
	40	if ($opt_V) {
	41	print STDERR "$progname $version PL$patchlevel\n";
	42	exit 0;
	43	} elsif ($opt_h) {
	44	&usage;
	45	}
	46
	47	&readpackage;
	48	&copyright'init($copyright) if -f $copyright;
	49
	50	system 'mkdir', 'bugs' unless -d 'bugs';
	51
	52	if (-f 'patchlevel.h') {
	53	open(PL,"patchlevel.h") \|\| die "$progname: can't open patchlevel.h: $!\n";
	54	while (<PL>) {
	55	$bnum = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/;
	56	}
	57	die "$progname: malformed patchlevel.h file.\n" if $bnum eq '';
	58	++$bnum;
	59	} else {
	60	$bnum=1;
	61	}
	62
	63	if ($opt_a) {
	64	open(MANI,"MANIFEST.new") \|\| die "$progname: can't read MANIFEST.new: $!\n";
65	@ARGV = ();
66	while (<MANI>) {
67	chop;
68	($_) = split(' ');
69	next if -d;
70	push(@ARGV,$_);
71	}
72	close MANI;
73	}
74
75	foreach $file (@ARGV) {
76	next if ($file =~ /^patchlevel.h$/); # Skip patchlevel.h
77	if (! -f $file) {
78	print "$progname: $file not found.\n";
79	next;
80	}
81	$files = &rcsargs($file);
82	@files = split(' ',$files);
83	$new='';
84	$revs=0;
85	$rlog = `rlog -rlastpat- $files 2>&1`;
86	($lastpat) = ($rlog =~ /lastpat: ([\d.]+)/);
87	($revs) = ($rlog =~ /selected revisions: (\d+)/);
88	if (!$revs) {
89	print "$progname: no cil has been done on $file.\n" ;;
90	} elsif ($revs == 1) {
91	($base) = ($rlog =~ /.*\nrevision\s+(\S+)/);
92	($a,$b,$c,$d) = split(/\./,$base);
93	if ($d ne '') {
94	if (!$opt_n) {
95	print
96	"$progname: no changes in $file since last patch. (Did you cil it?)\n";
97	next; # Skip file with no changes
98	} else {
99	$new='foo';
100	}
101	} else {
102	$revs=0;
103	$rlog = `rlog -r$revbranch- $files 2>&1`;
104	($revs) = ($rlog =~ /selected revisions: (\d+)/);
105	if (!$revs) {
106	print
107	"$progname: no changes in $file since base version. (Did you cil it?)\n";
108	next; # Skip file with no changes
109	} else {
110	($new) = ($rlog =~ /\nrevision\s*(\d+\.\d+\.\d+\.\d+)/);
111	}
112	}
113	} else {
114	($new) = ($rlog =~ /\nrevision\s*(\d+\.\d+\.\d+\.\d+)/);
115	}
116	if ($new ne '') {
117	($fname = $file) =~ s\|.*/\|\|;
118	$fname = substr($fname, 0, 11); # For filsystems with short names
119	open(PATCH,">>bugs/$fname.$bnum") \|\| die "Can't make patch";
120	print PATCH "\nIndex: $file\n";
121	open(CO,"co -p -rlastpat $files 2>/dev/null \|");
122	while (<CO>) {
123	if (/\$Header/ \|\| /\$Id/) {
124	print PATCH "Prereq: $lastpat\n";
125	last;
126	}
127	}
128	close CO;
129	if (!$opt_n) {
130	if ($mydiff eq '') {
131	open(DIFF,"rcsdiff -c -rlastpat -r$new $files \|") \|\|
132	die "$progname: can't fork rcsdiff: $!\n";
133	while (<DIFF>) {
134	if ($. == 1) {s\|\\\* \S+ \|*** $file.old \|;}
135	if ($. == 2) {s\|--- \S+ \|--- $file \|;}
136	s\|Lock[e]r:.*\$\|\$\|; # Use [e] to make it safe on itself
137	print PATCH;
138	}
139	close DIFF;
140	system 'rcs', "-Nlastpat:$new", @files;
141	} else {
142	&copyright'expand("co -p -rlastpat $file", "/tmp/pdo$$");
143	&copyright'expand("co -p -r$new $file", "/tmp/pdn$$");
144	open(DIFF, "$mydiff /tmp/pdo$$ /tmp/pdn$$ \|") \|\|
145	die "Can't run $mydiff";
146	while (<DIFF>) { # Contextual or unified diff
147	if ($. == 1) {
148	s\|\\\* \S+ \|*** $file.old \| \|\|
149	s\|--- \S+ \|--- $file.old \|;
150	}
151	if ($. == 2) {
152	s\|--- \S+ \|--- $file \| \|\|
153	s\|\+\+\+ \S+ \|+++ $file \|;
154	}
155	s\|Lock[e]r:.*\$\|\$\|; # Remove locker mark
156	print PATCH;
157	}
158	close DIFF;
159	system 'rcs', "-Nlastpat:$new", @files;
160	unlink "/tmp/pdn$$", "/tmp/pdo$$";
161	}
162	} else {
163	if ($mydiff eq '') {
164	open(DIFF,"rcsdiff -c -rlastpat $files \|") \|\|
165	die "Can't run rcsdiff";
166	while (<DIFF>) {
167	if ($. == 1) {s\|\\\* \S+ \|*** $file.old \|;}
168	if ($. == 2) {s\|--- \S+ \|--- $file \|;}
169	s\|Lock[e]r:.*\$\|\$\|; # Remove locker mark
170	print PATCH;
171	}
172	close DIFF;
173	} else {
174	system "co -p -rlastpat $files >/tmp/pdo$$";
175	system "cp $file /tmp/pdn$$";
176	open(DIFF, "$mydiff /tmp/pdo$$ /tmp/pdn$$ \|") \|\|
177	die "$progname: can't fork $mydiff: $!\n";
178	while (<DIFF>) {
179	# Contextual or unified diff
180	if ($. == 1) {
181	s\|\\\* \S+ \|*** $file.old \|;
182	s\|--- \S+ \|--- $file.old \|;
183	}
184	if ($. == 2) {
185	s\|--- \S+ \|--- $file \|;
186	s\|\+\+\+ \S+ \|+++ $file \|;
187	}
188	s\|Lock[e]r:.*\$\|\$\|; # Remove locker mark
189	print PATCH;
190	}
191	close DIFF;
192	unlink "/tmp/pdn$$", "/tmp/pdo$$";
193	}
194	}
195	}
196	}
197
198	sub usage {
199	print STDERR <<EOM;
200	Usage: $progname [-ahnV] [filelist]
201	-a : all the files in MANIFEST.new
202	-h : print this message and exit
203	-n : non update mode
204	-V : print version number and exit
205	EOM
206	exit 1;
207	}
208
209	sub readpackage {
210	if (! -f '.package') {
211	if (
212	-f '../.package' \|\|
213	-f '../../.package' \|\|
214	-f '../../../.package' \|\|
215	-f '../../../../.package'
216	) {
217	die "Run in top level directory only.\n";
218	} else {
219	die "No .package file! Run packinit.\n";
220	}
221	}
222	open(PACKAGE,'.package');
223	while (<PACKAGE>) {
224	next if /^:/;
225	next if /^#/;
226	if (($var,$val) = /^\s(\w+)=(.)/) {
227	$val = "\"$val\"" unless $val =~ /^['"]/;
228	eval "\$$var = $val;";
229	}
230	}
231	close PACKAGE;
232	}
233
234	sub rcsargs {
235	local($result) = '';
236	local($_);
237	while ($_ = shift(@_)) {
238	if ($_ =~ /^-/) {
239	$result .= $_ . ' ';
240	} elsif ($#_ >= 0 && do equiv($_,$_[0])) {
241	$result .= $_ . ' ' . $_[0] . ' ';
242	shift(@_);
243	} else {
244	$result .= $_ . ' ' . do other($_) . ' ';
245	}
246	}
247	$result;
248	}
249
250	sub equiv {
251	local($s1, $s2) = @_;
252	$s1 =~ s\|.*/\|\|;
253	$s2 =~ s\|.*/\|\|;
254	if ($s1 eq $s2) {
255	0;
256	} elsif ($s1 =~ s/$RCSEXT$// \|\| $s2 =~ s/$RCSEXT$//) {
257	$s1 eq $s2;
258	} else {
259	0;
260	}
261	}
262
263	sub other {
264	local($s1) = @_;
265	($dir,$file) = ('./',$s1) unless local($dir,$file) = ($s1 =~ m\|(./)(.)\|);
266	$dir = $TOPDIR . $dir if -d $TOPDIR . "$dir/RCS";
267	local($wasrcs) = ($file =~ s/$RCSEXT$//);
268	if ($wasrcs) {
269	`mkdir $dir` unless -d $dir;
270	$dir =~ s\|RCS/\|\|;
271	} else {
272	$dir .= 'RCS/';
273	`mkdir $dir` unless -d $dir;
274	$file .= $RCSEXT;
275	}
276	"$dir$file";
277	}
278
279	package copyright;
280
281	# Read in copyright file
282	sub init {
283	local($file) = @_; # Copyright file
284	undef @copyright;
285	open(COPYRIGHT, $file) \|\| die "Can't open $file: $!\n";
286	chop(@copyright = <COPYRIGHT>);
287	close COPYRIGHT;
288	}
289
290	# Reset the automaton for a new file.
291	sub reset {
292	$copyright_seen = @copyright ? 0 : 1;
293	$marker_seen = 0;
294	}
295
296	# Filter file, line by line, and expand the copyright string. The @COPYRIGHT@
297	# symbol may be preceded by some random comment. A leader can be defined and
298	# will be pre-pended to all the input lines.
299	sub filter {
300	local($line, $leader) = @_; # Leader is optional
301	return $leader . $line if $copyright_seen \|\| $marker_seen;
302	$marker_seen = 1 if $line =~ /\$Log[:\$]/;
303	$copyright_seen = 1 if $line =~ /\@COPYRIGHT\@/;
304	return $leader . $line unless $copyright_seen;
305	local($comment, $trailer) = $line =~ /^(.)\@COPYRIGHT\@\s(.*)/;
306	$comment = $leader . $comment;
307	$comment . join("\n$comment", @copyright) . "\n";
308	}
309
310	# Filter output of $cmd redirected into $file by expanding copyright, if any.
311	sub expand {
312	local($cmd, $file) = @_;
313	if (@copyright) {
314	open(CMD,"$cmd\|") \|\| die "Can't start '$cmd': $!\n";
315	open(OUT, ">$file") \|\| die "Can't create $file: $!\n";
316	&reset;
317	local($_);
318	while (<CMD>) {
319	print OUT &filter($_);
320	}
321	close OUT;
322	close CMD;
323	} else {
324	system "$cmd > $file";
325	die "Command '$cmd' failed!" if $?;
326	}
327	}
328
329	package main;
330
331	# Perform ~name expansion ala ksh...
332	# (banish csh from your vocabulary ;-)
333	sub tilda_expand {
334	local($path) = @_;
335	return $path unless $path =~ /^~/;
336	$path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
337	$path =~ s:^~:$ENV{'HOME'} \|\| (getpwuid($<))[$[+7]:e; # ~
338	$path;
339	}
340
341	# Set up profile components into %Profile, add any profile-supplied options
342	# into @ARGV and return the command invocation name.
343	sub profile {
344	local($profile) = &tilda_expand($ENV{'DIST'} \|\| '~/.dist_profile');
345	local($me) = $0; # Command name
346	$me =~ s\|./(.)\|$1\|; # Keep only base name
347	return $me unless -s $profile;
348	local(*PROFILE); # Local file descriptor
349	local($options) = ''; # Options we get back from profile
350	unless (open(PROFILE, $profile)) {
351	warn "$me: cannot open $profile: $!\n";
352	return;
353	}
354	local($_);
355	local($component);
356	while (<PROFILE>) {
357	next if /^\s*#/; # Skip comments
358	next unless /^$me/o;
359	if (s/^$me://o) { # progname: options
360	chop;
361	$options .= $_; # Merge options if more than one line
362	}
363	elsif (s/^$me-([^:]+)://o) { # progname-component: value
364	$component = $1;
365	chop;
366	s/^\s+//; # Trim leading and trailing spaces
367	s/\s+$//;
368	$Profile{$component} = $_;
369	}
370	}
371	close PROFILE;
372	return unless $options;
373	require 'shellwords.pl';
374	local(@opts);
375	eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
376	unshift(@ARGV, @opts);
377	return $me; # Return our invocation name
378	}
379