p42kbnow #1

#!/usr/bin/perl

###	
###	P42KBNOW
###	(c) 2002 Software Poetry, Inc.
###	http://www.softwarepoetry.com
###
###	Perforce daemon to index changelists, descriptions and optionally
###	diffs in KBnow. Check configuration below, and then install to run
###	under unix cron or the windows task scheduler.
###
###	License: This software is provided as-is with NO WARRANTY WHATSOEVER.
###	Software Poetry makes no claims as to its fitness for any purpose.
###	This file and any derivatives or translations of it may be freely
###	copied and redistributed so long as the original license and copyright
###	notices are included and not altered.
###

use strict;

# +-------------------------------------------------------------------------
# | Configuration Variables
# +-------------------------------------------------------------------------

# KBnow "incoming" directory ... must include the trailing path separator,
# and be sure to double-up backslashes on Windows....

my $c_szIncomingDir = "/home/kbnow/data/incoming/";

# full path to p4 binary and other p4 settings ... make sure to use 

my $c_szP4Command = "/usr/local/bin/p4 -p localhost:1666 -u sean";

# define as empty string to include diffs, "-s" to suppress them

my $c_szDiffArg = "-s";

# max length of subject field (taken from first line of description)

my $c_cchSubjectMax = 40;

# +-------------------------------------------------------------------------
# | Entrypoint
# +-------------------------------------------------------------------------

index_new_changelists();
exit(0);

# +-------------------------------------------------------------------------
# | index_new_changelists
# +-------------------------------------------------------------------------

sub index_new_changelists()
{
	my $szCommand;
	my @rgszChange;
	my $fSawChanges;

	if (!open(CHANGESFILE, "$c_szP4Command review -t kbnow |"))
		{
		print("Failed executing review command (does user have privs?)\n");
		exit(1);
		}

	$fSawChanges = 0;
	while (<CHANGESFILE>)
		{
		$fSawChanges = 1;
		@rgszChange = split;
		index_one_changelist($rgszChange[1]);
		}

	if ($fSawChanges)
		{
		system("$c_szP4Command counter kbnow $rgszChange[1]");
		}
}

# +-------------------------------------------------------------------------
# | index_one_changelist
# +-------------------------------------------------------------------------

sub index_one_changelist($)
{
	my $fHeaderDone;
	my @rgszHeaders;
	my $szCollected;
	my $szOutputPath;
	my $szCommand;
	my $nChange;

	print(STDOUT "indexing change $_[0]\n");

	# start reading the changelist
	$nChange = $_[0];
	if (!open(DESCFILE, "$c_szP4Command describe $c_szDiffArg $nChange |"))
		{
		print(STDOUT "couldn't open changelist description $nChange\n");
		exit(1);
		}

	# set up the output file

	$szOutputPath = get_output_file_path();
	if (!open(OUTFILE, ">$szOutputPath"))
		{
		print(STDOUT "couldn't open output file $szOutputPath\n");
		exit(1);
		}

	select(OUTFILE);

	# pull out header info

	$_ = <DESCFILE>;
	$szCollected = $_;
	@rgszHeaders = m/(.*)\ by\ (.*)\ on\ (.*)\n/;

	$fHeaderDone = 0;
	while (<DESCFILE>)
		{
		if (!$fHeaderDone)
			{
			$szCollected .= $_;

			$_ =~ s/^[ \t\n]//;
			$_ =~ s/[ \t\n]$//;

			if ($_ ne "")
				{
				if ($_ ne "Affected files ...")
					{
					$rgszHeaders[0] = substr($_,0,$c_cchSubjectMax);
					}

				print("From: $rgszHeaders[1]\n");
				print("Date: $rgszHeaders[2]\n");
				print("Subject: $rgszHeaders[0]\n");
				print("\n");

				print($szCollected);
				$fHeaderDone = 1;
				}			
			}
		else
			{
			print "$_";
			}
		}

	close(OUTFILE);
}

# +-------------------------------------------------------------------------
# | get_output_file_path
# +-------------------------------------------------------------------------

sub get_output_file_path()
{
	my $nCounter;
	my $szPathTest;
	my @stat;

	$nCounter = time();
	do	{
		$szPathTest = $c_szIncomingDir . "p4" . $nCounter;
		if (! -e $szPathTest)
			{
			return($szPathTest);
			}

		++$nCounter;
		}
		while (1);
}