#!/usr/local/bin/perl
# -*-perl-*-
#
#   Copyright (c) 1996 Network Appliance, Inc.
#   Copyright (c) 2002 PiroNet NDH AG
#
#   You may distribute under the terms of the Artistic License, as
#   specified in the README file included in the cvslines
#   distribution.
#
#   Original Author: Richard Geiger for Network Appliance, Inc.
#   Adaption to cvs >=1.11 by Juergen Jatzkowski and Ingo Rockel
#
#  $Id: cvslines,v 1.12 2005/10/11 08:14:31 irockel Exp $

use Carp;
require 5.000;

#
#  The overall release version number.
#
$Version = "1.6.9";

#
#  global cvslines config file.
#
$configpath = "";

#  Some conventions:
#
#    - All globals should be named with $Leading_Caps
#      (I believe in the judicious use of globals!)
#
#    - All constants should be named with $ALL_CAPS
#

#  Find out if we're running "in-house". This allows us to have
#  different defaults for certain site configuration parameters when
#  running at Network Appliance than might be sensible for the more
#  generic case, should this ever be more widely distributed.
#
if (-x "/bin/domainname")
  { $Mydomain = `/bin/domainname`; chop $Mydomain; }

$Here = `/bin/pwd`; chop $Here;

#  Turn off buffering on STDERRR & STDOUT
#
select(STDOUT); $| = 1; select(STDERR); $|= 1; select(STDOUT);

#  Avert an identity crisis
#
($Myname = $0) =~ s%^.*/%%;
$Mydirname = &dirname($0);

chdir $Mydirname || die;
$Mydirname = `/bin/pwd`; chop $Mydirname;
chdir $Here || die;

($Mynamebase = $Myname) =~ s/_.*//;
($Myspacbase = $Mynamebase) =~ s/./ /g;
($Mynameext = $Myname) =~ s/^.*_//;
$Myversion = "1.6.9";
$tagflag = "";


$Mycvs_versmsg = `cvs -v`;
# perform cvs version check, if branch flag needs to be appended.
if ($cvs_versmsg ~ /\nConcurrent Versions System\s+\(CVS\)\s+1\.([0-9]+)\.([0-9]+)*\s+/) 
  {
    if(!($2 >= 2 && $1 == 11) || ($1 > 11))
      {
        print "cvslines needs at least cvs 1.11.2 to properly work (you shouldn't use older\n";
        print "versions because of bugs and security issues!\n";

	exit -1;
      }
  }
    

(@pwent) = getpwuid($<);
if ($#pwent < 7)
  {
    print STDERR "$Mynamebase: can't get your passwd file entry.\n";
    exit 1;
  }  

$Username = $pwent[0];

if (defined($ENV{"HOME"}))
  { $Userhome = $ENV{"HOME"}; }
else
  { $Userhome = $pwent[7]; }

undef @pwent;

#  Site-dependent configuration...
#
#  Pick up any settings from our config file.
#
if (-f "$Mydirname/$Mynamebase-config")
  { require "$Mydirname/$Mynamebase-config"; }

#  Where this site's "official" cvslines version is
#
if (! defined($RELDIR)) { $RELDIR = "/usr/local/bin"; }

#  Normalize $RELDIR
#
chdir $RELDIR || die;
$RELDIR = `/bin/pwd`; chop $RELDIR;
chdir $Here || die;

#  Locate the "cvslines.log" file...
#
if ($Mydirname eq $RELDIR)
  {
    #  We're this site's officially installed version...
    #
    if    ($Mydomain eq "netapp.com")  { $LOGFILE = "/u/rmg/cvslines/cvslines.log"; }
    elsif (!defined($LOGFILE))         { $LOGFILE = "/usr/adm/cvslines.log"; }

    #  OK, now we know where we'd like to log.
    #  Check to see that we can...
    #
    if (! open(L, ">>$LOGFILE"))
      {
        #  Hmm, punt - trying logging to $Userhome/cvslines.log
        #
        $LOGFILE = "$Userhome/cvslines.log";
      }
    else
      { close L; }
  }
else
  { $LOGFILE = "$Mydirname/cvslines.log"; } # for debugging, we log here

#  Set RCSBIN
#
#  Honor any RCSBIN in the config file first...
#
if ($RCSBIN)
  {
    if (! -x "$RCSBIN/rcs")
      {
        #  Hmmm, the value we got from the config doesn't seem to be right.
        #
        print STDERR "$Mynamebase: no executable \"$RCSBIN/rcs\";\n".
                     "  check \$RCSBIN in the config file.\n";
        exit 1;
      }
    $ENV{"RCSBIN"} = $RCSBIN;
  }
elsif (defined($ENV{"RCSBIN"}))
  {
    #  otherwise, if there's already an RCSBIN in the environment,
    #  leave it be...
    #
  }
else
  {
    # otherwise, see what $PATH turns up...
    #
    my $path;
    my @path;
    my $dir;
    my $here;

    $path = $ENV{"PATH"};
    @path = split(/:/, $path);
    foreach $dir (@path)
      {
        if (-x "$dir/rcs")
          {
	    $here = `/bin/pwd`; chop $here;
            chdir $dir || die "can't chdir to \"$dir\": $!";
	    $dir = `/bin/pwd`; chop $dir;
            $ENV{"RCSBIN"} = $dir;
            chdir $here || die "can't chdir back to \"$here\": $!";
	    last;
          }
        #
        #  Well, I guess we just go with whatever cvs finds...
        #
      }
  }


if (-x "/usr/bin/ssh")
  { $Rshcmd = "/usr/bin/ssh -n"; }
elsif (-x "/usr/ucb/rsh")
  { $Rshcmd = "/usr/ucb/rsh -n"; }
elsif (-x "/usr/bsd/rsh")
  { $Rshcmd = "/usr/ucb/rsh -n"; }
elsif (-x "/bin/rsh")
  { $Rshcmd = "/bin/rsh -n"; }
elsif (-x "/usr/bin/rsh")
  { $Rshcmd = "/usr/bin/rsh -n"; }
else
  {
    print STDERR "$Mynamebase: can't find rsh (remote shell) command.\n";
    exit 1;
  }

$Hostname = `/bin/hostname`; chop $Hostname;

#  My usage
#
#        1         2         3         4         5         6         7         8
#2345678901234567890123456789012345678901234567890123456789012345678901234567890

$Usage = <<LIT;
$Mynamebase $Myversion: usage:

   $Mynamebase [status] [-l|-R] <file>|<dir> ...
   $Mynamebase checkout [-d <dir>] <line> <module> | -t <module>
   $Mynamebase commit [-n] [-l|-R] [-x|-X] [-b] [-o] [-i]
                        [-f <msgfile> | -m <msg> ]
                          [-all[-<line>...]|-only[+<line>...]] <file>|<dir> ...
   ${Mynamebase}_check <dir> <file> ... 
   $Mynamebase version

     -l  act on the current directory only
     -R  act recursivel on subdirectories (can override ~/.${Mynamebase}rc)
     -n  show, but don't execute, any cvs commit actions
     -x  don't do "[press Return to]> ..." prompts
     -X  do  "[press Return to]> ..." prompts (can override ~/.${Mynamebase}rc)
     -b  batch mode; requires -f or -m and -all or -only
     -q  quiet mode
     -o  show only lines from this tree's line group
     -a  don't use lgroups (i.e., consider all lines one group)
     -i  always inquire about which lines to update (per-file)
     -t  show known cvslines line names for <module>

LIT

$Planfile = "$Mynamebase.plan";


sub usage
{
  print STDERR $Usage;
  exit 1;
}


sub help
{
  print STDERR <<LIT;

$Usage

$Mynamebase is a facility that helps sites using CVS to manage
multiple lines of developement. It assists users to perform the
correct actions to propagate changes between various lines of
development at commit time. For more information, refer to the
cvslines(1) manual page.

LIT
  exit 1;
}

#  Subroutines common to mlutiple cvslines-* modules...
#

#  Slurp a whole file and return the contents.
#
sub slurp
{
  my ($path) = @_;
  my $slashsave;
  my $contents;
  my $m;

  if (! -f $path) { return ""; }

  if (! open(S, "<$path"))
    {
      $m = "can't open \"$path\" to read: $!";
      &log($m); print STDERR "$Mynamebase: $m\n"; exit 1;
    }
  $slashsave = $/; undef $/; $contents = <S>; $/ = $slashsave;
  close S;
  return $contents;
}


sub ident
{
  my ($path) = @_;
  
  if (! open(I, "<$path"))
    {
      print STDERR "$Mynamebase: ident(): Can't open \"<$path\":$!\n";
      return;
    }
  while (<I>)
    {
      if (/\$Id: /)
        { print "  $_";  ; last; }
    }
  close I;
}

sub setspecs
{
  my ($line_name) = @_;
  my $spec;
  my $state;
  my $specrev;

  ($spec, $state) =
     ($CVS_Lines_Spec{$line_name},$CVS_Lines_State{$line_name});
  if (defined($RCS_Tags{$spec}))
     { $specrev = $RCS_Tags{$spec}; } else { $specrev = "none"; }

  return($spec, $state, $specrev);
}


#  Called when we're trying to figure out which line a certain
#  file is on, and > 1 lines match. This can happen (at least)
#  when the head is declared as the line spec for > line.
# 
#  In this case we need to consult something outside of the standard
#  CVS information that declares the line for the tree we're in.
#
#  The protocol will be:
#    1. Refer to the environment variable $CVSLINE, if present.
#    2. Search up the tree from $here, looking for CVS/CVS_line,
#       the contents of which are a line name.
#    3. If neither of the above can be applied, punt.
#
sub this_line_resolve
{
  my $line;
  my $type;

  if (defined($ENV{"CVSLINE"}))
    {
      $line = $ENV{"CVSLINE"};
      $type = "the \"\$CVSLINE\" environment variable";
    }
  else
    {
      my $try = $CVS_Here;

      while (1)
        {
          if (-f "$try/CVS/cvsline")
            {
	      $line = &slurp("$try/CVS/cvsline"); chop $line;
              $type = "the \"$try/CVS/cvsline\" file";
	      last;
            }
          if ($try eq "/")
            {
              #  Oops. didn't find one.
              #
              print STDERR <<LIT;
$Mynamebase: problem:

  Cant resolve the line name for the file

    $here/$file

  Please correct this by setting the \$CVSLINE environment variable,
  or creating a .../CVS/cvsline file at the top of your working tree,
  and try again.

LIT
	      &log("couldn't resolve line name");
              exit 1;
            }
          $try = &dirname($try);
        }
    }
        
  #  We assume %CVS_Lines_Spec is valid at this point; confirm
  #  that what we came up with is a valid line name known to it.
  #
  if (defined($CVS_Lines_Spec{$line})) { return $line; }

  #  Oops. Now we're really confused...
  #
  print STDERR <<LIT;
$Mynamebase: problem:

  The line name "$line" (determined by $type)
  does not name a line known to this module.

  Please correct this and try again.

LIT
  &log("unknown line name (via $type)");
  exit 1;
  
}

#  Perlstuff for parsing RCS repository files
#

#  Some globals used by these routines...
#
$Rcs_Inquote = 0;       # remembers when we're in a '@' quoted string
$Rcs_Eofatal = 1;       # die if we hit the end of the file
$Rcs_File    = "?";     # caller should set this for the error message

sub lead
{ if (defined($Mynamebase)) { return "$Mynamebase: "; } else { return ""; } }


sub rcsline
{
  my $line;
  my $m;

  $line = <RCS>; $len = length($line);

  if ($line eq "")
    {
      if ($Rcs_Eofatal)
        {
	  $m = "unexpected eof on \"$Rcs_File\".";
          &log($m); printf STDERR "%s$m\n", &lead();
	  exit 1;
        }
      else
        { return undef; }
    }  
  chomp $line;
  return $line;
}
  
$Rcstok_Buf = "";
$Rcstok_pushed = undef;

#  Return the next token from the RCS repository file.
#  Caller should open the file on descriptor RCS.
#  (Caller should also empty $Rcstok_Buf!)

sub rcstok
{
  my $rcsstr;
  my $m;
  my $strpart;

  if (defined($Rcstok_pushed))
    {
      my $ret = $Rcstok_pushed;
      $Rcstok_pushed = undef;
      return $ret;
    }

  $Rcstok_Buf =~ s/^\s+//;

  if ($Rcstok_Buf eq "")
    {
      while (1)
        {
          $Rcstok_Buf = &rcsline();
          if (! defined ($Rcstok_Buf)) { return undef; }
          if ($Rcstok_Buf ne "") { last; }
        }
      $Rcstok_Buf =~ s/^\s+//;
    }

  #  num
  #
  if ($Rcstok_Buf =~ /^([0-9][0-9.]+)(.*)$/)
    { $Rcstok_Buf = $2; return $1; }

  #  : ; id
  #
  #  Note: the character class for "idchar" assumes all characters
  #  are printable ascii! May break with binary RCS files. TBD
  #
  if ($Rcstok_Buf =~ /^(:|;|[a-zA-Z][^ \t\n$,\.:;@]+)(.*)$/)
    { $Rcstok_Buf = $2; return $1; }

  #  string
  #
  if ($Rcstok_Buf =~ /^@(.*)$/)
    {
      $Rcstok_Buf = $1;
      $rcsstr = "";
      while (1)
        {
          if ($Rcstok_Buf eq "")
            {
              $rcsstr .= "\n";
              $Rcstok_Buf = &rcsline();
              if (! defined ($Rcstok_Buf)) { return undef; }
            }
          if ($Rcstok_Buf =~ /^([^@]+)(.*)$/)
            {
              $rcsstr .= $1;
              $Rcstok_Buf = $2;
              next;
            }
          if ($Rcstok_Buf =~ /^@@(.*)$/)
            {
              $rcsstr .= "@";
              $Rcstok_Buf = $1;
              next;
            }
          if ($Rcstok_Buf =~ /^@(.*)$/)
            {
              $Rcstok_Buf = $1;
              return $rcsstr;
            }
        }
    }

  $m = "rcstok(): internal error: \$Rcstok_Buf <$Rcstok_Buf>";
  &log($m); printf STDERR "%s$m\n", &lead();
  exit 1;
}


sub dirname
{
  my ($dir) = @_;

  $dir =~ s%^$%.%; $dir = "$dir/";
  if ($dir =~ m%^/[^/]*//*$%) { return "/"; }
  if ($dir =~ m%^.*[^/]//*[^/][^/]*//*$%)
    { $dir =~ s%^(.*[^/])//*[^/][^/]*//*$%$1%; { return $dir; } }
  return ".";
}


sub skip_to_rcstok
{
  my ($this) = @_;
  my $tok;
  while (($tok = &rcstok()) ne $this) { };
}


sub skip_to_deltas
{
  my $tok;

  # Called after we encounter ";" for symbols. We must now skip:
  #
  #   locks      {id : num}*;  {strict  ;}
  #   { comment  {string}; }
  #   { expand   {string}; }
  #   { newphrase }*

  while (1)
    {
      $tok = &rcstok();
      if ($tok =~ /^[0-9]/) { $Rcstok_pushed = $tok; last; }
      while (1)
        {
          $tok = &rcstok();
          if ($tok eq ";") { last; }
        }
    }
}


#
# use cvs log to retrieve log message for a specific revision.
#
sub get_RCS_log {
  my ($file, $rev) = @_;
  my $msg = "";
  my $logstart = 0;

  open (CVSLOG, "cvs log -r$rev $file |");

  # parse output.
  while (<CVSLOG>) {
    my $line = $_;
    # search revision
    if ($line =~ /revision\ ([1-9]*\.[1-9]*)/) {
      $logstart = 1;
    } elsif (($line =~ /^date/) ||
	     ($line =~ /^branch/) ||
	     ($line =~ /^\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/)) {
      # just ignore it. revision data not belonging to log.
    } elsif ($logstart) {
      # part of the log message.
      $msg = "$msg$line";
    }
  }

  close (CVSLOG);
  return $msg;
}

sub test_getrcslog
{
  $Testing_getrcslog = 1;
  printf "The log message is: <%s>\n", &get_RCS_log($ARGV[1], $ARGV[2]);
  exit 1;
}


sub test_rcstoks
{
  my $tok;

  open(RCS, "<$ARGV[1]") || die;
  $Rcstok_Buf = "";

  $Rcs_Eofatal = 0;
  while (defined($tok = &rcstok))
    { print "<$tok>\n"; }

  exit 1;
}

#  initialize RCS_Tags, RCS_Revs, (etc.) from an RCS ,v file.
#
sub set_RCS_revs
{
  my ($rep, $file, $do_texts, $repos_check) = @_;
  my $repfile;
  my $tag;
  my $rev;
  my $tok;
  my ($d_havedelta, $d_branches, $d_next, $d_rev);
  my $rcspath;
  my $msg;

  undef $RCS_Valid;
  undef %RCS_Tags;
  undef %RCS_Branchtags;
  undef %RCS_Revs;
  undef $RCS_Branch;
  undef %RCS_Texts;

  open (CVSLOG, "cvs log $file |");

  # needed for processing input stream.
  my $insymbols = 0;
  my $d_havedelta = 0;
  my $d_branches = "";
  my $d_next = "";

  while (<CVSLOG>) {
    my $line = $_;

    if ($line =~ /^head\:\ (.*)/) {
      $RCS_Tags{"head"} = $1;
    } elsif ($line =~ /^branch\:\ (.*)/) {
      $RCS_Branch = $1;
    } elsif ($line =~ /^symbolic\ names\:/) {
      $insymbols = 1;
    } elsif ($line =~ /^keyword\ substitution\:/) {
      # symbol table ends with next part (keyword sub).
      $insymbols = 0;
    } elsif ($insymbols && ($line =~ /([\s]*)([\d,\w,\_]*)\:\ (.*)/)) {
      # tag = rev
      my $tag = $2;
      my $rev = $3;
      $RCS_Tags{$tag} = $rev;
      # check if it is a branch tag
      if ($rev =~ /\.0\.[0-9]+$/) {
	$RCS_Branchtags{$rev} = 1;
      }

    } elsif ($line =~ /^revision\ (.*)/) {
      # check if we have a previously saved delta to add.
      my $tag = $1;
      if ($d_havedelta) {
        $RCS_Revs{$d_rev} = "$d_next:$d_branches";
      }

      # first set the d_next, but only if the branch
      # doesn't change.
      $d_next = "";
      if ($tag =~ /([0-9.]*)\.([0-9]+)/) {
        if ($d_rev =~ /$1.*/) {
          $d_next = $d_rev;
        }
      }

      $d_rev = $tag; $d_havedelta = 1; $d_branches = "";

    } elsif ($d_havedelta && ($line =~ /^branches\:\ \ (.*)/)) {
      $d_branches = $1;

      # remove the ;, we don't need them
      $d_branches =~ s/\;//g;

      # replace all double-blanks with single blanks.
      $d_branches =~ s/\ \ /\ /g;
    } elsif ($d_havedelta && (($line =~ /\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/) ||
			      ($line =~ /\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-/) ||
			      ($line =~ /^date\:/))) {
      # do nothing, these lines are just ignored.
    } elsif (defined ($do_texts) && ($d_havedelta)) {
      # the rest of it (without prefix) is log text which we
      # note in the RCS_Texts array if the do_texts param is defined.
      $RCS_Texts{$d_rev} = 1;
    }
  }

  # check if we have to save a last delta.
  if ($d_havedelta) {
    $RCS_Revs{$d_rev} = "$d_next:$d_branches";
  }

  close (CVSLOG);

  $RCS_Valid = 1;

  return 1;
}

sub rcs_tip
{
  my ($rev) = @_;
  my $next;

  #  Find the tip of the branch...
  #
  while (1)
    {
      if (! defined($RCS_Revs{$rev}))
        { return "???"; }
      ($next) = split(/:/, $RCS_Revs{$rev});
      if ($next eq "") { return $rev; }
      $rev = $next;
    }
}


#  given a "CVS line spec" (revision #, "head", or a tag)
#
sub rev_on_line
{
  my($line) = @_;

  if (defined($RCS_Tags{$line})) { $line = $RCS_Tags{$line}; }
  elsif ($line !~ /^[0-9.]+$/) { return "none"; }
  if ($line =~ /\.0\.([0-9]+)$/)
    {
      # It's a CVS branch revision number... demunge it:
      #
      $line =~ s/\.0(\.[0-9]+)$/$1/;

      #  OK, see whether the branch actually exists:
      #  (We have an assumption here that first rev is always ".1")
      #
      $line = "$line.1";
      if (! defined($RCS_Revs{$line}))
        {
          # Nope, so fall back to the root, which we know to be an
          # existing revision...

          $line =~ s/\.[0-9]+\.[0-9]+$//;
          return $line;
        }

      # Yep, the branch exists; so it *is* a branch; so, we go out to
      # the tip. (Right?)
      #
      return &rcs_tip($line);
    }

  #  OK, do we have an RCS branch or an RCS revision number?  (count
  #  the dots)
  #
  if (($line =~ tr/\././) % 2)
    {
      #  An odd number of dots... it's a revision number
      #
      if (defined($RCS_Revs{$line})) { return $line; }

      return "nonexistent revision: $line ???"; # Or should we assert?
    }
  else
    {
      #  An even number of dots... it's a branch number
      #  (We have an assumption here that first rev is always ".1")
      #
      return &rcs_tip("$line.1");
    }


}


#  Determine CVSROOT from a repository path name.
#
#  Assumes that the CVSROOT dir can be correctly determined from a
#  repository path by finding the first level (from the root) that
#  contains a "CVSROOT" directory
#
sub root_from_rep
{
  my ($rep) = @_;
  my $origrep = $rep;
  my $try;
  my @dirs;
  my $m;

  while (1)
    {
      $try = &dirname($rep);
      push(@dirs, $try);
      $rep = $try;
      if ($rep eq "/") { last; }
    }

  while ($#dirs >= 0)
    {
      $try = pop(@dirs);
      if (-d "$try/CVSROOT") { return $try; }
    }

  $m = "can't determine \$CVSROOT from \"$origrep\"";
  &log($m); printf STDERR "$Mynamebase: $m\n";
  exit 1;
}


#  There's no mutual exclusion on writes to the log file. I've decided
#  that this is OK. I just can't find a nice lightweight mechanism
#  that works for an NFS mounted log file. I considered writing a
#  little TCP based log daemon, but then you get all of the complexity
#  of that, and you have to keep the server running, and... what the
#  hell. With the usage we're seeing here, I haven't yet seen any
#  collsions causing garbled entries, and would be even willing to
#  live with a minimal amount of that in exchange for the
#  simplicitly. The log file is mainly for debugging and history
#  anyway; nothing else depends on it, at this point.
#
#  

$Log_Disabled = 0;

sub log
{
  my ($msg) = @_;
  my $pref;
  my $starsave;

  #  So don't make the entry, see what *I* care!
  #
  if ($Log_Disabled || (! open(L, ">>$LOGFILE")))
    {
      if (! $Log_Disabled)
        {
          $Log_Disabled = 1;
          print STDERR "$Mynamebase: can't log to \"$LOGFILE\": $!; logging disabled\n";
        }          
      return;
    }

  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $mon++;
  $pref = sprintf("%02d%02d%02d %02d%02d%02d %s.%s %s %s",
     $year, $mon, $mday, $hour, $min, $sec, $Hostname, $$, $Username, $Logfrom);

  #  If the message is multiline, preface each line with a leading ' '
  #  
  if ($msg =~ /\n/)
    {
      $starsave = $*; $* = 1;
      $msg =~ s/^/ /g; $msg =~ s/\s*$//g;
      $* = $starsave;
      $msg =~ s/^\s*\n//g; 
      $msg .= "\n";
      print L "$pref\n$msg";
    }
  else
    { print L "$pref $msg\n"; }
  close L;
}


sub noteNbail
{
  my ($msg) = @_;
  print STDERR "$Mynamebase: $msg\n";
  &log($msg);
  exit 1;
}


sub set_Ent
{
  local ($file) = @_;
  my @entry;
  my $dummy;

  @entry = grep(/^\/$file\//, @CVS_Entries);
  if ($#entry != 0)
    { &noteNbail("internal error: didn't find one entry for \"$file\" ($#entry entries found)."); }
  
  ($dummy, $Ent_Name, $Ent_Rev, $Ent_Time, $Ent_Opts, $Ent_Tag)
     = split(/\//, $entry[0]);

  $Ent_Tag =~ s/^T//;
  if ($Ent_Tag eq "") { $Ent_Tag = "head"; }
}

#  Configures a collection of global variables (CVS_*)
#  based on the named direcory (and its CVS/ information)
#
#  Sets up the following globals:
#    @CVS_Lines
#    %CVS_Lines_Spec
#    %CVS_Lines_State
#    %CVS_Lines_Opts
#    %CVS_Lines_Lgroups
#    $CVS_Root
#    $CVS_Repository
#    $CVS_Tag
#    @CVS_Entries
#    $CVS_Here;
#
sub module_config
{
  my ($dir) = shift;
  my ($useconfigprefix) = shift;
  my ($linename, $spec, $state, $opts, $lgroup);
  my $rep;
  my $cvs_entries;
  my $slashsave;
  my $configprefix;

  undef %CVS_Lines_Spec;
  undef %CVS_Lines_State;
  undef %CVS_Lines_Opts;
  undef %CVS_Lines_Lgroups;
  undef @CVS_Lines;
  undef @CVS_Entries;

  if ($useconfigprefix) {
    $configprefix = "$dir/";
  }

  #  set $CVS_Here
  #
  $CVS_Here = $dir;

  #  set $CVS_Root
  #
  if (! open(R, "<$dir/CVS/Root"))
    {
      printf STDERR "%scan't open \"$dir/CVS/Root\": $!\n", &lead();
      return 0;
    }
  $CVS_Root = <R>; chop $CVS_Root; close R;
  if ($CVS_Root =~ /^(:ext:|:pserver:|:server:){0,1}([^:]+):(.+)$/)
    {
      $CVS_Remotehost = $2;
      $CVS_Root = $3;
      if ($CVS_Remotehost =~ /^(.+)@(.+)$/)
        { $Rsh = "$Rshcmd -l $1 2>&1"; $CVS_Remotehost = $2; }
      else
        { $Rsh = "$Rshcmd 2>&1"; }
    }
  else
    { $CVS_Remotehost = ""; } 

  #  set $CVS_Repository
  #
  if (! open(R, "<$dir/CVS/Repository"))
    {
      printf STDERR "%scan't open \"$dir/CVS/Repository\": $!\n", &lead();
      return 0;
    }
  $CVS_Repository = <R>; chop $CVS_Repository; close R;
  $rep = "$CVS_Repository/";
  $CVS_Repository="$CVS_Root/$CVS_Repository";

  #  set $CVS_Tag
  #
  if (! -f "$dir/CVS/Tag")
    { $CVS_Tag = "head"; }
  else
    {
      if (! open(T, "<$dir/CVS/Tag"))
        {
          printf STDERR "%scan't open \"$dir/CVS/Tag\": $!\n", &lead();
          return 0;
        }
      $CVS_Tag = <T>; chop $CVS_Tag; close T;
      $CVS_Tag =~ s/^T//;
      if ($CVS_Tag eq "") { $CVS_Tag = "head"; } # can this ever happen?
    }

  #  set @CVS_Entries
  #
  $slashsave = $/; undef $/;
  if (! open(E, "<$dir/CVS/Entries"))
    {
      printf STDERR "%scan't open \"$dir/CVS/Entries\": $!\n", &lead();
      return 0;
    }

  $cvs_entries = <E>; close E; $/ = $slashsave;
  @CVS_Entries = split(/\n/, $cvs_entries);

  # OK, do the $Mynamebase.config file... it is stored in the module of
  # the rep, added to cvs and has to be checked out be the user.
  #
  if ($rep =~ /([^\/]*)\/(.*)/) {
    $rep = "$2";
    $rep =~ s/[^\/]*\//\.\.\//g;
  }

  $configpath = "$configprefix$rep$Mynamebase.config";
  $Configpath_Disable = "$configprefix$rep$Mynamebase.disable";


  if (! open(L, $configpath)) {
    printf STDERR "%scan't open \"$configpath\": $!\n", &lead;
    return 0;
  }

  while (<L>) {
    if (/^\s*\#|^\s*$/) { 
      next;
    }
    chop;
	
    if (/^~(.+)/) {
      if ($1 eq "ALL") { 
	$Users{"ALL"} = "on"; 
      } else { 
	$Users{$1} = "on"; 
      }
      next;
    }
    elsif (/^!~(.+)/) { $Users{$1} = "off"; next; }

    ($linename, $spec, $state, $opts, $lgroup) = split(/\s+/, $_);
    $CVS_Lines_Spec{$linename} = $spec;
    $CVS_Lines_State{$linename} = $state;
    $CVS_Lines_Opts{$linename} = $opts;
    $CVS_Lines_Lgroups{$linename} = $lgroup;
    $CVS_Lines[$#CVS_Lines + 1] = $linename;
  }
  close L;

  return 1;
}

#
#  $answer = &ask("prompt", "default[/re/]"[, [choice] ...]");
#
#    > "prompt"             A prompt
#    > "default[/re/]"      The default answer [and validation re]
#    > "choice" ...         The valid choices               
#    < $answer              The user's answer
#
#  This is a utility function for interactive prompting. The indicated
#  prompt is printed to the user's tty. The user can press return to
#  select the indicated default, or enter an answer. If the "choice"
#  arguments are supplied, then the user's answer must match one of
#  the alternatives exactly, or the answer is rejected and the user is
#  re-prompoted. Otherwise (if only the default is given) the user's
#  answer will only be validated if the optional "/re/" part of the
#  the "default" argument is given; if no "/re/" part is present, then
#  no validation is done whatsoever.
#
#  Kludge zone: if the global "$Emptydefault" is true, a default value
#  value "[]" will be shown in the prompt generated. Ugly, but, hey,
#  we're all entitled to one once in a while, no?
#

sub ask
{
  my (@askargs) = reverse(@_);
  my $tmpaskargs;
  my $prompt;
  my $default;
  my $validre;
  my $m;
  my $ans;
  my $choices;
  my $n;

  #  In Testmode, we must write newlines, cause cvs commit
  #  talks to stdout in line-buffered mode.
  #
  if ($Testmode) { $n = "\n"; } else { $n = ""; }

  if (! &openTTY()) { die "&openTTY() failed."; }

  if ($#askargs < 1)
    {
      $m = "ask: usage: ask(prompt, default[/re/], [choice] ...";
      &log($m); print TTYO "$m\n";
      exit 1;
    }

  $prompt = pop(@askargs);

  if (($default = pop(@askargs)) =~ "/.*/\$")
    {
      ($validre = $default) =~ s%^.*/(.*)/$%\1%;
      $default =~ s%^(.*)/.*/$%\1%;
    }

  @tmpaskargs = reverse(@askargs);
  @askargs = @tmpaskargs;

  if ($#askargs < 0)
    {
      askit: while (1)
        {
          if ($default eq "" && ! $Emptydefault)
            { printf TTYO "$prompt? $n"; $ans = <TTYI>; chop($ans); }
          else
            { 
              printf TTYO "$prompt [$default]? $n";
              $ans = <TTYI>; chop($ans);
              if ($ans eq "") { $ans = $default; }
            }
          if (defined($validre))
            { if ($ans =~ $validre) { last askit; } }
          else
            { last askit; }
          printf TTYO "what? (answer must match \"/$validre/\")\n";
        }
    }
  else
    {
      $choices = join(" ", @askargs);
      askit: while (1)
        {
          printf TTYO "$prompt ($choices) [$default]? $n";
          $ans = <TTYI>; chop($ans);
          if ($ans eq "") { $ans = $default; }
          $ans =~ tr/A-Z/a-z/;
          if ($choices =~ /^$ans | $ans | $ans$/) { last askit; }
          printf(TTYO "what? (please choose from the \"( )\" menu)\n");
        }
    }
  return $ans;
}


sub openTTY
{
  my $ttyi;
  my $ttyo;

  if (! defined($TTYI))
    {
      if ($Testmode || $Batch)
        { $ttyi = "<&STDIN"; } else { $ttyi = "</dev/tty"; }
      if (! open(TTYI, $ttyi)) { return 0; }
      $TTYI = $ttyi;
    }

  if (! defined($TTYO))
    {
      if ($Testmode || $Batch)
        { $ttyo = ">&STDOUT"; } else { $ttyo = ">/dev/tty"; }
      if (! open(TTYO, $ttyo)) { return 0; }
      select(TTYO); $| = 1; select(STDOUT);
      $TTYO = $ttyo;
    }

  return 1;
}
   

sub wait_return
{ if (! &openTTY()) { die "&openTTY() failed."; } <TTYI>; }


sub checkout
{
  my $linename;
  my $spec;
  my $stats;
  my $opts;
  my $lgroup;

  $Logfrom = "checkout";
  $Listlines = 0;
  $Codir = "";
  while ($#_ >= 0)
    {
      if ($_[0] eq "-t")
        {
  	  if ($#_ < 1) { usage; }
          shift; $Module = $_[0]; shift;
          $Listlines = 1; next;
        }
      if ($_[0] eq "-d")
        {
  	  if ($#_ < 1) { usage; }
          shift; $Codir = "-d $_[0] "; shift; next;
        }
      push(@Args, $_[0]);
      shift;
    }

  if (! $Listlines) {
    if ($#Args != 1) { &usage; }

    $Line = $Args[0];
    $Modulepath = $Args[1];
    ($Module = $Modulepath) =~ s/\/.*//;
  }

  # OK, do the $Mynamebase.config file... it is stored in the module of
  # the rep, added to cvs and has to be checked out be the user.
  # first we have to retrieve the relative path to the module config.
  my $rep = $Modulepath;
  if ($rep =~ /([^\/]*)\/(.*)/) {
    $rep = $2;
    $rep =~ s/[^\/]*\//\.\.\//g;
  }
  $Cvslines_config = "$rep/$Mynamebase.config";

  $configpath = "<$Cvslines_config";

  if (! open(L, $configpath)) {
    printf STDERR "%scan't open \"$configpath\": $!\n", &lead;
    exit 1;
  }

  $Spec = "";
  while (<L>)
    {
      if (/^\s*\#|^\s*$|^~|^!~/) { next; }
      if ($Listlines) { print; next; }
      ($linename, $spec, $state, $opts, $lgroup) = split(/\s+/, $_);
      if ($linename eq $Line) { $Spec = $spec; }
    }
  close L;

  if ($Listlines) { exit 0; }

  if ($Spec eq "") {
    printf STDERR "%sno line name: \"$Line\" known for this module\n", &lead;
    exit 1;
  }

  if ($Spec eq "head") { $rspec = ""; } else { $rspec = "-r $Spec "; }

  $cmd = "cvs checkout ${rspec}${Codir}${Modulepath}";

  printf "$cmd\n";

  &log("$cmd");

  exec "$cmd";

  exit 1; # A stopper, just in case
}


#  This is handy formatting stuff for the display of lines & their
#  revisions. The $W_* variables control field display widths;
#  headings will adjust automatically.
#
$W_Line = 10; $D_Line = '-' x $W_Line;
$W_Spec = 24; $D_Spec = '-' x $W_Spec;
$W_Specrev = 30; $D_Specrev = '-' x $W_Specrev;
$W_Currev = 22; $D_Currev = '-' x $W_Currev;
$Fmt = "%-${W_Line}s %-${W_Spec}s %1s%-${W_Specrev}s %-${W_Currev}s";

if (defined($ENV{"CVSLINES_TESTMODE"}))
  { $Testmode = 1; } else { $Testmode = 0; }

if (-f "$Userhome/.${Mynamebase}rc" && -r "$Userhome/.${Mynamebase}rc")
  { require "$Userhome/.${Mynamebase}rc"; }

#  Our defaults (if they've not been overidden in ~/.cvslinesrc)
#
if (! defined($Noexec))    { $Noexec = 0; }     # don't actually do anything for "commit"
if (! defined($Norecurse)) { $Norecurse = 0; }  # like cvs -l option
if (! defined($Noconfirm)) { $Noconfirm = 0; }  # don't prompt "proceed?" before each commit
if (! defined($Noaskexec)) { $Noaskexec = 0; }  # don't prompt "[press Return to]"
if (! defined($Logmsg))    { $Logmsg = "ask"; } # let cvs ask for the log message
if (! defined($Batsel))    { $Batsel = ""; }    # batch line select mode
if (! defined($Verbose))   { $Verbose = 1; }    # chattiness
if (! defined($Batch))     { $Batch = 0; }      # interactive
if (! defined($Showall))   { $Showall = 1; }    # show other lgroups
if (! defined($Stickyans)) { $Stickyans = 1; }  # first answer for any line used thereafter
if (! defined($Nolgroups)) { $Nolgroups = 0; }  # use lines groups if defined

#  $Mynamebase and $Mynamebase_check have different usages, so
#  we break 'em up before argument processing.
#
if ($Mynameext eq "check") { goto start_check; }

# option switch variables get defaults here...

#  What command is desired?
#  
   if ($ARGV[0] eq "status")   { $Cmd = "status"; shift; }
elsif ($ARGV[0] eq "checkout") { $Cmd = "checkout"; shift; }
elsif ($ARGV[0] eq "co")       { $Cmd = "checkout"; shift; }
elsif ($ARGV[0] eq "commit")   { $Cmd = "commit"; shift; }
elsif ($ARGV[0] eq "ci")       { $Cmd = "commit"; shift; }
elsif ($ARGV[0] eq "version")  { $Cmd = "version"; shift; }
elsif ($ARGV[0] eq "-rcstoks") { &test_rcstoks(); }
elsif ($ARGV[0] eq "-rcslog")  { &test_getrcslog(); }

if ($Cmd eq "checkout") { &checkout(@ARGV); }

# Check for options that apply to commit only
sub commitonly { if ($Cmd ne "commit") { &usage; } }

while ($#ARGV >= 0)
  {
    if ($ARGV[0] eq "-n") { &commitonly; $Noexec = 1; shift; next; }
    if ($ARGV[0] eq "-l") { $Norecurse = 1; shift; next; }
    if ($ARGV[0] eq "-R") { $Norecurse = 0; shift; next; }
    if ($ARGV[0] eq "-x") { &commitonly; $Noaskexec = 1; shift; next; }
    if ($ARGV[0] eq "-X") { &commitonly; $Noaskexec = 0; shift; next; }
    if ($ARGV[0] eq "-b") { &commitonly; $Batch = 1; shift; next; }
    if ($ARGV[0] eq "-q") { &commitonly; $Verbose = 0; shift; next; }
    if ($ARGV[0] eq "-o") { $Showall = 0; shift; next; }
    if ($ARGV[0] eq "-i") { &commitonly; $Stickyans = 0; shift; next; }
    if ($ARGV[0] eq "-a") { $Nolgroups = 1; shift; next; }
    if ($ARGV[0] =~ /^-all\b/)  { &commitonly; $Batsel = $ARGV[0]; shift; next; }
    if ($ARGV[0] =~ /^-only\b/) { &commitonly; $Batsel = $ARGV[0]; shift; next; }
    if ($ARGV[0] eq "-m")
      {
        &commitonly; if ($#ARGV < 1) { usage; }
        shift; $Logmsg = "msg:$ARGV[0]"; shift; next;
      }
    if ($ARGV[0] eq "-f")
      {
	&commitonly; if ($#ARGV < 1) { usage; }
        shift; $Logmsg = "file:$ARGV[0]"; shift; next;
      }
    if ($ARGV[0] eq "-help") { &help; }
    if ($ARGV[0] =~ /^-/)    { &usage; }

    push(@Paths, $ARGV[0]);
    shift;
  }

if ($Batch)
  {
    $ENV{"CVSLINES_BATCH"} = 1;
    $Noaskexec = 1;
    $Noconfirm = 1;
    if ($Batsel eq "")
      {
        print STDERR "$Mynamebase: batch mode must use either -all or -only.\n";
        exit 1;
      }   
    if ($Logmsg eq "ask")
      {
        print STDERR "$Mynamebase: batch mode must use either -f or -m.\n";
        exit 1;
      }   
  }

if ($Stickyans)
  { $Stickyans = "$Userhome/.$Mynamebase.ans"; } else { $Stickyans = ""; }

if ($Cmd eq "commit")
  {
    #  Stuff cvslines-check needs to know must be passed via the
    #  environment...
    #
    $ENV{"CVSLINES_VERBOSE"}   = $Verbose;
    $ENV{"CVSLINES_NOCONFIRM"} = $Noconfirm;
    $ENV{"CVSLINES_SHOWALL"}   = $Showall;
    $ENV{"CVSLINES_STICKYANS"} = $Stickyans;
    $ENV{"CVSLINES_NOLGROUPS"} = $Nolgroups;
  }

if ($Batsel ne "") { $ENV{"CVSLINES_BATSEL"} = $Batsel; }

#  If we ended up with $Logmsg =~ /^file:/, then verify that we can read
#  the file...
#
if ($Logmsg =~ /^file:(.*)$/)
  {
    my $file = $1;
    my $filedirname;
    my $filebasename;

    if (! -f $file || ! -r $file) 
      {
        print STDERR "$Mynamebase: can't read \"$file\": $!\n";
        exit 1;
      }

    $filedirname = &dirname($file);

    chdir $filedirname || die;
    $filedirname = `/bin/pwd`; chop $filedirname;
    chdir $Here || die;

    ($filebasename = $file) =~ s%^.*/%%;

    $Logmsgopt = " -F $filedirname/$filebasename";
  }
elsif ($Logmsg =~ /^msg:(.*)$/)
  {
    my $msg = $1;
    $msg =~ s/"/\\"/g;
    $Logmsgopt = " -m \"$msg\"";
  }

#  If we're not running the released version, flag the fact.
#
if ($Mydirname ne $RELDIR && (! $Testmode))
  { print STDERR "$Mynamebase: *** running from \"$Mydirname\" ***\n"; }

#  Default is the tree starting at "."
#
if ($#Paths == -1) { push(@Paths, "."); }

if ($Cmd eq "commit") { goto start_commit; }

if ($Cmd eq "version")
  {
    my $versmsg;

    print STDERR "$Mynamebase: version: $Version\n";
    &ident("$Mydirname/cvslines");
    &ident("$Mydirname/cvslines-status");
    &ident("$Mydirname/cvslines-check");
    &ident("$Mydirname/cvslines-commit");
    $* = 1;
    print STDERR "\n$Mynamebase: cvs -v:\n";
    $versmsg = `cvs -v`; $versmsg =~ s/^/  /g; print STDERR $versmsg;
    print STDERR "\n$Mynamebase: rcs -V:\n";
    $versmsg = `rcs -V`; $versmsg =~ s/^/  /g; print STDERR $versmsg;
    exit 0;
  }

#  Break the file up into the $Myname-* chunks in order to forego
#  compiling stuff we don't need, for efficiency...
#

start_status: 1;
####################################################################################################
#
#  status command processing begins here
#

require "$Mydirname/$Mynamebase-status";

start_commit: 1;
####################################################################################################
#
#  commit command processing begins here
#

require "$Mydirname/$Mynamebase-commit";

start_check: 1;
###################################################################################################
#
#  $Mynamebase_check begins here
#

require "$Mydirname/$Mynamebase-check";

