[metaconfig.git] / dist-3.0at70b / pat / patclean

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

# $Id: patclean.SH,v 3.0.1.2 1994/01/24 14:30:17 ram Exp $
#
#  Copyright (c) 1991-1993, 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 3.0.
#
# $Log: patclean.SH,v $
# Revision 3.0.1.2  1994/01/24  14:30:17  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:33  ram
# patch1: leading config.sh searching was not aborting properly
#
# Revision 3.0  1993/08/18  12:10:41  ram
# Baseline for dist 3.0 netwide release.
#

$version = '3.0';
$patchlevel = '70';

$RCSEXT = ',v' unless $RCSEXT;

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

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

$RCSEXT = ',v' unless $RCSEXT;
$ENV{'DIST'} = '/dev/null';	# Disable ~/.dist_profile

chop($pwd = `pwd`) unless -f '.package';
until (-f '.package') {
	die "$progname: no .package file!  Run packinit.\n" unless $pwd;
	chdir '..' || die "$progname: can't cd ..: $!\n";
	$pwd =~ s|(.*)/(.*)|$1|;
	$prefix = $2 . '/' . $prefix;
}
if ($prefix) {
	for (@ARGV) {
		s/^/$prefix/ unless m|^[-/]|;
	}
}

# We now are at the top level

&readpackage;

if ($opt_n) {
	&newer;				# Look for files newer than patchlevel.h
} elsif ($opt_a) {
	open(MANI,"MANIFEST.new") || die "$progname: can't read MANIFEST.new: $!\n";
	@ARGV = ();
	while (<MANI>) {
		s|^\./||;
		next if m|^patchlevel.h|;		# This file is built by hand
		chop;
		($_) = split(' ');
		next if -d;
		push(@ARGV,$_);
	}
	close MANI;
} elsif ($opt_m) {
	open(MODS,"bugs/.mods$bnum") || die "$progname: no modification found.\n";
	@ARGV = ();
	while (<MODS>) {
		next if m|^patchlevel.h$|;		# This file is built by hand
		chop;
		($_) = split(' ');
		push(@ARGV,$_);
	}
    close MODS;
}

# Set a temporary file for check outs
$TMPFILE = "/tmp/cl$$.tmp";

# Now loop over each file specified, doing a 'rcsclean'
foreach $file (@ARGV) {
	if (-f $file) {
		$files = &rcsargs($file);
		@files = split(' ', $files);
		$rlog = `rlog -rlastpat- $files 2>&1`;
		($revs) = ($rlog =~ /selected revisions: (\d+)/);
		if (!$revs) {
			print "$progname: $file has never been checked in--checking in...\n";
			system 'perl', '-S', 'patcil', '-p', $file;
			$revs = 2;		# At least null trunk + new fresh revision
		}
		# Look whether there is a branch
		if ($revs == 1) {
			$rlog = `rlog -r$revbranch $files 2>&1`;
			($revs) = ($rlog =~ /selected revisions: (\d+)/);
			$revs++;	# add the base revision
		}
		# We must only give the name of the RCS revision file, i.e. $files[1]
		if ($revs == 1) {
			system "co -q -p$baserev $files[1] > $TMPFILE";
		} else {
			system "co -q -p$revbranch $files[1] > $TMPFILE";
		}
		if ($? == 0) {
			system 'cmp', '-s', $file, $TMPFILE;
			if ($? == 0) {
				unlink $file;
				print "$progname: $file removed.\n";
			} else {
				# Check in file and make sure all was ok
				system 'perl', '-S', 'patcil', '-p', $file;
				system "co -q -p$revbranch $files[1] > $TMPFILE";
				if ($? == 0) {
					system 'cmp', '-s', $file, $TMPFILE;
					if ($? == 0) {
						unlink $file;
						print "$progname: $file removed.\n";
					} else {
						print "$progname: $file NOT removed.\n";
					}
				} else {
					print "$progname: could not check out--$file NOT removed.\n";
				}
			}
		} else {
			print "$progname: no revision--$file NOT removed.\n";
		}
	}
}

unlink "$TMPFILE";

sub usage {
	print STDERR <<EOM;
Usage: $progname [-ahnmV] [filelist]
  -a : all the files in MANIFEST.new
  -h : print this message and exit
  -n : all the files newer than patchlevel.h
  -m : all the modified files (which have been patciled)
  -V : print version number and exit
EOM
	exit 1;
}

sub newer {
	open(FIND, "find . -type f -newer patchlevel.h -print | sort |") ||
	die "Can't run find.\n";
	open(NEWER,">.newer") || die "Can't create .newer.\n";
	open(MANI,"MANIFEST.new");
	while (<MANI>) {
		($name,$foo) = split;
		$mani{$name} = 1;
	}
	close MANI;
	while (<FIND>) {
	s|^\./||;
	chop;
	next if m|^MANIFEST|;
	next if m|^PACKLIST$|;
	if (!$mani{$_}) {
		next if m|^MANIFEST.new$|;
		next if m|^Changes$|;
		next if m|^Wanted$|;
		next if m|^.package$|;
		next if m|^bugs|;
		next if m|^users$|;
		next if m|^UU/|;
		next if m|^RCS/|;
		next if m|/RCS/|;
		next if m|^config.sh$|;
		next if m|/config.sh$|;
		next if m|^make.out$|;
		next if m|/make.out$|;
		next if m|^all$|;
		next if m|/all$|;
		next if m|^core$|;
		next if m|/core$|;
		next if m|^toto|;
		next if m|/toto|;
		next if m|^\.|;
		next if m|/\.|;
		next if m|\.o$|;
		next if m|\.old$|;
		next if m|\.orig$|;
		next if m|~$|;
		next if $mani{$_ . ".SH"};
		next if m|(.*)\.c$| && $mani{$1 . ".y"};
		next if m|(.*)\.c$| && $mani{$1 . ".l"};
		next if (-x $_ && !m|^Configure$|);
	}
	print NEWER $_,"\n";
	}
	close FIND;
	close NEWER;
	print "Please remove unwanted files...\n";
	sleep(2);
	system '${EDITOR-vi} .newer';
	die "Aborted.\n" unless -s '.newer' > 1;
	@ARGV = split(' ',`cat .newer`);
}

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";
}

# 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
959f3c4c JH	1	#!/usr/bin/perl
	2	eval "exec perl -S $0 $*"
	3	if $running_under_some_shell;
	4
	5	# $Id: patclean.SH,v 3.0.1.2 1994/01/24 14:30:17 ram Exp $
	6	#
	7	# Copyright (c) 1991-1993, 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 3.0.
	14	#
	15	# $Log: patclean.SH,v $
	16	# Revision 3.0.1.2 1994/01/24 14:30:17 ram
	17	# patch16: now prefix error messages with program's name
	18	# patch16: added ~/.dist_profile awareness
	19	#
	20	# Revision 3.0.1.1 1993/08/19 06:42:33 ram
	21	# patch1: leading config.sh searching was not aborting properly
	22	#
	23	# Revision 3.0 1993/08/18 12:10:41 ram
	24	# Baseline for dist 3.0 netwide release.
	25	#
	26
	27	$version = '3.0';
	28	$patchlevel = '70';
	29
	30	$RCSEXT = ',v' unless $RCSEXT;
	31
	32	$progname = &profile; # Read ~/.dist_profile
	33	require 'getopts.pl';
	34	&usage unless $#ARGV >= 0;
	35	&usage unless &Getopts("ahnmV");
	36
	37	if ($opt_V) {
	38	print STDERR "$progname $version PL$patchlevel\n";
	39	exit 0;
	40	} elsif ($opt_h) {
	41	&usage;
	42	}
	43
	44	$RCSEXT = ',v' unless $RCSEXT;
	45	$ENV{'DIST'} = '/dev/null'; # Disable ~/.dist_profile
	46
	47	chop($pwd = `pwd`) unless -f '.package';
	48	until (-f '.package') {
	49	die "$progname: no .package file! Run packinit.\n" unless $pwd;
	50	chdir '..' \|\| die "$progname: can't cd ..: $!\n";
	51	$pwd =~ s\|(.)/(.)\|$1\|;
	52	$prefix = $2 . '/' . $prefix;
	53	}
	54	if ($prefix) {
	55	for (@ARGV) {
	56	s/^/$prefix/ unless m\|^[-/]\|;
	57	}
	58	}
	59
	60	# We now are at the top level
	61
	62	&readpackage;
	63
	64	if ($opt_n) {
65	&newer; # Look for files newer than patchlevel.h
66	} elsif ($opt_a) {
67	open(MANI,"MANIFEST.new") \|\| die "$progname: can't read MANIFEST.new: $!\n";
68	@ARGV = ();
69	while (<MANI>) {
70	s\|^\./\|\|;
71	next if m\|^patchlevel.h\|; # This file is built by hand
72	chop;
73	($_) = split(' ');
74	next if -d;
75	push(@ARGV,$_);
76	}
77	close MANI;
78	} elsif ($opt_m) {
79	open(MODS,"bugs/.mods$bnum") \|\| die "$progname: no modification found.\n";
80	@ARGV = ();
81	while (<MODS>) {
82	next if m\|^patchlevel.h$\|; # This file is built by hand
83	chop;
84	($_) = split(' ');
85	push(@ARGV,$_);
86	}
87	close MODS;
88	}
89
90	# Set a temporary file for check outs
91	$TMPFILE = "/tmp/cl$$.tmp";
92
93	# Now loop over each file specified, doing a 'rcsclean'
94	foreach $file (@ARGV) {
95	if (-f $file) {
96	$files = &rcsargs($file);
97	@files = split(' ', $files);
98	$rlog = `rlog -rlastpat- $files 2>&1`;
99	($revs) = ($rlog =~ /selected revisions: (\d+)/);
100	if (!$revs) {
101	print "$progname: $file has never been checked in--checking in...\n";
102	system 'perl', '-S', 'patcil', '-p', $file;
103	$revs = 2; # At least null trunk + new fresh revision
104	}
105	# Look whether there is a branch
106	if ($revs == 1) {
107	$rlog = `rlog -r$revbranch $files 2>&1`;
108	($revs) = ($rlog =~ /selected revisions: (\d+)/);
109	$revs++; # add the base revision
110	}
111	# We must only give the name of the RCS revision file, i.e. $files[1]
112	if ($revs == 1) {
113	system "co -q -p$baserev $files[1] > $TMPFILE";
114	} else {
115	system "co -q -p$revbranch $files[1] > $TMPFILE";
116	}
117	if ($? == 0) {
118	system 'cmp', '-s', $file, $TMPFILE;
119	if ($? == 0) {
120	unlink $file;
121	print "$progname: $file removed.\n";
122	} else {
123	# Check in file and make sure all was ok
124	system 'perl', '-S', 'patcil', '-p', $file;
125	system "co -q -p$revbranch $files[1] > $TMPFILE";
126	if ($? == 0) {
127	system 'cmp', '-s', $file, $TMPFILE;
128	if ($? == 0) {
129	unlink $file;
130	print "$progname: $file removed.\n";
131	} else {
132	print "$progname: $file NOT removed.\n";
133	}
134	} else {
135	print "$progname: could not check out--$file NOT removed.\n";
136	}
137	}
138	} else {
139	print "$progname: no revision--$file NOT removed.\n";
140	}
141	}
142	}
143
144	unlink "$TMPFILE";
145
146	sub usage {
147	print STDERR <<EOM;
148	Usage: $progname [-ahnmV] [filelist]
149	-a : all the files in MANIFEST.new
150	-h : print this message and exit
151	-n : all the files newer than patchlevel.h
152	-m : all the modified files (which have been patciled)
153	-V : print version number and exit
154	EOM
155	exit 1;
156	}
157
158	sub newer {
159	open(FIND, "find . -type f -newer patchlevel.h -print \| sort \|") \|\|
160	die "Can't run find.\n";
161	open(NEWER,">.newer") \|\| die "Can't create .newer.\n";
162	open(MANI,"MANIFEST.new");
163	while (<MANI>) {
164	($name,$foo) = split;
165	$mani{$name} = 1;
166	}
167	close MANI;
168	while (<FIND>) {
169	s\|^\./\|\|;
170	chop;
171	next if m\|^MANIFEST\|;
172	next if m\|^PACKLIST$\|;
173	if (!$mani{$_}) {
174	next if m\|^MANIFEST.new$\|;
175	next if m\|^Changes$\|;
176	next if m\|^Wanted$\|;
177	next if m\|^.package$\|;
178	next if m\|^bugs\|;
179	next if m\|^users$\|;
180	next if m\|^UU/\|;
181	next if m\|^RCS/\|;
182	next if m\|/RCS/\|;
183	next if m\|^config.sh$\|;
184	next if m\|/config.sh$\|;
185	next if m\|^make.out$\|;
186	next if m\|/make.out$\|;
187	next if m\|^all$\|;
188	next if m\|/all$\|;
189	next if m\|^core$\|;
190	next if m\|/core$\|;
191	next if m\|^toto\|;
192	next if m\|/toto\|;
193	next if m\|^\.\|;
194	next if m\|/\.\|;
195	next if m\|\.o$\|;
196	next if m\|\.old$\|;
197	next if m\|\.orig$\|;
198	next if m\|~$\|;
199	next if $mani{$_ . ".SH"};
200	next if m\|(.*)\.c$\| && $mani{$1 . ".y"};
201	next if m\|(.*)\.c$\| && $mani{$1 . ".l"};
202	next if (-x $_ && !m\|^Configure$\|);
203	}
204	print NEWER $_,"\n";
205	}
206	close FIND;
207	close NEWER;
208	print "Please remove unwanted files...\n";
209	sleep(2);
210	system '${EDITOR-vi} .newer';
211	die "Aborted.\n" unless -s '.newer' > 1;
212	@ARGV = split(' ',`cat .newer`);
213	}
214
215	sub readpackage {
216	if (! -f '.package') {
217	if (
218	-f '../.package' \|\|
219	-f '../../.package' \|\|
220	-f '../../../.package' \|\|
221	-f '../../../../.package'
222	) {
223	die "Run in top level directory only.\n";
224	} else {
225	die "No .package file! Run packinit.\n";
226	}
227	}
228	open(PACKAGE,'.package');
229	while (<PACKAGE>) {
230	next if /^:/;
231	next if /^#/;
232	if (($var,$val) = /^\s(\w+)=(.)/) {
233	$val = "\"$val\"" unless $val =~ /^['"]/;
234	eval "\$$var = $val;";
235	}
236	}
237	close PACKAGE;
238	}
239
240	sub rcsargs {
241	local($result) = '';
242	local($_);
243	while ($_ = shift(@_)) {
244	if ($_ =~ /^-/) {
245	$result .= $_ . ' ';
246	} elsif ($#_ >= 0 && do equiv($_,$_[0])) {
247	$result .= $_ . ' ' . $_[0] . ' ';
248	shift(@_);
249	} else {
250	$result .= $_ . ' ' . do other($_) . ' ';
251	}
252	}
253	$result;
254	}
255
256	sub equiv {
257	local($s1, $s2) = @_;
258	$s1 =~ s\|.*/\|\|;
259	$s2 =~ s\|.*/\|\|;
260	if ($s1 eq $s2) {
261	0;
262	} elsif ($s1 =~ s/$RCSEXT$// \|\| $s2 =~ s/$RCSEXT$//) {
263	$s1 eq $s2;
264	} else {
265	0;
266	}
267	}
268
269	sub other {
270	local($s1) = @_;
271	($dir,$file) = ('./',$s1) unless local($dir,$file) = ($s1 =~ m\|(./)(.)\|);
272	$dir = $TOPDIR . $dir if -d $TOPDIR . "$dir/RCS";
273	local($wasrcs) = ($file =~ s/$RCSEXT$//);
274	if ($wasrcs) {
275	`mkdir $dir` unless -d $dir;
276	$dir =~ s\|RCS/\|\|;
277	} else {
278	$dir .= 'RCS/';
279	`mkdir $dir` unless -d $dir;
280	$file .= $RCSEXT;
281	}
282	"$dir$file";
283	}
284
285	# Perform ~name expansion ala ksh...
286	# (banish csh from your vocabulary ;-)
287	sub tilda_expand {
288	local($path) = @_;
289	return $path unless $path =~ /^~/;
290	$path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
291	$path =~ s:^~:$ENV{'HOME'} \|\| (getpwuid($<))[$[+7]:e; # ~
292	$path;
293	}
294
295	# Set up profile components into %Profile, add any profile-supplied options
296	# into @ARGV and return the command invocation name.
297	sub profile {
298	local($profile) = &tilda_expand($ENV{'DIST'} \|\| '~/.dist_profile');
299	local($me) = $0; # Command name
300	$me =~ s\|./(.)\|$1\|; # Keep only base name
301	return $me unless -s $profile;
302	local(*PROFILE); # Local file descriptor
303	local($options) = ''; # Options we get back from profile
304	unless (open(PROFILE, $profile)) {
305	warn "$me: cannot open $profile: $!\n";
306	return;
307	}
308	local($_);
309	local($component);
310	while (<PROFILE>) {
311	next if /^\s*#/; # Skip comments
312	next unless /^$me/o;
313	if (s/^$me://o) { # progname: options
314	chop;
315	$options .= $_; # Merge options if more than one line
316	}
317	elsif (s/^$me-([^:]+)://o) { # progname-component: value
318	$component = $1;
319	chop;
320	s/^\s+//; # Trim leading and trailing spaces
321	s/\s+$//;
322	$Profile{$component} = $_;
323	}
324	}
325	close PROFILE;
326	return unless $options;
327	require 'shellwords.pl';
328	local(@opts);
329	eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
330	unshift(@ARGV, @opts);
331	return $me; # Return our invocation name
332	}
333