#!c:/perl/bin/perl -w
##############################################################################
# p4rmlabels - Delete labels older than a give number of days that match a
#              given pattern.  A optional preview mode is available to see
#              what labels would be deleted.
#
# Logic:
#
# 1. Get the list of labels
# 2. Determine old labels that match the given pattern
# 3. Delete old labels (preview only if specified)
#
##############################################################################
# Notes:
#
# - This uses the Date::Calc module.  Please install prior to running this
#   script.
##############################################################################
# Version  Date        Author              Description
# -------  ----------  ------------------  -----------------------------------
#
# 1.0      2003.03.25  ssmythe@docent.com  Initial Version
#
##############################################################################
 
use Getopt::Std;
use File::Path;
use File::Basename;
 
use Date::Calc qw(Delta_Days);
 
 
##############################################################################
# Init
##############################################################################
sub Init {
	# Function locals
 
	my $req_opt="";
 
	# Initialize globals
 
	our $scriptVersion="1.0";
	our $scriptName=basename($0);
	our $scriptAuthorName="Steve Smythe";
	our $scriptAuthorEmail="ssmythe\@docent.com";
	our $scriptAuthorExt="x9546";
	our %opts=();
	our $p4="p4";
	our $daysToExpire="";
	our $labelPattern="";
	our $nSwitch=0;
	our %labels=();
	our %oldLabels=();
	our $numOldLabels=0;
	our $currentYear="";
	our $currentMonth="";
	our $currentDay="";
	our $currentDate="";
		
	# Parse command line switches
 
	getopts("d:hl:nv", \%opts);
 
	# Display script version if need be
 
	if (exists($opts{"v"})) {
		Version();
		exit 0;
	}
 
	# Display script usage if need be
 
	if (exists($opts{"h"})) {
		Usage();
		exit 0;
	}
 
	# Check for required switches
 
	%req_opts=(d=>' ', l=>' ');
 
	foreach $req_opt (sort keys %req_opts) {
		if (!(exists($opts{$req_opt}))) {
			print "Error: $scriptName: missing required \"-$req_opt\" switch.\n";
			Usage();
			exit 0;
		}
	}
	
	# assign required switches to globals
	
	$daysToExpire=$opts{"d"};
	$labelPattern=$opts{"l"};
	
	# check optional switches
	
	if (exists($opts{"n"})) {
		$nSwitch=1;
	}
	
	# get datestamp
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime();
	$currentYear=$year + 1900;
	$currentMonth=$mon + 1;
	$currentDay=$mday;
	$currentDate=sprintf("%04d/%02d/%02d", $currentYear, $currentMonth, $currentDay);
}
 
 
##############################################################################
# Usage
##############################################################################
sub Usage {
	print <<EOF;
 
Usage: $scriptName [-h] [-v] -d {days} -l \"{labelpattern}\" [-n]
 
       -h    Displays help
       -v    Displays version
       -d    Delete labels greater than or equal to this number of days
       -l    Label pattern in Perl regexp (must be quoted)
       -n    Preview labels to be deleted (optional)
 
EOF
}
 
 
##############################################################################
# Version
##############################################################################
sub Version {
	print <<EOF;
 
$scriptName (v$scriptVersion)
 
by $scriptAuthorName ($scriptAuthorEmail, $scriptAuthorExt)
 
EOF
}
 
 
##############################################################################
# GetLabels
##############################################################################
sub GetLabels {
	my $cmd="";
	my @F=();
	my $labelName="";
	my $labelDate="";
	
	$cmd="$p4 labels";
	open(CMD, "$cmd |") || die "can't open command \"$cmd\" for piped output: $!";
	while(<CMD>) {
		chomp;
		@F=split;
		$labelName=$F[1];
		$labelDate=$F[2];
		$labels{$labelName}=$labelDate;
	}
	close(CMD) || die "can't close command \"$cmd\" for piped output: $!";
}
 
 
##############################################################################
# DetermineOldLabels
##############################################################################
sub DetermineOldLabels {
	my $label="";
	my $labelYear="";
	my $labelMonth="";
	my $labelDay="";
	my $deltaDays="";
	
	foreach $label (sort keys %labels) {
		if ($label =~ /$labelPattern/) {
			($labelYear,$labelMonth,$labelDay)=split(/\//, $labels{$label});
			$deltaDays=Delta_Days($labelYear,$labelMonth,$labelDay,$currentYear,$currentMonth,$currentDay);
			if ($deltaDays >= $daysToExpire) {
				$oldLabels{$label}="";
				$numOldLabels++;
			}
		}
	}
}
 
 
##############################################################################
# DeleteOldLabels
##############################################################################
sub DeleteOldLabels {
	my $label="";
	my $cmd="";
	
	if ($numOldLabels > 0) {
		foreach $label (sort keys %oldLabels) {
			if ($nSwitch == 0) {
				$cmd="$p4 label -d -f $label";
				open(CMD, "$cmd 2>&1 |") || die "can't open command \"$cmd\" for piped output: $!";
				while(<CMD>) {
					chomp;
					print "$_\n";
				}
				close(CMD) || die "can't close command \"$cmd\" for piped output: $!";
			} else {
				print "preview: Label $label deleted.\n";
			}
		}
	} else {
		print "No old labels to delete.\n";
	}
}
 
 
##############################################################################
# Process
##############################################################################
sub Process {
	GetLabels();
	DetermineOldLabels();
	DeleteOldLabels();
}
 
 
##############################################################################
# MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN #
##############################################################################
Init();
Process();