#!/usr/bin/perl use Net::SMTP; # Perfreview # #### What Does perfreview Do? # # perfreview - A change review 'daemon' for Perforce changes. # Sends email to user when files they've subscribed to # change in the depot. # #### How Does it Work? # # Uses 'p4 review' to dish up changes for review, # 'p4 reviews' to find out who should review the changes, # 'p4 describe' to fill out mail to send to users, and # Net::SMTP to deliver the mail. # #### Instructions: Please read before running! # # 1) There is no step 1. # # 2) This script can be installed in any directory, although # we recommend installing it in the same directory as # the p4d server. # # 3) If necessary, change the top line of this script to point to the # location of your local Perl executable. The Perl version should # be 4 or higher. # # 4) Change the values of the following variables as desired: my $once = 1; my $sleepTime = 60; my $doOutput = 1; my $p4 = "/usr/local/bin/p4"; my $mailhost = "mail"; my $counter = "review"; my $lockfile = "/tmp/perfreview.lock"; # $once says process the queue once instead of every minute; # This is good for being called by cron(8). # # $sleepTime is the number of seconds to wait before doing the # next change review (the default is 60 seconds); # # $doOutput, a Boolean value, specifies whether or not any output # is written to STDOUT (the default is false). # # $p4 is the executable and global arguments. # # $mailhost is the name of the SMTP email host. # # $lockfile is the name of a lockfile to be used in case this is # invoked from a cron job, and the script hasn't finished yet. # # $counter is the name of the counter to be used. (default = 'review') # # 5) If $doOutput is set to 0, run perfreview as # # perfreview.perl & # # Otherwise, run it as # # perfreview.perl >> somefile & # #### if (-e $lockfile) { die "Lockfile $lockfile already exists."; } open(LOCKFILE, ">$lockfile") || die "Cannot create lockfile $lockfile\n"; print LOCKFILE "locked\n"; close(LOCKFILE) || die "Cannot close lockfile $lockfile\n"; print("START: ". localtime() . "\n") if ($doOutput); select(STDOUT); $| = 1; # make unbuffered # if -1 is given, we'll run once $flag = shift( @ARGV ); $once = 1 if( $flag eq '-1' ); do { # Remember highest numbered change we see, so that we can # reset the 'review' counter once all mail is delivered. # If we crash, the worst that happens is we'll send the mail # again. local( $topChange ) = 0; # # REVIEW - list of changes to review. # open( REVIEW, "$p4 review -t $counter|" ) || next; while( <REVIEW> ) { # # Format: "Change x user <email> (Full Name)" # local( $change, $user, $email, $fullName ) = /Change (\d*) (\S*) <(\S*)> (\(.*\))$/; print (localtime() . "review '$change', user='$user', email='$email' fullname='$fullName'\n") if ($doOutput); # # Get list of people who will review this change # print(localtime() . "...mail start: From: $email\n") if ($doOutput); open( REVIEWERS, "$p4 reviews -c $change|" ) || next; local (@reviewers) = (); while( <REVIEWERS> ) { # user <email> (Full Name) local( $user2, $email2, $fullName2 ) = /(\S*) <(\S*)> (\(.*\))$/; print (localtime() . "......reviewer user2='$user2', email2='$email2', fullname2='$fullName2'\n") if ($doOutput); push(@reviewers, $email2); } close( REVIEWERS ); open( DESCRIBE, "$p4 describe -s $change|" ); local (@describe) = (); my %branches; while( <DESCRIBE> ) { # don't allow single .'s through $_ = "..\n" if( $_ eq ".\n" ); push(@describe, $_); if (m!\.\.\. //depot/project/([^/]+)/[^\#]+\#\d+ \w+!) { $branches{$1} = 1; } } close( DESCRIBE ); my @branches = keys(%branches); my $smtp = Net::SMTP->new($mailhost) || die "cannot connect to $mailhost via SMTP"; $smtp->mail("$email $fullName"); $smtp->to("$email"); # place other $smtp->to() here foreach (@reviewers) { $smtp->bcc($_); } # $smtp->bcc(@reviewers); $smtp->data(); $smtp->datasend("To: $email $fullName\n"); # may want to replace with with a list $smtp->datasend("Reply-To: $email\n"); if (scalar(@branches)) { $smtp->datasend("Subject: PERFORCE change $change for review on " . "branch(es): " . join(" ", @branches) . "\n"); } else { $smtp->datasend("Subject: PERFORCE change $change for review\n"); } $smtp->datasend("\n"); # for P4DB #$smtp->datasend("<http://perforce/p4db/chv.cgi?CH=$change>\n"); $smtp->datasend(@describe); $smtp->dataend(); $smtp->quit(); print(localtime() . "......mail end: From: $email\n") if ($doOutput); $topChange = $change; } # # Update counter to reflect changes reviewed. # system( "$p4 review -c $topChange -t $counter" ) if( $topChange ); print("Update counters...\n") if ($doOutput) } while( !$once && sleep($sleepTime) ); print("END: " . localtime() . "\n") if ($doOutput); unlink "$lockfile";
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#1 | 2662 | Todd Short |
Some general purpose scripts: * cleancheckpoint.perl: cleans up old checkpoint and journal files, allows user to leave a number around. * perfreview-smtp.perl: version of perfreview.perl daemon that uses SMTP instead of Sendmail -- not perfect, needs some work. * spacecheck.perl: a trigger script that prevents submissions of files with spaces. |