ctrlUserManager.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 = 'ctrlUManager.pl';
my $APPWHAT = 'ctrl file user name manager; version 2.03';
my $APPNOTICES = "Copyright (c) 2014 Perforce Software, Inc. and VIZIM Worldwide, Inc.
All rights reserved.
See LICENSE.txt for license information.";

=head1 User name manager

Tool to manage user names in ctrl files.

=cut

=head2 Name list mode

With one argument the tool operates in list mode.

The file specified by the argument is a control file.

Output is the total number of times each unique name is encountered.

=cut

=head2 Name mapping mode

With two arguments the tool operates in mapping mode.

The file specified by the first argument is the control file.
The file specified by the second argument is the name mapping specification.

Output is the content of the control file with all user name attribute values
mapped as specified.
If the name is not specified then standard user name mapping is performed.

=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 ctrl
$APPNAME ctrl mapping

  One argument is listing mode. Two arguments is mapping mode.\n";
  exit( 0 );
}

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 $modeMapping = exists $ARGV[1];
if( $modeMapping && ! -e $ARGV[1] ) {
  print "Mapping file does not exist - $ARGV[1]\n";
  exit( 1 );
}

=head3 Enforced name mappings

Names that don't occur within the mapping file and names proposed by the
mapping file are subject to processing against recommended Perforce user
name characters.

Space characters as well as the characters \ / [ and ] in a user name
are replaced by the underbar (_) character.

=cut


my %mappings = ();
sub MapName($)
{
  my $name = $_[0];
  return $mappings{$name}
    if exists $mappings{$name};
  $name =~ s![\s\\\/\]\[]!_!g;
  return $name;
}

=head3 Mapping file format

Each line within the mapping 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:

  old\tnew

where old is the old name, \t is the tab character, and new is the
new name.
Regardless of what is specified as the new name that name is
subject to enforced name mappings before being established as the
mapping for the old name.

=cut

if( $modeMapping ) {
  my $hMap = undef;
  open $hMap, '<', $ARGV[1] or die "Can't open $ARGV[1] - $!";
  while(<$hMap>) {
    chomp;
    next if m!^\s*$!;
    next if m!^\s*\#!;
    my ($old, $new) = (undef, undef);
    ($old, $new) = split "\t";
    if( ! defined $old ) {
      print "Don't understand mapping - $_\n";
      close $hMap;
      exit( 1 );
    }
    $mappings{$old} = MapName($new);
  }
  close $hMap;
}

my %users = ();
while (<$hIn>) {
  if( m!^(\s*\<.+ user\=\")([^\"]+)(\".*)$! ) {
    my ($before, $name, $after ) = ($1, $2, $3);
    if( $modeMapping ) {
      print $before, MapName( $name ), $after, "\n";
    } else {
      ++$users{$name};
    }
  } elsif( $modeMapping ) {
    print $_;
  }
}

if( ! $modeMapping ) {
  foreach my $user (sort keys %users) {
    print sprintf "%6d %s\n", $users{$user}, $user;
  }
}