TFSRenames.pl #1

#! /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::Path;
use File::Basename;
use File::Spec::Functions qw(rel2abs catfile);

use IO::Handle;

use Time::Local;

use Getopt::Long;

my $APPNAME = 'TFSRenames.pl';
my $APPWHAT = "TFS rename extraction; Version 1.03";
my $APPNOTICES = "Copyright (c) 2014 Perforce Software, Inc. and VIZIM Worldwide, Inc.
All rights reserved.
See LICENSE.txt for license information.";

=head1 TFS rename extraction tool

This tool extracts rename information from TFS based on server format file
names and changeset information for the target of a rename.

The output of the tool is used by TFSAssociate.pl

=cut

=head2 Operational Context

Workspace context of collection for renames.

=cut

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

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

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

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

my $ifERRORReported = 0;
my $errorContext = undef;

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

sub MsgERROR($)
{
  print STDERR "$errorContext\n" if defined $errorContext;
  print STDERR "***" . $_[0] . "***\n";
  print $hLog "$errorContext\n" if defined $errorContext && defined $hLog;
  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 CoordinateExit(;$)
{
  my $exitCode = $_[0];
  $exitCode = $ifERRORReported if ! defined $exitCode;

  $errorContext = undef;
  Msg( "\n" );
  MsgERROR( "Processing terminated with errors" ) if $exitCode != 0;
  Msg( ">>> Processing completed without errors" ) if $exitCode == 0;

  close $hLog if defined $hLog;

  exit( $exitCode );
}

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

  print "$APPWHAT
$APPNOTICES

Usage:

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

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

  Arguments:
    UNRESOLVED - Unresolved renames to process
";
  exit 0;
}

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

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

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

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

####################
#
# Extraction and extraction support
#
####################

sub RunTFCommand($;$)
{
  my ($command, $exitGood) = @_;
  $exitGood = 0 unless defined $exitGood;

  return (0, ())
    if $command eq '';

  my @results = `tf $command 2\>\&1`;
  my $exitCode = $? >> 8;

  MsgERRORResponse( "tf exit code $exitCode was not expected $exitGood", @results )
    if $exitCode != 0 && $exitCode != $exitGood;

  return ($exitCode, @results);
}

#
# Individual rename history command...
#
# tf history /format:detailed /itemmode /noprompt /version:C$version~$version $reference
#

sub RenameTargetInfo($$)
{
  my ($sourceReference, $sourceVersion) = @_;

  my $context = "Can't access history for C$sourceVersion of '$sourceReference'";
  my ($exitCode, @results) = RunTFCommand( "history /format:detailed /itemmode /noprompt /version:C$sourceVersion\~$sourceVersion \"$sourceReference\"", 100 );
  if( $exitCode == 0 ) {
    my $targetAction = '';
    my $targetReference = '';
    my $isItems = 0;
    foreach my $line (@results) {
      if( $isItems && $line =~ m!\s+(rename.*) (\$/.+)$! ) {
        ($targetAction, $targetReference) = ($1, $2);
        last;
      } elsif( $line =~ m!^Items! ) {
        $isItems = 1;
      } elsif( $line =~ m!^\S! ) {
        $isItems = 0;
      }
    }

    if( $targetReference eq '' ) {
      MsgERRORResponse( "Can't identify rename source", @results );
      return 0;
    }

    print "$sourceVersion $sourceReference -> $targetReference\n";
  } else {
    MsgERROR( $context );
    return 0;
  }
  return 1;
}


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

my $optHelp = 0;
my $optVersion = 0;

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

  OptionUsage( "Invalid specification" )
    unless( GetOptions( "help|?" => \$optHelp,
                        "log=s" => \$pathLog,
                        "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( "Don't understand anything but 1 argument" )
    if( scalar @ARGV != 1 );

# Establish a log

if( $pathLog ne '' ) {
  $pathLog = rel2abs( $pathLog );
  utilAssurePathFile( $pathLog );
  Msg("Activity logged in: $pathLog");
  open $hLog, '>', $pathLog;
}

# Identify the processing.

Msg( "$APPNAME - $APPWHAT" );
Msg( "Generated" . localtime() );

# Process the unresolved file

my $hUnresolved;

if( ! open( $hUnresolved, '<', $ARGV[0] ) ) {
  MsgERROR( "Can't open unresolved file '$ARGV[0]' - $!" );
  CoordinateExit();
}
while (<$hUnresolved>) {
  chomp;
  my ($type, $changeset, $path) = ( '', 0, '' );
  ($type, $changeset, $path) = ($1, $2, $3)
    if m!^(R.) (\d+) (.+)$!;
  next unless $type eq 'RF' || $type eq 'RP';
  RenameTargetInfo( $path, $changeset );
}
close $hUnresolved;

CoordinateExit();