pd_cleanup.pl #1

## pd_cleanup.pl - Delete unregistered and unused users and clients.
##
## Usage:
##        perl pd_cleanup.pl <g-opts>
##
## Users will be deleted if they do not belong to any groups, and
## they have not been used since the defined cutoff time.
##
## Clients will be deleted if their owners do not belong to any
## groups, and the client has not been used since the cutoff.
##
## In other words, if you're a registered user, this script should
## never affect you or any of your clients.
##
## You will be prompted before this script deletes anything.

my $cutOffTime = time - 60 * 60 * 24 * 365 * 2; #2 years ago

my $p4 = "p4";
my $opts = join " ", @ARGV;
if ( $opts ) { $p4 .= " $opts"; }

my @doomedUsers = ();
my @doomedClients = ();

if ( `$p4 -Ztag changes -m1 2>&1` !~ /\.\.\. change/ ) 
    { die "Having trouble running commands.  Login?\n"; }

## Check users.

print "Checking users...\n";
open USERS, "$p4 -Ztag users|" or die "Couldn't run $p4 users.";
my $userName = "";
my $userAccess = "";
while ( <USERS> )
{
    chomp;
    if ( /^\.\.\. User (.+)/ ) { $userName = $1; }
    if ( /^\.\.\. Access (.+)/ ) { $userAccess = $1; }
    if ( /^\.\.\./ ) { next; }
    if ( !$userName || !$userAccess ) { next; }

    if ( $userAccess > $cutOffTime )
    {
        print "Skipping $userName due to recent activity.\n";
    }
    elsif ( `$p4 groups $userName 2>&1` =~ /[a-zA-Z0-9_]/ )
    {
        print "Skipping $userName due to group membership.\n";   
    }
    else
    {
        print "Queueing $userName for deletion.\n";
        push @doomedUsers, $userName;
    }

    $userName = "";
    $userAccess = "";
}
close USERS;

## Check clients.

print "\n\nChecking clients...\n";
open CLIENTS, "$p4 -Ztag clients|" or die "Couldn't run $p4 clients.";
my $clientName = "";
my $clientOwner = "";
my $clientAccess = "";
while ( <CLIENTS> )
{
    chomp;
    if ( /^\.\.\. client (.+)/ ) { $clientName = $1; }
    if ( /^\.\.\. Access (.+)/ ) { $clientAccess = $1; }
    if ( /^\.\.\. Owner (.+)/ ) { $clientOwner = $1; }
    if ( /^\.\.\./ ) { next; }
    if ( !$clientName || !$clientAccess || !clientOwner ) { next; }

    if ( $clientAccess > $cutOffTime )
    {
        print "Skipping $clientName due to recent use.\n";
    }
    elsif ( `$p4 groups $clientOwner 2>&1` =~ /[a-zA-Z0-9_]/ )
    {
        print "Skipping $clientName due to group membership.\n";
    }
    else
    {
        print "Queueing $clientName for deletion.\n";
        push @doomedClients, $clientName;
    }

    $clientName = "";
    $clientAccess = "";
    $clientOwner = "";
}
close CLIENTS;

## Show the list, give one last chance to reconsider.

print "The following users:\n";
my $lineCount = 0;
foreach( @doomedUsers )
{
    if ( ++$lineCount >= 3 ) { $lineCount = 0; print "\n"; }
    printf( "%25s ", $_ );
}

print "\n\nand the following clients:\n";
$lineCount = 0;
foreach( @doomedClients )
{
    if ( ++$lineCount >= 3 ) { $lineCount = 0; print "\n"; }
    printf( "%25s ", $_ );
}
print "\nare scheduled for deletion.\nProceed? (y/n)\n";

$_ = <STDIN>;
if ( !/^y/i ) { die "Maybe next time, then.\n"; }

## Delete clients first, since old clients with open files can
## block a user from being deleted.

foreach( @doomedClients )
{
    print "Deleting $_... ";
    print `$p4 client -df $_`;
}
foreach( @doomedUsers )
{
    print "Deleting $_...  ";
    print `$p4 user -df $_`;
}
print "All done!\n";