#! /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

my $APPNAME = 'ctrlPathLength.pl';
my $APPWHAT = 'path length manager; version 2.05';
my $APPNOTICES = "Copyright (c) 2014 Perforce Software, Inc. and VIZIM Worldwide, Inc.
All rights reserved.
See LICENSE.txt for license information.";

=head1 Path length manager

Tool to manage path information within a ctrl file.
Analysis is based on length.
Skip processing is based on path.

=cut

=head2 List mode

With one argument the tool operates in list mode.

The file specified by the argument is scanned for path attribute patterns.
reference, source, and target attributes specify paths.
If the action is IGNORE the path is not scanned.

By default, output identifies the longest path encountered, all paths over
240 characters, and paths involved in case only renames.
The optional length argument can modify this value.
The environment variable TFS_LONGPATH can be used to establish a reporting
length other than 240 characters if the length argument is not specified.

The tool fails if TFS_LONGPATH is less than 10 or more than 255.

=cut

=head2 Skip mode

With two arguments the tool operates in skip mode.

The file specified by the first argument is scanned for path attribute
patterns.
reference, source, and target attributes specify paths.
The file specified by the second argument is the path skip specification.

Output is the content of the first argument with actions referencing skip
paths being changed to LENGTH.

=cut

if( defined $ARGV[0] && ($ARGV[0] =~ m!^\-+V!) ) {
  print "$APPWHAT\n";
  exit(0);
}

if( ! defined $ARGV[0]
    || $ARGV[0] =~ m!^\-+[h\?]! ) {
  print "$APPWHAT
$APPNOTICES

Usage:

$APPNAME -V
$APPNAME [-h|-?]
$APPNAME [-N] ctrl
$APPNAME      ctrl skip

  N is a numeric value between 10 and 2455 that specifies a reporting
  length other than 240. It overrides TFS_LONGPATH if that environment
  variable has a value.

  One argument is listing mode.
  Two arguments is skip mode. Where the skip file contains the TFS
      reference or files to skip (regardless of lenght).\n";
  exit( 0 );
}

my $longIs = exists $ENV{TFS_LONGPATH} ? $ENV{TFS_LONGPATH} : 240;
if( $longIs < 10 || $longIs > 255 ) {
  print "TFS_LONGPATH must be between 10 and 255\n";
  exit 1;
}
if( defined $ARGV[0] && $ARGV[0] =~ m!^\-+(\d+)$! ) {
  $longIs = $1;
  if( $longIs < 10 || $longIs > 255 ) {
    print "LENGTH option must be between 10 and 255\n";
    exit 1;
  }
  shift @ARGV;
}

if( ! -e $ARGV[0] ) {
  print "ctrl file does not exist - $ARGV[0]\n";
  exit( 1 );
}
my $hIn = undef;
open $hIn, '<', $ARGV[0] or die "Can't open $ARGV[0] - $!";

my $modeSkip = exists $ARGV[1];
if( $modeSkip && ! -e $ARGV[1] ) {
  print "Skip file does not exist - $ARGV[1]\n";
  exit( 1 );
}

=head3 Skip file format

Each line within the skip file is processed individually.

Blank lines, lines that contain only space characters, and lines
that have # as the first non-blank character are ignored as comments.

All other lines are expected to follow the pattern:

  info\tskip

where info is any random text that doesn't contain the tab character,
\t is the tab character, and skip is the path to skip.
The info can be used by skip file generation tools to insert potentially
useful.

=cut

my %skipPaths = ();
if( $modeSkip ) {
  my $hSkip = undef;
  open $hSkip, '<', $ARGV[1] or die "Can't open $ARGV[1] - $!";
  while(<$hSkip>) {
    chomp;
    next if m!^\s*$!;
    next if m!^\s*\#!;
    my ($info, $skip) = (undef, undef);
    ($info, $skip) = split "\t";
    if( ! defined $info ) {
      print "Don't understand mapping - $_\n";
      close $hSkip;
      exit( 1 );
    }
    $skipPaths{$skip} = $info;
  }
  close $hSkip;
}

my $longestPath = 0;
my %longPaths = ();
my $seq = 0;
while (<$hIn>) {
  my ($before, $action, $after) = ('', '', '');
  ($before, $action, $after) = ($1, $2, $3)
    if m!^(.+ action\=\")([^\"]+)(\".*)$!;
  if( $action eq '' || $action eq 'IGNORE' || $action eq 'LENGTH' ) {
    print $_
      if $modeSkip;
    next;
  }

  my $actionWas = $action;
  foreach my $attrib (qw/reference source target/) {
    my $path = '';
    $path = $1
      if m! $attrib\=\"([^\"]+)\"!;
    if( $path ne '' ) {
      $path =~ s!\;[XC]\d+$!!;

      if( $modeSkip ) {
        $action = 'LENGTH'
          if exists $skipPaths{$path};
      } else {      
        my $length = length $path;
        $longestPath = $length
          if $length > $longestPath;
        $longPaths{$path} = $length
          if $length >= $longIs;
      }
    }
  }

  if( $modeSkip && $action eq 'LENGTH' ) {
    print $before, "$action\" actionwas\=\"$actionWas", $after, "\n";
  } elsif( $modeSkip ) {
    print $_;
  }
}

if( ! $modeSkip ) {
  print "Longest path: $longestPath\n";

  print "\n\nPaths with $longIs or more characters:\n";
  foreach my $path (sort keys %longPaths) {
    print sprintf "%3d %s\n", $longPaths{$path}, $path;
  }
  print "  - none -\n"
    if scalar keys %longPaths == 0;
}