## 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";