TFSActions.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

my $APPNAME = 'TFSActions.pl';
my $APPWHAT = 'action reporter; version 1.17';
my $APPNOTICES = "Copyright (c) 2014 Perforce Software, Inc. and VIZIM Worldwide, Inc.
All rights reserved.
See LICENSE.txt for license information.";

=head1 action reporter

Tool to scan raw, item, and ctrl files for action and extract
information.
raw and item files have no extract information associated with the action
information.

Output is the number of times that a specific action is encountered.
If extract information is present then the action information is
qualified by the extract information.
If ttype information is present then the action information is
qualified by the ttype information.
If instance reports are requested then sequences containing the values are
identified.

The primary use of this tool is to examine the distribution of specific
TFS and import actions.
TFS specific actions are derived from raw and item files.
Import actions and the extracted TFS action that created them are derived
from ctrl files.

=cut

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

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

Usage:

$APPNAME -V
$APPNAME [-h|-?]
$APPNAME [-N] raw|item|ctrl
  N is number of instances to report. Default is 0.\n";
  exit( 0 );
}

my %tracking = ();
my $trackCount = 0;
if( defined $ARGV[0] && $ARGV[0] =~ m!-+(\d+)! ) {
  $trackCount = $1;
  shift @ARGV;
}

my %actions = ();

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

my $seq = 0;
while (<$hIn>) {
  $seq = $1 if m!^\<CC seq\=\"(\d+)\"!;
  $seq = $1 if m!^\<CSS number\=\"(\d+)\"!;
  my ($action, $extract, $ttype) = ('', '', '');
  $action = $1 if m! action\=\"([^\"]+)\"!;
  $extract = $1 if m! extract\=\"([^\"]*)\"!;
  $ttype = $1 if m! ttype\=\"([^\"]+)\"!;
  next if $action eq '';
  my $idx = $action;
  $idx .= " ($extract)" if $extract ne '';
  $idx .= " ..$ttype" if $ttype ne '';
  ++$actions{$idx};
  push @{$tracking{$idx}}, $seq
    if    $trackCount > 0
       && (! exists $tracking{$idx} || scalar @{$tracking{$idx}} < $trackCount);
}
close $hIn;

foreach my $action (sort keys %actions) {
  print sprintf "%8d", $actions{$action};
  if( $trackCount > 0 ) {
    print " [";
    foreach (@{$tracking{$action}}) { print sprintf " %4d", $_; }
    my $need = $trackCount - scalar @{$tracking{$action}};
    while($need > 0) { print sprintf " %4s", '-'; --$need; }
    print "]";
  }
  print " $action\n";
}