: # -*- perl -*-
eval 'exec perl -w -S $0 ${1+"$@"}' # Let `sh' locate `perl'
    if 0;

# Copyright 1993-2003 Stefan Merten

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# Based on: Id: sample.pl,v 2.1.1.2 1998/02/12 14:52:29 stefan Exp

=head1 NAME

lcvs - Add a global log file and unique tags to cvs and other useful tools

=head1 SYNOPSIS

B<lcvs> [I<cvs-option>...] I<cvs-command> [I<cvs-command-option>...]

=head1 DESCRIPTION

B<lcvs> is a wrapper around B<cvs> providing

=over 4

=item *

automated maintenance of a global log file for a B<cvs> module (i.e. a tree
administrated by B<cvs> registered as a module)

=item *

automated tagging with unique tags after commits

=item *

optional sending of mails on commit containing all the information collected
and nicely formatted

=item *

some additional sub commands missing in B<cvs> (see L<"ADDITIONAL COMMANDS">)

=back

It is used as front end to B<cvs> but also needs special arrangment in the
administrative files (see L<"PREREQUISITES">).

Because B<lcvs> is a wrapper, which changes some commands while passing through
others, the easiest way to use it is to use it in every place B<cvs> would have
been used.

Note: This manual assumes you have some knowledge about B<cvs> and its
concepts.

=head1 OPTIONS

All options are those used by the original B<cvs> command. Normally only
I<cvs-option>s are parsed to find the I<cvs-command> while other options are
not even looked at.

The exception from the rule is the option B<-H> without a I<cvs-command>. This
produces this manual page just as an invalid option does. Use B<--help> to get
help from B<cvs>.

When options are concerned some B<cvs> commands overlayed by B<lcvs> are more
restrictive than the original commands. This is described with the overlayed
command.

A I<cvs-option> of B<-s> generally specifies a variable for expansion in an
administrative file on the server holding the repository. For such variables
the prefix C<LCVS_> is reserved for internal use by B<lcvs>. See L<"LOGINFO
FORWARDING"> for uses of these reserved variables. All these variables may be
also set in the environemt but the values given by options supersede these.

=cut

###############################################################################

require 5.003;

# Switch warning on
$^W = 1;

use strict;
use diagnostics;

use Getopt::Long;
use Carp qw( carp croak confess );

use FindBin;

use File::Path;
use File::Basename;
use File::Find;

use Cwd;

use POSIX qw( :signal_h );
use IO::Socket;
use Net::hostent;
use Sys::Hostname;
use Errno qw( EADDRINUSE EBADF );

{
  local %ENV = ( POSIXLY_CORRECT => 1 );
  Getopt::Long::config("default", "bundling");
}

###############################################################################
###############################################################################
# Constants

# Option letters for <cvs-option> with descriptions for `GetOptions'()
my %OptCvs = ("=s" => [ qw( b T d e ) ],
	      "=i" => [ qw( z ) ],
	      "=s@" => [ qw( s ) ],
	      "" => [ qw( f H l n q Q r t v w x
                          help help-options help-commands help-synonyms ) ]);

# Option letters for <commit-option>
my %OptCommit = ("=s" => [ qw( r F m ) ],
		 "" => [ qw( l n f R ) ]);

# Option letters for <import-option>
my %OptImport = ("=s" => [ qw( m b k W ) ],
		 "=s@" => [ qw( I ) ],
		 "" => [ qw( d ) ]);

# Option letters for <add-option>
my %OptAdd = ("=s" => [ qw( m k ) ]);

# Option letters for <Changed-option>
my %OptChgd = ("=s" => [ qw( F ) ],
	       "" => [ qw( l ) ],
	       "" => [ qw( t ) ]);

# Option letters for <Ls-option>
my %OptLs = ("" => [ qw( f l ) ]);

# Option letters for <Log-option>
my %OptLog = ("" => [ qw( a d f v B D M T ) ]);

# Option letters for <Undo-option>
my %OptUndo = ("" => [ qw( f p r ) ]);

# Option letters for <Join-option>
my %OptJoin = ("" => [ qw( DUMMY ) ]);
# `DUMMY' is actually a dummy against a warning from `GetOptions'()...

# Option letters for <Increment-option>
my %OptInc = ("=s" => [ qw( F m ) ],
	      "" => [ qw( t ) ]);

# Help strings for the various sub commands (filled below)
my %HelpSs;

# Name of the CVSROOT environment variable
my $NmEnvCvsRoot = "CVSROOT";

# Default methods for CVSROOT
my $DfltMtdNoHst = "local";
my $DfltMtdHst = "ext";
my $NmMtdLoc = "local";
# Remote methods include: "ext", "server", "pserver", "gserver", "kserver",
# "fork"

# Names of the log files
my $NmFLog = "global.log";
my $NmFTag = "tag.log";
my $NmFJoin = "tag.join";
my $NmFLogIn = "log";

# Name of the file containing the root directory, the per-directory tag, and
# the repository
my $NmFCvsRoot = "Root";
my $NmFCvsTag = "Tag";
my $NmFCvsRepos = "Repository";

# Extension for undoing modifications
my $NmUndoExt = ".redo";

# Name of the directory containing CVS files
my $NmDCvs = "CVS";

# Name of the CVSROOT directory
my $NmDCvsRoot = "CVSROOT";

# Name of the modules file
my $NmFCvsModules = "$NmDCvsRoot/modules";

# Name of the trunk
my $NmTrunk = "TRUNK";

# Default symbolic version number if none is given for major or minor
my $DfltVerNum = 1;

# Delimiter for branches and version numbers in symbolic names
my $DlmBra = "-";
my $DlmVers = "_";

# Delimiter for the start and the middle of log files
my $DlmLen = 38;
my $DlmLogBeg = "*" x $DlmLen;
my $DlmLogMed = "-" x $DlmLen;

# The main trunk returning major number
my $ReTrunk = '(\d+)';

# A revision on the main trunk returning major and minor number
my $ReRevTrunk = $ReTrunk . '\.(\d+)';

# A revision denoting a leaf returning the complete revision
my $ReRevLeaf = '(\d+\.\d+(?:\.\d+\.\d+)*)';

# A revision denoting a branch returning the complete revision
my $ReRevBranch = '(\d+(?:\.\d+\.\d+)*)';

# A valid branch name returning name
my $ReBranch = '([a-zA-Z]\w*)';

# A branch from a CVS `Tag' file returning the name
my $ReCvsTag = 'T' . $ReBranch;

# A regular expression matching a symbolic name and returning the prefix, the
# branch (may be undefined), the major, and the minor version number
my $ReTag = '^(\w+?)(?:' . "\Q$DlmBra" . $ReBranch . ')?' . "\Q$DlmVers" .
    '(\d+)' . "\Q$DlmVers" . '(\d+)$'; # '

# A log message starts with this RE
my $ReCvsMsgLogMsg = '^Log Message:';

# Lines matching these REs mark up overlaps
my $ReOvrBeg1 = '^<{7}';
my $ReOvrBeg2 = '^={7}';
my $ReOvrEnd = '^>{7}';

# A mailer understanding `-s <subject> <addr>...' like `mail'
my $CmdMail = "mail";

# The executable
my $CmdCvs = "cvs";

# A normal `rsh'
my $CmdRsh = "rsh";

# A regex matching any `ssh' call
my $ReCmdSsh = 'ssh';

# The default port used to receive `loginfo' information
my $DfltPort = 20594;

# Name of the local host
my $HstLoc = "localhost";

# Unique prefix used for all `lcvs' variables. These are filtered from input
# options and added to output options. In addition they are put to the
# environment and read from there.
my $NmVarPfx = "LCVS_";

# Names for the variables used to tell the client the port and host to connect
# to
my $NmVarPort = $NmVarPfx . "PORT";
my $NmVarHost = $NmVarPfx . "HOST";

# Equivalent to `CVS_RSH'
my $NmVarRsh = $NmVarPfx . "RSH";

###############################################################################
###############################################################################
# Variables

# If this is set, verbose output is allowed
my $verb = 1;

# If this is set only help is asked for
my $help = 0;

# If this is set `-H' has been specified
my $help4Me = 0;

# If this is set disk is not changed
my $dont = 0;

# Send `loginfo' information to this port and host.
my $cltPort = $ENV{$NmVarPort} || $DfltPort;
my $cltHost = $ENV{$NmVarHost} || undef;

# Command to contact remote server with (similar to `CVS_RSH')
my $cltRsh = $ENV{$NmVarRsh} || undef;

# The directory to use for temporary stuff
my $tmpD = $ENV{"TMPDIR"} || $ENV{"TMP"} || $ENV{"TEMP"} || "/tmp";

# The root directory as specific as possible, the host hosting the directory,
# the user accessing it and the access method
my( $cvsRootD, $cvsRootHst, $cvsRootUsr, $cvsRootMtd );

# The working directory for commit runs
my $commitWorkD;

# Are we in an internal call currently?
my $isInt = 0;

# The module names associated with the directories in the repository
my %modNm2ModD;

# The global options
my @cvsOpts;

# Gathered information from the server by `loginfo'
my %server = ( logs => [ ], # Log lines from all sub-directories
	       msg => [ ], # Log message lines
	       date => undef, # First value of `-d'
	       user => undef, # First value of `-u'
	       addrs => [ ], # All values of `-m'
	     );

###############################################################################
###############################################################################
# Unspecialized functions

# Outputs the given strings `@lns' as error message. Returns 0.
sub errO(@) {
  my( @lns ) = @_;

  my $lns;
  foreach $lns ( @lns ) {
    my $ln;
    foreach $ln ( split(/\n/, $lns) )
      { warn("$FindBin::Script: $ln\n"); }
  }
  return 0;
}

##############################################################################

# Outputs the given strings `@lns' as verbose text. Returns 0.
sub vrbO(@) {
  my( @lns ) = @_;

  if($verb) {
    my $ln;
    foreach $ln ( @lns )
      { errO($ln); }
  }
  return 0;
}

##############################################################################

# Outputs error messages `@msg' and exits with code `$code'.
sub errEx($@) {
  my( $code, @msgs ) = @_;

  errO(@msgs);
  exit($code);
}

##############################################################################

# Prepends the path `$relP' relative to the one this script is started in to
# environment variable $PATH if this directory exists. Returns resulting path
# on success.
sub addMyP2P(;$ ) {
  my( $relP ) = @_;

  $relP = ""
      unless defined($relP);
  my $dstP = $FindBin::RealBin;
  $dstP .= "/$relP"
      if $relP;
  return ""
      unless -d $dstP;
  $ENV{"PATH"} = $dstP . ":" . $ENV{"PATH"};
  return $dstP;
}

##############################################################################
##############################################################################
# Common subs

# An external call. These set up a server listening on a port for `loginfo'
# information.
my $ExecCvsExt = 0;

# An internal call disabling processing of administrative calls
my $ExecCvsInt = 1;

# The lines output by the command are chomped and returned as an array. Output
# to the user is suppressed.
my $ExecCvsPip = 2;

# Command is executed using `exec()'
my $ExecCvsExe = 3;

# An internal call disabling processing of administrative calls though
# `loginfo' is called nonetheless
my $ExecCvsInf = 4;

# Executes a CVS command with arguments `@cvsOpts' and `@args'. Returns return
# value. `$tp' gives the type of execution wanted. It must be one of the
# `$ExecCvs'-constants.
sub execCvs($@) {
  my( $tp, @args ) = @_;

  my $int = $tp != $ExecCvsExt && $tp != $ExecCvsExe;

  my $inCmt = defined($commitWorkD);
  my $topInt = $inCmt && $int && !$isInt;
  $isInt = 1
      if $topInt;

  my( $r, @r );
  my @cmdArgs = ( $CmdCvs, @cvsOpts, @args );
  if($tp == $ExecCvsExe) {
    vrbOExe(@cmdArgs);
    exec(@cmdArgs);
  }
  elsif($tp == $ExecCvsPip) {
    vrbOExe(@cmdArgs);

    my $pid = open(OUT, "-|");
    if(defined($pid)) {
      unless($pid) {
	open(STDERR, ">&STDOUT");
	exec(@cmdArgs);
      }
      else {
	@r = <OUT>;
	close(OUT);
	chomp(@r);
      }
    }
  }
  elsif($tp == $ExecCvsInt) {
    vrbOExe(@cmdArgs);
    $r = system(@cmdArgs);
  }
  else # $tp == $ExecCvsExt || $tp == $ExecCvsInf
    { $r = execRcv(@cmdArgs); }

  $isInt = 0
      if $topInt;
  return defined($r) ? $r : @r;
}

##############################################################################

# Verbosely announces execution of `@cmd'.
sub vrbOExe(@) {
  my( @cmd ) = @_;

  vrbO(join(" ", "Executing", map{ /[\s;&()|^<>]/ ? "'$_'" : $_ }(@cmd)));
}

##############################################################################

# Reads file `$fNm' and returns line `$lnN' (zero-based) if given or all lines.
# All returned lines are chomped. If `$fNm' can't be read undef or an empty
# array is returned. If `$lnN' doesn't exist, an empty string is returned.
sub f2Ln($;$ ) {
  my( $fNm, $lnN ) = @_;

  return defined($lnN) ? undef : ( )
      unless open(F, $fNm);
  my @r = <F>;
  chomp(@r);
  close(F);

  return @r
      unless defined($lnN);
  return $lnN < @r ? $r[$lnN] : "";
}

##############################################################################

# Writes `@lns' to file `$fNm' adding line feeds. Returns undef on failure.
sub ln2F($@) {
  my( $fNm, @lns ) = @_;

  return undef
      unless open(F, ">" . $fNm);
  print(F map{ "$_\n" }(@lns));
  close(F);
  return 1;
}

##############################################################################

# Adds `@lns' to file `$fNm' adding line feeds. Returns undef on failure.
sub ln4F($@) {
  my( $fNm, @lns ) = @_;

  return ln2F(">" . $fNm, @lns);
}

##############################################################################

# Adds `@lns' to the global module file and commits it with `$msg'. Needs
# execution of `prepWorkD'().
sub ln4FCvsMod($@) {
  my( $msg, @lns ) = @_;

  my $owd = cwd();
  chdir($commitWorkD);
  execCvs($ExecCvsInt, "checkout", $NmFCvsModules);
  ln4F("$NmFCvsModules", @lns);
  execCvs($ExecCvsInf, "commit", "-m", $msg, $NmFCvsModules);
  execCvsRel(dirname($NmFCvsModules));
  chdir($owd);
}

##############################################################################

# Sets `%modNm2ModD '.
sub prepModNm2ModD() {
  # Prepare a file containing all modules
  my @modLns = execCvs($ExecCvsPip, "checkout", "-s");
  my @allMods;
  foreach ( @modLns ) {
    my( $nm, $state, $dir, @fs ) = split();
    next
	if $dir eq $NmDCvsRoot;
    push(@allMods, "$nm $dir");
  }
  %modNm2ModD = map{ split() }(@allMods);
}

##############################################################################

# Prepares a commit by setting up a temporary working directory.
sub prepWorkD() {
  # Set up working directory
  $commitWorkD = "$tmpD/lcvs.$$";
  errEx(1, "Can't create temporary directory `$commitWorkD'")
      unless grep{ $commitWorkD eq $_ }(mkpath($commitWorkD));
}

##############################################################################

# Returns the name of the most inner module containing `$reposD'. Returns
# relative directory to the top level directory as well. If no module is found
# returns empty array. Needs execution of `prepModNm2ModD'().
sub reposD2ModNm($ ) {
  my( $reposD ) = @_;

  my %modD2ModNm = reverse(%modNm2ModD);
  $reposD =~ s~^\Q$cvsRootD\E/*~~;
  my $topRelD = ".";
  while($reposD ne ".") {
    return ( $modD2ModNm{$reposD}, $topRelD )
	if exists($modD2ModNm{$reposD});
    $topRelD .= "/..";
    $reposD = dirname($reposD);
  }
  return ( );
}

##############################################################################

# Parses all options given via `%descr', returns a reference to a hash
# associating the option name with the value, and an array containing the
# options as strings. `@ARGV' is modified so the first non-option is the first
# entry. Returns empty array on error.
sub prsOpts(%) {
  my( %descr ) = @_;

  my %opts;
  my %args;

  # Build arguments for `Getopt::Long::GetOptions()'
  my( $dscr, $opts );
  while(( $dscr, $opts ) = each(%descr)) {
    my $i;
    foreach $i ( @$opts ) {
      if($dscr =~ /\@/) {
	$opts{$i} = [ ];
	$args{"$i$dscr"} = \@{$opts{$i}};
      }
      else {
	$opts{$i} = undef;
	$args{"$i$dscr"} = \$opts{$i};
      }
    }
  }
  return ( )
      unless Getopt::Long::GetOptions(%args);

  # Create options from the result
  my @r;
  while(( $dscr, $opts ) = each(%descr)) {
    my $opt;
    foreach $opt ( @$opts ) {
      my $dsh = length($opt) > 1 ? "--" : "-";
      if($dscr =~ /\@/) {
	my @vals = @{$opts{$opt}};
	my $val;
	foreach $val ( @vals )
	  { push(@r, "$dsh$opt", $val); }
      }
      elsif($dscr =~ /\=/) {
	push(@r, "$dsh$opt", $opts{$opt})
	    if defined($opts{$opt});
      }
      else {
	push(@r, "$dsh$opt")
	    if defined($opts{$opt});
      }
    }
  }
  return( \%opts, @r );
}

##############################################################################

# Executes `cvs release' for directory `$d'.
sub execCvsRel($ ) {
  my( $d ) = @_;

  open(SAVEIN, "<&STDIN");
  my $nmFYes = "$commitWorkD/yes";
  ln2F($nmFYes, "y");
  open(STDIN, $nmFYes);
  execCvs($ExecCvsInt, "release", "-d", $d);
  close(STDIN);
  open(STDIN, "<&SAVEIN");
  close(SAVEIN);
  print(STDERR "\n");
}

##############################################################################

# Creates a report by command `@$cmd' and matches each keys(`%re2Subs') to
# every line. On each match the corresponding values('%re2Subs') is executed as
# a sub and the result is pushed.
sub scanO($%) {
  my( $cmd, %re2Subs ) = @_;

  my @r;
  foreach ( execCvs($ExecCvsPip, @$cmd) ) {
    my( $re, $ex );
    while(( $re, $ex ) = each(%re2Subs)) {
      push(@r, &$ex())
	  if /$re/;
    }
  }
  return @r;
}

##############################################################################

# If there is something to log, creates a new log file using tag `$tag' and
# commit options `@cmtOpts'. Also sends mail if required.
sub log2FLog($@) {
  my( $tag, @cmtOpts ) = @_;

  return
      unless -r($NmFLog);
  return
      unless @{$server{logs}} || @{$server{msg}};

  unless($server{date}) {
    $server{date} = `date`;
    chomp($server{date});
  }
  $server{user} = getpwuid($>)
      unless $server{user};

  my @log = ( "Date: " . $server{date},
	      "Author: " . $server{user} );
  push(@log, "Tag: $tag")
      if $tag;
  push(@log, @{$server{logs}}, @{$server{msg}});
  unless($dont) {
    vrbO("Updating log file `$NmFLog'");
    # $$$ The permissions could be set more intelligent
    chmod(0666, $NmFLog);
    ln2F($NmFLog, $DlmLogBeg, @log, f2Ln($NmFLog));

  }
  execCvs($ExecCvsInf, "-r", "commit", @cmtOpts, "-n", $NmFLog);

  if(!$dont && @{$server{addrs}}) {
    vrbO("Sending mail to `@{$server{addrs}}'");
    errO("Can not send mail to @{$server{addrs}}")
	unless open(MAIL, "| $CmdMail -s 'Repository change by $server{user}' @{$server{addrs}}");
    print(MAIL map{ "$_\n" }(@log));
    errO("Problems sending mail to @{$server{addrs}}")
	unless close(MAIL);
  }
}

##############################################################################

my $warned1_5;

# Executes stuff needed for a administrative call to `loginfo'. This sub
# creates a nice message from all the lines `@lns' generated by all the
# `loginfo' calls. The result is stored in global variable `%server'.
sub doLoginfo(@) {
  my( @lns ) = @_;

  chomp(@lns);

  my $arg = shift(@lns);
  my( $dt, $usr, @addrs );
  if($arg =~ /^\d+$/) {
    # `loginfo' printing scheme starting with V1.6
    local( @ARGV ) = splice(@lns, 0, $arg);

    if(Getopt::Long::GetOptions("d=s" => \$dt, "u=s" => \$usr, "m=s@" => \@addrs)) {
      unless(@ARGV) {
	errO("Warning: Missing `%s' argument in `loginfo' on server - results may be invalid");
	push(@ARGV, "");
      }
      elsif(@ARGV > 1)
	{ errO("Warning: Too many arguments in `loginfo' on server - using last argument"); }
    }
    else
      { errO("Warning: Unsupported or invalid option in `loginfo' on server"); }
    $arg = $ARGV[-1];
  }
  else {
    errO("Warning: Deprecated calling scheme used in `loginfo' on server - switching to compatibility mode")
	unless $warned1_5;
    $warned1_5 = 1;
  }

  my( $modD, @modFs ) = split(' ', $arg);
  return 0
      if $modD eq $NmDCvsRoot || $isInt;
  $server{date} = $dt
      if !$server{date} && $dt;
  $server{user} = $usr
      if !$server{user} && $usr;
  foreach my $addr ( @addrs ) {
    push(@{$server{addrs}}, $addr)
	unless grep{ $addr eq $_ }(@{$server{addrs}});
  }

  my $msg;
  if(@modFs && $modFs[0] eq "-") {
    # If called by add or import
    shift(@modFs);
    $msg = join(" ", @modFs);
    @modFs = ( );
  }

  my @hdr;
  while(@lns && $lns[0] !~ /$ReCvsMsgLogMsg/)
    { push(@hdr, shift(@lns)); }
  push(@{$server{logs}}, "", $DlmLogMed, @hdr);
  until($lns[$#lns])
    { pop(@lns); }
  if(@{$server{msg}} && !@modFs) {
    $lns[0] = "";
    push(@{$server{msg}}, @lns);
  }
  else
    { $server{msg} = [ "", $DlmLogMed, @lns ]; }
  return 0;
}

##############################################################################

# Called by administrative file `loginfo' after commit for modified files
# `@modFs' in relative directory `$modD' - if configured this way.
sub loginfo() {
  errO("WARNING: Emulating deprecated call scheme using fixed port on local host",
       "WARNING: PLEASE change `\$CVSROOT/CVSROOT/loginfo'");
  IO::Socket::INET->new("$HstLoc:$DfltPort")->print(join("\n", scalar(@ARGV), @ARGV, ""), <STDIN>);
  return 0;
}

##############################################################################
##############################################################################

=head1 OVERLAYED COMMANDS

The following commands are overlayed by B<lcvs>. Some of them restrict the
possible options, and some of them use the parameters in special ways.

=head2 commit

The B<commit> command is central to all functions of B<lcvs>.

The following restrictions or modifications to the original command apply.

=over 4

=cut

sub sub_commit() {
  # Consider options and arguments
  my( $opts, @cmtOpts ) = prsOpts(%OptCommit);
  errEx(1, "Unknown <cvs-commit-option>")
      unless $opts;

=item *

Options B<-F> and B<-m>

One of these options must be present, so all files get the same log message.

If both options are missing, B<-F> F<log> is the default if F<log> is present.
In addition F<log> is removed after a successful B<commit>.

=cut

  my $rmLog;
  unless(defined($opts->{"m"}) || defined($opts->{"F"})) {
    if(-r($NmFLogIn)) {
      $opts->{"F"} = $NmFLogIn;
      push(@cmtOpts, "-F", $NmFLogIn);
      $rmLog = $NmFLogIn;
    }
    else
      { errEx(1, "Missing `-F' or `-m' option to commit"); }
  }

=item *

Option B<-l>

This option is not allowed, since the whole tree has to be checked in at once.

=cut

  errEx(1, "No `-l' option allowed for commit")
      if defined($opts->{"l"});

=item *

Option B<-r>

Arguments to this option need to identify a branch or may refer to the trunk.

=cut

  my $revBra = defined($opts->{"r"}) && $opts->{"r"};
  $revBra = ""
      if $revBra =~ /^$ReTrunk|$ReRevTrunk$/;
  errEx(1,
	"Arguments to `-r' need to be symbolic branches or refer to the trunk")
      if $revBra && $revBra !~ /^$ReBranch$/;

=item *

Arguments

A commit is permitted only without arguments, so the whole tree is committed.

=cut

  errEx(1, "No argument to commit allowed")
      if @ARGV;

  my $tag = fTag2Tag();
  prepWorkD();
  prepModNm2ModD();

=item *

Place of commit

A commit is permitted only in the top-level directory of a module.

=cut

  my $reposD = f2Ln("$NmDCvs/$NmFCvsRepos", 0);
  my( $modNm, $relD ) = reposD2ModNm($reposD);
  errEx(1, "Commit only in top level allowed")
      unless defined($relD) && $relD eq ".";

  # Execute the commit
  my $r = execCvs($ExecCvsExt, "commit", @cmtOpts);

  errEx(0, "No files checked in")
      unless @{$server{logs}};

=back

The following features are added.

=over 4

=item *

Maintains a tag

For each branch of each module a symbolic tag is maintained, which is updated
for each B<commit>.

See L<"TAGS"> for a description of tags.

This feature depends on the presence of the file F<tag.log>.

=cut

  if(defined($tag)) {
    my( $pfx, $maj, $min, $oldBra ) = prsTag($tag);
    my $newBra = f2Ln("$NmDCvs/$NmFCvsTag", 0);
    $newBra = defined($newBra) && $newBra =~ $ReCvsTag ? $1 : "";
    # This is a new branch
    $min = $DfltVerNum - 1
	unless $oldBra eq $newBra;
    $tag = mkTag($pfx, $maj, $min + 1, $newBra);
    tag2FTag($tag, @cmtOpts);
  }

=item *

Maintains a log file

The log file is filled with information gathered during the B<commit> and the
log message.

This feature depends on the presence of the file F<global.log>.

=cut

  log2FLog($tag, @cmtOpts);

=item *

Tags the module on each commit

The new tag is used to tag all files in the tree. This makes it possible to
identify each B<commit> by a unique symbolic name.

=cut

  if(defined($tag)) {
    vrbO("Tagging tree with new tag");
    execCvs($ExecCvsInt, "tag", "-F", $tag);
  }

=item *

If a B<Join> is pending tags the source branch

If this commit is done after a B<Join> operation B<commit> tags the source
branch with the tag found in F<lcvs.join>.

=cut

  my $srcTag = fTag2Tag($NmFJoin);
  if($srcTag) {
    my( $srcTagPfx, $srcTagMaj, $srcTagMin, $srcTagBra ) = prsTag($srcTag);
    my( $trgTagPfx, $trgTagMaj, $trgTagMin, $trgTagBra ) = prsTag($tag);
    $srcTagBra = $srcTagBra || $NmTrunk;
    $trgTagBra = $trgTagBra || $NmTrunk;

    my $markTag = "$srcTagBra-$trgTagBra";
    vrbO("Tagging source branch for pending Join");
    execCvs($ExecCvsInt, "rtag", "-r", $srcTag, "-F", $markTag, $modNm);
    unlink($NmFJoin);
  }

  if($rmLog) {
    vrbO("Removing `$rmLog'");
    unlink($rmLog);
  }
  rmtree($commitWorkD);
  return !!$r;
}

=back

=cut

##############################################################################

=head2 import

The B<import> command is important for some functions of B<lcvs>. Actually it
has three different operation modes.

=over 4

=item *

Creating a new module

The first operation mode is to create a new module. It enters a new tree as a
module, and prepares the tree for using logging (i.e. F<global.log> is added)
and tagging (i.e. F<tag.log> is added). It does not change the current
directory besides the B<lcvs> files named which are removed afterwards. In
particular it does not check out the new module.

This operation mode is chosen, if the working directory is not already
controlled by B<cvs>, by the presence of arguments, and if the named module
does not already exist in the B<cvs> module database. Thus the synopsis is

B<lcvs> B<import> I<options>... I<repository> [I<vendortag>] I<modulename>

=item *

Creating a new vendor branch

The second operation mode is to create a new vendor branch for an existing
module. If necessary the tree is prepared for using logging and tagging. It
does not change the current directory. In particular it does not check out the
new module.

This operation mode is chosen, if the working directory is not already
controlled by B<cvs>, by the presence of arguments, and if the named module
does already exists in the B<cvs> module database. Thus the synopsis is

B<lcvs> B<import> I<options>... I<repository> I<vendortag> I<modulename>

Note: This can be used to import to an existing vendor branch. However, in this
case logging and tagging is not performed. Therefore this use is deprecated and
in a later version of B<lcvs> may be prevented. Instead use the third mode of
operation.

=item *

Importing to an existing vendor branch

The third operation mode is to help the import to an existing vendor branch. It
maintains log information, and tags the module.

This operation mode is chosen, if the working directory is already controlled
by B<cvs> and the absense of any arguments. Thus the synopsis is

B<lcvs> B<import> I<options>...

=back

The following restrictions or modifications to the original command apply.

=over 4

=cut

sub sub_import() {
  # Consider options and arguments
  my( $opts, @impOpts ) = prsOpts(%OptImport);
  errEx(1, "Unknown <cvs-import-option>")
      unless $opts;

  # Check for a given vendor branch making this a vendor import
  my $vndBra;
  my $doVnd = -d($NmDCvs);
  if($doVnd) {
    $vndBra = f2Ln("$NmDCvs/$NmFCvsTag", 0);
    errEx(1, "No vendor branch given in `$NmDCvs/$NmFCvsTag'")
	unless defined($vndBra);
    $vndBra = $vndBra =~ $ReCvsTag ? $1 : "";
    errEx(1, "Invalid vendor branch in `$NmDCvs/$NmFCvsTag'")
	unless $vndBra;
  }

=item *

Option B<-b>

This option sets the import branch to use as usually.

It may be given for creating a new module using a vendor branch but this is not
recommended. In this case the default is C<1.1.1>.

It must be given when importing to a new vendor branch. In this case it must be
a vendor branch revision which is not already used for a vendor branch. The
value must be three dot seperated digits where the first two should be C<1>.
The last one should be a unique odd number for the vendor branches. I.e.
C<1.1.3> would be a valid vendor branch revision for the second vendor branch
while C<1.1.5> is a valid vendor branch revision for the third verndor branch.
Please note that B<lcvs> has no means to check your decision. In particular it
is not able to check whether the branch revision given already has any meaning
in the existing respository.

When importing a new module or to a new vendor branch the most significant
revision number given here is also used as the major version number for the
tag.

When importing to an existing vendor branch this option should not be given
because it is determined automatically.

Each file in a vendor branch needs to have a unique branch revision for this
branch. This may be hard to accomplish for branch revisions not starting with
C<1.1>. If you really need this it is best to start a new major revision on the
trunk by using B<Increment>.

=cut

  my $useBra = "1.1.1";
  if(defined($opts->{"b"})) {
    $useBra = $opts->{"b"};
    errEx(1, "Invalid branch revision `$useBra'")
	unless $useBra =~ /^(\d+\.)+\d+$/;

    my @useBra = split(/\./, $useBra);
    errEx(1, "Even number of revisions numbers given in `$useBra'")
	unless @useBra % 2;
    errEx(1, "Last number in branch revision `$useBra' is even")
	unless $useBra[-1] % 2;
  }
  elsif($doVnd) {
    my @allBras = scanO([ "status" ],
			'^\s*Sticky Tag:\s*' . "\Q$vndBra" .
			'\s*\(branch:\s*' . $ReRevBranch .
			'\)\s*$' => sub { $1 }); # ');
    my %uniqBras = map{ $_ => 0 }(@allBras);
    @allBras = keys(%uniqBras);
    errEx(1, "Can't determine branch revision for branch `$vndBra'")
	unless @allBras;
    errEx(1, "Need unique branch revision for vendor branch `$vndBra'")
	if @allBras > 1;
    $useBra = shift(@allBras);
    push(@impOpts, "-b", $useBra);
  }

=item *

Option B<-m>

A message must be given unless a new module is created on the trunk.

=cut

  errEx(1, "Missing `-m' option to import")
      unless defined($opts->{"m"}) || !$doVnd;

=item *

First argument I<repository>

When creating a new module or vendor branch, it gives the relative path in the
repository, which will act as the top level directory for the module.

When creating a new module this path must not be used by anything else. When
creating a new vendor branch I<repository> must match the respective path in
the B<cvs> module database. This is to prevent importing to an unrelated module
with the same name by accident.

When importing to an existing vendor branch the repository used for the checked
out version is used.

=cut

  my $reposD;
  if($doVnd) {
    errEx(1, "No arguments allowed for importing to existing vendor branch")
	if @ARGV;
    $reposD = f2Ln("$NmDCvs/$NmFCvsRepos", 0);
    $reposD =~ s~^\Q$cvsRootD\E/*~~;
  }
  else {
    $reposD = shift(@ARGV);
    errEx(1, "First argument must give the path in the repository for new module")
	unless $reposD;
  }

=item *

Second argument I<vendortag>

When creating a new module this argument may be given to actually import to a
vendor branch. If this option is not given, the import is done to the trunk.

When creating a new vendor branch this argument must be given and it names the
vendor branch.

When importing to an existing vendor branch the branch used for the checked out
version is used.

=cut

  unless($doVnd) {
    if(@ARGV > 1) {
      $vndBra = shift(@ARGV);
      errEx(1, "Vendor branch may not be empty")
	  unless $vndBra;
      errEx(1, "Missing `-m' option to import")
	  unless defined($opts->{"m"});
    }
    elsif(!defined($opts->{"m"}))
      # Committing new module to the trunk and no message - add empty message
      # so `cvs import' is happy.
      { push(@impOpts, "-m", ""); }
  }

=item *

Third argument I<modulename>

When creating a new module this is interpreted as the name of the new module.
This name must be unique in the repository.

When creating a new vendor branch this must give the module name to import to.
The module name must already exist in the repository and the module must be
located in the place I<repository> says.

When importing to an existing vendor branch the release tag is created in the
usual way using the vendor branch.

=cut

  my $modNm;
  my $relTag;
  if($doVnd) {
    $relTag = fTag2Tag();
    if($relTag) {
      my( $pfx, $maj, $min, $oldBra ) = prsTag($relTag);
      errEx(1,
	    "Branch `$oldBra' of old tag doesn't match vendor branch `$vndBra'")
	  unless $oldBra eq $vndBra;
      $relTag = mkTag($pfx, $maj, $min + 1, $vndBra);
    }
  }
  else {
    errEx(1, "Need module name for creation of new module or vendor branch")
	unless @ARGV;
    $modNm = shift(@ARGV);

    my @useBra = split(/\./, $useBra);
    $relTag = mkTag($modNm, $useBra[0], $DfltVerNum, $vndBra);
  }

  errEx(1, "Too many arguments for creation of new module")
      if @ARGV;

=item *

Place of import

When creating a new module, the current directory becomes the top-level
directory of the new module.

When creating a new vendor branch, the current directory is interpreted as the
top-level directory of the module. Take care that this is the correct
directory. If it is not you may cause big chaos in the repository.

An import to an existing vendor branch is permitted only in the top-level
directory of a module.

=cut

  my $doMod;
  my %oldLogFs;
  prepWorkD();
  prepModNm2ModD();
  if($doVnd) {
    my $relD;
    ( $modNm, $relD ) = reposD2ModNm($reposD);
    errEx(1, "Import only in top level allowed")
	unless defined($relD) && $relD eq ".";
  }
  elsif(exists($modNm2ModD{$modNm})) {
    # Creation of new vendor branch
    errEx(1, "Missing vendor branch for import to a new vendor branch")
	unless $vndBra;
    errEx(1, "Module name `$modNm' already used for directory `" .
	  $modNm2ModD{$modNm} . "' in repository differing from `$reposD'")
	unless $modNm2ModD{$modNm} eq $reposD;
    errEx(1, "Missing `-b' option for creation of a new vendor branch")
	unless $opts->{"b"};
    unless($dont) {
      if(-r($NmFLog))
	{ $oldLogFs{$NmFLog} = undef; }
      else
	{ ln2F($NmFLog, ""); }
      $oldLogFs{$NmFTag} = [ f2Ln($NmFTag) ]
	  if -r($NmFTag);
      ln2F($NmFTag);
    }
  }
  else {
    # Creation of a new module
    $doMod = 1;
    # Create log files
    unless($dont) {
      ln2F($NmFLog, "");
      ln2F($NmFTag);
    }
  }

  # Store tag
  tag2FTag($relTag, "")
      if $relTag;
  # Execute the import
  my $vndUsed = $vndBra || "trunk";
  my $relUsed = $relTag || "import";
  vrbO($doVnd ?
       "Importing module `$modNm' to existing vendor branch `$vndUsed' tagged `$relUsed'" :
       ("Creating new " . ($doMod ? "" : "vendor branch for ") .
	"module `$modNm' in repository `$reposD' on " .
	($vndBra ? "vendor branch `$vndBra'" : "trunk") .
	" tagged `$relUsed'"));
  my $r = execCvs($ExecCvsExt, "import", @impOpts,
		  $reposD, $vndUsed, $relUsed);

=back

In addition all the additional features of B<commit> are done. However, when
importing a new module or to a new vendor branch the log file is not
maintained.

=cut

  if($doVnd) {
    # Store log
    log2FLog($relTag, "-m", $relTag);
    execCvs($ExecCvsInt, "tag", "-F", $relUsed, $NmFLog);

    # Update imported tree
    # $$$ Doesn't work for completly new directories, since `update' doesn't
    # touch them
    execCvs($ExecCvsInt, "update", "-d", "-ko", "-r", $vndBra);

    # Remove superfluous backups
    find(sub { -f && /^\.\#/ && unlink }, ".");
  }
  elsif($doMod) {
    unless($dont) {
      # Remove log files
      unlink($NmFLog, $NmFTag);
      # Add module
      my $progNm = $FindBin::Script;
      ln4FCvsMod("Module `$modNm' added by $progNm",
		 "", "# Module added by $progNm", "$modNm $reposD");
    }
    unless($vndBra) {
      # Move branch to trunk
      my $owd = cwd();
      chdir($commitWorkD);
      execCvs($ExecCvsInt, "checkout", $modNm);

      $useBra =~ /^$ReRevTrunk/;
      my $trnkRev = $&;
      execCvs($ExecCvsInt, "rtag", "-n", "-r", $trnkRev, "-F", $relTag, $modNm);
      execCvs($ExecCvsInt, "admin", "-o:$vndUsed", "-n$vndUsed", "-b", $modNm);
      execCvsRel($modNm);
      chdir($owd);
    }
  }
  else {
    unless($dont) {
      # Remove or restore log files
      foreach my $f ( $NmFLog, $NmFTag ) {
	if(exists($oldLogFs{$f})) {
	  ln2F($f, @{$oldLogFs{$f}})
	      if defined($oldLogFs{$f});
	}
	else
	  { unlink($f); }
      }
    }
  }

  rmtree($commitWorkD);
  return !!$r;
}

##############################################################################

=head2 add

The B<add> command is important only because adding a directory leaves a trace
in a log file.

No restrictions or modifications to the original command apply.

=cut

sub sub_add() {
  # Consider options and arguments
  my( $opts, @addOpts ) = prsOpts(%OptAdd);
  errEx(1, "Unknown <cvs-add-option>")
      unless $opts;

  # Build environment
  prepWorkD();

  # Execute the add
  my $r = execCvs($ExecCvsExt, "add", @addOpts, @ARGV);

  # Add messages to log file
  log2FLog("", "-m", "New directory");

  rmtree($commitWorkD);
  return !!$r;
}

##############################################################################
##############################################################################

=head1 ADDITIONAL COMMANDS

The following commands are not B<cvs> commands but added to B<lcvs>. All such
commands start with a capital letter, so it is easy to distinguish them from
original B<cvs> commands.

=head2 Changed

=head3 Synopsis

B<lcvs> [I<cvs-option>...] B<Changed> [B<-l>] [B<-F> I<log-file>]

=head3 Description

This command gives a quick overview about the change state of the current tree.
Basically it reformats the output of a B<status> focusing on the important
information.

After that it outputs a log file if one is present.

A synonym for this command is B<Chgd>.

The following options are supported.

=over 4

=cut

sub sub_Changed() {
  # Consider options and arguments
  my( $opts, @chgdOpts ) = prsOpts(%OptChgd);
  errEx(1, "Unknown <cvs-Changed-option>")
      unless $opts;
  errEx(1, "No arguments allowed for `Changed'")
      if @ARGV;

  if($help) {
    print("Usage: lcvs Changed [-F logfile]\n" .
	  "\t-F file\tUse file as message file\n");
    return 0;
  }

=item B<-l>

Look in local directory only.

=cut

  my @statCmd = ( "status" );
  push(@statCmd, "-l")
      if defined($opts->{"l"});

=item B<-F> I<log-file>

This option gives the name of the log file to output. It defaults to F<log>. If
the log file is not present this is silently ignored.

=cut

  my $logFNm = defined($opts->{"F"}) ? $opts->{"F"} : $NmFLogIn;

=item B<-t>

Be terse. Do not add the message and output only file names of changed files.

=cut

  my $terse = defined($opts->{"t"});

=back

=cut

  # Execute the `status'
  my @rs = scanO([ @statCmd ],
		 '^cvs (status|server): Examining\s*' => sub
		 { "D $'" },
		 '^File:\s*(\S+)\s*Status:\s*' => sub
		 { ( "F $1", "S $'" ) },
		 '^File:\s*no file (\S+)\s*Status:\s*' => sub
		 { ( "F $1", "S $'" ) },
		 '^\s*(RCS Version|Repository revision):\s*' .
		 $ReRevLeaf . '\s*' => sub
		 { "R $'" },
		 '^\s*(RCS Version|Repository revision):\s*' .
		 'No revision control file\s*' => sub
		 { "R" });

  # Evaluate results
  my( $ex, $r, $dNm, $fNm, $msg ) = ( 0 );
  foreach $r ( @rs ) {
    my( $tp, $val ) = split(/ /, $r, 2);
    if($tp eq "D")
      { $dNm = $val eq "." ? "" : $val . "/"; }
    elsif($tp eq "F")
      { $fNm = $val; }
    elsif($tp eq "S")
      { $msg = $val eq "Up-to-date" ? "" : $val; }
    elsif($tp eq "R") {
      $fNm = $1
	  if defined($val) && $val =~ /\/([^\/]+),v$/;
      if($msg) {
	print($dNm . $fNm);
	print(":\t" . $msg)
	    unless $terse;
	print("\n");
	$ex = 1;
      }
    }
  }
  print(map{ "$_\n" }(f2Ln($logFNm)))
      unless $terse;
  return $ex;
}

##############################################################################

=head2 Increment

=head3 Synopsis

B<lcvs> [I<cvs-option>...] B<Increment> [B<-t>] [B<-F> I<log-file>] [B<-m> I<log-message>]

=head3 Description

This command increments the major number in the symbolic tag in F<tag.log>
and/or the most significant revision number in the RCS files.

This operation is useful to create a new most significant revision number to
base a set of new vendor branches on.

A synonym for this command is B<Inc>.

The following options are supported.

=over 4

=cut

sub sub_Increment() {
  # Consider options and arguments
  my( $opts, @incOpts ) = prsOpts(%OptInc);
  errEx(1, "Unknown <cvs-Increment-option>")
      unless $opts;
  errEx(1, "No arguments allowed for `Increment'")
      if @ARGV;

  if($help) {
    print("Usage: lcvs Increment [-t]\n" .
	  "\t-F <log>\n" .
	  "\t\tUse file <log> as the log message (default: log)\n" .
	  "\t-m <msg>\n" .
	  "\t\tUse message <msg> as the log message\n" .
	  "\t-t\tIncrement the symbolic tag only\n");
    return 0;
  }

=item B<-F> I<log-file>

=item B<-m> I<message>

These options are the same as for B<commit>. Also if none of them present
default to B<-F> F<log> and this is removed.

=cut

  my $rmLog;
  unless(defined($opts->{"m"}) || defined($opts->{"F"})) {
    if(-r($NmFLogIn)) {
      $opts->{"F"} = $NmFLogIn;
      push(@incOpts, "-F", $NmFLogIn);
      $rmLog = $NmFLogIn;
    }
    else
      { errEx(1, "Missing `-F' or `-m' option to `Increment'"); }
  }

=item B<-t>

Normally both the major number in the symbolic tag in F<tag.log> as well as the
most significant revision number in the RCS file are incremented. This option
increments only the major number in the symbolic tag. However, use of this
option is not recommended. Instead the most significant revision number should
be the same as the major version number in the symbolic tag.

Note: The option to increment the most significant revision number only is left
out consciously. This should not be done. If it us ultimately needed for some
reasons you can by using B<lcvs> B<commit> B<-r> I<revision>.

=cut

  my $noRev = defined($opts->{"t"});

  # Build enivronment
  prepModNm2ModD();
  prepWorkD();

=back

The following restrictions apply.

=over 4

=item *

Incrementing the most significant revision number does not work with access
method C<:local:>

Due to a bug in CVS B<cvs> B<commit> B<-r> I<revision> fails when using
C<:local:> as the method to access a local repository and when the module has
sub-directories. The work-around is to use method C<:fork:> instead.

=cut

  errEx(2, "Due to a `cvs' bug `Increment' does not work with access method `:local:'",
	"Use access method `:fork:' instead")
      if $cvsRootMtd eq $NmMtdLoc;

=item *

The command may be issued only in the top level of a checked out trunk

Such an increment makes no sense on a branch.

=cut

  my $reposD = f2Ln("$NmDCvs/$NmFCvsRepos", 0);
  my( $modNm, $relD ) = reposD2ModNm($reposD);
  errEx(1, "`Increment' only in top level allowed")
      unless defined($relD) && $relD eq ".";

  # Obtain information about branch
  my $tag = fTag2Tag();
  errEx(2, "Need `tag.log' for `Increment'")
      unless $tag;

  my( $tagPfx, $tagMaj, $tagMin, $tagBra ) = prsTag($tag);
  errEx(2, "`Increment' must be executed for the trunk")
      if $tagBra;

=item *

The tree must be unchanged

=cut

  # Execute the `status'
  my @rs = scanO([ "status" ],
		 '^File:\s*(no file )?\S+\s*Status:\s*' => sub
		 { ( $' ) });
  errEx(2, "`Increment' allowed only for unchanged tree")
      if grep{ $_ ne "Up-to-date" }(@rs);

=item *

As the most significant revision number to be incremented the highest most
significant revision number of F<tag.log> is used for which there is a symbolic
tag given

If B<lcvs> is used consistently this results in the highest most significant
revision number available.

=cut

  my $revMaj;
  unless($noRev) {
    my @revMajs = scanO([ "log", "-h", $NmFTag ],
			'^\t[^:]+:\s*(\d+)(\.\d+)*' => sub
			{ ( $1 ) });
    $revMaj = ( sort{ $b <=> $a }(@revMajs) )[0];
  }

=item *

No Join may be pending in this directory

=cut

  errEx(2, "No `Join' may be pending when doing an `Increment'")
      if fTag2Tag($NmFJoin);

=back

=cut

  # Prepare tag file and version numbers
  $revMaj++
      if defined($revMaj);
  $tagMaj++;
  $tag = mkTag($tagPfx, $tagMaj, $DfltVerNum, $tagBra);
  tag2FTag($tag, "");

  # Execute the commit
  # "-f", "-R" needed for versions prior to 1.11pl1
  my @cmtOpts = ( defined($opts->{"F"}) ? ( "-F", $opts->{"F"} ) :
		  ( "-m", $opts->{"m"} ), $revMaj ? ( "-r", $revMaj ) : ( ),
		  "-f", "-R" );
  my $r = execCvs($ExecCvsExt, "commit", @cmtOpts);
  # $$$ This creates a sticky tag - is this desired?

  # Maintain log file
  if($revMaj) {
    # Now `global.log' already has a revision .1 like all other files. Another
    # commit would bring this to .2 which is bad because vendor branches are
    # misguided then. Correct that.
    vrbO("Correcting revision of `global.log'");
    execCvs($ExecCvsInt, "admin", "-o$revMaj:", $NmFLog);
    execCvs($ExecCvsInt, "update", "-A", $NmFLog);
  }
  log2FLog($tag, @cmtOpts);

  # Do tagging
  vrbO("Tagging tree with new tag");
  execCvs($ExecCvsInt, "tag", "-F", $tag);

  if($rmLog) {
    vrbO("Removing `$rmLog'");
    unlink($rmLog);
  }
  rmtree($commitWorkD);
  return !!$r;
}

##############################################################################

=head2 Join

=head3 Synopsis

B<lcvs> [I<cvs-option>...] B<Join> [I<source-branch>]

=head3 Description

Joins the latest changes made on branch I<source-branch> to the current working
directory which must be the top level directory of a checked out version of the
target branch of the same module. If I<source-branch> is not given defaults to
the trunk.

Assume you have two branches A and B and from time to time you want to
integrate the changes made on source branch A into target branch B. This is
difficult by pure B<cvs>. This is where B<Join> helps.

B<Join> does two things:

=over 4

=item *

Join the differences into the current working directory

All differences between the last time the source branch was joined or the start
of the source branch and the current version are integrated into the files in
the working directory.

For this operation the special files of L<lcvs> receive special treatment so
you do not need to care about them.

Conflicts in other files need to be resolved by you.

=item *

Prepare special tagging on next commit

If source branch C<A> has been joined to target branch C<B> I<and> this join
has been committed to C<B> a special tag C<A-B> is set in branch C<A> marking
the last version which has been integrated into branch C<B>.

Though this tagging is prepared by B<Join> it is I<done> when the next
B<commit> takes place. For this a special file F<tag.join> is created in the
working directory listing the tag where the join took place. If for some reason
you do not want the next B<commit> to do this tagging then simply remove this
file. This effectively ignores the join that took place and another join will
join the same differences again.

=back

If a B<Join> has not been committed yet - i.e. if there is a F<tag.join> - then
B<Join> refuses to work. B<commit> the pending B<Join> first.

It is difficult to recognize a situation where the target branch has just been
created but no B<commit> has been done to it. Do not use B<Join> in such
situations.

=cut

sub sub_Join() {
  # Consider options and arguments
  my( $opts, @joinOpts ) = prsOpts(%OptJoin);
  errEx(1, "Unknown <cvs-Join-option>")
      unless $opts;
  errEx(1, "Too many arguments")
      if @ARGV > 1;

  if($help) {
    print("Usage: lcvs Join <source-branch>\n");
    return 0;
  }

  # Build enivronment
  my $srcBra = @ARGV ? shift(@ARGV) : "";
  prepModNm2ModD();

  my $reposD = f2Ln("$NmDCvs/$NmFCvsRepos", 0);
  my( $modNm, $relD ) = reposD2ModNm($reposD);
  errEx(1, "`Join' only in top level allowed")
      unless defined($relD) && $relD eq ".";

  # Check for pending join
  my $pndTag = fTag2Tag($NmFJoin);
  if($pndTag) {
    ( undef, undef, undef, $pndTag ) = prsTag($pndTag);
    errEx(2, "`Join' for " . ($pndTag ? "branch `$pndTag'" : "trunk") .
	  " still pending - commit this first");
  }

  # Obtain information about target branch
  my $trgTag = fTag2Tag();
  errEx(2, "Need `tag.log' for `Join'")
      unless $trgTag;

  my( $trgTagPfx, $trgTagMaj, $trgTagMin, $trgTagBra ) = prsTag($trgTag);
  $trgTagBra = $trgTagBra || $NmTrunk;
  vrbO("Obtaining needed tags");

  # Check source branch
  my @lns = execCvs($ExecCvsPip, "update", "-p",
		    $srcBra ? ( "-r", $srcBra ) : ( "-A" ), $NmFTag);
  errEx(2, "Source branch `$srcBra' does not exist")
      if grep{ /no\s+such\s+tag/ ||
		   /is\s+no\s+longer\s+in\s+the\s+repository/ }(@lns);

  # Obtain version tag from source branch
  my @starLns = grep{ $lns[$_] =~ /^\*+$/ }(0 .. $#lns);
  errEx(3, "Internal error: Unexpected output from `update -p':", @lns)
      unless @starLns;

  my $srcTag = $lns[$starLns[0] + 1];
  my( $srcTagPfx, $srcTagMaj, $srcTagMin, $srcTagBra ) = prsTag($srcTag);
  $srcTagBra = $srcTagBra || $NmTrunk;
  errEx(2, "Branch `$srcBra' exists but has not been committed yet - `Join' makes no sense")
      unless ($srcBra || $NmTrunk) eq $srcTagBra;
  errEx(2, "Source branch and target branch are identical")
      if $srcTagBra eq $trgTagBra;

  # Build tag used to mark the join point and check for the first join
  my $markTag = "$srcTagBra-$trgTagBra";
  @lns = execCvs($ExecCvsPip, "update", "-p", "-r", $markTag, $NmFTag);

  my $first = grep{ /no\s+such\s+tag/ ||
			/is\s+no\s+longer\s+in\s+the\s+repository/ }(@lns);

  vrbO("Joining branch `$srcTagBra' into branch `$trgTagBra'");
  if(execCvs($ExecCvsExt, "update", $first ? ( ) : ( "-j", $markTag ),
	     "-j", $srcTag))
    { errEx(2, "`cvs update' failed - considering the join to be void"); }
  else {
    errEx(2, "Can't write `$NmFJoin'")
	unless ln2F($NmFJoin, $srcTag);
  }

  vrbO("Rebuilding `$NmFTag'");
  push(@cvsOpts, "-Q");
  unlink($NmFTag);
  execCvs($ExecCvsInt, "update", $NmFTag);

  # Combine `global.log' by putting the second part of each overlap before the
  # first one
  vrbO("Merging `$NmFLog'");
  my $md = ( stat($NmFLog) )[2] & 07777;
  errEx(2, "Can't open `$NmFLog' to read overlaps")
      unless open(I, $NmFLog);
  unlink($NmFLog);
  errEx(2, "Can't open `$NmFLog' to write overlaps")
      unless open(O, ">" . $NmFLog);

  my $ln;
  my $in = 0;
  my $fnd = 0;
  @lns = ( );
  while(defined($ln = <I>)) {
    if($ln =~ /$ReOvrBeg1/) {
      $in = 1;
      $fnd++;
    }
    elsif($ln =~ /$ReOvrBeg2/)
      { $in = 2; }
    elsif($ln =~ /$ReOvrEnd/) {
      print(O @lns);
      @lns = ( );
      $in = 0;
    }
    elsif($in == 1)
      { push(@lns, $ln); }
    else
      { print(O $ln); }
  }
  close(I);
  close(O);
  chmod($md, $NmFLog);

  # Nothing to join at all
  unless($fnd) {
    vrbO("Nothing new on source branch - considering join void");
    unlink($NmFJoin);
  }

  return 0;
}

##############################################################################

=head2 List

=head3 Synopsis

B<lcvs> [I<cvs-option>...] B<List> [B<-l>] [B<-f>]

=head3 Description

This command lists all files in current tree.

A synonym for this command is B<Ls>.

The following options are supported.

=over 4

=cut

sub sub_List() {
  # Consider options and arguments
  my( $opts, @lsOpts ) = prsOpts(%OptLs);
  errEx(1, "Unknown <cvs-List-option>")
      unless $opts;
  errEx(1, "No arguments allowed for `List'")
      if @ARGV;

  if($help) {
    print("Usage: lcvs List [-fl]\n" .
	  "\t-f\tInclude log files in listing\n" .
	  "\t-l\tLocal directory only (not recursive)\n");
    return 0;
  }

=item B<-f>

Normally the files F<global.log> and F<tag.log> created by B<lcvs> are not
included in the output. If this option is given, the files are treated as
ordinary files.

=cut

  my @skpNms = defined($opts->{"f"}) ? ( ) : ( $NmFLog, $NmFTag );

=item B<-l>

Look in local directory only.

=cut

  my @statCmd = ( "status" );
  push(@statCmd, "-l")
      if defined($opts->{"l"});

=back

=cut

  # Execute the `status'
  @cvsOpts = grep{ $_ !~ /-q/i }(@cvsOpts);
  my @rs = scanO([ @statCmd ],
		 '^cvs (status|server): Examining\s*' => sub
		 { "D $'" },
		 '^File:\s*(\S+)' => sub
		 { "F $1" },
		 '^\s*(RCS Version|Repository revision):\s*' .
		 $ReRevLeaf . '\s*' => sub
		 { "R $'" },
		 '^\s*(Working revision):\s*New file\!\s*' => sub
		 { "N" });

  # Evaluate results
  my( $r, $dNm, $fNm );
  foreach $r ( @rs ) {
    my( $tp, $val ) = split(/ /, $r, 2);
    if($tp eq "D")
      { $dNm = $val eq "." ? "" : $val . "/"; }
    elsif($tp eq "F")
      { $fNm = $val; }
    elsif($tp eq "R") {
      $fNm = $1
	  if $val =~ /\/([^\/]+),v$/;
      print($dNm . $fNm . "\n")
	  unless grep{ $_ eq $fNm }(@skpNms);
    }
    elsif($tp eq "N") {
      print($dNm . $fNm . "\n")
	  unless grep{ $_ eq $fNm }(@skpNms);
    }
  }
  return 0;
}

##############################################################################

=head2 Log

=head3 Synopsis

B<lcvs> [I<cvs-option>...] B<Log> [B<-a>] [B<-d>] [B<-f>] [B<-v>] [B<-B>] [B<-D>] [B<-M>] [B<-T>]

=head3 Description

This command outputs the contents F<global.log> in various ways.

=cut

sub sub_Log() {
  # Consider options and arguments
  my( $opts, @lsOpts ) = prsOpts(%OptLog);
  errEx(1, "Unknown <cvs-Log-option>")
      unless $opts;
  errEx(1, "Too many arguments")
      if @ARGV > 1;

  if($help) {
    print("Usage: lcvs Log [-adfvBDMT] [<log-file>]\n" .
	  "\t-a\tAuthor\n" .
	  "\t-d\tDate\n" .
	  "\t-f\tFiles\n" .
	  "\t-v\tVersions\n" .
	  "\t-B\tOmit branch\n" .
	  "\t-D\tOmit directories\n" .
	  "\t-M\tOmit log message\n" .
	  "\t-T\tOmit tag\n");
    return 0;
  }

=pod

If there is an argument this is opened as a file for reading. If no argument is
given it defaults to F<global.log>.

The following options are supported.

=over 4

=cut

  my $fNm = @ARGV ? shift(@ARGV) : $NmFLog;
  errEx(2, "Can't open `$fNm'")
      unless open(LOG, $fNm);

  while(defined($_ = <LOG>)) {

=item B<-a>

Include author.

=item B<-d>

Include date.

=item B<-f>

Include files.

=item B<-v>

Include RCS version.

=item B<-B>

Exclude branch.

=item B<-D>

Exclude directories.

=item B<-M>

Exclude log message.

=item B<-T>

Exclude tag.

=back

=cut

    my $inMsg = /^Log Message:/ .. /^\*{$DlmLen}$/;
    print()
	if defined($opts->{"a"}) && /^Author:/ ||
	    defined($opts->{"d"}) && /^Date:/ ||
	    defined($opts->{"f"}) && (/^[A-Z][a-z]* Files:$/ ..	/^$/) ||
	    defined($opts->{"v"}) && /^    RCS Version:/ ||
	    !defined($opts->{"B"}) && /^Revision\/Branch:/ ||
	    !defined($opts->{"D"}) && /^In directory / ||
	    !defined($opts->{"M"}) && $inMsg && $inMsg > 1 ||
	    $inMsg && $inMsg =~ /E/ ||
	    !defined($opts->{"T"}) && /^Tag:/;
  }

  return 0;
}

##############################################################################

=head2 Undo

=head3 Synopsis

B<lcvs> [I<cvs-option>...] B<Undo> [B<-f>]

B<lcvs> [I<cvs-option>...] B<Undo> B<-p>

B<lcvs> [I<cvs-option>...] B<Undo> B<-r>

=head3 Description

This command undoes the changes made to files in the current working directory
reverting all changed files back to there unchanged version which is typically
the one noted in F<tag.log>. The changed files are saved by renaming them using
the extension C<.redo>.

This does I<not> work for added and removed files. Local additions and removals
must be reverted by hand. This also does not work if B<cvs> reports an
unresolved conflict. In all these cases the files causing trouble are output.

=cut

sub sub_Undo() {
  # Consider options and arguments
  my( $opts, @undoOpts ) = prsOpts(%OptUndo);
  errEx(1, "Unknown <cvs-Undo-option>")
      unless $opts;
  errEx(1, "Too many arguments")
      if @ARGV;

  if($help) {
    print("Usage: lcvs Undo [-f]\n" .
	  "\tlcvs Undo -r\n" .
	  "\tlcvs Undo -p\n" .
	  "\t-f\tRemove instead of save change files\n" .
	  "\t-p\tPurge previously saved files\n" .
	  "\t-r\tRedo previous undo\n");
    return 0;
  }

=pod

The following options are supported.

=over 4

=item B<-f>

Instead of renaming the changed files remove them from the file system.

Use with care. Any changes are I<really lost> if this option is used.

=item B<-p>

Purges all C<.redo> files created by a previous run. This is meant for cleaning
up and should be done if it is clear that the changes are no longer needed.

This is a security feature so no changes are removed by accident.

=item B<-r>

Instead of undoing redo the changes by renaming the changed files by removing
the extension C<.redo>.

Does work only until B<-p> is used.

=back

=cut

  # Execute the `status'
  @cvsOpts = grep{ $_ !~ /-q/i }(@cvsOpts);
  # From the cvs source (`src/status.c', Rev. 1.57, Lines 126+) these strings
  # may occur as a value of "Status:":
  #
  # "Unknown"
  # "Needs Checkout"
  # "Needs Patch"
  # "Unresolved Conflict"
  # "Locally Added"
  # "Locally Removed"
  # "File had conflicts on merge"
  # "Locally Modified"
  # "Entry Invalid"
  # "Up-to-date"
  # "Needs Merge"
  # "Classify Error" (should not occur)

  my @rs = scanO([ "status" ],
		 '^cvs (status|server): Examining\s*' => sub
		 { "D $'" },
		 '^File:\s*(\S+)\s*Status:\s*(Locally\s+Modified|Needs\s+Merge|File\s+had\s+conflicts\s+on\s+merge)' => sub
		 { ( "M $1" ) },
		 '^File:\s*(\S+)\s*Status:\s*Locally\s+Added' => sub
		 { ( "A $1" ) },
		 '^File:\s*no file (\S+)\s*Status:\s*(Locally\s+Removed|Needs\s+Checkout)' => sub
		 { ( "R $1" ) },
		 '^File:\s*(no file )?(\S+)\s*Status:\s*(Unresolved\s+Conflict|Entry\s+Invalid|Unknown)' => sub
		 { ( "C $2" ) },
		 '^File:\s*(no file )?(\S+)' => sub
		 { ( "F $2" ) },
		);

  # Evaluate results
  my( $r, $dNm );
  my %modTp2Fs = ( M => [ ], A => [ ], R => [ ], C => [ ] );
  my @fs = ( $NmFJoin );
  foreach $r ( @rs ) {
    my( $tp, $val ) = split(/ /, $r, 2);
    if($tp eq "D")
      { $dNm = $val eq "." ? "" : $val . "/"; }
    elsif($tp eq "F")
      { push(@fs, $dNm . $val); }
    else
      { push(@{$modTp2Fs{$tp}}, $dNm . $val); }
  }

  if($opts->{"p"}) {
    vrbO("Purging changed files");
    unlink(map{ $_ . $NmUndoExt }(@fs))
	unless $dont;
  }
  elsif($opts->{"r"}) {
    unless($dont) {
      vrbO("Reverting to changed files");
      foreach my $f ( @fs ) {
	my $fRedo = $f . $NmUndoExt;
	if(-f($fRedo)) {
	  unlink($f);
	  rename($fRedo, $f);
	}
      }
    }
  }
  else {
    my $fail;
    if(@{$modTp2Fs{C}}) {
      $fail = 1;
      errO("Files with unresolved conflicts: @{$modTp2Fs{C}}");
    }
    if(@{$modTp2Fs{A}}) {
      $fail = 1;
      errO("Locally added files: @{$modTp2Fs{A}}");
    }
    if(@{$modTp2Fs{R}}) {
      $fail = 1;
      errO("Locally removed files: @{$modTp2Fs{R}}");
    }
    errEx(2, "Can't undo because of these files -- undo this yourself and try again")
	if $fail;
    errEx(0, "Nothing to undo")
	unless @{$modTp2Fs{M}};

    unless($dont) {
      vrbO("Undoing changes");
      foreach my $f ( @{$modTp2Fs{M}}, -r($NmFJoin) ? ( $NmFJoin ) : ( ) ) {
	if($opts->{"f"})
	   { unlink($f); }
	else {
	  my $fRedo = $f . $NmUndoExt;
	  unlink($fRedo);
	  rename($f, $fRedo);
	}
      }
      execCvs($ExecCvsInt, "update", @{$modTp2Fs{M}});
    }
  }

  return 0;
}

##############################################################################
##############################################################################

=head1 LOGINFO FORWARDING

B<lcvs> is usable with the more modern arrangements of remote repositories -
i.e. the repository you are working with is not available in the file system of
the computer you are issuing the B<lcvs> command. The problem is that the
information for a B<commit> and similar sub commands is generated on the
repository server and thus can not be used locally without special arrangment.
However, B<lcvs> needs this information locally to put it in the F<global.log>
file.

=head2 Administrative file F<loginfo>

B<lcvs> tackles this problem by opening a port on the local (client) machine.
On this port the information generated on the repository server by the
administrative file F<loginfo> is expected. To forward the information from the
server F<loginfo> should contain the line:

	ALL	perl -MIO::Socket -e 'IO::Socket::INET->new("${=LCVS_HOST}:${=LCVS_PORT}")->print(join("\n", scalar(@ARGV), @ARGV, ""), <STDIN>)' -- -d "`date`" -u ${USER} %s

This forwards the information from a server host holding the repository to the
client host currently executing B<lcvs>. If this fails on the server you will
see an error message just after the messages about the checkin of a file.

Of course you may choose something different than C<ALL>. Consult the CVS
documentation for details.

See L<"loginfo options"> for a description of the options you may give. See
L<"LCVS_HOST and LCVS_PORT"> and L<"Standard scenarios"> for a description on
how to get the information from the server to the client machine.

=head2 F<loginfo> options

There are several options you may add to the B<perl> call noted above. These
are used to transfer more information from the server environment to the
client. Please note that you must have C<--> in the F<loginfo> line because
otherwise options are interpreted by B<perl>.

The following options are supported:

=over 4

=item B<-d> C<"`date`">

This transfers the date on the server to the client. As shown in the synopsis
the quoted output of the B<date> command should be used.

Using this option has the advantage to have a single time zone and clock for
all users committing to the repository.

Defaults to the date on the client.

=item B<-m> I<mail-address>

This gives a mail address to which the information added to F<global.log> is
sent to.

Note: This is more useful than other solutions sending mail directly by
F<loginfo> because B<lcvs> gathers all the messages from a commit of a module
to form a reasonable message where other solutions send a message for each
committed directory.

If this option is used the user executing B<lcvs> must have the command B<mail>
available.

Defaults to nothing so by default no mail is sent.

This option may be given multiple to send mail to more than one address.

=item B<-u> C<${USER}>

This transfers the user name on the server to the client. As shown in the
synopsis the internal B<cvs> variable C<${USER}> should be used.

Defaults to the user name of the user calling B<lcvs> on the client.

=back

=head2 C<LCVS_HOST> and C<LCVS_PORT>

As you may have noted in the line above the script called on the repository
server gets the information about wich port on which host to connect to through
the B<cvs> variables C<LCVS_HOST> and C<LCVS_PORT>. These variables can be
defined on the B<lcvs> command line by using

	B<-s> C<LCVS_>I<...>C<=>I<...>

to set host and port and they may be set in the environment. However, this is
usually not necessary because B<lcvs> figures out good defaults. For some
B<cvs> sub commands they are always used internally to communicate the host and
port B<lcvs> is expecting the loginfo information.

When allocating the port to listen on B<lcvs> checks the availability of the
given or a built-in default port. If this port is not available the next one is
tried until a free one is found. The port found is used for setting
C<LCVS_PORT> in the B<cvs> call.

=head2 Standard scenarios

There are several cases you may consider for setting up things so everything
works as it should. You always need to update F<loginfo> as noted above.

=over 4

=item * No extra repository server

If you are using no extra repository server but keep a local C<$CVSROOT> you
should not need to do anything special. This case is indicated by a repository
method of C<local>.

=item * Remote repository server and reachable client

If you are using a remote repository server and no firewall gets in your way
and your local host is reachable from the server host you can connect to the
local port from the remote host. In general you should not need to do anything
special, because B<lcvs> figures out the default name for the client host. This
case is indicated by a repository method other than C<local>.

If B<lcvs> is not able to figure out the correct host name which is accesible
by the remote server you need to specify this name by

	-s LCVS_HOST="external.host.name.here"

An IP address will do also.

=item * Remote repository server and unreachable client

If you are using a remote repository server and a firewall or network address
translation blocks simple port access in general you have a problem.

However, in this case you are probably already using a B<ssh> connection to the
repository server so please see the next point.

=item * B<cvs> via B<ssh>

Today B<cvs> access to public servers is often done via B<ssh>(as for instance
to L<http://savannah.gnu.org> or L<http://cvs.sourceforge.net>). You have to
set enivronment variable C<CVS_RSH> to B<ssh> or something similar in these
cases. B<ssh> can be configured to tunnel port connections through its own
(secure) connection. This feature is employed by B<lcvs>.

If you want to use this solution you need to set the environment variable
C<CVS_RSH> to I</path/to/lcvs>. I.e. instead of B<ssh> B<lcvs> is called again.

In addition you need to set the environment variable C<LCVS_RSH> to the real
B<ssh> you want to use or you used until now. You may also use B<-s>
C<LCVS_RSH=>I<ssh> instead of setting an environment variable. C<LCVS_RSH> may
contain option so it is a bit more useful than C<CVS_RSH>. In particular you
may add B<-v> to watch and debug the B<ssh> connection.

There is an automatic recognizing the string B<ssh> in C<LCVS_RSH>. If this is
found you do not need to do more. In any other case you have to set

	-s LCVS_HOST="localhost"

Remember, that the client actually connects to a port on the server host which
is forwarded to the client by B<ssh>.

This solution does work for every B<ssh> connection of course regardless
whether there is a firewall or not.

Though this seems to be the perfect solution there is one major drawback. At
the moment it is impossible to ensure, that B<ssh> is able to open the remote
tunnel end of the port B<lcvs> wants to use. Normally this should not be a
problem because the connections are rather short and so instances of B<lcvs>
competing about the same port should live rather short. However it might be
useful to roll the dice and define a personal port (a number between say 2000
and 60000) and to put this value to the environment variable C<LCVS_PORT>. This
way it is alway present and does no harm. Rolling the dice should distribute
the ports randomly among many users, so no instances of B<lcvs> compete about
the same port on a repository server.

=back

=cut

##############################################################################

# Uses a simple protocol with these steps:
# 1. Child first receives a cookie
# 2. Child executes command
# 3. Child sends cookie back to indicate being done
# 4. Child receives cookie back so the parent has received the cookie

# Contains the return value harvested by the latest `sigChld' handler.
my $chldR;

# Handler for catching a SIGCHLD
sub sigChld() {
  $chldR = $? >> 8
      unless wait() < 0;
}

##############################################################################

# Server communicating with process `$pid' by socket `$srv'. Returns array of
# array references containing the log lines from each connection.
sub execRcvSrv($$) {
  my( $pid, $srv ) = @_;

  # Set a signal handler so `accept()' are interrupted by a dying child
  undef($chldR);
  sigaction(SIGCHLD,
	    POSIX::SigAction->new('sigChld',
				  POSIX::SigSet->new(), SA_RESETHAND));

  my $cok = "COOKIE $$\n";
  my( $last, @logs );
  for(my( $cnt, $clt ) = ( 0 ); !$last; close($clt), $cnt++) {
    # Wait for a successful `accept'() which may fail by timeout
    1 until ($clt = $srv->accept()) || defined($chldR);
    last
	unless $clt;

    unless($cnt) {
      # Step 1
      print($clt $cok);
      next;
    }

    my( $ln, @log );
    while(!$last && defined($ln = <$clt>)) {
      # Step 3?
      unless($last = !@log && $ln eq $cok)
        # Step 2
	{ push(@log, $ln); }
      else
        # Step 4
	{ print($clt $ln); }
    }
    push(@logs, \@log)
	if @log;
  }
  close($srv);
  $chldR = $? >> 8
      unless waitpid($pid, 0) < 0;
  errO("Protocol not completed - continuing anyway")
      unless $last;
  return @logs;
}

##############################################################################

# Client executing `@cmd' and communicating on `$port'.
sub execRcvClt($@) {
  my( $port, @cmd ) = @_;

  my $sync = IO::Socket::INET->new("localhost:$port");
  errEx(3, "Can't connect to socket locally")
      unless $sync;

  # Step 1
  my $cok = <$sync>;
  close($sync);

  # Step 2
  my $r = system(@cmd) >> 8;

  # Step 3
  $sync = IO::Socket::INET->new("localhost:$port");
  errEx(3, "Can't connect to socket locally")
      unless $sync;
  print($sync $cok);

  # Step 4
  $cok = <$sync>;
  close($sync);
  exit($r);
}

##############################################################################

# Execute `@cmd' while receiving `loginfo' data. Return result of command or -1
# on internal errors.
sub execRcv(@ ) {
  my( @cmd ) = @_;

  my $srv;
  my $port;
  for($port = $cltPort;
      !($srv = IO::Socket::INET->new(Proto => 'tcp', LocalPort => $port,
				     Listen => SOMAXCONN, Reuse => 1,
				     Timeout => 1));
      $port++) {
    if($port > 0xFF00 || $! != EADDRINUSE && $! != EBADF) {
      errO("Can't allocate a dynamic port for receiving `loginfo' information: $!");
      return -1;
    }
  }
  splice(@cmd, 1, 0, "-s", "$NmVarPort=$port");
  $ENV{$NmVarPort} = $port;

  my $host = $cltHost ||
      ($cvsRootMtd eq $NmMtdLoc || $cltRsh && $cltRsh =~ /$ReCmdSsh/ ?
       $HstLoc : gethostbyaddr(gethostbyname(hostname())->addr())->name());
  splice(@cmd, 1, 0, "-s", "$NmVarHost=$host");
  $ENV{$NmVarHost} = $host;

  $ENV{$NmVarRsh} = $cltRsh
      if $cltRsh;

  vrbOExe(@cmd);

  my $pid = fork();
  unless(defined($pid)) {
    errO("Can't fork: $!");
    return -1;
  }

  execRcvClt($port, @cmd)
      unless $pid;

  my @logs = execRcvSrv($pid, $srv);
  foreach my $log ( @logs ) {
    if(@$log)
      { doLoginfo(@$log); }
    else
      { errO("Received invalid loginfo"); }
  }
  return $chldR;
}

##############################################################################

# This is an internal call happened by a `CVS_RSH=lcvs'.
sub sub_server() {
  if(defined($ENV{$NmVarRsh})) {
    unshift(@ARGV, "-R", "$ENV{$NmVarPort}:$HstLoc:$ENV{$NmVarPort}")
	if $ENV{$NmVarRsh} =~ /$ReCmdSsh/ && defined($ENV{$NmVarPort});
    unshift(@ARGV, split(' ', $ENV{$NmVarRsh}));
  }
  else
    { unshift(@ARGV, $CmdRsh); }
  { exec(@ARGV); }
  exit(-1);
}

##############################################################################
##############################################################################

=head1 TAGS

The tags automatically maintained by B<lcvs> consist of these parts.

=over 4

=item *

Module name

This may be an arbitrary identifier, but the B<cvs> module name is not only the
default but the only one making sense. The name must be alphanumeric and may
contain undescores.

=item *

Branch identifier

The branch identifier is the tag used to create this branch prefixed with a
dash. The branch identifier must be alphanumeric and may contain undescores.

This part does not exist if this is not a branch.

=item *

Major version number

The major version number consists of a underscore and a non-empty sequence of
digits.

The major version number is never changed by B<lcvs>. For branches it is
derived from the trunk or branch the branch is split from, so every branch gets
an own counting.

=item *

Minor version number

The minor version number consists of a underscore and a non-empty sequence of
digits.

The minor version number is incremented by 1 on each commit. For a new branch
it starts with 1.

=back

The tag is held in the file F<tag.log> and noted in the log file F<global.log>
on each commit.

=cut

# Parses symbolic name `$tag' and returns an array of the prefix, the major and
# minor number and an optional branch identifier.
sub prsTag($ ) {
  my( $tag ) = @_;

  return $tag =~ $ReTag ? ( $1, $3, $4, defined($2) ? $2 : "" ) : ( );
}

##############################################################################

# Returns a symbolic name made from `$pfx', `$maj', `$min' and `$bra'.
sub mkTag($$$$) {
  my( $pfx, $maj, $min, $bra ) = @_;

  return $pfx . ($bra ? $DlmBra . $bra : "") .
      $DlmVers . $maj . $DlmVers . $min;
}

##############################################################################

# Returns a valid tag from the tag file if present. Exits on error.
sub fTag2Tag(;$) {
  my( $fNm ) = @_;
  $fNm = $fNm || $NmFTag;

  my $tag = f2Ln($fNm, 0);
  return undef
      unless defined($tag);
  my @dum = prsTag($tag);
  errEx(1, "Incorrect symbolic tag in `$fNm'")
      unless @dum;
  return $tag;
}

##############################################################################

# Puts tag `$tag' to the tag file using commit options `@cmtOpts'. Does no
# commit if `!$cmtOpts[0]'.
sub tag2FTag($@) {
  my( $tag, @cmtOpts ) = @_;

  unless($dont) {
    vrbO("Storing new tag `$tag'");
    chmod(0666, $NmFTag);
    ln2F($NmFTag, $tag);
  }
  execCvs($ExecCvsInf, "-r", "commit", @cmtOpts, "-n", $NmFTag)
      unless @cmtOpts && !$cmtOpts[0];
}

##############################################################################
##############################################################################
# The realm of main

# Parses all cvs options, sets internal flags accordingly, and returns parsed
# options. `@ARGV' is shifted to the first non-option afterwards.
sub getCvsOpts() {
  my( $opts, @r ) = prsOpts(%OptCvs);

  exec("perldoc", "$FindBin::Bin/$FindBin::Script")
      unless $opts;

  # Use some options internally
  $verb = defined($opts->{"q"}) || defined($opts->{"Q"}) ? 0 : $verb;
  $help4Me = defined($opts->{"H"});
  $help = $help4Me || defined($opts->{"help"});
  $tmpD = $opts->{"T"} || $tmpD;
  $dont = defined($opts->{"n"});

  my $cvsRoot = $opts->{"d"} || f2Ln("$NmDCvs/$NmFCvsRoot", 0) ||
      $ENV{$NmEnvCvsRoot};
  ( $cvsRootMtd, $cvsRootUsr, $cvsRootHst, $cvsRootD ) =
      $cvsRoot =~ /(?::([a-z]+):)?(?:(\w+)@)?(?:([-.\w]+):)?(\/.*)$/;
  $cvsRootMtd = $cvsRootHst ? $DfltMtdHst : $DfltMtdNoHst
      unless $cvsRootMtd;

  foreach my $ass ( @{$opts->{"s"}} ) {
    my( $var, $val ) = split(/=/, $ass, 2);
    if($var eq $NmVarPort) {
      errEx(2, "Invalid value for port in `-s' option setting `$NmVarPort'")
	  unless $val =~ /^\d+$/;
      $cltPort = $val;
    }
    elsif($var eq $NmVarHost)
      { $cltHost = $val; }
    elsif($var eq $NmVarRsh)
      { $cltRsh = $val; }
  }

  # Remove given `-s LCVS_...' options
  for(my $i = 0; $i < @r - 1; ) {
    if($r[$i] eq "-s" && $r[$i + 1] =~ /^\Q$NmVarPfx\E/)
      { splice(@r, $i, 2); }
    else
      { $i++; }
  }

  return @r;
}

##############################################################################
##############################################################################
# Handle arguments

# Catch internal call calling server
if(@ARGV >= 2) {
  my @lst = split(' ', $ARGV[-1]);
  sub_server()
      if @lst >= 2 && $lst[-1] eq "server";
}

my $usageS = "Usage: $FindBin::Script [<cvs-option>...] <cvs-command> [<cvs-command-option>...]";

# Options and usage
@cvsOpts = getCvsOpts();

my $cmd = "";
$cmd = shift(@ARGV)
    if @ARGV;

exec("perldoc", "$FindBin::Bin/$FindBin::Script")
    if !$cmd && $help4Me;

errEx(1, $HelpSs{$cmd})
    if $help && defined($HelpSs{$cmd});

##############################################################################
# Now work

# Add our path, so this program is found easily by administrative calls
addMyP2P();

my $ex;

# All the commands called from the administrative files - today this emulates
# old and deprecated behaviour
if($cmd eq "loginfo")
  { $ex = loginfo(); }
elsif($cmd =~ /info$/)
  { errEx(1, "Called from unknown administrative file `$cmd'"); }

# All the commands called from the modules file - today this gives a
# hint for an old entry
elsif($cmd =~ /modules$/)
  { errEx(1, "Called from unknown modules program `$cmd'"); }

# Additional commands
elsif(grep{ $cmd eq $_ }("Changed", "Chgd"))
  { $ex = sub_Changed(); }
elsif(grep{ $cmd eq $_ }("List", "Ls"))
  { $ex = sub_List(); }
elsif(grep{ $cmd eq $_ }("Log"))
  { $ex = sub_Log(); }
elsif(grep{ $cmd eq $_ }("Undo"))
  { $ex = sub_Undo(); }
elsif(grep{ $cmd eq $_ }("Join"))
  { $ex = sub_Join(); }
elsif(grep{ $cmd eq $_ }("Increment", "Inc"))
  { $ex = sub_Increment(); }

# Real cvs commands
elsif(!$help) {
  if(grep{ $cmd eq $_ }("commit", "ci", "com"))
    { $ex = sub_commit(); }
  elsif(grep{ $cmd eq $_ }("import", "im", "imp"))
    { $ex = sub_import(); }
  elsif(grep{ $cmd eq $_ }("add", "ad", "new"))
    { $ex = sub_add(); }
}

unless(defined($ex)) {
  # Nothing matched
  unshift(@ARGV, $cmd)
      if $cmd;
  execCvs($ExecCvsExe, @ARGV);
}
exit($ex);

##############################################################################
##############################################################################

=head1 ENVIRONMENT

All environment variables starting with C<LCVS_> can be superseded by B<-s>
C<LCVS_>I<...> options.

=over 4

=item C<CVS_RSH>

If this is set to I</the/path/to/>B<lcvs> then B<lcvs> is called to make the
connection to the server host holding the repository. In this case C<LCVS_RSH>
is used.

See L<"LOGINFO FORWARDING"> for further infomation.

=item C<LCVS_RSH>

The analogon to C<CVS_RSH>. It's value should be the one you would use for
C<CVS_RSH> when not using B<lcvs>.

It is used when a B<ssh> call is rerouted through B<lcvs>. The value of this
variable I<may> contain options separated by white space. B<-v> might be useful
to debug the connection to the repository server.

See L<"LOGINFO FORWARDING"> for further infomation.

=item C<LCVS_PORT>

=item C<LCVS_HOST>

See L<"LOGINFO FORWARDING"> for further infomation.

=back

=head1 FILES

=over 4

=item F<global.log>

The global log file for a tree located in the top level directory of the tree.
This is created by the overlayed B<import> command. If it is not present no
logging takes place. This I<should> be controlled by B<cvs> so it is checked
out with the remaining files.

The log file grows at the beginning so the latest information is always at the
beginning of the file.

=item F<tag.log>

The global file containing the latest tag on a single line. See L<"TAGS"> for a
description of the format. This is created by the overlayed B<import> command.
If it is not present no tagging takes place. This I<should> be controlled by
B<cvs> so it is checked out with the remaining files.

This file may be used by other software to easily fetch the current tag of a
tree.

=item F<tag.join>

This file is created by the B<Join> sub command and it used by a following
B<commit>. It contains the latest tag from the source tree at the time the last
B<Join> took place.

=item F<log>

In some places used as a default file containing the log message for the
current / next commit.

=back

=head1 HISTORY

A suite of scripts implementing the concept of B<lcvs> started in 1993. These
scripts hooked into several B<cvs> administrative files.

In 1998 this has been replaced by this Perl script wrapped around B<cvs> making
things much easier. At the same time some minor changes took place in the
concept.

In 2002 remote repositories have been made working. This simplified the code
and the program logic considerably.

Because of this long history the code of B<lcvs> is not as clean as it could
be. But then - it works ;-) .

=cut

=head1 BUGS

There may be smaller bugs and flaws in the concept. In particular the operation
without F<global.log> and/or F<tag.log> is not tested. However, I'm using
B<lcvs> and it's predesseors for many years now and it works fine.

The following is actually more a ToDo list.

=over 4

=item *

What about sub-modules (i.e. more than one F<global.log>)?

=item *

Any flags appearing only in F<~/.cvsrc> are not recognized by B<lcvs>.

=item *

The client/server communication should actually be part of the B<cvs> remote
communication protocol. That would mean a change in B<cvs> itself, however.
Such a change should create a possibility to redirect the output of all server
side scripts back to the local client.

=item *

The information generated by B<cvs> when importing a new module or to a new
vendor branch is not put to the log file yet. At least for imports to a new
vendor branch this might be useful. However, this is difficult because there is
no possibility to check in the changed log file later.

=back

=head1 PREREQUISITES

Because this is a Perl program, Perl (>= V5.005) must be installed.

Before using B<lcvs> you should change the CVS administrative file C<loginfo>
according to the information in L<"LOGINFO FORWARDING">.

To put a tree already existing in the B<cvs> repository under B<lcvs> control
add a F<global.log> and F<tag.log> file at the top level. Initialize F<tag.log>
according to L<"TAGS">.

=head1 SEE ALSO

L<cvs>

=head1 AUTHOR

Stefan Merten <smerten@oekonux.de>

=head1 LICENSE

This program is licensed under the terms of the GPL. See

	http://www.gnu.org/licenses/gpl.txt

=head1 AVAILABILTY

See

	http://www.merten-home.de/FreeSoftware/lcvs/

=cut