#!/mit/watchmaker/vaxbin/perl
	eval "exec /mit/watchmaker/vaxbin/perl -S $0 $*"
		if $running_under_some_shell;

# $Header: packinit.SH,v 2.0.1.1 88/08/05 00:27:49 lwall Exp $
#
# $Log:	packinit.SH,v $
# Revision 2.0.1.1  88/08/05  00:27:49  lwall
# patch1: now depends on perlpath
# 
# Revision 2.0  88/06/28  23:18:55  lwall
# Baseline.
# 

$orgname='MIT Project Athena';
$hostname='thor';
$mydomain='.mit.edu';
$nametype='bsd';

print '
This program designates the current directory as the top level directory
of a package on which you want to use the programs metaconfig, makedist,
or the patch generation programs.  It will not damage the current directory
in any way except to create a .package file.

';

$mypackver=1;
if (-f '.package') {
    do readpackage();
    if ($packver > $mypackver) {
	die "This .package file was produced by a newer packinit than I am.\n".
	    "Please find a packinit of version $packver or greater.\n";
    }
}

# Now set up to do reads with possible shell escape.
sub myread {
    ($rp,$dflt) = @_;
    $rp .= " [$dflt]";
    print "$rp ";
    $ans='!';
    while ($ans =~ /^!/) {
	$ans = <stdin>;
	chop($ans);
	if ($ans eq '!') {
	    system '/bin/sh';
	    print "\n$rp ";
	}
	elsif ($ans =~ s/^!//) {
	    system '/bin/sh', '-c', $ans;
	    print "\n$rp ";
	}
    }
    $ans = $dflt if $ans eq '';
    $ans;
}

$dflt = $package;
($dflt) = (`pwd` =~ m|.*/(.*)|) unless $package;

print " 
Your package will be known by some name, which should be a single word.
Generally it is the name of the chief executable program.

";
$package = do myread("What is the name of your package? ",$dflt);

if ($baserev ne '') {
    $dflt=$baserev;
}
else {
    print "\n";
    $dflt='';
    print "Checking RCS files for current version...";
    @rcs = <RCS/*,v *,v>;
    $rcs = shift(@rcs);
    if (! -f $rcs) {
	$rcs = shift(@rcs);
	if (! -f $1) {
	    print "I don't see any RCS files there (yet).";
	    $dflt='1.1';
	}
    }
    $revs=0;
    if ($dflt eq '') {
	$rlog = `rlog $rcs`;
	($dflt) = ($rlog =~ /\nhead:\s*(\d+\.\d+)/);
	$rlog = `rlog -r$dflt.1- -r$dflt.2- -r$dflt.3- -r$dflt.4- $rcs`;
	($revs) = ($rlog =~ /selected revisions:\s*([\d.]+)/);
	$dflt='1.1' if $dflt eq '';
    }

    print "
To use the patch generating portion of the system, you must have RCS.  You
must begin with a freshly checked-in trunk revision (n.n) and choose a branch
number for patches.  The trunk revision upon which the patch branch is based
is called the base revision.

";

    if ($revs > 1) {
	print
"(The current revision ($dflt) has branches--you may have to check in a new
trunk revision, or use patbase to mark the base revisions.)\n";
	($first,$second) = split(/\./,$dflt);
	++$second;
	$dflt="$first.$second";
    }
}

print "\n";
$foo = do myread("What is or will be the base revision number? ", $dflt);
if ($baserev ne $foo) {
    $baserev = $foo;
    $ftpdir = '';		# invalidate ftp directory on version change
}

print "\n";

$dflt = ($patchbranch ne '' ? $patchbranch : 1);
$patchbranch =
    do myread("What branch number do you want to use for patches? ", $dflt);

print "\n";
$dflt = ($mydiff eq '' ? 'n' : 'y');
$ans = do myread(
    "Do you want to use your own diff (rather than rcsdiff -c) for patches? ",
    $dflt);
if ($ans =~ /^n/i) {
    $mydiff='';
}
else {
    $dflt = $mydiff || 'diff -c';
    $mydiff = do myread("What diff command do you want to use? ", $dflt);
}

print "
Over the lifetime of the $package package, people will want to request
distribution kits and patches.  In particular, automatically generated
patches will say where to get previous patches from.

";
$logname = do getlogname();
$dflt = $maintname || do getfullname($logname);
$maintname = do myread("Who should requests be sent to (full name)? ", $dflt);

print "
Now you need to give a one-line network mailing address for $maintname.
It does not need to be parseable by machine, but can be of the form:

	{name1,name2,name3}!myhost!myname

	or

	myname@myhost.domain

";
$dflt = $maintloc || "$logname@$hostname$mydomain";
$maintloc = do myread("What is the network mailing address? ", $dflt);

print "\n";
$dflt = ($ftpsite ? 'y' : 'n');
$ans = do myread(
    "Will you put patches where they can be acquired by anonymous FTP? ",$dflt);
if ($ans =~ /^n/i) {
    $ftpsite='';
}
else {
    print "\n";
    $dflt = $ftpsite;
    ($dflt = $maintloc) =~ s/.*@([^\s,()]*).*/$1/ unless $dflt;
    $ftpsite = do myread("What is the Internet sitename for that? ",$dflt);
}

print "\n";
$dflt = $orgname || $ENV{'ORGANIZATION'};
$orgname = do myread("Organization: ",$dflt);

print "\n";
$dflt = $newsgroups || 'comp.sources.bugs';
$newsgroups = do myread("Newsgroup(s) to post patches to: ", $dflt);

print "\n";
$dflt = $recipients || 'source-archives@mirror.TMC.COM';
$recipients = do myread("Recipient(s) to send patches to: ",$dflt);

print "\n";
if ($ftpsite) {
    $dflt = $ftpdir || "/usr/spool/ftp/pub/$package.$baserev/patches";
    $ftpdir = do myread("FTP directory to copy patches to: ",$dflt);
}
else {
    $ftpdir = '';
}

print "\nCreating .package...\n";
open(PACKAGE, '>.package') || die "Can't create .package";
print PACKAGE
": basic variables
package=$package
baserev=$baserev
patchbranch=$patchbranch
mydiff='$mydiff'
maintname='$maintname'
maintloc='$maintloc'
ftpsite='$ftpsite'
orgname='$orgname'
newsgroups='$newsgroups'
recipients='$recipients'
ftpdir='$ftpdir'

: derivative variables--do not change
revbranch=\"\$baserev.\$patchbranch\"
packver='$mypackver'
";

sub readpackage {
    if (! -f '.package') {
        if (-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 getlogname {
    local($logname) = $ENV{'USER'};
    $logname = $ENV{'LOGNAME'} unless $logname;
    chop($logname = `who am i`) unless $logname;
    $logname =~ s/\s.*//;
    $logname =~ s/.*!//;
    $logname;
}

sub getfullname {
    local($logname) = @_;
    local($foo,$bar);
    if ($ENV{'NAME'}) {
	$ENV{'NAME'};
    }
    else {
	open(PASSWD,'/etc/passwd') || die "Can't open /etc/passwd";
	while (<PASSWD>) {
	    /(\w+):/;
	    last if $1 eq $logname;
	}
	close PASSWD;
	local($login,$passwd,$uid,$gid,$gcos,$home,$shell) = split(/:/);
	if (-f "$home/.fullname") {
	    open(FN,"$home/.fullname");
	    chop($foo = <FN>);
	    close FN;
	    $foo;
	}
	elsif ($nametype eq 'bsd') {
	    $gcos =~ s/[,;].*//;
	    if ($gcos =~ /&/) {		# oh crud
		($foo,$bar) = ($logname =~ /(.)(.*)/);
		$foo =~ y/a-z/A-Z/;
		$gcos =~ s/&/$foo$bar/;
	    }
	    $gcos;
	}
	else {
	    $gcos =~ s/[(].*//;
	    $gcos =~ s/.*-//;
	    $gcos;
	}
    }
}
