#!/usr/local/bin/perl
#
# p4d-watch.pl -- generate event log from p4d journal 
#
# Warning: 
#    Anyone with access to this file has complete, 
#    automatic control of your Perforce installation.
#
# Warning:
#    Anyone with access to this file can automatically 
#    modify any file on the network.  See p4d-watch.html
#
# THIS CODE IS PROVIDED AS-IS WITHOUT WARRANTY OR COPYRIGHT.
#
# $Id: //guest/brad_barber/p4d-watch/main/p4d-watch.pl#2 $
# $Date: 2002/07/09 $$Change: 1939 $$Author: brad_barber $
#

use diagnostics;
use strict;
use Getopt::Long;
use Time::localtime;

use vars qw($logfile $journal $nomail $norandom); # set by SlurpCommandLine()

#######################
### Usage and help
#######################

$::usage = "
Usage: p4d-watch.pl [--watch s] [--follow] [--change n] [--journal s] [--logfile s]
                    --help --version --debug
";

$::help = "
$::usage
Watch a p4d journal file for check-ins and other interesting events.

Example: $0 -change 234567 --follow

Options:
  --change n	    start watching at \@n
  --eventlog s	    event log [default 'p4d-watch.log']
		      Format: \@ev\@ rev \@event\@ \@args\@ \@date\@ change \@user\@ \@client\@
		      On Unix, may be deleted with auto restart
  --errorlog s	    error log [default 'p4d-watch.err']
		      On Unix, may be deleted with auto restart
  --follow	    continue to watch for new entries
  --journal s	    journal file [default 'journal']
		      Must exist at initialization
		      On Unix, may be deleted and restarted
  --watch s	    watch file [default 'p4d-watch.cfg']
		      Format: filespec type event args #comments
		      Type: 'once' per match/change, 'all' matches, 'skip' remaining
		      Multiple args separated by '\@'
		      Use event p4d-newwatch to re-read the watch file
			
Help options:
  --debug	    print debugging messages to stdout
  --help	    print this message and exit
  --version	    print version number and exit

";

#######################
### Globals
#######################

$::change_first = 0;	# changed to 1 after seek
$::watchfile = "p4d-watch.cfg";
$::errorlog = "p4d-watch.err";
$::eventlog = "p4d-watch.log";
$::journal = "journal";
$::version = '$Date: 2002/07/09 $$Author: brad_barber $$Id: //guest/brad_barber/p4d-watch/main/p4d-watch.pl#2 $';
$::newwatch = undef;	# set by Process_revcx() to invoke Process_newwatch()
$::check_freq = 10;    # CheckOpenStatus() frequency, approx seconds
$::journal_size = 0;	#                  last known journal size
%::p4actions = (        # http://www.perforce.com/perforce/doc.011/schema/index.html#DmtAction
    "0" => "add",
    "1" => "edit",
    "2" => "delete",
    "3" => "branch",
    "4" => "integ",
    "5" => "import",
    );

#######################
### Main 
#######################

&SlurpCommandLine();

&CheckOpenStatus();  # opens JOURNAL, ERRORLOG, EVENTLOG

# Seek to EOF if --follow and not --change
#   Do not seek if journal restarted
if ($::follow && $::change_first == 0) {
    seek(JOURNAL, 0, 2); 
    $::change_first = 1;  
}

&Read_watch(0, $::watchfile);

# set OUTPUT_AUTOFLUSH
my $old_fh = select(ERRORLOG);
$| = 1;
select(EVENTLOG);
$| = 1;
select($old_fh);

my $isfollow = 1;
while ($isfollow) {
    # $select->canread() is apparently always true on files
    while (<JOURNAL>) {
	my $line = $_;
	if (length($line) > 20) {
	    my ($cmd, $flag, $db) = unpack("A4 x3 A4 A7", $line);  #removes trailing spaces
	    if ($cmd eq "\@pv\@" || $cmd eq "\@rv\@") {
		if ($db eq "revcx\@") {
		    my $change = int(substr($line, 18, 7));
		    if ($change >= $::change_first) {
   			&Process_revcx($change, substr($line, 25));
		    }
		    if (defined $::newwatch) {
			&Process_newwatch($change, $::newwatch);
			$::newwatch = undef;
		    }
		} elsif ($db eq "change\@") {
		    my $change = int(substr($line, 19, 7));
 		    if ($change >= $::change_first) {
      			&Process_change($change, substr($line, 26));
		    }
		} elsif ($flag ne "\@db.") {
		    print ERRORLOG &Today() . " unknown journal format: $line";
		}
	    }
	}
    }
    seek(JOURNAL, 0, 1);  # clear EOF flag
    sleep(1);
    &CheckOpenStatus();
    $isfollow = $::follow;
}
exit 0;
# end of main()

#+--------
# CheckOpenStatus -- check that opened files have not changed
#
#   only user of globals, $::check_cnt, $::journal_inode, $::error_inode, $::event_inode
# 
sub CheckOpenStatus () {
    my @sb;  # can not use File::stat since it does not accept filehandles

    if (!defined $::check_cnt || $::check_cnt++ >= $::check_freq) {
	if ($::debug) {
	    print "CheckOpenStatus: checking file status and journal size $::journal_size " . &Today() . "\n";
	}
	if (defined $::error_inode) {
	    if (! scalar(@sb = stat($::errorlog)) || $sb[1]  != $::error_inode) {
		close ERRORLOG;
		$::error_inode = undef;
		if ($::debug) {
		    print "CheckOpenStatus: reopening $::errorlog\n";
		}
	    }
	}
	if (!defined $::error_inode) {
	    open(ERRORLOG, ">> $::errorlog") or die("can not open file $::errorlog: $!\n");
	    @sb = stat(ERRORLOG);
	    $::error_inode = $sb[1]; # ino field
	    # set OUTPUT_AUTOFLUSH
	    my $old_fh = select(ERRORLOG);
	    $| = 1;
	    select($old_fh);
	}

	if (defined $::event_inode) {
	    if (! scalar (@sb = stat($::eventlog)) || $sb[1] != $::event_inode) {
		close EVENTLOG;
		$::event_inode = undef;
		if ($::debug) {
		    print "CheckOpenStatus: reopening $::eventlog\n";
		}
	    }
	}
	if (!defined $::event_inode) {
	    if (!open(EVENTLOG, ">> $::eventlog")) {
		print ERRORLOG "can not open file $::eventlog: $!\n";
		die "can not open file $::eventlog: $!\n";
	    }
	    @sb = stat(EVENTLOG);
	    $::event_inode = $sb[1];
	    my $old_fh = select(EVENTLOG);
	    $| = 1;
	    select($old_fh);
	}

	if (defined $::journal_inode) {
	    @sb = stat($::journal);
	    if (!scalar(@sb) 
		    || $sb[1] != $::journal_inode
		    || $sb[7] < $::journal_size) { # p4d -jj/-jc truncate the journal
		close JOURNAL;
		$::journal_inode = undef;
		if ($::debug) {
		    print "CheckOpenStatus: reopening $::journal (will wait if needed)\n";
		}
	    }
	    if (scalar(@sb)) {
		$::journal_size = $sb[7];
	    }
	}
	if (!defined $::journal_inode) {
	    while (!open(JOURNAL, "$::journal")) {
		if (!defined $::check_cnt) {  # initial call	
		    print ERRORLOG "can not open file $::journal: $!\n";
		    die "can not open file $::journal: $!\n";
		}
		sleep 1;
	    }
	    @sb = stat(JOURNAL);
	    $::journal_inode = $sb[1];
	    $::journal_size = $sb[7];
	    my $event = "\@ev\@ 0 \@p4d-newjournal\@ \@$::journal_inode\@ \@" . &Today() . "\@ 0 \@\@ \@\@ \@\@\n";
	    print EVENTLOG $event;
	}
	$::check_cnt = 0;
    }
} # end CheckOpenStatus

#+--------
# Process_change -- record change in $::change_user{}
#
sub Process_change () {
    my ($change, $remainder) = (@_);    
    if ($remainder =~ /^([0-9]+) \@([^@]+)\@ \@([^@]+)\@/) {
	my ($firstchange, $client, $user) = ($1, $2, $3);
	if ($::debug) {
	    print "Process_change: $change $user\@$client\n";
	}
	if (scalar keys %::change_user > 1000) {
	    foreach my $key (keys %::change_user) {
		if ($key < $change - 500) {
		    delete($::change_user{$key});
		}
	    }
	    foreach my $key (keys %::change_watch) {
		my ($num, $watch) = split(/-/, $key);
		if ($num < $change - 500) {
		    delete($::change_watch{$key});
		}
	    }
	}
	$::change_user{$change} = "$user\@$client";
    } else {
	print ERRORLOG &Today() . " Process_change: unknown format: $change $remainder\n";
    }
}

#+--------
# Process_newwatch -- update watchfile and rebuild $::watch_...
#
sub Process_newwatch () {
    my ($change, $depotfile) = (@_);    

    if ($::debug) {
	print "Process_newwatch: change $change depotfile $depotfile\n";
    }
    my $text = `p4 print -q "$depotfile" 2>&1 1>$::watchfile`;
    if ($text !~ /^$/) {
	print ERRORLOG &Today() . " Process_newwatch: Could not print '$depotfile' to '$::watchfile': $text";
	return;
    }
    &Read_watch($change, $::watchfile);
}

#+--------
# Process_revcx -- 
#
sub Process_revcx () {
    my ($change, $remainder) = (@_);    

    # @pv@ 0 @db.revcx@ 240500 @//product/DAS/main/phase3-build.xml@ 33 1 
    if ($remainder =~ /^\@([^@]+)\@ ([0-9]+) ([0-9]+)/) {
	my ($depotfile, $rev, $p4action) = ($1, $2, $3);
	if (defined $::p4actions{$p4action}) {
	    $p4action = $::p4actions{$p4action};
	}
	if ($::debug) {
	    print "Process_revcx: $change $depotfile $rev $p4action\n";
	}
	my $i = -1;
	for my $regexp (@::watch_regexp) {
	    $i++;
	    if ($depotfile =~ /$regexp/) {
		my $arg1 = $1 || "";
		my $arg2 = $2 || "";
		my $arg3 = $3 || "";
		my $type = $::watch_type[$i];
		last if ($type eq "skip");
		if ($type eq "once") {
		    next if (defined $::change_watch{"$change-$i"});
		    $::change_watch{"$change-$i"} = 1;
		} elsif ($type ne "all") {
		    print ERRORLOG &Today() . " Process_revcx: type $type of watch $i is not 'skip', 'once', or 'all'\n";
		    next;
		}
		my $action = $::watch_action[$i];
		my $params = $::watch_params[$i];
		my $filespec = $::watch_filespec[$i];
		$filespec =~ s/\*/$arg1/;
		$filespec =~ s/\*/$arg2/;
		$filespec =~ s/\*/$arg3/;
		my $user = "";
		my $client = "";
		if (defined $::change_user{$change}) {
		    ($user, $client) = split(/\@/, $::change_user{$change});
		} else {
   		    print ERRORLOG &Today() . " Process_revcx: could not locate change $change\n";
		}
		if ($::debug) {
		    print "Process_revcx: watch $i $action $params $filespec depotfile $depotfile arg1 $arg1 arg2 $arg2 $change $user\@$client\n";
		}

		# [cbb 5/02] could not get /gee to work, too lazy to use a hash or sub
		#    no strict 'refs'; params =~ s/\$([a-z]+|[1-9])/${$1}/ge;
		$action =~ s/\$1/$arg1/g;
		$action =~ s/\$2/$arg2/g;
		$action =~ s/\$3/$arg3/g;
		$action =~ s/\$change/$change/g;
		$action =~ s/\$user/$user/g;
		$action =~ s/\$client/$client/g;
		$action =~ s/\$depotfile/$depotfile/g;
		$action =~ s/\$filespec/$filespec/g;
		$action =~ s/\@/\@\@/g;
		$params =~ s/\$1/$arg1/g;
		$params =~ s/\$2/$arg2/g;
		$params =~ s/\$3/$arg3/g;
		$params =~ s/\$change/$change/g;
		$params =~ s/\$user/$user/g;
		$params =~ s/\$client/$client/g;
		$params =~ s/\$depotfile/$depotfile/g;
		$params =~ s/\$filespec/$filespec/g;
		$params =~ s/\@/\@\@/g;
		my $event = "\@ev\@ 0 \@$action\@ \@$params\@ \@" . &Today() . "\@ $change \@$user\@ \@$client\@ \@$p4action\@\n";
		if ($::debug) {
		    print "Process_revcx: $event";
		}
		print EVENTLOG $event;
		if ($action eq "p4d-newwatch") {
		    $::newwatch = $depotfile;
		}
	    }
	}
    } else {
	print ERRORLOG &Today() . " Process_revcx: unknown format: $change $remainder\n";
    }
}

#+--------
# Read_watch -- read $::watchfile into @::watch...
#
sub Read_watch () {
    my ($change, $watchfile) = (@_);
    @::watch_filespec = ();
    @::watch_regexp = ();
    @::watch_type = ();
    @::watch_action = ();
    @::watch_params = ();
    open(WATCH, $watchfile) 
	or die("can not open --watch $watchfile: $!\n");
    while (<WATCH>) {
        my $line = $_;
	$line =~ s/#.*//;
	$line =~ s/^\s+//;
	$line =~ s/\s+$//;
	if ($line ne "") {
	    my ($filespec, $type, $action, $params) = split(/\s+/, $line, 4);
	    if (!defined $type || ($type ne "skip" && !defined $action)) {
		print ERRORLOG &Today() . " p4d-watch.pl: watch should be: filespec type action [params]\n          or: filespec skip\n  instead of: $line\n";
		next;
	    }
	    $action = $action || "";
	    $params = $params || "";
	    my $filepat = "\^$filespec\$";
	    $filepat =~ s|\*|([^/]*)|g;
	    $filepat =~ s/\./\\./g;
	    $filepat =~ s/\\\.\\\.\\\./.*/g;
	    if ($::debug) {
		print "Read_watch: $filespec $filepat $type $action $params\n";
	    }
	    push (@::watch_filespec, $filespec);
	    push (@::watch_regexp, qr/$filepat/);
	    push (@::watch_type, $type);
	    push (@::watch_action, $action);
	    push (@::watch_params, $params);
	}
    }
    close(WATCH);
    my $event = "\@ev\@ 0 \@p4d-newwatch-done\@ \@\@ \@" . &Today() . "\@ $change \@\@ \@\@ \@\@\n";
    print EVENTLOG $event;
}

#+--------
# SlurpCommandLine() reads in the command line, sets global variables according
# to the command line parameters, and populates the global @::users array.
sub SlurpCommandLine() {
    my %options = ();
    my ($tlogfile,$tinput,$tusername,$tfullname,$tgroup,$tpasswd);
    my ($input,$username,$fullname,$group,$passwd);

    # read all of the options
    GetOptions(\%options,
	       "help",
	       "version",
	       "debug!",
	       "change=n",
	       "journal=s",
	       "watch=s",
	       "errorlog=s",
	       "eventlog=s",
	       "follow!",
	       "nomail",
	       "input=s",
		) or die $::usage;

    if (defined($options{'help'})) {
	    print "$::help";
	    exit 0;
    }
    if (defined($options{'version'})) {
        print $::version, "\n";
        exit 0;
    }
    if (defined($options{'debug'})) {
        $::debug = 1;
    }
    if (defined($options{'follow'})) {
        $::follow = $options{'follow'};
    }
    if (defined($options{'journal'})) {
        my $tjournal = $options{'journal'};
        # Untaint the journal
        $tjournal =~ /^([-\w.=+\/,0-9]*)$/;
        $::journal = $1;
    }
    if (defined($options{'errorlog'})) {
        my $terrorlog = $options{'errorlog'};
        # Untaint the errorlog
        $terrorlog =~ /^([-\w.=+\/,0-9]*)$/;
        $::errorlog = $1;
    }
    if (defined($options{'eventlog'})) {
        my $teventlog = $options{''};
        # Untaint the eventlog
        $teventlog =~ /^([-\w.=+\/,0-9]*)$/;
        $::eventlog = $1;
    }
    if (defined($options{'watch'})) {
        my $twatchfile = $options{'watch'};
        # Untaint the watchfile
        $twatchfile =~ /^([-\w.=+\/,0-9]*)$/;
        $::watchfile = $1;
    }
    if (defined($options{'change'})) {
        $::change_first = $options{'change'};
    }

}

#+--------
# Today() returns today's date as yyyy/mm/dd hh:mm:ss
sub Today() {
    my $tm = localtime;
    my $date = sprintf "%04d/%02d/%02d %02d:%02d:%02d",
	$tm->year+1900, $tm->mon+1, $tm->mday, $tm->hour, $tm->min, $tm->sec;
    return $date;
}