#!/usr/bin/perl
# ======================================================================
#
# NAME: checkcase.pl
#
# AUTHOR: Bruce McPeek
# DATE  : 12/15/2005
#
# PURPOSE: To parse a perforce changelist at submission time to validate
# that no part of the fully qualified names of added or branched files
# differ only in case from existing path / file names.
#
# ======================================================================

use strict;
use warnings;
use diagnostics;

# assigned changelist number & P4 server's IP:port are passed to
# this trigger on the command line

# we are assuming that a P4CONFIG file is being used to set P4USER/P4PASSWD.

my $cl_num = shift @ARGV;

my $srvr_ip_port = shift @ARGV;

my $verify_hash_ref;
my @submit_errors;

my $p4_command = "p4 -p $srvr_ip_port -ztag describe -s $cl_num";

my $p4_calls = "";			### test line
my $p4_dirs_calls = "";		### test line
my $p4_files_calls = "";	### test line
my $dirs_cache_hits = "";	### test line
my $files_cache_hits = "";	### test line
my $cache_hits_total = "";	### test line

&get_changelist();

# If 'add's and / or 'branch'es were found parse the hash and verify.
# If none were found, we are done so exit.
if (defined($verify_hash_ref)) {
  foreach my $top_key (keys (%$verify_hash_ref)) {
    my $top_ref="\$verify_hash_ref -> {\"$top_key\"}";
    my $top_path = "//$top_key/";
    if (ref(eval($top_ref))) {
      &go_deeper($top_path, $top_ref);
    }
    else {
      push(@submit_errors, "There is a file at the top level. This should not be.\nThe most likely cause is a trigger script error.\nPlease contact your Perforce administrator about this error.");
      &exit_trigger();
    }
  }
}

print "\$p4_calls = $p4_calls\n";					### test line
print "\$p4_dirs_calls = $p4_dirs_calls\n";			### test line
print "\$p4_files_calls = $p4_files_calls\n\n";		### test line
print "\$dirs_cache_hits = $dirs_cache_hits\n";		### test line
print "\$files_cache_hits = $files_cache_hits\n";	### test line
print "\$cache_hits_total = $cache_hits_total\n";	### test line

&exit_trigger();

sub get_changelist {
  # The relevant portion of the changelist is returned in a set of four values,
  # depotFile###, action###, type###, and rev###; where ### is a number unique
  # in the changelist that starts at 0 and increments for each set.
  #
  # For what we are doing, we are interested only in depotFile & action.
  
  my ($key, $element, $prev_key, $prev_element);
  
  # Split changelist into seperate lines. Be careful here, the desc field can have
  # embedded newlines.
  foreach my $line (split /\.\.\./ ,`$p4_command`) {
    $line =~ s/\n+$//s;				# strip out extra line feeds, usually the data for "desc".
    $line =~ m/^ (\w*)\b (.*)$/s;	# capture keys and data

    $key=$1;						#
    $element=$2;					# capture regex memory
    
    # This section is dependent on the changelist layout. Should that change, this
    # section may need to be reworked.
    # The trigger for adding a file to the hash-to-be-evaluated is the action field.
    # If the action is add or branch then we add the associated depotFile (which are the
    # previous key and element when evaluating the action field.
    
    # If we have an add or branch in the changelist, add it to our hash-to-be-evaluated.
    if ((defined($prev_element)) && (($element eq "add") || ($element eq "branch"))) {
      my $hash_ref_name = '$verify_hash_ref';						# name of hash ref to contain files and paths to verify
      my $eval_cmd = "$hash_ref_name -> ";							# setup command string to be eval'ed
  
      my $path_elements = [split(/\//,(substr($prev_element,2)))];	# strip leading // from the string & put the path
  		    														# into $path_elements in list context, split on '/'.
      my $file = pop(@$path_elements);								# capture file name
      
      foreach my $dir (@$path_elements) {
        $eval_cmd = $eval_cmd . "{\"$dir\"}";						# build out eval command string
      }
      $eval_cmd = $eval_cmd . "{\"$file\"} = \"$prev_element\";";
      eval ($eval_cmd);
    }
    
    $prev_key=$key;
    $prev_element=$element;
  }
  $p4_calls++;	### test line
  return;
}

sub go_deeper {
  my $curr_path = shift @_;
  my $curr_ref = shift @_;
  my $local_ref = eval ($curr_ref);							# We need a reference to be evaluated by keys
  my ($file_list_requested, $dir_list_requested);
  my (%dir_list_cache, %file_list_cache);
  foreach my $sub_hash_key (keys (%$local_ref)) {
    my $new_ref = $curr_ref . "{\"$sub_hash_key\"}";
    
    if (($dir_list_requested) && (ref(eval($new_ref)))) {	### test line
      $dirs_cache_hits++;									### test line
      $cache_hits_total++;									### test line
    }														### test line
    
    if (($file_list_requested) && (!ref(eval($new_ref)))) {	### test line
      $files_cache_hits++;									### test line
      $cache_hits_total++;									### test line
    }														### test line
    
    if ((!$file_list_requested) && (!ref(eval($new_ref)))) {	# Create the file list cache if we have not tried to create
      %file_list_cache = &list_files($curr_path);				# it before and we are dealing with a file element.
      $file_list_requested++;
    }
    elsif ((!$dir_list_requested) && (ref(eval($new_ref)))) {	# Create the dir list cache if we have not tried to create
      %dir_list_cache = &list_dirs($curr_path);					# it before and we are dealing with a directory element.
      $dir_list_requested++;
    }

    if (ref(eval($new_ref))) {
      # A directory element. Check the dir's case against the dir cache. If it is not in the cache, there is not a
      # mis-match to worry about and we don't need to go any further down this path because nothing below this dir will
      # be a problem. If it is in the cache, make sure it is the same case as the dir in the cache and continue down.
      # If it is a mismatch, write a descriptive message to the error array and skip the rest of the tree below this point.

      if (exists($dir_list_cache{(lc($sub_hash_key))})) {
        if ($dir_list_cache{(lc($sub_hash_key))} eq $sub_hash_key) {
          my $new_path = $curr_path . "$sub_hash_key/";
          &go_deeper($new_path, $new_ref);
        }
        else {
          push(@submit_errors, "'$curr_path$sub_hash_key'\nis a case-mismatch of\n'$curr_path$dir_list_cache{(lc($sub_hash_key))}'\n");
        }
      }
    }
    else {
      # A file element. Check the file's case against the file cache. If it is in the cache, make sure
      # it is the same case as the file in the cache. If it is a mismatch, write a descriptive message to the
      # error array and continue with the next item.

      if ((exists($file_list_cache{(lc($sub_hash_key))})) && ($file_list_cache{(lc($sub_hash_key))} ne $sub_hash_key)) {
        push(@submit_errors, "'$curr_path$sub_hash_key'\nis a case-mismatch of\n'$curr_path$file_list_cache{(lc($sub_hash_key))}'\n");
      }
    }
  }
}

sub exit_trigger {
  if (@submit_errors) {
    # If there are errors, display them and exit with a non-zero exit code
    foreach my $error_item (@submit_errors) {
      print "\n$error_item\n";
    }
    exit(1);
  }
  else {
    # Else exit with a exit code of zero
    exit(0);
  }
}

sub list_dirs {
  my $base_dir = shift @_;
  my $p4_dirs_command = "p4 -ztag dirs \"$base_dir*\"";
  my %dir_list;
  my $lc_name;
  foreach my $line (split /\.\.\./ ,`$p4_dirs_command`) {
    $line =~ s/\n+$//s;
    $line =~ m/^ dir \/\/.*\/(.+)$/;		# Capture the last path element into the regex memory
    if (defined($1)) { 
      ($lc_name = $1) =~ tr/A-Z/a-z/;		# Create a lower case version of the dir name and
      $dir_list{$lc_name} = "$1";			# use it for a key, with the data being the unchanged
    }										# dir name
  }
  $p4_calls++;		### test line
  $p4_dirs_calls++;	### test line
  return(%dir_list);
}

sub list_files {
  my $base_dir = shift @_;
  my $p4_files_command = "p4 -ztag files \"$base_dir*\"";
  my %file_list;
  my $lc_name;
 foreach my $line (split /\.\.\./ ,`$p4_files_command`) {
    $line =~ s/\n+$//s;
    $line =~ m/^ depotFile \/\/.*\/(.+)$/;	# Capture the filename element into the regex memory
    if (defined($1)) {
      ($lc_name = $1) =~ tr/A-Z/a-z/;		# Create a lower case version of the file name and
      $file_list{$lc_name} = "$1";			# use it for a key, with the data being the unchanged
    }										# file name
  }
  $p4_calls++;			### test line
  $p4_files_calls++;	### test line
  return(%file_list);  
}