#! /usr/bin/perl -w
use strict;

=head1 Notices

Originally developed for Perforce by VIZIM (www.vizim.com)

Copyright (c) 2014 Perforce Software, Inc. and VIZIM Worldwide, Inc.
All rights reserved.

Please see LICENSE.txt in top-level folder of this distribution for
license information

=cut

use v5.14.0;   # Earliest version testing was performed against

use File::Copy;
use File::Path;
use File::Basename;
use File::Spec::Functions qw(rel2abs catfile);

use IO::Handle;

use Getopt::Long;

use Digest::MD5;

=head1 TFS to Perforce import tool

This tool coordinates import from TFS to Perforce using a TFS
import control file.

=cut

####################
#
# Program constants and globals
#
####################

$| = 1;   # force STDOUT to keep logs up to date in case of failure/ abort

my $MINIMUM_CONTROL_VERSION = 4.31;
my $MINIMUM_CLIENT_VERSION = 2012.1;
my $MINIMUM_SERVER_VERSION = 2012.1;

my $APPNAME = 'TFSImport.pl';
my $versionMajor = 3;
my $versionMinor = '43';
my $APPWHAT = "TFS to Perforce import coordination; Version $versionMajor.$versionMinor";
my $APPNOTICES = "Copyright (c) 2014 Perforce Software, Inc. and VIZIM Worldwide, Inc.
All rights reserved.
See LICENSE.txt for license information.";

my $directoryStartup = rel2abs( '.' );

my $progressEvery = exists $ENV{TFS_PROGRESSEVERY} ? $ENV{TFS_PROGRESSEVERY} : 10;

=head2 Processing

There are two phases to import processing: validation and import.
During the validation phase the specified control file is checked for
consistency against expected formats and values.
During the generation phase the control file is used to coordinate the
import from TFS to Perforce.
Import is not attempted if errors are detected during the validation phase.

=cut

my $isActive = 0;       # 1 when active processing, 0 is "inactive" evaluation processing.

my $hControl;

my $pathCS2CL = 'cs2cl.map';
my $hCS2CL;

=head2 Operational modes

The various optional operational modes and their purpose are:

=over 4

=item Check syntax

Only the syntax of the control file is verified.
There is no attempt to import.

=item Changeset head

A changeset to changelist mapping is expected
for content version changeset references.
Normally, references to a changeset without a mapping creates a
log entry and uses #head.
If changeset head mode is not enabled the log warning becomes
an error.

=item No submit

Do not perform a submit.
Useful for isolated changeset migration testing.

=item Verbose mode

Produces a full trace of import activity.
Useful for smaller controlled environments.
Too much information for general use.

=back

=cut

my $modeCheckSyntax = 0;
my $modeChangesetHead = 1;
my $modeNoSubmit = 0;
my $modeTraceCommands = 0;
my $modeVerbose = 0;

=head2 Stop file

A clean, coordinated stop of an import is accomplished by creating a stop
file in the directory of execution.
Existence of the stop file is the important characteristic.
Content of the stop file, if any, is ignored.

Import will not be initiated if the stop file exists.

For reference, the full path to the stop file is identified in the first few
lines of output from this tool.

=cut

my $pathStopFile = rel2abs( catfile( $directoryStartup, 'Import.stop' ) );

=head2 Input file

Failure causes relating to input files are not easy
to trace or diagnose.
For this reason, all such content is specified through input redirection using
a single common file.
A single common file is used to avoid the overhead of identifying temporary
files.

For reference, the full path to the input file is identified in the first few 
lines of output from this tool.

=cut

my $pathMigrateIn = rel2abs( catfile( $directoryStartup, 'migrate.in' ) );

####################
#
# TFS and P4 command support
#
####################

my %tf = ();
my @tfResults = ();
my $tfExitCode = 0;

sub RunTFCommand($;$)
{
  my ($command, $format) = @_;
  $format = 1 if ! defined $format;

  foreach my $key (keys %tf) { delete $tf{$key}; }

  @tfResults = `tf $command 2\>\&1`;
  $tfExitCode = $? >> 8;

  if( $modeTraceCommands ) {
    Msg( "TF $command" );
    Msg( ".. exit code $tfExitCode" );
    foreach my $line (@tfResults) {
      chomp $line;
      Msg( ".. $line" );
    }
  }

  return $tfExitCode if $format == 0;

  foreach my $line (@tfResults) {
    chomp $line;
    next if $line =~ m!^\s*$!;
    if( $line =~ m!^([^\:]+)\: (.+)$! ) {
      my ($idx, $value) = ($1, $2);
      $idx =~ s!\s+!!g;
      $tf{$idx} = $value;
    }
  }
  return $tfExitCode;
}

my $P4USER = '';
my $P4PORT = '';
my $P4CLIENT = '';
 
my @p4Results = ();
my $p4ExitCode = 0;

sub RunP4Command($)
{
  my ($command) = @_;

  my $invoke = 'p4 -ztag';
  $invoke = "p4 -u $P4USER -c $P4CLIENT -p $P4PORT -ztag"
    if $P4USER ne '' && $P4CLIENT ne '' && $P4PORT ne '';
  @p4Results = `$invoke $command 2\>\&1`;
  $p4ExitCode = $? >> 8;

  if( $modeTraceCommands ) {
    Msg( "p4 $command" );
    Msg( ".. exit code $p4ExitCode" );
    foreach my $line (@p4Results) {
      chomp $line;
      Msg( ".. $line" );
    }
  }

  return $p4ExitCode;
}

sub FindP4Return($;$)
{
  my ($idx, $notFound) = @_;
  $notFound = ''
    if ! defined $notFound;

  foreach my $line (@p4Results) {
    return $1 if $line =~ m!^\.{3} $idx (.+)$!;
  }
  return $notFound;
}

####################
#
# Messaging support
#
####################

my $pathLog = '';
my $hLog = undef;

my $ifERRORReported = 0;          # 1 if an ERROR message has been reported
my $errorContext = undef;
my $logContext = undef;
my $LOGReportCount = 0;           # Number of LOG reports.

sub Msg($)
{
  print "$_[0]\n";
  print $hLog "$_[0]\n" if defined $hLog;
}

sub MsgERROR($)
{
  print STDERR "\n";
  print STDERR "$errorContext\n" if defined $errorContext;
  print STDERR "*** $_[0] ***\n";
  print $hLog "\n" if defined $hLog;
  print $hLog "$errorContext\n" if defined $hLog && defined $errorContext;
  print $hLog "*** $_[0] ***\n" if defined $hLog;
  $errorContext = undef;
  $ifERRORReported = 1;
  return 1;
}

sub MsgERRORResponse($@)
{
  my ($error, @results) = @_;
  MsgERROR( $error );
  Msg( "Response details:" );
  foreach my $line (@results) {
    chomp $line;
    Msg( ".. $line" );
  }
}

sub MsgVERBOSE($)
{
  return unless $modeVerbose;
  Msg( $_[0] );  
}

sub MsgLOG($)
{
  print '+' if defined $logContext && defined $hLog;
  print $hLog "$logContext\n" if defined $hLog && defined $logContext;
  print $hLog "++ $_[0]\n" if defined $hLog;
  print "++ $_[0]\n" if ! defined $hLog;
  $logContext = undef;
  ++$LOGReportCount;
}

sub OptionUsage(;$)
{
  my $errorMessage = $_[0];
  
  MsgERROR( $errorMessage ) if defined $errorMessage;

  print "$APPWHAT
$APPNOTICES

Usage:

  $APPNAME -V
  $APPNAME [-h|-?]
  $APPNAME [options] CONTROL

  Options:
    -log LOG - Create a copy of all message output in the log file LOG.
              If LOG exists, it is overwritten. Default is output to STDOUT
              only.

    -cs2cl CS2CL - Use CS2CL as the changeset to changelist mapping file. New
              changeset to changelist mapping information is appended to this
              file. Existing content is used to initialize the internal
              mapping table. Default file is $pathCS2CL.

    -progress COUNT - Issue progress message every COUNT changeset
              extractions. COUNT defaults to $progressEvery. 0 is no progress
              tracking.

    -mode MODE - Specifies that the features specified by MODE are to be
              enabled. Available features are:
                 C - Check syntax then exit.
                 M - Map missing CS to CL mappings as #head not error
                 S - no Submit.
                 T - trace P4 and TFS commands.
                 V - Verbose mode. Full activity trace.

    -TFS TLD - Specifies TLD as the Top Level Directory of the TFS workspace
              to use for import. Default is specified by the environment
              variable TFS_TLD. The directory TLD must exist.

  Arguments:
    CONTROL - The TFS import control file.

  Current Perforce context:
";
  RunP4Command( 'set' );
  if( $p4ExitCode == 0 ) {
    $P4USER = '- not defined';
    $P4CLIENT = '- not defined';
    $P4PORT = '- not defined';
    foreach my $line (@p4Results) {
      my ($env, $value) = ('', '');
      ($env, $value) = ($1, $2) if $line =~ m!^([^\=]+)\=(.+)$!;
      $P4USER = $value if $env eq 'P4USER';
      $P4CLIENT = $value if $env eq 'P4CLIENT';
      $P4PORT = $value if $env eq 'P4PORT';
    }
    print "      USER: $P4USER\n";
    print "    CLIENT: $P4CLIENT\n";
    print "      PORT: $P4PORT\n";
  } else {
    foreach my $line (@p4Results) {
      print "    $line\n";
    }
  }

  if( exists $ENV{TFS_TLD} && -e $ENV{TFS_TLD} ) {
    print "\n  TFS context for $ENV{TFS_TLD}\n";
    chdir( $ENV{TFS_TLD} );
  } else {
    print "\n  TFS context for current directory\n";
  }

  RunTFCommand( 'workfold' );
  if( $tfExitCode == 0 ) {
    print "     WORKSPACE: $tf{Workspace}\n" if exists $tf{Workspace};
    print "     WORKSPACE: - not defined\n" if ! exists $tf{Workspace};
    print "    COLLECTION: $tf{Collection}\n" if exists $tf{Collection};
    print "    COLLECTION: - not defined\n" if ! exists $tf{Collection};
  } else {
    foreach my $line (@tfResults) {
      print "    $line\n";
    }
  }
  print "\n";

  exit 0;
}

sub OptionVersion()
{
  print "$APPWHAT\n";
  exit 0;
}

sub EnvironmentWhichMode($)
{
  my $which = $_[0];

  $modeCheckSyntax = 1     if $which =~ s!C!!ig;
  $modeChangesetHead = 0   if $which =~ s!M!!ig;
  $modeNoSubmit = 1        if $which =~ s!S!!ig;
  $modeTraceCommands = 1   if $which =~ s!T!!ig;
  $modeVerbose = 1         if $which =~ s!V!!ig;
    
  if( $which ne '' ) {
    MsgERROR( "Unknown operational mode(s): '$which'" );
    return 0;
  }
  return 1;
}

####################
#
# Progress tracking
#
####################

=head1 Progress Tracking

Progress tracking is provided to assist with the management of an import.

An estimate of remaining import time is part of the progress tracking
information.
However, it is mostly intended for planning purposes.
Network performance, file content size, and the number of versions that a
file has all impact the accuracy of the completion estimate.

=cut

my $progressEventCount = 0;          # count of progress event this phase
my $progressEventTotal = 0;          # total progress events (CC tags)

my $progressTimeStart = undef;       # time() at start of progress tracking
my $progressTimeLast = undef;        # time() as of last progress report

my $progressUnitsCount = 0;          # count of progress units this phase
my $progressUnitsTotal = 0;          # total number of progress units (AI tags)

my $progressFORMAT = 'C: %d of %d U: %d of %d L %s E %s ER %s';

sub TimeHHMMSS($)
{
    return sprintf "%2d:%02d:%02d", $_[0]/3600, ($_[0]/60) % 60, $_[0] % 60;
}

sub ProgressInit()
{
  if( $isActive ) {
    $progressTimeStart = time();
    $progressTimeLast = $progressTimeStart;

    $progressEventTotal = $progressEventCount;
    $progressUnitsTotal = $progressUnitsCount;
   
    if( $progressEvery <= 0 ) {
      Msg( "No progress tracking" );
    } else {
      Msg( "Progress tracking every $progressEvery changesets" );
      $progressFORMAT = 'C: %' . length($progressEventTotal) . 'd of %' . length($progressEventTotal) . 'd'
                      . ' U: %' . length($progressUnitsTotal) . 'd of %' . length($progressUnitsTotal) . 'd'
                      . ' L %s E %s ER %s';
    }
  }

  $progressEventCount = 0;
  $progressUnitsCount = 0;
}

=head2 Progress Output

Progress output uses the format:

  C: CE of TE U: CU of TU L HHMMSS E HHMMSS ER HHMMSS

CE is the count of changeset processed and TE is the total changeset to process.
CU is the count of units (files and directories) processed and TU is the total
units to process.

HHMMSS is a time value.
L is the time required to complete the most recent
processing, E is the time since start of processing, and ER is an
estimate of the time required to complete the import.

=cut

sub ProgressReport()
{
  my $now = time();
  my $remaining = int( ($progressUnitsTotal - $progressUnitsCount) * (($now - $progressTimeStart) / $progressUnitsCount) );

  Msg( '' );
  Msg( sprintf $progressFORMAT,
               $progressEventCount, $progressEventTotal,
               $progressUnitsCount, $progressUnitsTotal,
               TimeHHMMSS( $now - $progressTimeLast ),
               TimeHHMMSS( $now - $progressTimeStart ),
               TimeHHMMSS( $remaining ) );

  $progressTimeLast = $now;
}

sub Progress()
{
  ++$progressEventCount;
  return if $progressEvery <= 0 || ! $isActive;

  if(    ($progressEventCount == $progressEventTotal)
      || ($progressEventCount % $progressEvery == 0) ) {
    ProgressReport();
  } else {
    print '.';
  }
}

sub CoordinateExit(;$)
{
  my $exitCode = $_[0];
  $exitCode = $ifERRORReported if ! defined $exitCode;

  $errorContext = undef;
  Msg( '' );
  Msg( "$LOGReportCount log messages" );
  MsgERROR( "Processing terminated by errors" ) if $exitCode != 0;
  Msg( "Processing completed without errors" ) if $exitCode == 0;

  close $hLog     if defined $hLog;
  close $hCS2CL   if defined $hCS2CL;

  exit( $exitCode );
}

####################
#
# General utility functions.
#
####################

sub utilAssurePathElements($)
{
  my $FilePath = $_[0];

  my ($name, $Dir, $suffix) = fileparse( $FilePath, (qr(\.[^\.]+),qr(\.)));
  unless( -e $Dir ) {
      mkpath( $Dir, 0, 0777 );
  }
}

use Win32;

sub PathCase($)
{
  my $path = $_[0];
  
  return Win32::GetLongPathName( $path );
}

sub isDirectoryEmpty($);
sub isDirectoryEmpty($)
{
  my $path = $_[0];

  return 0 if ! -e $path;
  return 0 if ! -d $path;
  my $hDir;
  return 0 if !opendir($hDir, $path);
  my $isEmpty = 1;
  while ($_ = readdir($hDir)) {
    next if m!^\.{1,2}$!;
    my $thisPath = "$path/$_";
    next if -d $thisPath && isDirectoryEmpty( $thisPath );
    $isEmpty = 0;
    last;
  }
  closedir($hDir);
  return $isEmpty;
}

sub XMLTextDecode($)
{
  my $Text = $_[0];
  return '' unless defined $Text;     # safety check

  $Text =~ s/\&gt;/>/g;
  $Text =~ s/\&lt;/</g;
  $Text =~ s/\&apos;/\'/g;
  $Text =~ s/\&quot;/\"/g;
  $Text =~ s/\&amp;/\&/g;     # must be last decode
  return $Text;
}

# XML Tag reader that supports the subset of XMl encoding used by these tools.
#
#  $refRemainder - Reference to text remaining on a line after processing
#       of the current tag has been completed. On entry, the scanner is
#       primed with this text. On exit, this is the text following the tag
#       just processed. If the source was a line of text then the exit value
#       is the join of post-tag text and any remaining "lines" from the
#       original source.
#
#   $source - source of further text input. May be a file GLOB, a reference
#       to an array of text lines, a text constant, a text variable, or a
#       scalar reference. Lines are read from a file and elements are shifted
#       from the array. Text is split on /\n/.
#
#   $refAttributes - reference to a hash into which tag attributes are written.
#       The attribute TAG is set to the tag name. Any existing elements are
#       removed from the hash at the start of processing. By convension
#       attribute names are lower case so there should be no conflict with
#       the key TAG.
#
# Returns:
#
#   undef - when no further tags are available from the source.
#
#   A single text value that represents the value of the tag. This may be '',
#   but it may also be the encoding of XML tags embedded by this tag.
#   \n characters are "restored" to the returned value.

sub TagRead($$$)
{
  my ($refRemainder, $source, $refAttributes) = @_;
  
  my @src = ref($source) eq '' ? split /\n/, $source : ();
  my $line = defined $refRemainder ? $$refRemainder : '';
    
  foreach( keys %{$refAttributes} ) { delete $refAttributes->{$_}; }

  my $value = '';
  my $isComment = 0;
  my $idx = '';
  my $isFields = 0;
  while( 1 ) {
    

    # If the line is empty or only space characters remain, then establish
    # the next line from the source.

    if( $line =~ m/^\s*$/ ) {
      if( ref($source) eq '' ) {
        $line = shift @src;
      } elsif(ref($source) eq 'GLOB') {
        $line = <$source>;
      } elsif( ref($source) eq 'ARRAY' ) {
        $line = shift @{$source};
      } else {
        die "**FATAL** Don't understand tag source";
      }
            
      if( defined $line ) {
        chomp( $line );
      } else {
        $line = '';     # for remainder processing
        $value = undef;
        last;
      }
    }
       
    # If in a comment, then anything except an end of comment is
    # ignored.
        
    if( $isComment ) {
      if( $line =~ m/[^>]*\-\->(.*)$/ ) {
        $line = $1;
        $isComment = 0;
      } else {
        $line = '';
      }
            
    # If not currently processing a tag then look for one to start.
    # Anything prior to a '<' that isn't white space shouldn't be
    # there but is ignored. This includes blank lines.
        
    } elsif( $idx eq '' ) {
      if( $line =~ m/^\s*$/ ) {
        $line = '';
      } elsif( $line =~ m/^\s*<([^\/\s>]+)(.*)$/ ) {
        ($idx, $line) = ($1, $2);
        if( $idx =~ m/^\!\-\-/ ) {
          $isComment = 1;
          $idx = '';
        } else {
          $refAttributes->{TAG} = $idx;
          $isFields = 1;
        }
      } else {
        die "**FATAL** Bad tag format at $line";
      }
            
    # If extracting attributes (AKA fields), then either find one or
    # expect an end of the tag attribute sequence.
       
    } elsif( $isFields ) {
      $line =~ s/^\s+//;
      if( $line =~ m/^([^\s\=\>]+)\=\"([^\"]*)\"(.*)$/ ) {
        my ($key, $value) = ($1, $2);
        $line = $3;
        $refAttributes->{$key} = XMLTextDecode( $value );
      } elsif( $line =~ m/^\/>(.*)$/ ) {
        $line = $1;
        $idx = '';
        last;
      } elsif( $line =~ m/^>(.*)$/ ) {
        $line = $1;
        $isFields = 0;
      } else {
        die "**FATAL** In $idx don't understand attribute $line";
      }
            
    # Otherwise we're extracting tag value and only a formal
    # end tag is not value.
        
    } else {
      if( $line =~ m/(.*)<\/$idx>(.*)$/ ) {
        $value .= $1;
        $line = $2;
        $idx = '';
        last;
      } else {
        $value .= $line . "\n";
        $line = '';
      }
    }
  }

  # Various fatal format problems.
    
  die "**FATAL** Unterminated tag '$idx'"   if $idx ne '';
  die "**FATAL** Unterminated comment"      if $isComment;

  # Establish remainder. The remainder may be just space characters.
  # A trim really doesn't save much overhead as the extraction loop
  # needs to deal with "dead" space.

  if( defined $refRemainder ) {
    if( ref($source) eq '' ) {
      $line .= "\n"
        unless $line =~ m/^\s*$/;
      $line .= join "\n", @src;
    }
    $$refRemainder = $line;
  }
    
  return $value;
}

####################
#
# Infrastructure
#
####################

my $TFSRoot = '';
my $P4Root = '';
my $DEPOTRoot = '';
my $serverCaseHandling = '';

=head1 Infrastructure Context

Infrastructure context is important to import operation.
It defines and uses the state of operational context to support
initialization, current operation, and restart.

The import operates within the context of the current working environment to
make it easier to isolate differences.

Infrastructure context is validated and detailed prior to the start of
import processing.

=cut

sub InfrastructureValidate()
{
  Msg( 'Validate Perforce infrastructure...' );

=head2 Perforce Context

Perforce context is relative to a workspace that maps the entire collection
being migrated to a depot.
The user and client are established by the Perforce context at the start of
operation.

The user must be a super user.
The user should have full write access to
the depot structure that is the target of the import.

The client must exist and have no currently opened files.
The client options must allow clobber and rmdir.
Client submit options must allow for the submit of unchanged files.

The client view may have only one line.
The depot side of the view line can be arbitrarily complex.
The client side of the view line must be exactly //clientName/...

The Perforce client and server must be at or later than specific versions.

=cut

  RunP4Command( '-V' );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "(InfrastructureValidate) $p4ExitCode: p4 -V", @p4Results );
    return 0;
  }
  foreach my $line (@p4Results) {
    if( $line =~ m!/(\d{4}\.\d+)/! ) {
      Msg( "  Client version: $1" );
      if( $1 < $MINIMUM_CLIENT_VERSION ) {
        MsgERROR( "Client version must be at least $MINIMUM_CLIENT_VERSION" );
        return 0;
      }
      last;
    }
  }

  RunP4Command( 'set' );  # set so we can say where the value comes from
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "(InfrastructureValidate) $p4ExitCode: set", @p4Results );
    return 0;
  } else {
    foreach my $line (@p4Results) {
      my ($env, $value) = ('', '');
      ($env, $value) = ($1, $2) if $line =~ m!^([^\=]+)\=(.+)$!;
      $P4USER = $value if $env eq 'P4USER';
      $P4CLIENT = $value if $env eq 'P4CLIENT';
      $P4PORT = $value if $env eq 'P4PORT';
    }
    Msg( "  Perforce user: $P4USER" );
    $P4USER =~ s! \S+$!!;
    Msg( "  Perforce workspace: $P4CLIENT" );
    $P4CLIENT =~ s! \S+$!!;
    Msg( "  Perforce connection: $P4PORT" );
    $P4PORT =~ s! \S+$!!;
  }

  RunP4Command( 'info' );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "(InfrastructureValidate) $p4ExitCode: info", @p4Results );
    return 0;
  } else {
    $serverCaseHandling = FindP4Return( 'caseHandling' );
    Msg( "  Server case handling: $serverCaseHandling" );
    my $serverVersion = FindP4Return( 'serverVersion' );
    $serverVersion = $1
      if $serverVersion =~ m!/(\d{4}\.\d+)/!;
    if( $serverVersion ne '' ) {
      Msg( "  Server Version: $serverVersion" );
      if( $serverVersion < $MINIMUM_SERVER_VERSION ) {
        MsgERROR( "Server version must be at least $MINIMUM_SERVER_VERSION" );
        return 0;
      }
    } else {
      MsgERRORResponse( '(InfrastructureValidate) no serverVersion: info', @p4Results );
      return 0;
    }
  }

  RunP4Command( 'protect -o' );
  MsgERRORResponse( "(InfrastructureValidate) $p4ExitCode: protect -o", @p4Results )
    if $p4ExitCode != 0;

  # Validate the workspace

  RunP4Command( 'client -o' );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "(InfrastructureValidate) $p4ExitCode: client -o", @p4Results );
  } else {
    my $options = FindP4Return( 'Options', 'noclobber normdir' );
    MsgERROR( 'Workspace does not allow clobber' )
      if $options =~ m!noclobber!;
    MsgERROR( 'Workspace does not rmdir' )
      if $options =~ m!normdir!;
    MsgERROR( 'Workspace is not submitunchanged' )
      if FindP4Return( 'SubmitOptions' ) ne 'submitunchanged';
    MsgERROR( 'Workspace does not appear to exist' )
      if FindP4Return( 'Update' ) eq '';

    $P4Root = FindP4Return( 'Root' );
    if( $P4Root eq '' ) {
      MsgERROR( 'Unable to establish workspace root' );
    } else {
      Msg( "  Workspace root: $P4Root" );
      $P4Root =~ s!\\!\/!g;
      if( $serverCaseHandling eq 'sensitive' ) {
        if( -e $P4Root ) {
          my $caseRoot = PathCase( $P4Root );
          MsgERROR( "Local workspace root path has character case differences - $caseRoot" )
            if $caseRoot ne $P4Root;
        } elsif( $P4Root =~ m!^[a-z]! ) {
          MsgERROR( "Drive letter in workspace root must be upper case" );
        }
      }
    }
    if( FindP4Return( 'View1' ) ne '' ) {
      MsgERRORResponse( 'Client view is too complex - more than one view line', @p4Results );
    } else {
      my $view = FindP4Return( 'View0' );
      Msg( "  View line: $view" );
      MsgERROR( "Client side of view is too complex - not //client/..." )
        if $view !~ m!\/\/$P4CLIENT\/\.{3}$!;
      $DEPOTRoot = $1 if $view =~ m!^(//.+)/\.{3} //$P4CLIENT!;
      if( $DEPOTRoot eq '' ) {
        MsgERROR( "Can't establish depot root from view" );
      } else {
        Msg( "  Depot Root: $DEPOTRoot" );
      }
    }
  }

  # There can't be any open files

  RunP4Command( 'opened' );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "(Determine open files) $p4ExitCode: opened", @p4Results ); 
    return 0; 
  }
  if( scalar @p4Results != 0 ) {
    MsgERRORResponse( "Workspace $P4CLIENT has open files", @p4Results );
    return 0;
  }

  Msg( 'Validate TFS infrastructure...' );

# WARNING WARNING WARNING WARNING WARNING
#
# To keep the Perforce infrastructure true, the TFS infrastructure
# must be done last because it requires a chdir().
#
# WARNING WARNING WARNING WARNING WARNING

=head2 TFS Context

TFS context is relative to a workspace that maps the entire collection
being migrated.
The top level directory of the workspace must be specified.
It can be specified using the environment variable TFS_TLD or through
a command line option.

The TFS user should have full read access
to all files referenced by the import.

=cut
    
  $TFSRoot = $ENV{TFS_TLD}
    if $TFSRoot eq '' && exists $ENV{TFS_TLD};
  MsgERROR( 'TFS top level directory not specified' )
    if $TFSRoot eq '';
  MsgERROR( 'TFS top level directory does not exist' )
    if $TFSRoot ne '' && ! -e $TFSRoot;

  if( $TFSRoot ne '' && -e $TFSRoot && -d $TFSRoot ) {
    Msg( "  TFS top level directory: $TFSRoot" );
    chdir( $TFSRoot );
    $TFSRoot =~ s!\\!\/!g;
  }
  RunTFCommand( 'workfold' );
  if( $tfExitCode != 0 ) {
    MsgERRORResponse( "(Establish TFS workspace) $tfExitCode: workfold", @tfResults );
  } else {
    Msg( "  TFS workspace: $tf{Workspace}" )
      if exists $tf{Workspace};
    Msg( "  TFS collection: $tf{Collection}" )
      if exists $tf{Collection};
    Msg( '  Workspace mappings:' );
    foreach my $key (keys %tf) {
      next unless $key =~ m!^\$!;
      Msg( "    $key : $tf{$key}" );
    }
    MsgERROR( 'Workspace does not map $/' )
      unless exists $tf{'$/'};
  }
}

####################
#
# Changeset to changelist mapping
#
####################

=head1 Changeset to changelist mapping

The primary purpose of changeset to changelist mapping is to provide the
import processing with a way to reference non-current versions of file
content when re-creating branch and merge operations.
The secondary purpose is to provide users with information so that TFS
changesets can be related post-import to the changelist that emulated them.

Unknown and duplicate changeset mappings are treated as error
conditions.
Unknown mappings are indicative of a control file with incomplete information.
Duplicate mappings are indicative of control files that duplicate prior
import processing.

=cut

=head2 CS2CL file format

Blank lines and lines with # as the first nonblank character are comments.

Each update is prefixed with generation time and date information.
This information is for human reference and plays no role in import
processing.

Other lines represent either changeset to changelist mappings or delete to
changeset mappings.

Changeset to changelist mappings use the format:

  CS ssss CL llll

Where ssss is the TFS changeset number and llll is the import changelist that
represents that changeset.

Delete to changeset mappings use the format:

  Xxxxx CS ssss

Where Xxxxx is a TFS delete reference and ssss is the changeset that
contains that delete reference.

=cut

my %CS2CL = ();

sub CS2CLInit()
{
  if( $pathCS2CL eq '' ) {
    MsgERROR( "Changeset to changelist mapping file specification required" );
    return 0;
  }

  $pathCS2CL = rel2abs( catfile( $directoryStartup, $pathCS2CL ) )
    unless $pathLog =~ m!^[\\/]! || $pathLog =~ m!\:!;
  Msg( "Changeset to Changelist mapping file: $pathCS2CL" );
  if( -e $pathCS2CL ) {
    open $hCS2CL, '<', $pathCS2CL;
    while(<$hCS2CL>) {
      next if m!^\s*\#!;
      next if m!^\s*$!;
      if( m!^\s*CS (\S+) CL (\d+)! ) {
        $CS2CL{$1} = $2;
      } elsif( m!^\s*(X\d+) CS (\d+)! ) {
        $CS2CL{$1} = $2;
      } else {
        chomp;
        MsgERROR( "Don't understand CS2CL mapping - $_" );
        return 0;
      }
    }
    close $hCS2CL;
  } else {
    utilAssurePathElements( $pathCS2CL );
  }

  open $hCS2CL, '>>', $pathCS2CL;
  $hCS2CL->autoflush(1);
  print $hCS2CL "# $APPNAME $versionMajor.$versionMinor; " . localtime() . "\n";

  return 1;
}

sub CS2CLMap($$)
{
  my ($changeset, $changelist) = @_;

  if( ! exists $CS2CL{$changeset} ) {
    $CS2CL{$changeset} = $changelist;
    print $hCS2CL "CS $changeset CL $changelist\n"
      if $changelist != 0;
  } elsif( $CS2CL{$changeset} == 0 ) {
    $CS2CL{$changeset} = $changelist;
    print $hCS2CL "CS $changeset CL $changelist\n"; 
  } else {
    MsgERROR( "Duplicate mapping for changeset $changeset" );
  }
}

sub CS2CLAsCL($;$)
{
  my ($changeset, $adjust) = @_;
  $adjust = 0 if ! defined $adjust;
  $changeset = $1
    if $changeset =~ m!^C(\d+)$!;

  if( exists $CS2CL{$changeset} ) {
    return "\@" . ($CS2CL{$changeset} + $adjust)
      if $CS2CL{$changeset} != 0;

    if( $modeChangesetHead ) {
      MsgLOG( "Changeset $changeset is not mapped; using #head" );
    } else {
      MsgERROR( "Changeset $changeset is not mapped" );
    }
  } else {
    if( $modeChangesetHead ) {
      MsgLOG( "Changeset $changeset is unknown, using #head" );
    } else {
      MsgERROR( "Changeset $changeset is unknown" );
    }
  }
  return '#head';
}

sub CS2CLAsRevRange($)
{
  my ($CSRange) = @_;

  my ($first, $second) = ($CSRange, $CSRange);
  ($first, $second) = ($1, $2)
    if $CSRange =~ m!^([^\~]+)\~(.+)$!;

  $first = CS2CLAsCL( $first );
  $second = CS2CLAsCL( $second );

  return '#head'
    if $first eq '#head' || $second eq '#head';
  return $first
    if $first eq $second;
  
  return "$first,$second";
}

####################
#
# Content processing
#
####################

my $currentChangeset = 0;
my $currentChangelist = 0;
my $currentDescription = '';

my $allowEmptyChangelist = 0;

sub FileDetails($)
{
  my $path = $_[0];

  return 'Does Not Exist' unless -e $path;
  return 'Directory' if -d $path;
  return 'Not A File' unless -f $path;

  my $hLocal;
  if( ! open( $hLocal, '<:bytes', $path ) ) {
    MsgERROR( "Can't open to evaluate - $path; $!" );
    return "Can Not Open - $!";
  }

  my $type = '';  
  my $header = '';
  read $hLocal, $header, 3, 0;
  if( $header =~ m!^\xEF\xBB\xBF! ) {
    $type = 'UTF8';
  } elsif( $header =~ m!^\xFE\xFF! ) {
    $type = 'UTF16BE';
  } elsif( $header =~ m!^\xFF\xFE! ) {
    $type = 'UTF16LE';
  } else {
    $type = -z $path ? 'EMPTY' : 'NOBOM';
  }
  seek $hLocal, 0, 0;

  my $ctx = Digest::MD5->new;
  
  $ctx->reset();
  $ctx->addfile( $hLocal );
  close( $hLocal );

  return ($type, uc $ctx->hexdigest() );
}

my %backwardTypes = (
                      'ctempobj'  => 'binary+Sw',
                      'ctext'     => 'text+C',
                      'cxtext'    => 'text+Cx',
                      'ktext'     => 'text+k',
                      'kxtext'    => 'text+kx',
                      'ltext'     => 'text+F',
                      'tempobj'   => 'binary+FSw',
                      'ubinary'   => 'binary+F',
                      'uxbinary'  => 'binary+Fx',
                      'xbinary'   => 'binary+x',
                      'xltext'    => 'text+Fx',
                      'xtempobj'  => 'binary+Swx',
                      'xtext'     => 'text+x',
                      'xunicode'  => 'unicode+x',
                      'xutf16'    => 'utf16+x'
                     );

sub TypeConsistency($$$)
{
  my ($file, $contentType, $p4Type) = @_;

  MsgERROR( "p4Type not defined - $file" )
    if ! defined $p4Type;

  # Determine a standard base+modifier for the Perforce type

  my $thisType = $p4Type;

  $thisType = $backwardTypes{$p4Type}
    if exists $backwardTypes{$p4Type};

  my ($base, $modifier) = ($thisType, '');
  ($base, $modifier) = ($1, $2)
    if $thisType =~ m!^([^\+]+)\+(.+)$!;

  MsgVERBOSE( "Check $contentType against $p4Type ($base+$modifier) - $file" );

  my $newBase = '';

  # Can't tell about empty files. Accept what's already there.

  if( $contentType eq 'EMPTY' ) {

    $newBase = '';

  # NOBOM is consistent with text or binary. Perforce utf16 will create
  # a BOM when populating so restored content would not be consistent.

  } elsif( $contentType eq 'NOBOM' ) {

    $newBase = 'binary'
      if $base eq 'utf16';

  # UTF8 is consistent with text and binary. Perforce utf16 needs to
  # transform to text.

  } elsif( $contentType eq 'UTF8' ) {

    $newBase = 'text'
      if $base eq 'utf16';

  # UTF16BE is consistent with binary. Perforce actually transforms into
  # utf16 which populates as UTF16LE which would result in bad content.

  } elsif( $contentType eq 'UTF16BE' ) {

    $newBase = 'binary'
      if $base ne 'binary';

  # UTF16LE is consistent with binary or utf16.

  } elsif( $contentType eq 'UTF16LE' ) {

    $newBase = 'utf16'
      if $base eq 'text';

  }

  if( $newBase ne '' ) {
    my $newType = $newBase;
    $newType .= "+$modifier"
      if $modifier ne '';
    MsgVERBOSE( "  convert type from $p4Type to $newType" );
    RunP4Command( "reopen -c $currentChangelist -t $newType \"$file\"" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "(Change type) $p4ExitCode: reopen -t $newType $file", @p4Results );
      return 0;
    }
  }

  return 1;
}

sub TFSWorkspace2Server($)
{
  my $server = $_[0];
  if( ! defined $server ) {
    MsgERROR( "TFSW2S - undefined reference" );
    return '$/';
  }
  $server = '$/' unless defined $server;
  $server =~ s!\\!\/!g;
  $server =~ s!^$TFSRoot!\$!i;
  return $server;
}

sub TFSServer2Workspace($)
{
  my $workspace = $_[0];
  if( ! defined $workspace ) {
    MsgERROR( "TFSS2W - undefined reference" );
    return $TFSRoot;
  }
  $workspace =~ s!\;X\d+$!!;
  $workspace =~ s!\$!$TFSRoot!;
  return $workspace;
}

sub TFSServer2P4Workspace($)
{
  my $workspace = $_[0];
  if( ! defined $workspace ) {
    MsgERROR( "TFSS2P4W - undefined reference" );
    return $TFSRoot;
  }
  $workspace =~ s!\;X\d+$!!;
  $workspace =~ s!\$!$P4Root!;
  return $workspace; 
}

sub TFSServer2Depot($)
{
  my $depot = $_[0];
  if( ! defined $depot ) {
    MsgERROR( "TFSS2D - undefined reference" );
    return $DEPOTRoot;
  }
  $depot =~ s!\;X\d+$!!;
  $depot =~ s!\$!$DEPOTRoot!;
  return $depot; 
  
  return $depot;
}

####################
#
# Import control
#
####################

=head1 Import processing

Generation has arranged.

Matter of translating to Perforce commands.

Consistentcy checks of environment relative to control file.

=cut

my $ifUpdatedCurrent = 0;
my %updatedUnits = ();
my $updatedDirectory = '';
my %p4Types = ();

sub P4TypesReset()
{
  foreach my $key (keys %p4Types) {
    delete $p4Types{$key};
  }
}

sub P4TypesFromResults()
{
  my $path = '';
  foreach (@p4Results) {
    chomp;
    if( m!^\.{3} path (.+)$! ) {
      $path = $1;
      $path =~ s!\\!\/!g;
    }
    $p4Types{uc $path} = $1
      if m!^\.{3} type (.+)$!;
  }
}

sub P4TypeIs($)
{
  my $path = $_[0];
  $path =~ s!\\!\/!g;
  return exists $p4Types{uc $path} ? $p4Types{uc $path} : '';
}

sub UpdatedReset()
{
  $ifUpdatedCurrent = 0;
  $updatedDirectory = '';

  foreach my $key (keys %updatedUnits) {
    MsgLOG( "Update of '$key' ($updatedUnits{$key}) not acknowledged" );
    delete $updatedUnits{$key};
  }
}

sub UpdatedDirectoryGet($)
{
  my $thisDirectory = $_[0];
  MsgVERBOSE( "DirectoryGet $thisDirectory" );
  $updatedDirectory = $thisDirectory;
}

sub UpdatedUnitGet($$)
{
  my ($thisAction, $thisUnit) = @_;

  my $unit = '';
  if( $thisAction eq 'Getting' || $thisAction eq 'Replacing' ) {
    $unit = TFSWorkspace2Server( "$updatedDirectory/$thisUnit" );
  } elsif( $thisAction eq 'Deleting' ) {
    $unit = TFSWorkspace2Server( $thisUnit );
  }

  if( $unit eq '' ) {
    MsgERROR( "Don't recognize update action $thisAction for $thisUnit - $unit" );
  } else {

    # Various case related rename scenarios play havoc with reference
    # case. Create case independent various of the index values.

    MsgVERBOSE( "UnitGet $thisAction $thisUnit $unit" );
    $updatedUnits{uc $unit} = $thisAction;
  }
}

sub UpdatedUnitConfirm($$$)
{
  my ($thisAction, $thisUnit, $unitConfirm) = @_;
  $unitConfirm = 'yes'
    unless defined $unitConfirm;
  return 1 if $unitConfirm eq 'no';

  my $expect = '';
  my $unit = $thisUnit;
  $unit =~ s!\;[CX]\d+$!!;

  if( $thisAction eq 'add' ) {
    $expect = 'Getting';
    return 1 if $unit eq '$/';

  } elsif( $thisAction eq 'edit' ) {
    $expect = 'Replacing';

  } elsif( $thisAction eq 'delete' ) {
    $expect = 'Deleting';

  } elsif( $thisAction eq 'undelete' ) {
    $expect = 'Getting';

  } elsif(    $thisAction eq 'rename-F-source'
           || $thisAction eq 'rename-P-source'
           || $thisAction eq 'rename-C-source' ) {
    return 1 if $unitConfirm eq 'target';
    $expect = 'Deleting';

  } elsif(    $thisAction eq 'rename-F-target'
           || $thisAction eq 'rename-P-target'
           || $thisAction eq 'rename-C-target' ) {
    return 1 if $unitConfirm eq 'source';
    $expect = 'Getting';

  } elsif(    $thisAction eq 'renamecase-F-source'
           || $thisAction eq 'renamecase-P-source'
           || $thisAction eq 'renamecase-C-source' ) {
    return 1;

  } elsif(    $thisAction eq 'renamecase-F-target'
           || $thisAction eq 'renamecase-P-target'
           || $thisAction eq 'renamecase-C-target' ) {
    $expect = 'Replacing';

  } elsif( $thisAction eq 'branch-source' ) {
    return 1;

  } elsif( $thisAction eq 'branch-target' ) {
    $expect = 'Getting';

  } elsif(    $thisAction eq 'merge-M-source'
           || $thisAction eq 'merge-B-source'
           || $thisAction eq 'merge-E-source'
           || $thisAction eq 'merge-D-source'
           || $thisAction eq 'merge-U-source' ) {
    return 1;

  } elsif( $thisAction eq 'merge-B-target' ) {
    $expect = 'Getting';

  } elsif(    $thisAction eq 'merge-M-target'
           || $thisAction eq 'merge-E-target' ) {
    $expect = 'Replacing';

  } elsif( $thisAction eq 'merge-U-target' ) {
    $expect = 'Getting';

  } elsif( $thisAction eq 'merge-D-target' ) {
    $expect = 'Deleting';

  } else {
    MsgERROR( "Don't recognize UnitConfirm $thisAction for $thisUnit" );
    return 0;

  }

  return 1 if ! $isActive; # syntax needs to check $thisAction

  $expect = $unitConfirm
    if $unitConfirm ne 'yes' && $unitConfirm ne 'source' && $unitConfirm ne 'target';
  MsgVERBOSE( "UnitConfirm $thisAction $thisUnit" );
  if( exists $updatedUnits{uc $unit} ) {
    MsgVERBOSE( "... $updatedUnits{uc $unit} $expect" );
    my $match = $updatedUnits{uc $unit} eq $expect;
    MsgERROR( "UnitConfirm $thisAction $unit was $updatedUnits{uc $unit} not $expect" )
      unless $match;
    delete $updatedUnits{uc $unit};      
    return $match;

  } elsif( $thisUnit =~ m!\;X\d+$! ) {

    # Assume not knowing for a deleted unit is deleted to deleted. If
    # it's not then the post-processing pass will report the issue.

    MsgVERBOSE( '... no updated entry for deleted unit' );

  } else {
    MsgVERBOSE( '... no updated entry' );
    MsgLOG( "No update for UnitConfirm $thisAction of $thisUnit" );
  }

  return 1;
}

sub UpdatedUnitIgnore($)
{
  my $unit = $_[0];
  $unit =~ s!\;[CX]\d+$!!;

  MsgVERBOSE( "UnitIgnore $unit" );
  delete $updatedUnits{uc $unit}
    if exists $updatedUnits{uc $unit};

  return 1;
}

=head2 add actions

Should be a new file in both TFS and Perforce.

Content from TFS copied to the Perforce workspace.

Perforce type validated against content.

=cut

my @adds = ();
my @edits = ();
my @deletes = ();
my @merges = ();
my $ifCaseAction = 0;

sub ActionADD($)
{
  my $refItemFields = $_[0];
  return 0 unless UpdatedUnitConfirm( 'add', $$refItemFields{reference}, $$refItemFields{unitconfirm} );
  return 1 unless $isActive;

  my $referenceTFS = TFSServer2Workspace( $$refItemFields{reference} );
  my $referenceP4 = TFSServer2P4Workspace( $$refItemFields{reference} );

  MsgVERBOSE( "add $referenceP4" );
  if( ! -e $referenceTFS ) {
    MsgVERBOSE( '... TFS does not exist' );
    MsgERROR( "add TFS reference does not exist - $referenceTFS" );
    return 0;

  } elsif( -d $referenceTFS ) {
    MsgVERBOSE( '... directory' );
    $allowEmptyChangelist = 1;

  } elsif( -e $referenceP4 ) {
    MsgVERBOSE( '... add as edit' );
    MsgLOG( "(add) P4 exists; recover as edit - $$refItemFields{reference}" );
    push @edits, { id => 'add', reference => "$$refItemFields{reference}" };

  } else {
    MsgVERBOSE( '... add' );
    push @adds, { id => 'add', reference => "$$refItemFields{reference}" };

  }

  return 1;
}

=head2 branch actions

Source should exist, target will be added.

Sources that are directories may not exist.
This happens when TFS attempt to branch an empty directory.

Reference of source may not be the current head version.

Resulting content may be modified after an initial branch.

Integrate in Perforce then validate target content in Perforce against
target content in TFS.

Need to validate Perforce type against branched content.

=cut

sub ActionBRANCH($)
{
  my $refItemFields = $_[0];
  return 0 unless UpdatedUnitConfirm( 'branch-source', $$refItemFields{source}, $$refItemFields{unitconfirm} );
  return 0 unless UpdatedUnitConfirm( 'branch-target', $$refItemFields{target}, $$refItemFields{unitconfirm} );
  return 1 unless $isActive;

  my $sourceTFS = TFSServer2Workspace( $$refItemFields{source} );
  my $targetTFS = TFSServer2Workspace( $$refItemFields{target} );
  my $sourceP4 = TFSServer2P4Workspace( $$refItemFields{source} );
  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{target} );

  MsgVERBOSE( "branch \"$$refItemFields{source}\" \"$$refItemFields{target}\"" );
  if( ! -e $sourceTFS ) {
    MsgVERBOSE( '... TFS source does not exist' );
    MsgERROR( "branch TFS source does not exist - $sourceTFS" );
    return 0;

  } elsif( -d $sourceTFS || -d $targetTFS ) {
    MsgVERBOSE( '... directory' );
    $allowEmptyChangelist = 1;

  } elsif( -e $targetP4 && -e $targetTFS ) {
    MsgVERBOSE( '... p4 target exists; recover as edit' );
    MsgLOG( "(branch) P4 target exists; recover as edit - $$refItemFields{target}" );
    push @edits, { id => 'branch',
                   reference => "$$refItemFields{target}" };

  } elsif( ! -e $sourceP4 && ! -e $targetP4 && -e $targetTFS ) {
    MsgVERBOSE( '... p4 env does not exist; recover as add' );
    MsgLOG( "(branch) no p4 files; recover as add - $$refItemFields{source} -> $$refItemFields{target}" );
    push @adds, { id => 'branch',
                  reference => "$$refItemFields{target}" };

  } elsif( -f $sourceP4 && ! -e $targetP4 ) {
    MsgVERBOSE( '... branch' );
    push @merges, { id => 'branch',
                    resolve => '',
                    source => "$$refItemFields{source}",
                    svu => "$$refItemFields{svu}",
                    target => "$$refItemFields{target}" };

  } else {
    MsgVERBOSE( '... else' );
    MsgERROR( "branch else - $$refItemFields{source} $$refItemFields{target}" );
    return 0;
  }

  return 1;
}


=head2 delete action

Target should exist prior to the delete.

Delete removes from both TFS and Perforce workspace.

=cut

sub ActionDELETE($)
{
  my $refItemFields = $_[0];

  return 0 unless UpdatedUnitConfirm( 'delete', $$refItemFields{reference}, $$refItemFields{unitconfirm} );
  return 1 unless $isActive;

  my $referenceTFS = TFSServer2Workspace( $$refItemFields{reference} );
  my $referenceP4 = TFSServer2P4Workspace( $$refItemFields{reference} );

  MsgVERBOSE( "delete $$refItemFields{reference}" );
  if( -e $referenceTFS ) {
    MsgVERBOSE( '... TFS exists' );
    MsgERROR( "delete TFS exists - $$refItemFields{reference}" );
    return 0;

  } elsif( ! -e $referenceP4
           && exists $$refItemFields{rtype}
           && $$refItemFields{rtype} eq 'D' ) {
    MsgVERBOSE( '... assume empty directory' );
    $allowEmptyChangelist = 1;

  } elsif( ! -e $referenceP4 ) {
    MsgVERBOSE( '... p4 does not exist' );
    MsgLOG( "(delete) P4 does not exist - $$refItemFields{reference}" );
    $allowEmptyChangelist = 1;
    
  } elsif( -d $referenceP4 ) {
    MsgVERBOSE( '... directory' );
    $allowEmptyChangelist = 1;

  } elsif( -f $referenceP4 ) {
    MsgVERBOSE( '... file' );
    push @deletes, { id => 'delete', reference => "$$refItemFields{reference}" };

  } else {
    MsgVERBOSE( '... else' );
    MsgERROR( "delete else - $$refItemFields{reference}" );
    return 0;
  }

  return 1;
}

=head2 edit action

Updated content in TFS.

Copy from TFS to Perforce workspace.

If Perforce workspace version does not exist, treat as an add to achieve
consistency between the Perforce and TFS workspaces.

Need to check for change of content type.

=cut

sub ProcessEDITAsAdd($)
{
  my $refItemFields = $_[0];

  my $referenceTFS = TFSServer2Workspace( $$refItemFields{reference} );
  my $referenceP4 = TFSServer2P4Workspace( $$refItemFields{reference} );

  my ($referenceTypeTFS, $referenceMD5TFS) = FileDetails( $referenceTFS );
  MsgVERBOSE( "... EditAsAdd TFS source - $referenceTypeTFS $referenceMD5TFS" );
  utilAssurePathElements( $referenceP4 );
  if( ! copy( $referenceTFS, $referenceP4 ) ) {
    MsgERROR( "(EDITAsAdd) copy failure \"$referenceTFS\" \"$referenceP4\" - $!" );
    return 0;
  }
  RunP4Command( "add -c $currentChangelist \"$referenceP4\"" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "(EDITAsAdd) $p4ExitCode: add $referenceP4", @p4Results );
    return 0;
  }
  return TypeConsistency( $referenceP4, $referenceTypeTFS, FindP4Return( 'type' ) );
}

sub ActionEDIT($)
{
  my $refItemFields = $_[0];
  return 0 unless UpdatedUnitConfirm( 'edit', $$refItemFields{reference}, $$refItemFields{unitconfirm} );
  return 1 unless $isActive;

  my $referenceTFS = TFSServer2Workspace( $$refItemFields{reference} );
  my $referenceP4 = TFSServer2P4Workspace( $$refItemFields{reference} );

  MsgVERBOSE( "edit $$refItemFields{reference}" );
  if( ! -e $referenceTFS ) {
    MsgVERBOSE( '... TFS does not exist' );
    MsgERROR( "edit TFS does not exist - $referenceTFS" );
    return 0;

  } elsif( -d $referenceTFS ) {
    MsgVERBOSE( '... TFS directory' );
    $allowEmptyChangelist = 1;

  } elsif( ! -e $referenceP4 ) {
    MsgVERBOSE( '... p4 does not exist' );
    MsgLOG( "(edit) P4 does not exist; recover as add - $$refItemFields{reference}" );
    push @adds, { id => 'edit', reference => "$$refItemFields{reference}" };

  } elsif( -d $referenceP4 ) {
    MsgVERBOSE( '... p4 directory' );
    MsgERROR( "edit p4 is directory - $referenceP4" );
    return 0;

  } elsif( -f $referenceTFS && -f $referenceP4 ) {
    MsgVERBOSE( '... edit' );
    push @edits, { id => 'edit', reference => "$$refItemFields{reference}" };

  } else {
    MsgVERBOSE( '... else' );
    MsgERROR( "edit else - $$refItemFields{reference}" );
    return 0;
  }

  return 1;
}

=head2 Merge Support

Equivalent to an integrate and resolve in Perforce.
Observations about merge and resolve:

=over 4

=item *

It is assumed that the TFS merge algorithm is similar, but different from,
the Perforce merge algorithm.
Thus, TFS and Perforce may have different merge results.
They may also have different resolve actions.

=item *

Relative to tracking, TFS has a deleted to deleted merge.
Perforce does not.

=back

Replicating the TFS resolve within Perforce is desirable.
Secondary merge actions are indicative of TFS resolve activities.

=cut

=head2 Merge branch

Merge action that creates a branch.

The only consistency failure scenario is one where the TFS workspace does not
contain the specified target.

=cut

sub ActionMERGE_B($)
{
  my $refItemFields = $_[0];

  return 0 unless UpdatedUnitConfirm( 'merge-B-source', $$refItemFields{source}, $$refItemFields{unitconfirm} );
  return 0 unless UpdatedUnitConfirm( 'merge-B-target', $$refItemFields{target}, $$refItemFields{unitconfirm} );
  return 1 if ! $isActive;

  my $sourceTFS = TFSServer2Workspace( $$refItemFields{source} );
  my $targetTFS = TFSServer2Workspace( $$refItemFields{target} );
  my $sourceP4 = TFSServer2P4Workspace( $$refItemFields{source} );
  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{target} );

  MsgVERBOSE( "merge-B \"$$refItemFields{source}\" \"$$refItemFields{target}\"" );
  if( ! -e $sourceTFS && ! -e $targetTFS ) {
    MsgVERBOSE( '... TFS merge of deleted' );
    $allowEmptyChangelist = 1;

  } elsif( -d $sourceTFS || -d $targetTFS ) {
    MsgVERBOSE( '... TFS is directory' );
    $allowEmptyChangelist = 1;

  } elsif( ! -e $targetTFS ) {
    MsgVERBOSE( '... TFS target does not exist' );
    MsgERROR( "merge-B TFS target does not exist - $targetTFS" );
    return 0;

  } elsif( -f $targetP4 && -f $targetTFS ) {
    MsgVERBOSE( '... p4 target exists' );
    MsgLOG( "(merge-B) P4 target exists; recover as edit - $$refItemFields{target}" );
    push @edits, { id => 'merge-B', reference => "$$refItemFields{target}" };

  } elsif( ! -e $sourceP4 && ! -e $targetP4 && -e $targetTFS) {
    MsgVERBOSE( '... p4 files do not exist' );
    MsgLOG( "(merge-B) P4 files do not exist; recover as add - $$refItemFields{source}; $$refItemFields{target}" );
    push @adds, { id => 'merge-B', reference => "$$refItemFields{target}" };

  } elsif( -e $sourceP4 && ! -e $targetP4 ) {
    MsgVERBOSE( '... branch' );
    push @merges, { id => 'merge-B',
                    resolve => '',
                    version => "$$refItemFields{sversion}",
                    source => "$$refItemFields{source}",
                    svu => "$$refItemFields{svu}",
                    target => "$$refItemFields{target}" };

  } else {
    MsgVERBOSE( '... else' );
    MsgERROR( "merge-B else - $$refItemFields{target}" );
    return 0;
  }
  
  return 1;
}

=head3 merge

The action 'merge' specifies that there is no content change to the target.
This covers these cases:

=over 4

=item *

Both source and target are deleted.
Perforce does not track such integrations as being valid.

=item *

Conflicting changes that were resolved in TFS with KeepYours.

=item *

Merge of a file with unchanged content.

=item *

Merge of files with identical content changes.

=back

=cut

sub ActionMERGE_M($)
{
  my $refItemFields = $_[0];

  return 0 unless UpdatedUnitConfirm( 'merge-M-source', $$refItemFields{source}, $$refItemFields{unitconfirm} );
  return 0 unless UpdatedUnitConfirm( 'merge-M-target', $$refItemFields{target}, $$refItemFields{unitconfirm} );
  return 1 if ! $isActive;

  my $sourceTFS = TFSServer2Workspace( $$refItemFields{source} );
  my $targetTFS = TFSServer2Workspace( $$refItemFields{target} );
  my $sourceP4 = TFSServer2P4Workspace( $$refItemFields{source} );
  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{target} );

  MsgVERBOSE( "merge-M \"$$refItemFields{source}\" \"$$refItemFields{target}\"" );
  if( ! -e $sourceTFS && ! -e $targetTFS ) {
    MsgVERBOSE( '... TFS merge of deleted' );
    $allowEmptyChangelist = 1;

  } elsif( -d $sourceTFS || -d $targetTFS ) {
    MsgVERBOSE( '... TFS is directory' );
    $allowEmptyChangelist = 1;

  } elsif( ! -e $targetTFS ) {
    MsgVERBOSE( '... TFS target does not exist' );
    MsgERROR( "(merge-M) TFS target does not exist - $$refItemFields{target}" );
    return 0;

  # If the TFS source doesn't exist, but the target does then we've
  # encountered a known TFS merge reporting anomaly. There are two versions
  # of this anomaly. One version is associated with a plain merge. That needs
  # a new open for the edit. Another version is associated with merge rename.
  # Normally the rename and merge have different sources. Sometimes, however,
  # The merge source is the rename source. Which means the edit is against a
  # file already open for add.

  } elsif( ! -e $sourceTFS && -e $targetTFS ) {
    MsgVERBOSE( '... no TFS source; recover as edit' );
    MsgLOG( "(merge-M) no TFS source; recover as edit - $$refItemFields{source}; $$refItemFields{target}" );
    if( exists $$refItemFields{secondary} && $$refItemFields{secondary} eq 'yes' ) {
      push @edits, { id => 'merge-M', reference => "$$refItemFields{target}", open => 'yes' };
    } else {
      push @edits, { id => 'merge-M', reference => "$$refItemFields{target}" };
    }

  } elsif( -e $sourceP4 && -e $targetP4 ) {
    MsgVERBOSE( '... merge' );
    my ($sourceTypeP4, $sourceMD5P4) = FileDetails( $sourceP4 );
    my ($targetTypeP4, $targetMD5P4) = FileDetails( $targetP4 );
    my ($targetTypeTFS, $targetMD5TFS) = FileDetails( $targetTFS );

    my $resolveAs = '-af';
    $resolveAs = '-at' if $targetMD5TFS eq $sourceMD5P4;
    $resolveAs = '-ay' if $targetMD5TFS eq $targetMD5P4;

    push @merges, { id => 'merge-M',
                    resolve => "$resolveAs",
                    version => "$$refItemFields{sversion}",
                    source => "$$refItemFields{source}",
                    svu => "$$refItemFields{svu}",
                    target => "$$refItemFields{target}" };

  } else {
    MsgVERBOSE( '... else' );
    MsgERROR( "merge-M else - $$refItemFields{source}" );
    return 0;
  }
  
  return 1;
}

=head3 merge delete

The action 'merge delete' specifies that the target will be deleted.
This covers these cases:

=over 4

=item *

The source was deleted and the target is being deleted.

=item *

The source was deleted and the target was changed.
This was resolved with TakeTheirs.

=back


TFS does not allow delete of a file currently open for merge.
Thus, all cases must deal with a source that is currently deleted.

=cut

sub ActionMERGE_D($)
{
  my $refItemFields = $_[0];

  return 0 unless UpdatedUnitConfirm( 'merge-D-source', $$refItemFields{source}, $$refItemFields{unitconfirm} );
  return 0 unless UpdatedUnitConfirm( 'merge-D-target', $$refItemFields{target}, $$refItemFields{unitconfirm} );
  return 1 if ! $isActive;

  my $sourceTFS = TFSServer2Workspace( $$refItemFields{source} );
  my $targetTFS = TFSServer2Workspace( $$refItemFields{target} );
  my $sourceP4 = TFSServer2P4Workspace( $$refItemFields{source} );
  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{target} );

  MsgVERBOSE( "merge-D \"$$refItemFields{source}\" \"$$refItemFields{target}\"" );
  if( -e $targetTFS ) {
    MsgVERBOSE( '... TFS target exists' );
    MsgERROR( "merge-D TFS target exists - $$refItemFields{target}" );
    return 0;

  } elsif( ! -e $sourceP4 && ! -e $targetP4 ) {
    MsgVERBOSE( '... p4 merge of deleted' );
    $allowEmptyChangelist = 1;

  } elsif( -e $sourceP4 && ! -e $targetP4 ) {
    MsgVERBOSE( '... p4 source exists' );
    MsgLOG( "(merge-D) P4 source exists - $$refItemFields{source}; $$refItemFields{target}" );
    $allowEmptyChangelist = 1;

  } elsif( -e $sourceP4 && -e $targetP4 ) {
    MsgVERBOSE( '... p4 source and target exist' );
    MsgLOG( "(merge-D) P4 source and target exist; delete target - $$refItemFields{source}; $$refItemFields{target}" );
    RunP4Command( "delete -c $currentChangelist \"$targetP4\"" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "(merge-D) $p4ExitCode: delete $targetP4", @p4Results );
      return 0;
    }

  } elsif( -e $targetP4 ) {
    my $sourceRev = CS2CLAsRevRange( $$refItemFields{sversion} );
    MsgVERBOSE( "... merge from $sourceRev" );

    RunP4Command( "integrate -c $currentChangelist -d \"$sourceP4\"$sourceRev \"$targetP4\"" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "(merge-D) $p4ExitCode: integrate -d \"$sourceP4\" \"$targetP4\"", @p4Results );
      return 0;
    }

    RunP4Command( "resolve -n -c $currentChangelist" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "(merge-D $$refItemFields{target}) $p4ExitCode: resolve -n", @p4Results );
      return 0;
    }

    if( $p4Results[0] !~ m!^No file\(s\) to resolve! ) {
      MsgVERBOSE( '... resolve -at' );
      RunP4Command( "resolve -c $currentChangelist -at" );
      if( $p4ExitCode != 0 ) {
        MsgERRORResponse( "(merge-D $$refItemFields{target}) $p4ExitCode: resolve -at", @p4Results );
        return 0;
      }
    } else {
      MsgVERBOSE( '... no resolve' );
    }
  }

  return 1;
}

=head3 merge edit

The action 'merge edit' specifies that the content of the target is modified.
This covers these cases:

=over 4

=item *

Source changes propogate to target.

=item *

Source changes merge with target changes without conflict.

=item *

Conflicting changes that were resolve with an editor.

=item *

Conflicting changes that were resolved in TFS with acceptTheirs.
Can't be KeepYours since that would be 'merge'.

=back

=cut

sub ActionMERGE_E($)
{
  my $refItemFields = $_[0];

  return 0 unless UpdatedUnitConfirm( 'merge-E-source', $$refItemFields{source}, $$refItemFields{unitconfirm} );
  return 0 unless UpdatedUnitConfirm( 'merge-E-target', $$refItemFields{target}, $$refItemFields{unitconfirm} );
  return 1 if ! $isActive;

  my $sourceTFS = TFSServer2Workspace( $$refItemFields{source} );
  my $targetTFS = TFSServer2Workspace( $$refItemFields{target} );
  my $sourceP4 = TFSServer2P4Workspace( $$refItemFields{source} );
  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{target} );

  MsgVERBOSE( "merge-E \"$$refItemFields{source}\" \"$$refItemFields{target}\"" );
  if( ! -e $sourceTFS && ! -e $targetTFS ) {
    MsgVERBOSE( '... TFS merge of deleted' );
    $allowEmptyChangelist = 1;

  } elsif( -d $sourceTFS || -d $targetTFS ) {
    MsgVERBOSE( '... TFS is directory' );
    $allowEmptyChangelist = 1;

  } elsif( ! -e $targetTFS ) {
    MsgVERBOSE( '... TFS target does not exist' );
    MsgERROR( "merge-E TFS target does not exist - $$refItemFields{target}" );
    return 0;

  # If the TFS source doesn't exist, but the target does then we've
  # encountered a known TFS merge reporting anomaly. There are two versions
  # of this anomaly. One version is associated with a plain merge. That needs
  # a new open for the edit. Another version is associated with merge rename.
  # Normally the rename and merge have different sources. Sometimes, however,
  # The merge source is the rename source. Which means the edit is against a
  # file already open for add.

  } elsif( ! -e $sourceTFS && -e $targetTFS ) {
    MsgVERBOSE( '... no TFS source; recover as edit' );
    MsgLOG( "(merge-M) no TFS source; recover as edit - $$refItemFields{source}; $$refItemFields{target}" );
    if( exists $$refItemFields{secondary} && $$refItemFields{secondary} eq 'yes' ) {
      push @edits, { id => 'merge-E', reference => "$$refItemFields{target}", open => 'yes' };
    } else {
      push @edits, { id => 'merge-E', reference => "$$refItemFields{target}" };
    }

  } elsif( ! -e $sourceP4 && -e $targetP4 && -e $targetTFS ) {
    MsgVERBOSE( '... no p4 source; recover as edit' );
    MsgLOG( "(merge-E) no P4 source; recover as edit - $$refItemFields{source}; $$refItemFields{target}" );
    push @edits, { id => 'merge-E', reference => "$$refItemFields{target}" };

  } elsif( -e $sourceP4 && ! -e $targetP4 ) {
    MsgVERBOSE( '... no p4 target; recover as branch' );
    MsgLOG( "(merge-E) no p4 Target; recover as branch - $$refItemFields{source}; $$refItemFields{target}" );
    push @merges, { id => 'merge-E',
                    resolve => '',
                    version => "$$refItemFields{sversion}",
                    source => "$$refItemFields{source}",
                    svu => "$$refItemFields{svu}",
                    target => "$$refItemFields{target}" };

  } elsif( -e $sourceP4 && -e $targetP4 ) {
    MsgVERBOSE( '... merge' );
    my ($sourceTypeP4, $sourceMD5P4) = FileDetails( $sourceP4 );
    my ($targetTypeP4, $targetMD5P4) = FileDetails( $targetP4 );
    my ($targetTypeTFS, $targetMD5TFS) = FileDetails( $targetTFS );

    my $resolveAs = '-af';
    $resolveAs = '-at' if $targetMD5TFS eq $sourceMD5P4;
    $resolveAs = '-ay' if $targetMD5TFS eq $targetMD5P4;

    push @merges, { id => 'merge-M',
                    resolve => "$resolveAs",
                    version => "$$refItemFields{sversion}",
                    source => "$$refItemFields{source}",
                    svu => "$$refItemFields{svu}",
                    target => "$$refItemFields{target}" };

  } else {
    MsgVERBOSE( '... else' );
    MsgERROR( "merge-E else - $$refItemFields{source}" );
    return 0;
  }

  return 1;
}

=head3 merge undelete

The action 'merge undelete' specifies that the content of the target is
being restored.
If the target had never existed this would be a branch.

This covers these cases:

=over 4

=item *

Source has been modified and the target has been deleted.
There will be nothing to resolve.

=back

TFS branches deleted files.
Thus, TFS may believe there is a relationship to the undelete that Perforce
doesn't recognize.
All undeletes must be forced.

=cut

sub ActionMERGE_U($)
{
  my $refItemFields = $_[0];

  return 0 unless UpdatedUnitConfirm( 'merge-U-source', $$refItemFields{source}, $$refItemFields{unitconfirm} );
  return 0 unless UpdatedUnitConfirm( 'merge-U-target', $$refItemFields{target}, $$refItemFields{unitconfirm} );
  return 1 if ! $isActive;

  my $sourceTFS = TFSServer2Workspace( $$refItemFields{source} );
  my $targetTFS = TFSServer2Workspace( $$refItemFields{target} );
  my $sourceP4 = TFSServer2P4Workspace( $$refItemFields{source} );
  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{target} );

  MsgVERBOSE( "merge-U $$refItemFields{source}" );
  if( -d $sourceTFS ) {
    MsgVERBOSE( '... directory' );
    $allowEmptyChangelist = 1;

  } elsif( ! -e $targetTFS ) {
    MsgVERBOSE( '... TFS target does not exist' );
    MsgERROR( "merge-U TFS target does not exist - $$refItemFields{target}" );
    return 0;

  } elsif( -e $targetP4 ) {
    MsgVERBOSE( '... p4 target exists' );
    MsgERROR( "merge-u p4 target exists - $$refItemFields{target}" );
    return 0;

  } elsif( -e $sourceP4 ) {
    my $sourceRev = CS2CLAsRevRange( $$refItemFields{sversion} );
    MsgVERBOSE( "... merge from $sourceRev" );

    RunP4Command( "integrate -c $currentChangelist -f -Dt \"$sourceP4\"$sourceRev \"$targetP4\"" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "(merge-U) $p4ExitCode: integrate -f -Dt \"$sourceP4\" \"$targetP4\"", @p4Results );
      return 0;
    }

    # There should be nothing to resolve. But...

    RunP4Command( "resolve -n -c $currentChangelist" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "(merge-U) $p4ExitCode: resolve -n", @p4Results );
      return 0;
    }

    if( $p4Results[0] =~ m!^No file\(s\) to resolve! ) {
      MsgVERBOSE( '... nothing to resolve' );
    } else {
      MsgVERBOSE( '... resolve -at' );
      MsgLOG( "(merge-U) resolve $$refItemFields{target}" );
      RunP4Command( "resolve -c $currentChangelist -at" );
      if( $p4ExitCode != 0 ) {
        MsgERRORResponse( "(merge-E) $p4ExitCode: resolve -at", @p4Results );
        return 0;
      }
    }

  } else {
    MsgVERBOSE( '... else' );
    MsgERROR( "merge-U else - $$refItemFields{target}" );
    return 0;
  }

  return 1;
}

=head2 rename actions

Used in TFS and Perforce for both rename and move.
Source exists, target does not.

Moved in Perforce.

Target content in Perforce is validated against TFS content.

=cut

sub ProcessRENAMEAsMergeDelete($)
{
  my $refItemFields = $_[0];

  my $sourceP4 = TFSServer2P4Workspace( $$refItemFields{source} );
  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{target} );

  RunP4Command( "integ -c $currentChangelist \"$sourceP4\" \"$targetP4\"" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "(RENAMEAsMergeDelete) $p4ExitCode: integrate \"$sourceP4\" \"$targetP4\"", @p4Results );
    return 0;
  }

  RunP4Command( "resolve -n -c $currentChangelist" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "(RENAMEAsMergeDelete) $p4ExitCode: resolve -n", @p4Results );
    return 0;
  }

  if( $p4Results[0] !~ m!^No file\(s\) to resolve! ) {
    RunP4Command( "resolve -c $currentChangelist -at" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "(RENAMEAsMergeDelete) $p4ExitCode: resolve -at", @p4Results );
      return 0;
    }
  }

  RunP4Command( "delete -c $currentChangelist \"$sourceP4\"" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "(RENAMEAsMergeDelete) $p4ExitCode: delete $sourceP4", @p4Results );
    return 0;
  }
  return 1;
}

sub ActionRENAME_F($)
{
  my $refItemFields = $_[0];
  return 0 unless UpdatedUnitConfirm( 'rename-F-source', $$refItemFields{source}, $$refItemFields{unitconfirm} );
  return 0 unless UpdatedUnitConfirm( 'rename-F-target', $$refItemFields{target}, $$refItemFields{unitconfirm} );
  return 1 unless $isActive;

  my $targetTFS = TFSServer2Workspace( $$refItemFields{target} );
  my $sourceP4 = TFSServer2P4Workspace( $$refItemFields{source} );
  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{target} );

  MsgVERBOSE( "rename_f $$refItemFields{source}; $$refItemFields{target}" );
  if( ! -e $targetTFS ) {
    MsgVERBOSE( '... TFS target - does not exist' );
    if( exists $$refItemFields{optional} ) {
      MsgVERBOSE( '... optional' );
      MsgLOG( "(rename_f) rename deleted unit - $$refItemFields{source}; $$refItemFields{target}" );
      $allowEmptyChangelist = 1;

    } else {
      MsgERROR( "(rename_f) TFS target does not exist - $$refItemFields{source}; $$refItemFields{target}" );
      return 0;
    }

  } elsif( ! -f $targetTFS ) {
    MsgERROR( "(rename_f) TFS not a file - $$refItemFields{source}; $$refItemFields{target}" );
    return 0;

  } elsif( ! -e $sourceP4 ) {
    MsgVERBOSE( '... P4 source - does not exist' );
    if( exists $$refItemFields{optional} ) {
      MsgVERBOSE( '... optional' );
      MsgLOG( "(rename_f) rename deleted unit - $$refItemFields{source}; $$refItemFields{target}" );
      $allowEmptyChangelist = 1;

    } else {
      MsgERROR( "(rename_f) P4 source does not exist - $$refItemFields{source}; $$refItemFields{target}" );
      return 0;
    }

  } elsif( -d $sourceP4 ) {
    MsgERROR( "(rename_f) P4 is a directory - $$refItemFields{source}; $$refItemFields{target}" );
    return 0;

  } elsif( -f $sourceP4 ) {
    MsgVERBOSE( '... file' );
    if( -e $targetP4 ) {
      MsgVERBOSE( '... process as merge delete' );
      MsgLOG( "(rename_f) P4 target exists; process as merge delete - $$refItemFields{source}; $$refItemFields{target}" );
      return ProcessRENAMEAsMergeDelete( $refItemFields );

    } else {
      if( ! exists $$refItemFields{ttype} ) {
        RunP4Command( "open -c $currentChangelist \"$sourceP4\"" );
        if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
          MsgERRORResponse( "(rename_f) $p4ExitCode: open $sourceP4", @p4Results );
          return 0;
        }
      }

      utilAssurePathElements( $targetP4 )
        if ! -e $targetP4;   # to assure workspace path case

      RunP4Command( "move -c $currentChangelist \"$sourceP4\" \"$targetP4\"" );
      if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
        MsgERRORResponse( "(rename_f) $p4ExitCode: move $sourceP4 $targetP4", @p4Results );
        return 0;
      }
    }

  } else {
    MsgERROR( "(rename_f) else - $$refItemFields{source}; $$refItemFields{target}" );
    return 0;
  }

  return 1;
}

sub ActionRENAME_P($)
{
  my $refItemFields = $_[0];

  return 1 unless $isActive;

  UpdatedUnitIgnore( $$refItemFields{source} );
  UpdatedUnitIgnore( $$refItemFields{target} );

  my $targetTFS = TFSServer2Workspace( $$refItemFields{target} );
  my $sourceP4 = TFSServer2P4Workspace( $$refItemFields{source} );
  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{target} );

  MsgVERBOSE( "rename_p $$refItemFields{source}; $$refItemFields{target}" );
  if( ! -e $targetTFS ) {
    MsgVERBOSE( '... TFS - does not exist' );
    if( exists $$refItemFields{optional} ) {
      MsgVERBOSE( '... optional' );
      MsgLOG( "(rename_p) rename deleted unit - $$refItemFields{source}; $$refItemFields{target}" );
      $allowEmptyChangelist = 1;

    } else {
      MsgERROR( "(rename_p) TFS does not exist - $$refItemFields{source}; $$refItemFields{target}" );
      return 0;
    }

  } elsif( ! -d $targetTFS ) {
    MsgERROR( "(rename_p) TFS not a directory - $$refItemFields{source}; $$refItemFields{target}" );
    return 0;

  } elsif( -f $sourceP4 ) {
    MsgERROR( "(rename_p) P4 is a file - $$refItemFields{source}; $$refItemFields{target}" );
    return 0;

  } elsif( -d $sourceP4 ) {
    MsgVERBOSE( '... directory' );
    if( -e $targetP4 ) {
      MsgERROR( "(rename_p) P4 target exists - $$refItemFields{source}; $$refItemFields{target}" );
      return 0;

    } else {
      utilAssurePathElements( $targetP4 );  # to assure workspace path case
      RunP4Command( "open -c $currentChangelist \"$sourceP4/...\"" );
      if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
        MsgERRORResponse( "(rename_p) $p4ExitCode: open $sourceP4/...", @p4Results );
        return 0;
      }
      RunP4Command( "move -c $currentChangelist \"$sourceP4/...\" \"$targetP4/...\"" );
      if( $p4ExitCode != 0 || FindP4Return( 'fromFile' ) eq '' ) {
        MsgERRORResponse( "(rename_p) $p4ExitCode: move $sourceP4/... $targetP4/...", @p4Results );
        return 0;
      }
    }

  } else {
    MsgERROR( "(rename_p) else - $$refItemFields{source}; $$refItemFields{target}" );
    return 0;
  }

  return 1;
}

sub ActionRENAME_C($)
{
  my $refItemFields = $_[0];
  return 0 unless UpdatedUnitConfirm( 'rename-C-source', $$refItemFields{source}, $$refItemFields{unitconfirm} );
  return 0 unless UpdatedUnitConfirm( 'rename-C-target', $$refItemFields{target}, $$refItemFields{unitconfirm} );
  return 1 unless $isActive;

  my $targetTFS = TFSServer2Workspace( $$refItemFields{target} );
  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{target} );

  MsgVERBOSE( "rename-C $$refItemFields{source} $targetP4" );
  if(    exists $$refItemFields{ttype}
      && $$refItemFields{ttype} eq '2CP'
      && $serverCaseHandling eq 'insensitive'
      && -e $targetP4 ) {

    MsgVERBOSE( '... 2CP' );
    my $currentCaseP4 = PathCase( $targetP4 );
    if( $currentCaseP4 ne $targetP4 ) {
      MsgVERBOSE( '... case correct' );
      if( ! rename( $currentCaseP4, $targetP4 ) ) {
        MsgERROR( "(rename_c) rename $currentCaseP4 to $targetP4 - $!" );
        return 0;
      }
    }
    chmod 0777, $targetP4;  # the renamecase_p sync has left this read-only
    RunP4Command( "add -c $currentChangelist \"$targetP4\"" );
    if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
      MsgERRORResponse( "(rename-C) $p4ExitCode: add $targetP4", @p4Results );
      return 0;
    }

  } elsif( -e $targetP4 ) {
    MsgVERBOSE( '... exists' );

  } elsif( -d $targetTFS ) {
    if( isDirectoryEmpty( $targetTFS ) ) {
      MsgVERBOSE( '... empty directory' );
      MsgLOG( "(rename_c) empty directory - $$refItemFields{source}; $$refItemFields{target}" );
    } else {
      MsgVERBOSE( '... directory' );
    }
    $allowEmptyChangelist = 1;

  } elsif( ! -e $targetP4 && exists $$refItemFields{optional} ) {
    MsgVERBOSE( '... optional (rename of deleted unit)' );
    MsgLOG( "(rename_c) rename deleted - $$refItemFields{source}; $$refItemFields{target}" );
    $allowEmptyChangelist = 1;

  } elsif( ! -e $targetP4 && -e $targetTFS ) {
    MsgVERBOSE( '... P4 target does not exist; recover as add' );
    MsgLOG( "(rename_c) P4 target does not exist; recover as add - $$refItemFields{source}; $$refItemFields{target}" );

    push @adds, { id => 'rename_c', reference => "$$refItemFields{target}" };

  } else {
    MsgVERBOSE( '... else' );
    MsgERROR( "(rename-C) else - $targetP4" );
    return 0;
  }

  return 1;
}

=head2 renamedelete

Secondary action.
Parameters already verified by primary.

Revert is consistent with how Perforce replicates the workspace, but doesn't
leave the audit trail that TFS would.

Different scenarios.
Rename of a deleted file - already deleted.
Rename of an added file (case only rename) - revert.
Delete of a renamed file prior to checkin - needs to revert the rename and
delete the source.

=cut

sub ActionRENAMEDELETE($)
{
  my $refItemFields = $_[0];
  return 1 unless $isActive;

  my $targetP4 = TFSServer2P4Workspace( $$refItemFields{reference} );

  MsgVERBOSE( "renamedelete $$refItemFields{reference}" );
  if( -f $targetP4 ) {
    MsgVERBOSE( '... file' );
    RunP4Command( "revert -c $currentChangelist \"$targetP4\"" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "(renamedelete) revert $targetP4", @p4Results );
      return 0;
    }
    my $clientFile = '';
    my $oldAction = '';
    foreach (@p4Results) {
      $clientFile = $1 if m!^\.{3} clientFile (.+)$!;
      $oldAction = $1 if m!^\.{3} oldAction (.+)$!;
      last if $oldAction eq 'move/delete';
    }
    $clientFile =~ s!\\!\/!g;
    if( $oldAction eq 'move/delete' ) {
      RunP4Command( "delete -c $currentChangelist \"$clientFile\"" );
      if( $p4ExitCode != 0 ) {
        MsgERRORResponse( "(renamedelete) delete $clientFile", @p4Results );
        return 0;
      }
    } elsif( -f $targetP4 && $oldAction eq 'add' ) {
      MsgVERBOSE( '... unlink' );
      unlink $targetP4;
    }

  } elsif( -d $targetP4 ) {
    MsgVERBOSE( '... directory' );
    $allowEmptyChangelist = 1;

  } elsif( ! -e $targetP4 ) {
    MsgVERBOSE( '... does not exist' );
    MsgLOG( "(renamedelete) delete deleted - $$refItemFields{reference}" );
    $allowEmptyChangelist = 1;

  } else {
    MsgERROR( "(renamedelete) else - $$refItemFields{reference}" );
    return 0;

  } 

  return 1;
}

=head2 renameedit

Secondary action.
Parameters already verified by primary.

Already open so just overwrite current contents.
However, need to check for type consistency.

=cut

sub ActionRENAMEEDIT($)
{
  my $refItemFields = $_[0];
  return 1 unless $isActive;

  my $referenceTFS = TFSServer2Workspace( $$refItemFields{reference} );
  my $referenceP4 = TFSServer2P4Workspace( $$refItemFields{reference} );

  MsgVERBOSE( "renameedit $$refItemFields{reference}" );
  if( ! -e $referenceTFS ) {
    MsgERROR( "(renameedit) TFS does not exist - $$refItemFields{reference}" );
    return 0;

  } elsif( -d $referenceTFS ) {
    MsgERROR( "(renameedit) TFS is directory - $$refItemFields{reference}" );
    return 0;

  } elsif( ! -e $referenceP4 ) {
    MsgERROR( "(renameedit) P4 does not exist - $$refItemFields{reference}" );
    return 0;

  } elsif( -d $referenceP4 ) {
    MsgERROR( "(renameedit) P4 is directory - $$refItemFields{reference}" );
    return 0;

  } elsif( -f $referenceP4 ) {
    RunP4Command( "opened -c $currentChangelist \"$referenceP4\"" );
    if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
      MsgERRORResponse( "(renameedit) $p4ExitCode: opened $referenceP4", @p4Results );
      return 0;
    }
    if( ! copy( $referenceTFS, $referenceP4 ) ) {
      MsgERROR( "(renameedit) copy failure $referenceTFS $referenceP4 - $!" );
      return 0;
    }

    my ($referenceTypeTFS, $referenceMD5TFS) = FileDetails( $referenceTFS );
    return TypeConsistency( $referenceP4, $referenceTypeTFS, FindP4Return( 'type' ) );

  } else {
    MsgERROR( "(renameedit) else - $$refItemFields{reference}" );
    return 0;
  }

  return 1;
}

=head2 rename case actions

Used in TFS and Perforce for rename of an element where the only change is
the case of one or more characters in a name.
Need to assume operation from a Windows client - which is not case sensitive.
However, need to support both case sensitive and case insensitive servers.

Assume case insensitive servers adapt to the last used character case.
Case sensitive servers are able to change case but not through
the workspace.

Source exists. Targets are not significant.

Moved in Perforce.

No need for content or file type validation.

=cut

sub ActionRENAMECASE_F($)
{
  my $refItemFields = $_[0];

  return 0 unless UpdatedUnitConfirm( 'renamecase-F-target', $$refItemFields{reference}, $$refItemFields{unitconfirm} );
  return 1 unless $isActive;

  my $referenceTFS = TFSServer2Workspace( $$refItemFields{reference} );
  my $referenceP4 = TFSServer2P4Workspace( $$refItemFields{reference} );

  MsgVERBOSE( "renamecase_f reference $$refItemFields{reference}" );
  MsgVERBOSE( "... $serverCaseHandling" );
  if( ! -e $referenceTFS ) {
    if( exists $$refItemFields{optional} ) {
      MsgVERBOSE( '... TFS does not exist - optional (rename of deleted unit)' );
      MsgLOG( "(renamecase_f) rename deleted unit - $$refItemFields{reference}" );
      $allowEmptyChangelist = 1;
    } else {
      MsgERROR( "(renamecase_f) TFS does not exist - $referenceTFS" );
      return 0;
    }

  } elsif( ! -f $referenceTFS ) {
    MsgERROR( "(renamecase_f) TFS not a file - $referenceTFS" );
    return 0;

  } elsif( -d $referenceP4 ) {
    MsgERROR( "(renamecase_f) P4 is a directory - $referenceP4" );
    return 0;

  } elsif( $serverCaseHandling eq 'sensitive' ) {
    if( exists $$refItemFields{casesetup} ) {
      MsgVERBOSE( "... case setup ($$refItemFields{casesetup})" );
      return 1;

    } else {
      MsgVERBOSE( "... case operation" );
      if( ! -e $referenceP4 ) {
        MsgVERBOSE( '... does not exist' );
        MsgLOG( "(renamecase_f) P4 does not exist - $$refItemFields{reference}" );
        $allowEmptyChangelist = 1;
        return 1;
      }
      my $currentCaseP4 = PathCase( $referenceP4 );
      if( ! exists $$refItemFields{ttype} || ($$refItemFields{ttype} ne '2F') ) {
        RunP4Command( "open -c $currentChangelist \"$currentCaseP4\"" );
        if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
          MsgERRORResponse( "(renamecase_f) $p4ExitCode: open $currentCaseP4", @p4Results );
          return 0;
        }
      }
      RunP4Command( "move -c $currentChangelist \"$currentCaseP4\" \"$referenceP4\"" );
      if( $p4ExitCode != 0 || FindP4Return( 'fromFile' ) eq '' ) {
        MsgERRORResponse( "(renamecase_f) $p4ExitCode: move $currentCaseP4 $referenceP4", @p4Results );
        return 0;
      }
      if( ! rename( $currentCaseP4, $referenceP4 ) ) {
        MsgERROR( "(renamecase_f) rename $currentCaseP4 to $referenceP4 - $!" );
        return 0;
      }
    }

  } elsif( $serverCaseHandling eq 'insensitive' ) {
    if( exists $$refItemFields{casesetup} ) {
      MsgVERBOSE( "... case setup ($$refItemFields{casesetup})" );
      if( exists $$refItemFields{ttype} && $$refItemFields{ttype} eq '2F' ) {
        MsgVERBOSE( '... 2F' );
        return 1;
      }
      if( ! -e $referenceP4 ) {
        MsgVERBOSE( '... does not exist' );
        MsgLOG( "(renamecase_f) setup P4 does not exist - $$refItemFields{reference}" );
        return 1;
      }
      if( ! exists $$refItemFields{ttype} || $$refItemFields{ttype} ne '2F' ) {
        push @deletes, { id => 'renamecase-F', reference => "$$refItemFields{reference}" };
        $ifCaseAction = 1;
      }

    } elsif( ! exists $$refItemFields{ttype} || $$refItemFields{ttype} ne '2F' ) {
      MsgVERBOSE( '... case operation ! 2F' );
      my $syncTo = CS2CLAsCL( $currentChangeset . 'C', -1 );
      MsgVERBOSE( "... $syncTo" );
      RunP4Command( "sync \"$referenceP4\"$syncTo" );
      if( $p4ExitCode != 0 ) {
        MsgERRORResponse( "(renamecase_f) $p4ExitCode: sync $referenceP4$syncTo", @p4Results );
        return 0;
      }
      my $currentCaseP4 = PathCase( $referenceP4 );
      if( ! rename( $currentCaseP4, $referenceP4 ) ) {
        MsgERROR( "(renamecase_f) rename $currentCaseP4 to $referenceP4 - $!" );
        return 0;
      }
      chmod 0777, $referenceP4;  # sync has left this read-only
      MsgVERBOSE( "... add file $$refItemFields{reference}" );
      push @adds, { id => 'renamecase-F', reference => "$$refItemFields{reference}", content => 'asis' };

    } elsif( exists $$refItemFields{ttype} && $$refItemFields{ttype} eq '2F' ) {
      MsgVERBOSE( '... case operation 2F' );
      RunP4Command( "revert -c $currentChangelist \"$referenceP4\"" );
      if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
        MsgERRORResponse( "(renamecase_f) $p4ExitCode: revert $referenceP4", @p4Results );
        return 0;
      }
      my $sourceP4 = TFSServer2P4Workspace( $$refItemFields{source} );
      RunP4Command( "open -c $currentChangelist \"$sourceP4\"" );
      if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
        MsgERRORResponse( "(renamecase_f) $p4ExitCode: open $sourceP4", @p4Results );
        return 0;
      }
      RunP4Command( "move -c $currentChangelist \"$sourceP4\" \"$referenceP4\"" );
      if( $p4ExitCode != 0 || FindP4Return( 'fromFile' ) eq '' ) {
        MsgERRORResponse( "(renamecase_f) $p4ExitCode: move $sourceP4 $referenceP4", @p4Results );
        return 0;
      }
    }

  } else {
    MsgERROR( "(renamecase_f) else $$refItemFields{reference}" );
    return 0;
  }

  return 1;
}

sub ActionRENAMECASE_P($)
{
  my $refItemFields = $_[0];

  return 1 unless $isActive;

  UpdatedUnitIgnore( $$refItemFields{reference} );

  my $referenceTFS = TFSServer2Workspace( $$refItemFields{reference} );
  my $referenceP4 = TFSServer2P4Workspace( $$refItemFields{reference} );

  MsgVERBOSE( "renamecase_p reference $$refItemFields{reference}" );
  if( ! -e $referenceTFS ) {
    MsgERROR( "(renamecase_p) TFS $referenceTFS - does not exist" );
    return 0;

  } elsif( -d $referenceTFS ) {
    if( isDirectoryEmpty( $referenceTFS ) ) {
      MsgVERBOSE( "... empty" );
      $allowEmptyChangelist = 1;
      return 1;
    }
    if( -e $referenceP4 && ! -d $referenceP4 ) {
      MsgERROR( "(renamecase_p) P4 $referenceP4 - is not a directory" );
      return 0;
    }

    MsgVERBOSE( "... $serverCaseHandling" );
    if( $serverCaseHandling eq 'sensitive' ) {
      if( ! -e $referenceP4 ) {
        MsgERROR( "(renamecase_p) P4 $referenceP4 - does not exist" );
        return 0;
      }
      if( exists $$refItemFields{casesetup} ) {
        MsgVERBOSE( "... case setup ($$refItemFields{casesetup})" );
        return 1;

      } else {
        MsgVERBOSE( "... case operation" );
        my $currentCaseP4 = PathCase( $referenceP4 );
        RunP4Command( "open -c $currentChangelist \"$currentCaseP4/...\"" );
        if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
          MsgERRORResponse( "(renamecase_p) $p4ExitCode: open $currentCaseP4/...", @p4Results );
          return 0;
        }
        RunP4Command( "move -c $currentChangelist \"$currentCaseP4/...\" \"$referenceP4/...\"" );
        if( $p4ExitCode != 0 || FindP4Return( 'fromFile' ) eq '' ) {
          MsgERRORResponse( "(renamecase_p) $p4ExitCode: move $currentCaseP4/... $referenceP4/...", @p4Results );
          return 0;
        }
        if( ! rename( $currentCaseP4, $referenceP4 ) ) {
          MsgERROR( "(renamecase_p) rename $currentCaseP4 to $referenceP4 - $!" );
          return 0;
        }

      }

    } else {
      if( exists $$refItemFields{casesetup} ) {
        MsgVERBOSE( "... case setup ($$refItemFields{casesetup})" );
        if( ! -e $referenceP4 ) {
          MsgERROR( "(renamecase_p) P4 $referenceP4 - does not exist" );
          return 0;
        }
        RunP4Command( "delete -c $currentChangelist \"$referenceP4/...\"" );
        if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
          MsgERRORResponse( "(renamecase_p) $p4ExitCode: delete $referenceP4/...", @p4Results );
          return 0;
        }
        $ifCaseAction = 1;

      } else {
        MsgVERBOSE( '... case operation' );
        if( ! -e $referenceP4 ) {
          MsgVERBOSE( '... does not exist' );
          mkpath( $referenceP4, 0, 0777 );
        } else {
          MsgVERBOSE( '... exists' );
        }
        my $syncTo = CS2CLAsCL( $currentChangeset . 'C', -1 );
        MsgVERBOSE( "... $syncTo" );
        RunP4Command( "sync \"$referenceP4/...\"$syncTo" );
        if( $p4ExitCode != 0 || FindP4Return( 'depotFile' ) eq '' ) {
          MsgERRORResponse( "(renamecase_p) $p4ExitCode: sync $referenceP4/...$syncTo", @p4Results );
          return 0;
        }
      }
    }

  } else {
    MsgERROR( "(renamecase_p) TFS $referenceTFS - not a directory" );
    return 0;
  }
  
  return 1;
}

sub ActionRENAMECASE_C($)
{
  my $refItemFields = $_[0];
  return 0 unless UpdatedUnitConfirm( 'renamecase-C-target', $$refItemFields{reference}, $$refItemFields{unitconfirm} );
  return 1 unless $isActive;

  my $referenceTFS = TFSServer2Workspace( $$refItemFields{reference} );
  my $referenceP4 = TFSServer2P4Workspace( $$refItemFields{reference} );

  MsgVERBOSE( "renamecase_c $$refItemFields{reference}" );
  if( $serverCaseHandling eq 'sensitive' ) {
    MsgVERBOSE( "... $serverCaseHandling" );
    if( -f $referenceP4 ) {
      MsgVERBOSE( '... file' );
      my $currentCaseP4 = PathCase( $referenceP4 );
      if( $currentCaseP4 ne $referenceP4 ) {
        MsgVERBOSE( "... $currentCaseP4 to $referenceP4" );
        RunP4Command( "move -c $currentChangelist \"$currentCaseP4\" \"$referenceP4\"" );
        if( $p4ExitCode != 0 || FindP4Return( 'fromFile' ) eq '' ) {
          MsgERRORResponse( "(renamecase_c) $p4ExitCode: move $currentCaseP4 $referenceP4", @p4Results );
          return 0;
        }
      }

    } elsif( -d $referenceP4 ) {
      MsgVERBOSE( '... directory' );
      $allowEmptyChangelist = 1;

    } elsif( ! -e $referenceP4 && exists $$refItemFields{optional} ) {
      MsgVERBOSE( '... optional does not exist' );
      MsgLOG( "(renamecase_c) rename deleted - $$refItemFields{reference}" );
      $allowEmptyChangelist = 1;

    } else {
      MsgERROR( "(renamecase_c) else sensitive - $$refItemFields{reference}" );
      return 0;
    }

  } elsif( $serverCaseHandling eq 'insensitive' ) {
    MsgVERBOSE( "... $serverCaseHandling" );
    if( -f $referenceP4 ) {
      MsgVERBOSE( '... file' );
      my $currentCaseP4 = PathCase( $referenceP4 );
      if( $currentCaseP4 ne $referenceP4 ) {
        MsgVERBOSE( "... rename $currentCaseP4 to $referenceP4" );
        if( ! rename( $currentCaseP4, $referenceP4 ) ) {
          MsgERROR( "(renamecase_c) rename $currentCaseP4 to $referenceP4 - $!" );
          return 0;
        }
      }
      chmod 0777, $referenceP4;  # renamecase_p sync has left this read-only
      MsgVERBOSE( '... add file' );
      push @adds, { id => 'renamecase-C', reference => "$$refItemFields{reference}", content => 'asis' };

    } elsif( -d $referenceP4 ) {
      MsgVERBOSE( '... directory' );
      $allowEmptyChangelist = 1;

    } elsif( ! -e $referenceP4 && exists $$refItemFields{optional} ) {
      MsgVERBOSE( '... optional does not exist' );
      MsgLOG( "(renamecase_c) rename deleted - $$refItemFields{reference}" );
      $allowEmptyChangelist = 1;

    } else {
      MsgERROR( "(renamecase_c) else insensitive - $$refItemFields{reference}" );
      return 0;
    }

  } else {
    MsgERROR( "(renamecase_c) else $$refItemFields{reference}" );
    return 0;

  }

  return 1;
}


=head2 undelete actions

A file with this path existed in the past.

To create an undelete (AKA rollback) relationship in Perforce a sync against
the revision just prior to the delete is used to populate the Perforce
workspace.
The content in the Perforce workspace is validated against the TFS content
which may result in a further edit and file type specification.

=cut

sub ActionUNDELETE($)
{
  my $refItemFields = $_[0];
  return 0 unless UpdatedUnitConfirm( 'undelete', $$refItemFields{reference}, $$refItemFields{unitconfirm} );
  return 1 unless $isActive;

  my $referenceTFS = TFSServer2Workspace( $$refItemFields{reference} );
  my $referenceP4 = TFSServer2P4Workspace( $$refItemFields{reference} );

  MsgVERBOSE( "Undelete $$refItemFields{reference}" );
  if( ! -e $referenceTFS ) {
    MsgVERBOSE( '... TFS does not exist' );
    MsgERROR( "undelete TFS does not exist - $referenceTFS" );
    return 0;

  } elsif( -e $referenceP4 ) {
    MsgERROR( "undelete p4 exists - $referenceP4" );
    return 0;

  } elsif( -d $referenceTFS ) {
    MsgVERBOSE( '... directory' );
    $allowEmptyChangelist = 1;

  } elsif( -f $referenceTFS ) {
    my ($referenceTypeTFS, $referenceMD5TFS) = FileDetails( $referenceTFS );
    utilAssurePathElements( $referenceP4 );
    my $syncTo = CS2CLAsCL( $$refItemFields{deleted}, -1 );
    MsgVERBOSE( "... sync to $syncTo - $referenceTypeTFS $referenceMD5TFS" );
    RunP4Command( "sync -f \"$referenceP4\"$syncTo" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "(undelete) $p4ExitCode: sync -f $referenceP4$syncTo", @p4Results );
      return 0;
    }
    my ($referenceTypeP4, $referenceMD5P4) = FileDetails( $referenceP4 );
    RunP4Command( "add -c $currentChangelist \"$referenceP4\"" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "(undelete) $p4ExitCode: add $referenceP4", @p4Results );
      return 0;
    }
    MsgVERBOSE( "... TFS $referenceTypeTFS $referenceMD5TFS ... P4 $referenceTypeP4 $referenceMD5P4" );
    if( $referenceMD5TFS ne $referenceMD5P4 ) {
      MsgVERBOSE( '... update from TFS' );
      if( ! copy( $referenceTFS, $referenceP4 ) ) {
        MsgERROR( "(undelete) copy faiure '$referenceTFS' '$referenceP4' - $!" );
        return 0;
      }
    }
    return TypeConsistency( $referenceP4, $referenceTypeTFS, FindP4Return( 'type' ) );

  } else {
    MsgERROR( "undelete else - $$refItemFields{reference}" );
    return 0;
  }

  return 1;
}

=head2 Change Container

A change container (CC tag) marks the start of a sequence of action
specifications that reflect a TFS changeset that is to be imported as
a Perforce changelist.

The container specifies the TFS changeset and the check-in comment associated
with the creation of that changeset.

There is no processing during the validation phase.
During the import phase:

=over 4

=item *

The TFS workspace is synchronized to the specified TFS changeset prior to
action processing.
The TFS actions are recorded for use as a baseline for checks against
expected results.

=item *

A Perforce changelist is created for the import processing.
All import processing for this container is performed relative to this
changelist.

=back

=cut

sub CreateChangelist($)
{
  my $hCLin;
  open $hCLin, '>', $pathMigrateIn;
  print $hCLin "Change: new\n";
  print $hCLin "Description:\n";
  print $hCLin $_[0];
  close $hCLin;

  RunP4Command( "change -i <$pathMigrateIn" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "(create changeset) $p4ExitCode: change -i", @p4Results );
    return 0;
  } else {
    $currentChangelist = 0;
    $currentChangelist = $1 if $p4Results[0] =~ m!^Change (\d+) created!;
    MsgERRORReponse( 'P4 change -i did not create changelist', @p4Results )
      if $currentChangelist == 0;
  }

  return $currentChangelist != 0;
}

sub ProcessTagCC($$)
{
  my ($refItemFields, $value) = @_;
  if( -e $pathStopFile ) {
    MsgERROR( "Stop file encountered" );
    return 0;
  }
  $currentChangeset = '??';
  $currentChangeset = $$refItemFields{seq}
    if exists $$refItemFields{seq};
  $errorContext = "Sequence $currentChangeset";
  $logContext = $errorContext;

  return 1 if ! $isActive;

  $allowEmptyChangelist = 0;
  $ifCaseAction = 0;

  RunTFCommand( "get /v:$$refItemFields{seq}" );
  if( $tfExitCode != 0 ) {
    MsgERRORResponse( "(TFS sync) $tfExitCode: get /v:$$refItemFields{seq}", @tfResults );
    return 0;

  } else {
    MsgVERBOSE( "==$$refItemFields{seq}==" );
    foreach my $line (@tfResults) {
      chomp $line;
      if( $line =~ m!^All files are up to date! ) {
        $ifUpdatedCurrent = 1;
        last;
      } elsif( $line =~ m!^(\S\:.+)\:$! ) {
        UpdatedDirectoryGet($1);
      } elsif( $line =~ m!^(\S+) (.+)$! ) {
        UpdatedUnitGet($1, $2);
      }
    }
  }

  $value = XMLTextDecode( $value );
  $currentDescription = '';
  $currentDescription = " No user check-in comment"
    if $value =~ m!^\s*$!;
  foreach my $line (split "\n", $value) {
    $currentDescription .= ' '
      unless $line =~ m!^\s!;
    $currentDescription .= "$line\n";
  }
  $currentDescription .= " ==$currentChangeset==";

  return CreateChangelist( $currentDescription );
}

=head2 Change Submit

A change submit (CS tag) marks the end of an action sequence that implemented
a TFS changeset.

During the validation phase, the changeset to changelist mapping is created
and verified against duplication.

During the import phase, if there are no reported errors:

=over 4

=item *

If the changelist has at least one open file it is submitted.
Changesets with only directory relative actions can create
empty Perforce changelists which can not be submitted.

=item *

After a submit the user information is updated.

=item *

After a submit the date and time information is updated.

=item *

The changelist to changeset mapping entry is created using the actual
changelist value of the submit.

=back

=cut

sub ProcessTagCS($$;$)
{
  my ($refItemFields, $value, $description) = @_;

  if( $isActive ) {

    return 0 if $modeNoSubmit;

    MsgVERBOSE( "submit $currentChangelist" );
    RunP4Command( "submit -c $currentChangelist" );
    if( $p4ExitCode != 0 ) {
      if( $p4Results[-1] =~ m!No files to submit!i ) {
        MsgVERBOSE( '... empty changelist' );
        MsgLOG( 'Empty changelist' )
          unless $allowEmptyChangelist;
        RunP4Command( "change -d $currentChangelist" );
        if( $p4ExitCode != 0 ) {
          MsgERROR( "Failed to delete empty changelist $currentChangelist" );
          return 0;
        }
      } else {
        MsgERRORResponse( "(submit) $p4ExitCode: submit -c $currentChangelist", @p4Results );
        return 0;
      }
    } else {
      my $submitted = FindP4Return( 'submittedChange', 0 );
      if( $submitted != 0 ) {
        MsgVERBOSE( "... submitted as $submitted" );
        $currentChangelist = $submitted;

        my $user = $P4USER;
        $user = $$refItemFields{user}
          if exists $$refItemFields{user};
        $user =~ s![\s\\\/\]\[]!_!g;
        my $date = undef;
        if( exists $$refItemFields{when} ) {
          $date = $1 if $$refItemFields{when} =~ m!^\d+ (.+)$!;
          $date =~ s!\.!\/!g;
        }
      
        my $hCLin;
        open $hCLin, '>', $pathMigrateIn;
        print $hCLin "Change: $currentChangelist\n";
        print $hCLin "Status: submitted\n";
        print $hCLin "User: $user\n";
        print $hCLin "Date: $date\n"
          if defined $date;
        print $hCLin "Client: $P4CLIENT\n";
        print $hCLin "Description:\n";
        print $hCLin $currentDescription
          if ! defined $description;
        print $hCLin $description
          if defined $description;
        close $hCLin;

        RunP4Command( "change -f -i <$pathMigrateIn" );
        if( $p4ExitCode != 0 ) {
          MsgERRORResponse( "(submit changeset update) $p4ExitCode: change -f -i", @p4Results );
          return 0;
        }
      } else {
        MsgERRORResponse( "(submit) unrecognized success: submit -c $currentChangelist", @p4Results );
        return 0;
      }
    }

    if( ! defined $description ) {
      UpdatedReset();
      P4TypesReset();
      CS2CLMap( $currentChangeset, $currentChangelist );
    } else {
      CS2CLMap( "$currentChangeset" . 'C', $currentChangelist );
    }

  } else {
    CS2CLMap( $currentChangeset, 0 );

  }

  return 1;
}

=head2 Action Item

An action item (AI tag) specifies an action that needs to be processed
in order to re-create the changes reflected by a TFS changeset.

Action item processing combines Perforce commands against a Perforce workspace
with content from a TFS workspace.

Action items specify both files and directories.
If a directory relative action also impacts files, there are
separate actions relating to each of those files.
If a directory relative action does not impact any files it is ignored.

In theory, file specific actions could be replaced by a single directory
relative Perforce action to reduce import time overhead.
In practice, this mostly improves the relatively rare instance of
creating branches.
Regardless, the TFS handling of file content types require that most of the
individual file actions be performed.

The import does not current perform any directory replacement
processing.

=over 6

=item NOTE

Real-time file information is required to validate directory replacement.
Directory replacement combinations can not be validated during generation
processing without additional information that would significantly increase
extraction time.

=back

=cut

sub ProcessTagAI($$)
{
  my ($refItemFields, $value) = @_;

  ++$progressUnitsCount;
  if( ! exists $$refItemFields{action} ) {
    MsgERROR( "AI tag missing action attribute" );
    return 0;

  } elsif( $$refItemFields{action} eq 'add' ) {
    return ActionADD( $refItemFields );

  } elsif( $$refItemFields{action} eq 'branch' ) {
    return ActionBRANCH( $refItemFields );

  } elsif( $$refItemFields{action} eq 'delete' ) {
    return ActionDELETE( $refItemFields );

  } elsif( $$refItemFields{action} eq 'edit' ) {
    return ActionEDIT( $refItemFields );

  } elsif( $$refItemFields{action} eq 'merge-B' ) {
    return ActionMERGE_B( $refItemFields );

  } elsif( $$refItemFields{action} eq 'merge-M' ) {
    return ActionMERGE_M( $refItemFields );

  } elsif( $$refItemFields{action} eq 'merge-D' ) {
    return ActionMERGE_D( $refItemFields );

  } elsif( $$refItemFields{action} eq 'merge-E' ) {
    return ActionMERGE_E( $refItemFields );

  } elsif( $$refItemFields{action} eq 'merge-U' ) {
    return ActionMERGE_U( $refItemFields );

  } elsif( $$refItemFields{action} eq 'rename-P' ) {
    return ActionRENAME_P( $refItemFields );

  } elsif( $$refItemFields{action} eq 'rename-F' ) {
    return ActionRENAME_F( $refItemFields );

  } elsif( $$refItemFields{action} eq 'rename-C' ) {
    return ActionRENAME_C( $refItemFields );

  } elsif( $$refItemFields{action} eq 'renamecase-P' ) {
    return ActionRENAMECASE_P( $refItemFields );

  } elsif( $$refItemFields{action} eq 'renamecase-F' ) {
    return ActionRENAMECASE_F( $refItemFields );

  } elsif( $$refItemFields{action} eq 'renamecase-C' ) {
    return ActionRENAMECASE_C( $refItemFields );

  } elsif( $$refItemFields{action} eq 'renamedelete' ) {
    return ActionRENAMEDELETE( $refItemFields );

  } elsif( $$refItemFields{action} eq 'renameedit' ) {
    return ActionRENAMEEDIT( $refItemFields );

  } elsif( $$refItemFields{action} eq 'undelete') {
    return ActionUNDELETE( $refItemFields );

  } elsif( $$refItemFields{action} eq 'IGNORE' ) {
    $allowEmptyChangelist = 1;
    return 1;

  } elsif( $$refItemFields{action} eq 'LENGTH' ) {
    MsgLOG( "LENGTH action removes $$refItemFields{actionwas}" )
      if $isActive;
    $allowEmptyChangelist = 1;
    return 1;

  }

  MsgERROR( "Don't recognize action $$refItemFields{action}" );
  return 0;
}

sub ProcessAdds($)
{
  my $type = $_[0];
  return 1 unless $isActive;

  MsgVERBOSE( "ProcessAdds $type" );
  if( scalar @adds == 0 ) {
    MsgVERBOSE( '... no adds' );
    return 1;
  }
  
  my $hIn;
  open $hIn, '>', $pathMigrateIn;
  while( my $item = shift @adds ) {
    unless( exists $item->{content} && $item->{content} eq 'asis' ) {
      my $referenceTFS = TFSServer2Workspace( $item->{reference} );
      my $referenceP4 = TFSServer2P4Workspace( $item->{reference} );
      utilAssurePathElements( $referenceP4 );
      if( ! copy( $referenceTFS, $referenceP4 ) ) {
        MsgERROR( "($item->{id}) copy failure $referenceTFS $referenceP4 - $!" );
        close $hIn;
        return 0;
      }
    }
    print $hIn TFSServer2Depot( $item->{reference} ), "\n";
  }
  close $hIn;
  RunP4Command( "-x $pathMigrateIn add -c $currentChangelist" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "add $p4ExitCode: add", @p4Results );
    return 0;
  }
  my $clientFile = '';
  foreach my $line (@p4Results) {
    $clientFile = $1 if $line =~ m!^\.+ clientFile (.+)$!;
    if( $line =~ m!^\.+ type (.+)$! ) {
      my $addType = $1;
      my ($type, $md5) = FileDetails( $clientFile );
      MsgVERBOSE( "... $addType $type $md5 - $clientFile" );
      return 0 unless TypeConsistency( $clientFile, $type, $addType );
    }
  }

  return 1;
}

sub ProcessDeletes($)
{
  my $type = $_[0];
  return 1 unless $isActive;

  MsgVERBOSE( "ProcessDeletes $type" );
  if( scalar @deletes == 0 ) {
    MsgVERBOSE( '... no deletes' );
    return 1;
  }
  
  my $hIn;
  open $hIn, '>', $pathMigrateIn;
  while( my $item = shift @deletes ) {
    print $hIn TFSServer2Depot( $item->{reference} ), "\n";
  }
  close $hIn;

  RunP4Command( "-x $pathMigrateIn delete -c $currentChangelist" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "delete $p4ExitCode: delete", @p4Results );
    return 0;
  }

  return 1;
}

sub ProcessEdits($)
{
  my $type = $_[0];
  return 1 unless $isActive;

  MsgVERBOSE( "ProcessEdits $type" );
  if( scalar @edits == 0 ) {
    MsgVERBOSE( '... no edits' );
    return 1;
  }
  
  my $hIn;
  open $hIn, '>', $pathMigrateIn;
  my $openCount = 0;
  foreach my $item (@edits) {
    if( exists $item->{open} ) {
      ++$openCount;
    } else {
      print $hIn TFSServer2Depot( $item->{reference} ), "\n";
    }
  }
  close $hIn;

  RunP4Command( "-x $pathMigrateIn edit -c $currentChangelist" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "edit $p4ExitCode: edit", @p4Results );
    return 0;
  }

  my %types = ();
  my $depotFile = '';
  foreach my $item (@p4Results) {
    $depotFile = $1 if $item =~ m!^\.{3} depotFile (.+)$!;
    $types{uc $depotFile} = $1
      if $item =~ m!^\.{3} type (.+)$!;
  }

  if( $openCount > 0 ) {
    open $hIn, '>', $pathMigrateIn;
    foreach my $item (@edits) {
      next unless exists $item->{open};
      print $hIn TFSServer2Depot( $item->{reference} ), "\n";
    }
    close $hIn;

    RunP4Command( "-x $pathMigrateIn opened -c $currentChangelist" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "edit $p4ExitCode: opened", @p4Results );
      return 0;
    }

    foreach my $item( @p4Results ) {
      $depotFile = $1 if $item =~ m!^\.{3} depotFile (.+)$!;
      $types{uc $depotFile} = $1
        if $item =~ m!^\.{3} type (.+)$!;
    }
  }

  foreach my $item (@edits) {
    my $referenceTFS = TFSServer2Workspace( $item->{reference} );
    my $referenceP4 = TFSServer2P4Workspace( $item->{reference} );
    my $depot = TFSServer2Depot( $item->{reference} );
    if( ! copy( $referenceTFS, $referenceP4 ) ) {
      MsgERROR( "($item->{id}) copy failure $referenceTFS $referenceP4 - $!" );
      return 0;
    }
    my ($type, $md5) = FileDetails( $referenceP4 );
    return 0 unless TypeConsistency( $referenceP4, $type, $types{uc $depot} );
  }

  @edits = ();
  return 1;
}

sub ProcessMergeSequence($$$)
{
  my ($type, $version, $refItems) = @_;

  MsgVERBOSE( "MergeSequence $type" );
  if( $version eq 'latest' ) {
    MsgVERBOSE( '... version latest' );
    $version = '';
  } else {
    my $was = $version;
    $version = CS2CLAsCL( $version );
    MsgVERBOSE( "... version $version ($was)" );
  }

  my $hIn;
  open $hIn, '>', $pathMigrateIn;
  print $hIn "Branch: ImportSupportBranch\n";
  print $hIn "Description:\n";
  print $hIn " Branching for changeset $currentChangeset\n";
  print $hIn "View:\n";
  foreach my $item (@{$refItems}) {
    MsgVERBOSE( "... $item->{source} $item->{target}" );
    print $hIn ' "', TFSServer2Depot( $item->{source} ), '"',
               ' "', TFSServer2Depot( $item->{target} ), '"', "\n";
  }
  close $hIn;

  RunP4Command( "branch -i <$pathMigrateIn" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "ProcessMerges $p4ExitCode: branch -i <$pathMigrateIn", @p4Results );
    return 0;
  }

  RunP4Command( "integ -f -i -d -c $currentChangelist -b ImportSupportBranch //$P4CLIENT/...$version" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "ProcessMerges $p4ExitCode: integ -f -i -d -b ImportSupportBranch ...", @p4Results );
    return 0;
  }

  my $count = 0;
  foreach my $resolve ('-at', '-ay', '-af') {
    $count = 0;
    open $hIn, '>', $pathMigrateIn;
    foreach my $item (@{$refItems}) {
      if( $item->{resolve} eq $resolve ) {
        MsgVERBOSE( "... ... $resolve $item->{target}" );
        print $hIn TFSServer2Depot( $item->{target} ), "\n";
        ++$count;
      }
    }
    close $hIn;

    if( $count > 0 ) {
      RunP4Command( "-x $pathMigrateIn resolve -c $currentChangelist $resolve" );
      if( $p4ExitCode != 0 ) {
        MsgERRORResponse( "ProcessMerges $p4ExitCode: resolve $resolve", @p4Results );
        return 0;
      }
    }
  }

  my @editMerge = ();
  foreach my $item (@{$refItems}) {
    next unless $item->{resolve} eq '-af' || $item->{resolve} eq '';
    my ($typeTFS, $MD5TFS) = FileDetails( TFSServer2Workspace( $item->{target} ) );
    if( ! defined $MD5TFS ) {
      MsgERROR( "ProcessMergeSequence TFS file detail errors - $item->{target}" );
      return 0;
    }
    my ($typeP4, $MD5P4) = FileDetails( TFSServer2P4Workspace( $item->{target} ) );
    if( ! defined $MD5P4 ) {
      MsgERROR( "ProcessMergeSequence p4 file detail errors - $item->{target}" );
      return 0;
    }
    next if $MD5TFS eq $MD5P4;
    push @editMerge, $item;
  }

  return 1 if scalar @editMerge == 0;

  open $hIn, '>', $pathMigrateIn;
  foreach my $item (@{$refItems}) {
    print $hIn TFSServer2Depot( $item->{target} ), "\n";
  }
  close $hIn;

  RunP4Command( "-x $pathMigrateIn edit -c $currentChangelist" );
  if( $p4ExitCode != 0 ) {
    MsgERRORResponse( "ProcessMerges $p4ExitCode: edit", @p4Results );
    return 0;
  }

  my $isEditOpen = 0;
  my %types = ();
  my $depotFile = '';
  foreach my $item (@p4Results) {
    if( $item =~ m!^(.+) - can't edit \(already opened for ([^\)]+)\)!i ) {
      MsgVERBOSE( "... $1 - $2" );
      $isEditOpen = 1;
      next;
    }
    $depotFile = $1 if $item =~ m!^\.{3} depotFile (.+)$!;
    $types{uc $depotFile} = $1
      if $item =~ m!^\.{3} type (.+)$!;
  }
  if( $isEditOpen ) {
    RunP4Command( "-x $pathMigrateIn opened -c $currentChangelist" );
    if( $p4ExitCode != 0 ) {
      MsgERRORResponse( "ProcessMerges $p4ExitCode: opened", @p4Results );
      return 0;
    }
    foreach my $item (@p4Results) {
      $depotFile = $1 if $item =~ m!^\.{3} depotFile (.+)$!;
      $types{uc $depotFile} = $1
        if $item =~ m!^\.{3} type (.+)$!;
    }
  }

  foreach my $item (@editMerge) {
    my $targetTFS = TFSServer2Workspace( $item->{target} );
    my $targetP4 = TFSServer2P4Workspace( $item->{target} );
    MsgVERBOSE( "... ... edit $targetP4" );
    if( ! copy( $targetTFS, $targetP4 ) ) {
      MsgERROR( "($item->{id}) copy failure $targetTFS $targetP4 - $!" );
      return 0;
    }
    my ($type, $md5) = FileDetails( $targetP4 );
    my $depot = TFSServer2Depot( $item->{target} );
    return 0 unless TypeConsistency( $targetP4, $type, $types{uc $depot} );
  }

  @editMerge = ();
  return 1;
}

sub ProcessMerges($)
{
  my $type = $_[0];
  return 1 unless $isActive;

  MsgVERBOSE( "ProcessMerges $type" );
  if( scalar @merges == 0 ) {
    MsgVERBOSE( '... no merges' );
    return 1;
  }

  my %svus = ();
  foreach my $item (@merges) { ++$svus{$item->{svu}}; }

  foreach my $idx (keys %svus) {
    MsgVERBOSE( "... svu $idx" );
    my @thisIDX = ();
    my @nextIDX = ();
    foreach my $item (@merges) {
      if( $item->{svu} eq $idx ) {
        push @thisIDX, $item;
        MsgVERBOSE( "... this $item->{source} -> $item->{target}" );
      } else {
        push @nextIDX, $item;
        MsgVERBOSE( "... next $item->{source} -> $item->{target}" );
      }
    }
    while( scalar @thisIDX > 0 ) {
      my @thisTime = ();
      my @nextTime = ();
      my %sources = ();
      while( my $item = shift @thisIDX ) {
        if( exists $sources{uc $item->{source}} ) {
          push @nextTime, $item;
        } else {
          push @thisTime, $item;
          ++$sources{uc $item->{source}};
        }
      }
      return 0 unless ProcessMergeSequence( $type, $idx, \@thisTime );
      @thisIDX = @nextTime;
    }
    @merges = @nextIDX;
  }
  
  return 1;
}

sub ProcessTagPROCESS($$)
{
  my ($refItemFields, $value) = @_;
  return 0 unless ProcessMerges( $$refItemFields{type} );
  return 0 unless ProcessAdds( $$refItemFields{type} );
  return 0 unless ProcessEdits( $$refItemFields{type} );
  return 0 unless ProcessDeletes( $$refItemFields{type} );
  if( $ifCaseAction ) {
    $ifCaseAction = 0;
    ProcessTagCS( $refItemFields, $value, $currentDescription . "\n  case only rename setup" );
    return 0 unless CreateChangelist( $currentDescription );
  }
  return 1;
}

sub ProcessControlFile()
{
  my %tagFields = ();
  my $tagRemains = '';
    
  my $tagValue = TagRead( \$tagRemains, $hControl, \%tagFields );
  if( $tagFields{TAG} eq 'TFSCONTROL' ) {
    if( ! exists $tagFields{version} ) {
      MsgERROR( "Version attribute not found" );
      return 0;
    } elsif( $tagFields{version} < $MINIMUM_CONTROL_VERSION ) {
      Msg( "Control version: $tagFields{version}" );
      MsgERROR( "Control version $MINIMUM_CONTROL_VERSION or later is required" );
      return 0;
    } elsif( ! $isActive ) {
      Msg( "Control encoding version: $tagFields{version}" );
    }
  } else {
    MsgERROR( "No starting tag - TFSCONTROL - found" );
    return 0;
  }

  while( 1 ) {
    $tagValue = TagRead( \$tagRemains, $hControl, \%tagFields );
    last    unless defined $tagValue;
    if( $tagFields{TAG} eq 'CC' ) {
      ProcessTagCC( \%tagFields, $tagValue );

    } elsif( $tagFields{TAG} eq 'AI' ) {
      ProcessTagAI( \%tagFields, $tagValue );

    } elsif( $tagFields{TAG} eq 'CS' ) {
      Progress();
      ProcessTagCS( \%tagFields, $tagValue );

    } elsif( $tagFields{TAG} eq 'PROCESS' ) {
      ProcessTagPROCESS( \%tagFields, $tagValue );

    } else {
      MsgERROR( "???tag - $tagFields{TAG}???" );
    }
    last if $ifERRORReported;
  }
  return $ifERRORReported;
}

####################
#
# Main processing point
#
####################

my $optHelp = 0;
my $optVersion = 0;
my $WhichMode = '';

Getopt::Long::Configure( "auto_abbrev", "no_ignore_case" );

OptionUsage( "Invalid specification" )
  unless( GetOptions( "help|?" => \$optHelp,
                      "mode=s" => \$WhichMode,
                      "log=s" => \$pathLog,
                      "progress=i" => \$progressEvery,
                      "cs2cl=s" => \$pathCS2CL,
                      "TFS=s" => \$TFSRoot,
                      "Version" => \$optVersion
                     ) );

# Help and version are one description and we're done

OptionVersion() if $optVersion;
OptionUsage() if $optHelp || scalar @ARGV == 0;

# Don't understand anything but 1 argument

OptionUsage( 'Required control file argument not specified' )
  if( scalar @ARGV < 1 );
OptionUsage( 'Extra control files specified' )
  if( scalar @ARGV > 1 );

OptionUsage()    unless EnvironmentWhichMode($WhichMode);

# Establish a log

if( $pathLog ne '' ) {
  $pathLog = rel2abs( catfile( $directoryStartup, $pathLog ) )
    unless $pathLog =~ m!^[\//]! || $pathLog =~ m!\:!;
  utilAssurePathElements( $pathLog );
  Msg("Activity logged in: $pathLog");
  open $hLog, ">", $pathLog;
  $hLog->autoflush(1);
}

Msg( "$APPNAME Version $versionMajor.$versionMinor starting " . localtime() );

CoorindateExit() unless CS2CLInit();
my $controlFilename = rel2abs( $ARGV[0] );

# Validation processing.

InfrastructureValidate();
CoordinateExit() if $ifERRORReported;

Msg( "Control information from: $controlFilename" );
if( ! -e $controlFilename ) {
  MsgERROR( "Control file does not exist" );
  CoordinateExit();
}
if( ! -f $controlFilename ) {
  MsgERROR( "Control file is not a file" );
  CoordinateExit();
}

Msg( "Import stop file: $pathStopFile" );
Msg( "Processing input file: $pathMigrateIn" );

$isActive = 0;

Msg( "Validation phase..." );
ProgressInit();

open $hControl, '<', $controlFilename;
ProcessControlFile( );
CoordinateExit() if $ifERRORReported;
CoordinateExit() if $modeCheckSyntax;
close $hControl;

# Import processing

$isActive = 1;

Msg( "" );
Msg( "Import phase..." );
Msg( "  Processing $progressEventCount changesets referencing $progressUnitsCount units." );
ProgressInit();

open $hControl, '<', $controlFilename;
ProcessControlFile( );

ProgressReport() if $ifERRORReported;

CoordinateExit();