[metaconfig.git] / bin / patmake

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

# $Id: patmake.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.
#
# Original Author: Larry Wall <lwall@netlabs.com>
# Contribution by: Graham Stoney <greyham@research.canon.oz.au>
#
# $Log: patmake.SH,v $
# Revision 3.0.1.5  1995/09/25  09:21:19  ram
# patch59: now calls patsend with -i to add more instructions
#
# Revision 3.0.1.4  1994/10/29  16:43:09  ram
# patch36: a lot of setup is now performed by patlog
# patch36: added various escapes in strings for perl5 support
#
# Revision 3.0.1.3  1994/01/24  14:30:55  ram
# patch16: now prefix error messages with program's name
# patch16: added ~/.dist_profile awareness
#
# Revision 3.0.1.2  1993/08/24  12:18:59  ram
# patch3: now asks for patch mailing/posting after all patches edited
# patch3: patch release notification is done via new patnotify
# patch3: random cleanup, removed old RCS logs
#
# Revision 3.0.1.1  1993/08/19  06:42:38  ram
# patch1: leading config.sh searching was not aborting properly
#
# Revision 3.0  1993/08/18  12:10:45  ram
# Baseline for dist 3.0 netwide release.
#

$defeditor='/usr/bin/vi';
$version = '3.5';
$patchlevel = '0';
$mailer = '/usr/sbin/sendmail';

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

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

&readpackage;
&readusers;

$FILEOVERHEAD = 40;		# Name of files, Index, Prereq
$MAXPATSIZE = 50000;	# Maximum allowed size for a patch
$PATOVERHEAD = 2500;	# Litterature
$FIRST_PAT = 3000;		# Give space for first patch (descriptions)

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

@ARGV = <[Mm]akefile*>;
$mf = '';
if ($#ARGV > 0) {
	while (<>) {
		$mf .= $_ if /^[a-z.]+\s*:/;	# Rules in makefile
	}
}
$after = '';
$after .= "\t\tConfigure -ders\n" if -f 'Configure';
$after .= "\t\tmake depend\n" if $mf =~ /^depend:/m;
$after .= "\t\tmake\n" if $mf;
$after .= "\t\tmake test\n" if $mf =~ /^test:/m;
$after .= "\t\tmake install\n" if $mf =~ /^install:/m;
$after .= "\t\tmake install.man\n" if $mf =~ /^install\.man:/m;

chdir 'bugs' if -d 'bugs';
die "$progname: patch #$bnum already exists.\n" if -f "patch$bnum";

@patlist=<*.$bnum>;
die "$progname: no diff files for patch #$bnum.\n" if
	$patlist[0] =~ /^\*/ || $patlist[0] eq '';

# Whether they asked for a changelog file or not, call patlog.
# This will create at least the .pri and .subj and .clog files that we need.
# If a changelog file is needed, it will update it and create the necessary
# patch before we go on and put all those patches together.
# Note that we make use of the '-r' option, in case they have already
# run patlog themselves and made the necessary adjustments. Since -r supersedes
# -u, it's safe to allow ~/.dist_profile processing anyway.

chdir '..' if -d '../bugs';
system 'perl', '-S', 'patlog', '-r';	# Must be called from top-level dir
chdir 'bugs' if -d 'bugs';

@patlist=<*.$bnum>;		# Reget it, in case Changes.xx appeared due to patlog

# Look for size of each diff file
for (@patlist) {
	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
		$blksize,$blocks) = stat($_);
	$size{$_} = $size;
}

# Sort the array, biggest sizes first
sub revnum { $size{$a} < $size{$b} ? 1 : $size{$a} > $size{$b} ? -1 : 0; }
@patlist = sort revnum @patlist;

# Put files in a patch
for (@patlist) {
	$i=1;
	# Find the patch in which the current file can go
	# Divide size by 15 to count the 3 spaces added in front of each line
	while (($newtot = int($tot[$i] + $size{$_} + $size{$_}/15 + $FILEOVERHEAD)) >
			$MAXPATSIZE-$PATOVERHEAD-($i == 1 ? $FIRST_PAT : 0) && $tot[$i]) {
		$i++;
	}
	# Adding $_ to patch $i giving $newtot bytes
	$tot[$i] = $newtot;		# Update size of kit $i
	$list[$i] .= " $_";		# Add file to the kit $i
}

$numpat = $#list;		# Number of patches to generate

if ($numpat > 1) {
	print "$progname: Warning: generating $numpat patches.\n";
	sleep(1);
}

$hah = " (hah!)" if $bnum == 1;
$patbase = $bnum;			# First patch generated

open(PRIORITY, ".pri$bnum");
chop($priority = <PRIORITY>);
close PRIORITY;
$priority = 'LOW' unless $priority;

for ($i = 1; $i <= $numpat; $i++) {		# For all patches...
	open(PATCH,">patch$bnum") || die "Can't create patch #$bnum";
	chop($date=`date`);
	print PATCH
"System: $package version $baserev
Patch #: $bnum
";
	print PATCH "Priority: $priority\n" unless $priority eq '';
	# Print subjects only for first patch
	if ($i == 1) {
		open(SUBJECTS, ".subj$bnum");
		print PATCH while <SUBJECTS>;
		close SUBJECTS;
	} else {
		print PATCH "Subject: patch #$patbase, continued\n";
	}
	print PATCH
"Date: $date
From: $maintname <$maintloc>

Description:
";
	# Print description and repeat-by only for first patch
	if ($i == 1) {
		open(LOGS, ".clog$bnum");
		$_ = <LOGS>; $_ = <LOGS>; $_ = <LOGS>;	# Skip first three lines
		print PATCH while <LOGS>;
		close LOGS;
		print PATCH "Repeat-By: \n";
	} else {
		print PATCH "\tSee patch #$patbase.\n\n";
	}
	print PATCH
"
Fix:	From rn, say \"| patch -p -N -d DIR\", where DIR is your $package source
	directory.  Outside of rn, say \"cd DIR; patch -p -N <thisarticle\".
	If you don't have the patch program, apply the following by hand,
	or get patch (version 2.0, latest patchlevel).

	After patching:
";
	# Do $after only after last patch
	if ($i == $numpat) {
		print PATCH $after;
	} else {
		printf PATCH
"\t\t*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #%d FIRST ***\n",
$patbase + $numpat - 1;
	}
	print PATCH "
	If patch indicates that patchlevel is the wrong version, you may need
	to apply one or more previous patches, or the patch may already
	have been applied.  See the patchlevel.h file to find out what has or
	has not been applied.  In any event, don't continue with the patch.

	If you are missing previous patches$hah they can be obtained from me:

		$maintname <$maintloc>

";
	if ($mailagent ne 'false') {
		print PATCH
"	If you send a mail message of the following form it will greatly speed
	processing:

		Subject: Command
		\@SH mailpatch PATH $package $baserev LIST
			   ^ note the c

	where PATH is a return path FROM ME TO YOU either in Internet notation,
	or in bang notation from some well-known host, and LIST is the number
	of one or more patches you need, separated by spaces, commas, and/or
	hyphens.  Saying 35- says everything from 35 to the end.

	To get some more detailed instructions, send me the following mail:

		Subject: Command
		\@SH mailhelp PATH

";
	}
	if ($ftpsite) {
		print PATCH
"	You can also get the patches via anonymous FTP from
	$ftpsite.
";
	}
	# Print patchlevel at the top of each patch
	print PATCH "
Index: patchlevel.h
";
	if ($last eq '') {
		`echo "#define PATCHLEVEL 1" >patchlevel.h`;
		`cp /dev/null patchlevel.h.null`;
		print PATCH `diff -c patchlevel.h.null patchlevel.h`;
		unlink 'patchlevel.h', 'patchlevel.h.null';
	}
	else {
		print PATCH
"Prereq: $last
${patchline}c${patchline}
< #define PATCHLEVEL $last
---
> #define PATCHLEVEL $bnum
";
	}
	$last = $bnum;			# Update last patch
	push(@patset, $bnum);	# Record set of generated patch(es)

	@ARGV = split(' ', $list[$i]);
	while (<>) { print PATCH; }
	print PATCH "\n*** End of Patch $bnum ***\n";
	close PATCH;

	# Update patchlevel.h file
	$editor = $ENV{'VISUAL'};
	$editor = $ENV{'EDITOR'} unless $editor;
	$editor = $defeditor unless $editor;
	$editor = 'vi' unless $editor;
	system $editor, "patch$bnum";
	if (-s "patch$bnum") {
		system 'chmod', '-w', "patch$bnum";		# Protect newly created patch
		chdir '..';
		`echo "#define PATCHLEVEL 0" >patchlevel.h` unless -f 'patchlevel.h';
		open(PL,"patchlevel.h") ||
			die "$progname: can't open patchlevel.h: $!\n";
		open(PLN,">patchlevel.h+") ||
			die "$progname: can't create new patchlevel.h: $!\n";
		while (<PL>) {
			if (/^#define\s+PATCHLEVEL\s+(\d+)/) {
				$bnum = $1;
				$bnum++;		# Update patch level
				print PLN "#define PATCHLEVEL $bnum\n";
			} else {
				print PLN;		# Simply copy other lines
			}
		}
		close PLN;
		close PL;
		`mv -f patchlevel.h+ patchlevel.h`;
		die "$progname: malformed patchlevel.h file.\n" if $bnum eq '';
	} else {
		unlink "patch$bnum";
		die "$progname: aborted.\n";
	}

	chdir 'bugs' || die "$progname: cannot cd to bugs: $!\n";
	
	# Find priority for next patch in loop
	$priority='';
	open(PATCH, "patch$bnum") || die "Cannot re-open patch #$bnum !\n";
	while (<PATCH>) {
		/^Priority:\s*(\S+)\s*$/ && ($priority = $1);
	}
	close PATCH;

	$bnum++;	# For next patch in loop
}

utime time, time, 'patchlevel.h';	# Reset timestamp on patchlevel

if (@patset == 1) {
	$bnum = pop(@patset);
	$patch = "patch #$bnum";
} else {
	$bmin = shift(@patset);
	$bmax = pop(@patset);
	$bnum = "$bmin-$bmax";
	$patch = "patches #$bmin thru #$bmax";
}

# Post generated patches
if ($newsgroups) {
	print "\nDo you wish to post $patch to $newsgroups? [y] ";
	$ans = <stdin>;
	system 'patpost', $bnum unless $ans =~ /^n/i;
}

# Mail generated patches
if ($recipients) {
	print "\n";
	if (0 == ($recipients =~ tr/ //)) {
		print "Do you wish to send $patch to $recipients? [y] ";
	} else {
		print "The following people are on the recipient list:\n\n";
		foreach $addr (split(' ', $recipients)) {
			print "\t$addr\n";
		}
		print "\nDo you wish to send $patch to them? [y] ";
	}
	$ans = <stdin>;
	system 'patsend', '-i', $bnum, $recipients unless $ans =~ /^n/i;
}

# Copy patches to FTP directory
if ($ftpdir) {
	print "\nDo you wish to copy $patch to $ftpdir? [y] ";
	$ans = <stdin>;
	system 'patftp', $bnum unless $ans =~ /^n/i;
}

# Notify people about it.
if ($notify) {
	print "\n";
	if (0 == ($notify =~ tr/ //)) {
		print "Do you wish to notify $notify? [y] ";
	} else {
		print "The following people are on the notify list:\n\n";
		foreach $addr (split(' ', $notify)) {
			print "\t$addr\n";
		}
		print "\nDo you wish to notify them? [y] ";
	}
	$ans = <STDIN>;
	system 'patnotify', $notify unless $ans =~ /^n/i;
}

sub usage {
	print STDERR <<EOM;
Usage: $progname [-hV]
  -h : print this message and exit
  -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 readusers {
	return unless open(USERS, 'users');
	local($_);
	local($status, $name, $pl);
	while (<USERS>) {
		next if /^#/;
		chop if /\n$/;				# Emacs may leave final line without \n
		($status, $pl, $name) = split;
		# Handle oldstyle two-field user file format (PL13 and before)
		$name = $pl unless defined $name;
		if ($status eq 'M') {
			$recipients = $recipients ? "$recipients $name" : $name;
		} elsif ($status eq 'N') {
			$notify = $notify ? "$notify $name" : $name;
		}
	}
	close USERS;
}

# 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: patmake.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	# Original Author: Larry Wall <lwall@netlabs.com>
	16	# Contribution by: Graham Stoney <greyham@research.canon.oz.au>
	17	#
	18	# $Log: patmake.SH,v $
	19	# Revision 3.0.1.5 1995/09/25 09:21:19 ram
	20	# patch59: now calls patsend with -i to add more instructions
	21	#
	22	# Revision 3.0.1.4 1994/10/29 16:43:09 ram
	23	# patch36: a lot of setup is now performed by patlog
	24	# patch36: added various escapes in strings for perl5 support
	25	#
	26	# Revision 3.0.1.3 1994/01/24 14:30:55 ram
	27	# patch16: now prefix error messages with program's name
	28	# patch16: added ~/.dist_profile awareness
	29	#
	30	# Revision 3.0.1.2 1993/08/24 12:18:59 ram
	31	# patch3: now asks for patch mailing/posting after all patches edited
	32	# patch3: patch release notification is done via new patnotify
	33	# patch3: random cleanup, removed old RCS logs
	34	#
	35	# Revision 3.0.1.1 1993/08/19 06:42:38 ram
	36	# patch1: leading config.sh searching was not aborting properly
	37	#
	38	# Revision 3.0 1993/08/18 12:10:45 ram
	39	# Baseline for dist 3.0 netwide release.
	40	#
	41
	42	$defeditor='/usr/bin/vi';
	43	$version = '3.5';
	44	$patchlevel = '0';
	45	$mailer = '/usr/sbin/sendmail';
	46
	47	$progname = &profile; # Read ~/.dist_profile
	48	require 'getopts.pl';
	49	&usage unless &Getopts("hV");
	50
	51	if ($opt_V) {
	52	print STDERR "$progname $version PL$patchlevel\n";
	53	exit 0;
	54	} elsif ($opt_h) {
	55	&usage;
	56	}
	57
	58	&readpackage;
	59	&readusers;
	60
	61	$FILEOVERHEAD = 40; # Name of files, Index, Prereq
	62	$MAXPATSIZE = 50000; # Maximum allowed size for a patch
	63	$PATOVERHEAD = 2500; # Litterature
	64	$FIRST_PAT = 3000; # Give space for first patch (descriptions)
65
66	if (-f 'patchlevel.h') {
67	open(PL,"patchlevel.h") \|\| die "$progname: can't open patchlevel.h: $!\n";
68	while (<PL>) {
69	if (/^#define\s+PATCHLEVEL\s+(\d+)/) {
70	$last = $1;
71	$patchline = $.; # Record PATCHLEVEL line
72	}
73	}
74	die "$progname: malformed patchlevel.h file.\n" if $last eq '';
75	$bnum = $last + 1;
76	}
77	else {
78	$patchline = 1;
79	$bnum = 1;
80	$last = '';
81	}
82
83	@ARGV = <[Mm]akefile*>;
84	$mf = '';
85	if ($#ARGV > 0) {
86	while (<>) {
87	$mf .= $_ if /^[a-z.]+\s*:/; # Rules in makefile
88	}
89	}
90	$after = '';
91	$after .= "\t\tConfigure -ders\n" if -f 'Configure';
92	$after .= "\t\tmake depend\n" if $mf =~ /^depend:/m;
93	$after .= "\t\tmake\n" if $mf;
94	$after .= "\t\tmake test\n" if $mf =~ /^test:/m;
95	$after .= "\t\tmake install\n" if $mf =~ /^install:/m;
96	$after .= "\t\tmake install.man\n" if $mf =~ /^install\.man:/m;
97
98	chdir 'bugs' if -d 'bugs';
99	die "$progname: patch #$bnum already exists.\n" if -f "patch$bnum";
100
101	@patlist=<*.$bnum>;
102	die "$progname: no diff files for patch #$bnum.\n" if
103	$patlist[0] =~ /^\*/ \|\| $patlist[0] eq '';
104
105	# Whether they asked for a changelog file or not, call patlog.
106	# This will create at least the .pri and .subj and .clog files that we need.
107	# If a changelog file is needed, it will update it and create the necessary
108	# patch before we go on and put all those patches together.
109	# Note that we make use of the '-r' option, in case they have already
110	# run patlog themselves and made the necessary adjustments. Since -r supersedes
111	# -u, it's safe to allow ~/.dist_profile processing anyway.
112
113	chdir '..' if -d '../bugs';
114	system 'perl', '-S', 'patlog', '-r'; # Must be called from top-level dir
115	chdir 'bugs' if -d 'bugs';
116
117	@patlist=<*.$bnum>; # Reget it, in case Changes.xx appeared due to patlog
118
119	# Look for size of each diff file
120	for (@patlist) {
121	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
122	$blksize,$blocks) = stat($_);
123	$size{$_} = $size;
124	}
125
126	# Sort the array, biggest sizes first
127	sub revnum { $size{$a} < $size{$b} ? 1 : $size{$a} > $size{$b} ? -1 : 0; }
128	@patlist = sort revnum @patlist;
129
130	# Put files in a patch
131	for (@patlist) {
132	$i=1;
133	# Find the patch in which the current file can go
134	# Divide size by 15 to count the 3 spaces added in front of each line
135	while (($newtot = int($tot[$i] + $size{$_} + $size{$_}/15 + $FILEOVERHEAD)) >
136	$MAXPATSIZE-$PATOVERHEAD-($i == 1 ? $FIRST_PAT : 0) && $tot[$i]) {
137	$i++;
138	}
139	# Adding $_ to patch $i giving $newtot bytes
140	$tot[$i] = $newtot; # Update size of kit $i
141	$list[$i] .= " $_"; # Add file to the kit $i
142	}
143
144	$numpat = $#list; # Number of patches to generate
145
146	if ($numpat > 1) {
147	print "$progname: Warning: generating $numpat patches.\n";
148	sleep(1);
149	}
150
151	$hah = " (hah!)" if $bnum == 1;
152	$patbase = $bnum; # First patch generated
153
154	open(PRIORITY, ".pri$bnum");
155	chop($priority = <PRIORITY>);
156	close PRIORITY;
157	$priority = 'LOW' unless $priority;
158
159	for ($i = 1; $i <= $numpat; $i++) { # For all patches...
160	open(PATCH,">patch$bnum") \|\| die "Can't create patch #$bnum";
161	chop($date=`date`);
162	print PATCH
163	"System: $package version $baserev
164	Patch #: $bnum
165	";
166	print PATCH "Priority: $priority\n" unless $priority eq '';
167	# Print subjects only for first patch
168	if ($i == 1) {
169	open(SUBJECTS, ".subj$bnum");
170	print PATCH while <SUBJECTS>;
171	close SUBJECTS;
172	} else {
173	print PATCH "Subject: patch #$patbase, continued\n";
174	}
175	print PATCH
176	"Date: $date
177	From: $maintname <$maintloc>
178
179	Description:
180	";
181	# Print description and repeat-by only for first patch
182	if ($i == 1) {
183	open(LOGS, ".clog$bnum");
184	$_ = <LOGS>; $_ = <LOGS>; $_ = <LOGS>; # Skip first three lines
185	print PATCH while <LOGS>;
186	close LOGS;
187	print PATCH "Repeat-By: \n";
188	} else {
189	print PATCH "\tSee patch #$patbase.\n\n";
190	}
191	print PATCH
192	"
193	Fix: From rn, say \"\| patch -p -N -d DIR\", where DIR is your $package source
194	directory. Outside of rn, say \"cd DIR; patch -p -N <thisarticle\".
195	If you don't have the patch program, apply the following by hand,
196	or get patch (version 2.0, latest patchlevel).
197
198	After patching:
199	";
200	# Do $after only after last patch
201	if ($i == $numpat) {
202	print PATCH $after;
203	} else {
204	printf PATCH
205	"\t\t* DO NOTHING--INSTALL ALL PATCHES UP THROUGH #%d FIRST *\n",
206	$patbase + $numpat - 1;
207	}
208	print PATCH "
209	If patch indicates that patchlevel is the wrong version, you may need
210	to apply one or more previous patches, or the patch may already
211	have been applied. See the patchlevel.h file to find out what has or
212	has not been applied. In any event, don't continue with the patch.
213
214	If you are missing previous patches$hah they can be obtained from me:
215
216	$maintname <$maintloc>
217
218	";
219	if ($mailagent ne 'false') {
220	print PATCH
221	" If you send a mail message of the following form it will greatly speed
222	processing:
223
224	Subject: Command
225	\@SH mailpatch PATH $package $baserev LIST
226	^ note the c
227
228	where PATH is a return path FROM ME TO YOU either in Internet notation,
229	or in bang notation from some well-known host, and LIST is the number
230	of one or more patches you need, separated by spaces, commas, and/or
231	hyphens. Saying 35- says everything from 35 to the end.
232
233	To get some more detailed instructions, send me the following mail:
234
235	Subject: Command
236	\@SH mailhelp PATH
237
238	";
239	}
240	if ($ftpsite) {
241	print PATCH
242	" You can also get the patches via anonymous FTP from
243	$ftpsite.
244	";
245	}
246	# Print patchlevel at the top of each patch
247	print PATCH "
248	Index: patchlevel.h
249	";
250	if ($last eq '') {
251	`echo "#define PATCHLEVEL 1" >patchlevel.h`;
252	`cp /dev/null patchlevel.h.null`;
253	print PATCH `diff -c patchlevel.h.null patchlevel.h`;
254	unlink 'patchlevel.h', 'patchlevel.h.null';
255	}
256	else {
257	print PATCH
258	"Prereq: $last
259	${patchline}c${patchline}
260	< #define PATCHLEVEL $last
261	---
262	> #define PATCHLEVEL $bnum
263	";
264	}
265	$last = $bnum; # Update last patch
266	push(@patset, $bnum); # Record set of generated patch(es)
267
268	@ARGV = split(' ', $list[$i]);
269	while (<>) { print PATCH; }
270	print PATCH "\n* End of Patch $bnum *\n";
271	close PATCH;
272
273	# Update patchlevel.h file
274	$editor = $ENV{'VISUAL'};
275	$editor = $ENV{'EDITOR'} unless $editor;
276	$editor = $defeditor unless $editor;
277	$editor = 'vi' unless $editor;
278	system $editor, "patch$bnum";
279	if (-s "patch$bnum") {
280	system 'chmod', '-w', "patch$bnum"; # Protect newly created patch
281	chdir '..';
282	`echo "#define PATCHLEVEL 0" >patchlevel.h` unless -f 'patchlevel.h';
283	open(PL,"patchlevel.h") \|\|
284	die "$progname: can't open patchlevel.h: $!\n";
285	open(PLN,">patchlevel.h+") \|\|
286	die "$progname: can't create new patchlevel.h: $!\n";
287	while (<PL>) {
288	if (/^#define\s+PATCHLEVEL\s+(\d+)/) {
289	$bnum = $1;
290	$bnum++; # Update patch level
291	print PLN "#define PATCHLEVEL $bnum\n";
292	} else {
293	print PLN; # Simply copy other lines
294	}
295	}
296	close PLN;
297	close PL;
298	`mv -f patchlevel.h+ patchlevel.h`;
299	die "$progname: malformed patchlevel.h file.\n" if $bnum eq '';
300	} else {
301	unlink "patch$bnum";
302	die "$progname: aborted.\n";
303	}
304
305	chdir 'bugs' \|\| die "$progname: cannot cd to bugs: $!\n";
306
307	# Find priority for next patch in loop
308	$priority='';
309	open(PATCH, "patch$bnum") \|\| die "Cannot re-open patch #$bnum !\n";
310	while (<PATCH>) {
311	/^Priority:\s(\S+)\s$/ && ($priority = $1);
312	}
313	close PATCH;
314
315	$bnum++; # For next patch in loop
316	}
317
318	utime time, time, 'patchlevel.h'; # Reset timestamp on patchlevel
319
320	if (@patset == 1) {
321	$bnum = pop(@patset);
322	$patch = "patch #$bnum";
323	} else {
324	$bmin = shift(@patset);
325	$bmax = pop(@patset);
326	$bnum = "$bmin-$bmax";
327	$patch = "patches #$bmin thru #$bmax";
328	}
329
330	# Post generated patches
331	if ($newsgroups) {
332	print "\nDo you wish to post $patch to $newsgroups? [y] ";
333	$ans = <stdin>;
334	system 'patpost', $bnum unless $ans =~ /^n/i;
335	}
336
337	# Mail generated patches
338	if ($recipients) {
339	print "\n";
340	if (0 == ($recipients =~ tr/ //)) {
341	print "Do you wish to send $patch to $recipients? [y] ";
342	} else {
343	print "The following people are on the recipient list:\n\n";
344	foreach $addr (split(' ', $recipients)) {
345	print "\t$addr\n";
346	}
347	print "\nDo you wish to send $patch to them? [y] ";
348	}
349	$ans = <stdin>;
350	system 'patsend', '-i', $bnum, $recipients unless $ans =~ /^n/i;
351	}
352
353	# Copy patches to FTP directory
354	if ($ftpdir) {
355	print "\nDo you wish to copy $patch to $ftpdir? [y] ";
356	$ans = <stdin>;
357	system 'patftp', $bnum unless $ans =~ /^n/i;
358	}
359
360	# Notify people about it.
361	if ($notify) {
362	print "\n";
363	if (0 == ($notify =~ tr/ //)) {
364	print "Do you wish to notify $notify? [y] ";
365	} else {
366	print "The following people are on the notify list:\n\n";
367	foreach $addr (split(' ', $notify)) {
368	print "\t$addr\n";
369	}
370	print "\nDo you wish to notify them? [y] ";
371	}
372	$ans = <STDIN>;
373	system 'patnotify', $notify unless $ans =~ /^n/i;
374	}
375
376	sub usage {
377	print STDERR <<EOM;
378	Usage: $progname [-hV]
379	-h : print this message and exit
380	-V : print version number and exit
381	EOM
382	exit 1;
383	}
384
385	sub readpackage {
386	if (! -f '.package') {
387	if (
388	-f '../.package' \|\|
389	-f '../../.package' \|\|
390	-f '../../../.package' \|\|
391	-f '../../../../.package'
392	) {
393	die "Run in top level directory only.\n";
394	} else {
395	die "No .package file! Run packinit.\n";
396	}
397	}
398	open(PACKAGE,'.package');
399	while (<PACKAGE>) {
400	next if /^:/;
401	next if /^#/;
402	if (($var,$val) = /^\s(\w+)=(.)/) {
403	$val = "\"$val\"" unless $val =~ /^['"]/;
404	eval "\$$var = $val;";
405	}
406	}
407	close PACKAGE;
408	}
409
410	sub readusers {
411	return unless open(USERS, 'users');
412	local($_);
413	local($status, $name, $pl);
414	while (<USERS>) {
415	next if /^#/;
416	chop if /\n$/; # Emacs may leave final line without \n
417	($status, $pl, $name) = split;
418	# Handle oldstyle two-field user file format (PL13 and before)
419	$name = $pl unless defined $name;
420	if ($status eq 'M') {
421	$recipients = $recipients ? "$recipients $name" : $name;
422	} elsif ($status eq 'N') {
423	$notify = $notify ? "$notify $name" : $name;
424	}
425	}
426	close USERS;
427	}
428
429	# Perform ~name expansion ala ksh...
430	# (banish csh from your vocabulary ;-)
431	sub tilda_expand {
432	local($path) = @_;
433	return $path unless $path =~ /^~/;
434	$path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
435	$path =~ s:^~:$ENV{'HOME'} \|\| (getpwuid($<))[$[+7]:e; # ~
436	$path;
437	}
438
439	# Set up profile components into %Profile, add any profile-supplied options
440	# into @ARGV and return the command invocation name.
441	sub profile {
442	local($profile) = &tilda_expand($ENV{'DIST'} \|\| '~/.dist_profile');
443	local($me) = $0; # Command name
444	$me =~ s\|./(.)\|$1\|; # Keep only base name
445	return $me unless -s $profile;
446	local(*PROFILE); # Local file descriptor
447	local($options) = ''; # Options we get back from profile
448	unless (open(PROFILE, $profile)) {
449	warn "$me: cannot open $profile: $!\n";
450	return;
451	}
452	local($_);
453	local($component);
454	while (<PROFILE>) {
455	next if /^\s*#/; # Skip comments
456	next unless /^$me/o;
457	if (s/^$me://o) { # progname: options
458	chop;
459	$options .= $_; # Merge options if more than one line
460	}
461	elsif (s/^$me-([^:]+)://o) { # progname-component: value
462	$component = $1;
463	chop;
464	s/^\s+//; # Trim leading and trailing spaces
465	s/\s+$//;
466	$Profile{$component} = $_;
467	}
468	}
469	close PROFILE;
470	return unless $options;
471	require 'shellwords.pl';
472	local(@opts);
473	eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
474	unshift(@ARGV, @opts);
475	return $me; # Return our invocation name
476	}
477