#!/usr/bin/env perl

use Time::ParseDate;
use Time::localtime;
use Getopt::Long;

my $defaultdays = 120;
my $dayseconds = 60 * 60 * 24;
my $todaystring = "";			# date to label current tag list
my $todayseconds = 0;			# reference time stamp

GetOptions (
                'help' => \$help,
				'scan=s' => \$scan,
				'days=i' => \$days,
				'file=s' => \$file,
				'purge' => \$purge,
				'onlypurge' => \$onlypurge,
	);

if ( $help )    { help() and exit(0); }

today();

# Must have a working directory for cvs log to work

if( ! -e "doc" )
{
	system("cvs co -r V6_6-branch V6_6_ALL");
}

if( ! -e "doc" )
{
	die "Failed to check out a working directory\n";
}

if( $days )
{
	print "Changing Days of interest from $defaultdays days to $days days\n";
}
else
{
	$days =  $defaultdays;
}

my $tagfile = "OldTags-" . $days . "-" . $todaystring;
my $LogFile = $tagfile . ".tagrmlog";

print "logfile is $LogFile\n";

open(STDOUT, ">$LogFile") or die "Could not open $LogFile: $!\n";
open(STDERR, ">&STDOUT");
select(STDERR); $| = 1;
select(STDOUT); $| = 1;

print "Processing build tags for <$days> days\n";

if(!$onlypurge)
{
	# default is to always produce list
	if ( $scan )
	{
		tagscan( $scan );
	}
	else
	{
		tagscan( "src/Imakefile" );
	}
}

if( $file )
{
	print "Changing from $tagfile to $file for tag purging\n";
}
else
{
	$file =  $tagfile;
	print "Tag purging file is $file\n";
}

print "Tag purging file is $file\n";
open(TAGS,"<$file") || die "Can't open Tag file $file: $!\n";

if( $purge )
{
	my $line;
	print "Purging tag file\n";
	while(<TAGS>)
	{
		chomp($_);
		$line = $_;
		#print "$line\n";
		purgetag($line);
	}
}
close(TAGS);

print "Bye\n";

exit(0);

sub help
{

	print "Usage: writefile.pl --megs=#
Options:
	[-h/--help]                             See this
	[-s/--scan]                             Scan for tags and dates
											Defaults to src/CODING_GUIDLINES

	[-d/--days]								Collect older then How Many Days?
											Defaults to 120 days

	[-f/--file]								File to purge tags with(list of tags);
											Defaults to file built after today();

	[-p/--purge]							Use list of tags to purge repository;
											Defaults to file built after today();

	[-o/--onlypurge]						Use list of tags to purge repository;
											Defaults to file built after today();
											Skips scaning step.

	example:		dateparse.pl --days=460 --purge  (anything older then 460 days purged)
	\n";
}

sub purgetag
{
	my $targettag = shift;
	my $repository = $ENV{CVSROOT};
	my $line = "";

	print "Tag to purge is...... $targettag\n";

	# without one module for "ALL" we hit each directory in repository
	# what upper level directories are there....
	open(DIR, "ls $repository 2>&1 |") || die "Could not open listing of ---$repository---: $!\n";
	while(<DIR>)
	{
		chomp($_);
		$line = $_;
		#print "$line\n";
		if( -d $line )
		{
			print "Removing tag $targettag from directory $line\n";
			system("cvs rtag -d $targettag $line");
		}
	}
	close(DIR);
}

sub tagscan
{
	my $targetfile = shift;
	my $input = "cvs log " . $targetfile;
	my $line;
	my $thisage = 0;

	my $tagstamp = 0;

	print "File will be $tagfile\n";

 	open(TAGS,">$tagfile") || die "Could not create $tagfile: $!\n";

	if(!targetfile )
	{
		die "No source to collect tags from.......\n";
	}

	open( INTAGS, "$input 2>&1 |") || die "Could not open ---$input---: $!\n";
	while(<INTAGS>)
	{
		chomp($_);
		$line = $_;
		#print "$line\n"; 
		#
		# This match skips BUILD tags without dates like one
		# VDT_GLOBUS one and dates without BUILD at the start
		# and Dates which have been modifications like
		# 2004-5-26-1(of which there are something like 3 as of 1/21/05)
		#
		if( $line =~ /^\s*(BUILD.*)(\d{4}-\d+-\d+):.*$/)
		{
			# print "Build Tag = $1$2 Date Code = $2\n";
			# check age of tag
			# translate to seconds
			$tagstamp = get_timestamp($2);
			# print "seconds for $2 is $tagstamp\n";
			$thisage = get_days($tagstamp);
			if( $thisage > $days )
			{
				#print "Days $thisage exceeds $days days\n";
				#print "Build Tag = $1$2 Date Code = $2\n";
				print TAGS "$1$2\n";
			}
		}
	}
	close(INTAGS);
	close(TAGS);
}

sub today
{
	my $tm = localtime;
	my $nicedate = sprintf("%04d-%02d-%02d", $tm->year+1900, ($tm->mon)+1, $tm->mday);
	#print "Currently $nicedate\n";
	my $NowSeconds = parsedate("$nicedate");
	#print "Now seconds $NowSeconds\n";
	$todayseconds = $NowSeconds;
	$todaystring = $nicedate;
}

sub get_timestamp
{
	my $tagtimestamp = shift;
	if( !$tagtimestamp )
	{
		die "get_timestamp was not passed a timestamp from tag\n";
	}

	my $tagseconds = parsedate($tagtimestamp);
	return($tagseconds);
}

sub get_days
{
	my $timestampfromtag = shift;
	my $diffseconds = 0;
	my $days = 0;

	if(!$timestampfromtag)
	{
		die "get_days needs to be passed a timestamp(seconds)\n";
	}
	 
	$diffseconds = $todayseconds - $timestampfromtag;
	$days = $diffseconds / $dayseconds;
	#print "That is $days old\n";
	return($days);
}

sub old
{
my $tagdate = "2005-1-13";
my $TagSeconds = parsedate("$tagdate");
print "$TagSeconds\n";

my @Time = gmtime($TagSeconds);
print localtime($TagSeconds). " is the time\n";
print "DOM = $Time[3], mon = $Time[4]\n";

# current date in seconds......

my $tm = localtime;
my $nicedate = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $tm->year+1900, ($tm->mon)+1, $tm->mday, $tm->hour, $tm->min, $tm->sec);
print "Currently $nicedate\n";
my $NowSeconds = parsedate("$nicedate");
print "Now seconds $NowSeconds\n";
}
