p4review.pl #2

#!/usr/bin/env cmperl
#-*-mode:perl-*-
#***************************************************************************
#
#
#***************************************************************************
#
#         File : p4review.pl
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : p4review.pl is not cutting it.  The plan is to expand the
#                the review dameon and its functionality to send email to
#                users according to the parameters of the JobView in their
#                User Specification.
#
#***************************************************************************

use Dumpvalue;
use Getopt::Long;
use Mail::Mailer;
use P4;
use Pod::Usage;
use strict;

#
# Get arguments and options.
#
my (%opts);
@{$opts{args}} = @ARGV;
GetOptions ( \%opts,
             'admin=s',
             'bccadmin',
             'debug',
             'file=s',
             'help|?',
             'lastmodified=s',
             'man',
             'notify=s',
             'port=s',
             'password=s',
             'jobs',
             'smtpserver=s',
             'toauthor',
             'user=s'
           );

# Help messages.
pod2usage(-verbose => 1) if $opts{help};
pod2usage(-exitstatus => 0, -verbose => 2) if $opts{man};

# Look at a configuration file if it is specified
if ($opts{file}) {
    my ($out) = parseConfig(\%opts);
    if ($out != 1) {
        print STDERR $out;
        exit 1;
    }
}

# Check that all required fields are specified.
print "'--notify'(-n) requires [c | j | cj | jc]\n" unless $opts{notify} =~ /^c$|^j$|^cj$|^jc$/;
print "'--lastmodified' (-l) is required when '--notify j' is specified.\n" if ((not defined $opts{lastmodified}) && ($opts{notify} =~ /j/));
print "'--admin' (-a) is a required option.\n" unless defined $opts{admin} || defined $opts{file};
pod2usage(-verbose => 1) unless defined $opts{admin} && defined $opts{notify};
if ($opts{notify} =~ /j/) {
    pod2usage(-verbose => 1) unless defined $opts{lastmodified};
}


#
#Run the main program.
#
my $exit = main(%opts);

#
# Exit the script with a valid exit status.
#
exit not $exit;

#***************************************************************************
#
#     Function : main
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Main program body
#
#
#***************************************************************************
sub main {
    my (%args) = @_;

    if ($args{debug}) {
        my $out = sendMail( smtp    => $args{smtpserver},
                            from    => 'Mr. Perforce <perforce@reshape.com>',
                            to      => $args{admin},
                            debug   => $args{debug},
                            subject => "Testing the review script.",
                            message => "This would be the body of the email.\n"
                          );
        if ($out != 1) {
            print STDERR "Unable to open a connection to the SMTP server '$args{smtp}': $out\n";
            return 0;
        }
    }

    #
    # New P4 object.
    #
    my ($p4) = P4->new();
    $p4->ParseForms();

    #
    # Set connection string.
    #
    $p4->SetUser($args{user}) if $args{user};
    $p4->SetPort($args{port}) if $args{port};
    $p4->SetPassword($args{password}) if $args{password};

    $p4->Init();
    if ($p4->ErrorCount > 0) {
        print STDERR "Failed to connect to Perforce Server at " . $p4->GetPort() . "\n";
        print STDERR join "", @{$p4->Errors};
        return 0;
    }
    if ($args{debug}) {
        print "\nTesting Perforcer Server Connection Running 'p4 info':\n\t", join "\n\t", $p4->Info, "\n";
        if ($p4->ErrorCount > 0) {
            print STDERR "Failed in call to 'p4 info' (runs only in debug mode).\n";
            print STDERR join "", @{$p4->Errors};
            $p4->Final();
            return 0;
        }
    }

    #
    # Send mail for the review change lists.
    #
    if ($args{notify} =~ /c/) {
        my ($out) = reviewChanges($p4, %args);
        if ($out != 1) {
            my $out = sendMail( smtp    => $args{smtpserver},
                                from    => 'Mr. Perforce <perforce@reshape.com>',
                                to      => $args{admin},
                                debug   => $args{debug},
                                subject => "Review script failed while reviewing changelists.",
                                message => "User: $args{user}\nPort: $args{port}\nClient: $args{client}\n$out\n"
                      );
            if (not $args{repeat}) {
                $p4->Final();
                return 0;
            }
        }
    }

    #
    # Send mail for the job reviews.
    #
    if ($args{notify} =~ /j/) {
        my ($out) = reviewJobs($p4, %args);
        if ($out != 1) {
            my $out = sendMail( smtp    => $args{smtpserver},
                                from    => 'Mr. Perforce <perforce@reshape.com>',
                                to      => $args{admin},
                                debug   => $args{debug},
                                subject => "Review script failed while reviewing jobs.",
                                message => "User: $args{user}\nPort: $args{port}\nClient: $args{client}\n$out\n"
                      );
            if (not $args{repeat}) {
                $p4->Final();
                return 0;
            }
        }
    }

    #
    # Diconnect from Perforce server.
    #
    $p4->Final();


    #
    # Run the script as a daemon if "repeat" is set to a value other than 0
    # or is undef.  By the eay, resetting 'repeat' to 0 in the config file
    # is a great way to stop the daemon.
    #
    if ($args{repeat}) {
        sleep $args{repeat};
        my ($command) = "$^X $0 @{$args{args}}";
        print "Command: $command\n" if ($args{debug});
        exec $command;
    }

    return 1;
}

#***************************************************************************
#
#     Function : sendMail
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Send the email message.
#
#
#***************************************************************************
sub sendMail {
    my (%args) = @_;

    print "\nMailing Parameters:\n", (join "", map { $_ = "\t$_ => $args{$_}\n"} keys(%args)), "\n" if $args{debug};
    Dumpvalue->new->dumpValue(\%args) if $args{debug};

    my $mailer = Mail::Mailer->new("smtp", $args{smtpserver});
    $mailer->open({ From    => $args{from},
                    To      => $args{to},
                    Bcc     => $args{bcc},
                    Subject => $args{subject}
                  });
    print $mailer $args{message};
    $mailer->close;

    return 1;
}

#***************************************************************************
#
#     Function : reviewChanges
#       Author : Jeremy Russell
#         Date : November 28, 2001
#
#  Description : Parse the configuration file to get the default values.
#
#
#***************************************************************************
sub reviewChanges {
    my ($p4) = shift;
    my (%args) = @_;

    my ($lastReport) = $p4->Counter('p4review');
    print "Last Change Review Done: $lastReport\n" if defined $args{debug};
    print "Last Change List: ", $p4->Counter('change'), "\n" if defined $args{debug};

    my (@changes) = $p4->Review('-t', 'p4review');
    print "New Changes:\n\t", join "\n\t", @changes, "\n" if defined $args{debug};

    my (%change);
    foreach my $change (@changes) {
        my ($number) = (split / /, $change)[1];
        my ($email) = (split / /, $change)[3];
        $email =~ s/^\<|\>$//g;
        my ($name) = (split /\(/, $change)[1];
        $name =~ s/^\(|\)$//g;

        my (@reviewerList);
        my (@reviewers) = $p4->Reviews('-c', $number);
        foreach my $reviewer (@reviewers) {
            my ($email) = (split / /, $reviewer)[1];
            $email =~ s/^\<|\>$//g;
            my ($name) = (split /\(/, $reviewer)[1];
            $name =~ s/^\(|\)$//g;
            push(@reviewerList, "$name <$email>");
        }

        #
        # Get the change specification for the current change.
        #
        my ($changeSpec) = $p4->Describe('-s', $number);
        delete $changeSpec->{specdef};

        print "Change Description:\n" if defined $args{debug};
        Dumpvalue->new->dumpValue($changeSpec) if defined $args{debug};

        #
        # Format the body of the text message.
        # This I must admit would have been easier from the command line...
        #
        my @desc;
        push (@desc, "Change $number by $changeSpec->{user}\@$changeSpec->{client} on ",  scalar localtime($changeSpec->{time}), ".\n\n");

        my (@changeDesc) = split /\n/, $changeSpec->{desc};

        foreach my $x (@changeDesc) {
            $x =~ s/^\s+//;
            push (@desc, "\t$x\n");
        }

        push (@desc, "\nAffected files ...\n\n");
        for (my $x; $x <= $#{$changeSpec->{depotFile}}; $x++) {
            my ($line) = "... $changeSpec->{depotFile}->[$x]\#$changeSpec->{rev}->[$x] $changeSpec->{action}->[$x]\n";
            push (@desc, $line);
        }

        #
        # Add the author to the reviewers list if 'toauthor' is set.
        #
        push(@reviewerList, "$name <$email>") if defined $args{toauthor};
        undef @reviewerList if $args{debug};
        push(@reviewerList, "Perforce Administrator <$args{admin}>") if $args{debug};
        my ($bccadmin);
        $bccadmin = $args{admin} if $args{bccadmin};

        $change{$number} = { email     => $email,
                             name      => $name,
                             reviewers => \@reviewerList
                           };

        my $out = sendMail( smtp    => $args{smtpserver},
                            to      => \@reviewerList,
                            debug   => $args{debug},
                            bcc     => $bccadmin,
                            from    => "$name <$email>",
                            subject => "PERFORCE$args{server} change $number for review",
                            message => \@desc
                          );
        if ($out != 1) {
            print STDERR "Unable to open a connection to the SMTP server '$args{smtpserver}': $out\n";
            return 0;
        }

        my $out = $p4->Counter('p4review' , $number);
        print "Increment Counter Value: $out\n" if defined $args{debug};
        print "New Counter Value: ", $p4->Counter('p4review'), "\n\n" if defined $args{debug};
    }

    if ($args{debug}) {
        print "\nChange Data Strcuture:\n";
        Dumpvalue->new->dumpValue(\%change);
        print "\n\n";
    }

    return 1;
}

#***************************************************************************
#
#     Function : reviewJobs
#       Author : Jeremy Russell
#         Date : December 03, 2001
#
#  Description : Figure out the list of users to notify per job change.
#
#
#***************************************************************************
sub reviewJobs {
    my ($p4) = shift;
    my (%args) = @_;

    #
    # Get the time of the last job query.
    #
    my ($number) = time();
    my ($lastReport) = $p4->Counter('p4job');
    print "Last Job Review Done: $lastReport\n" if defined $args{debug};
    print "Last Job: ", $p4->Counter('job'), "\n" if defined $args{debug};

    #
    # Parse the job date counter.
    #
    my ($date) = perforceDate($lastReport);
    print "Date: $date\n\n"if $args{debug};

    #
    # Parse out the list of reviews for which to check.
    #
    my (%reviewerList);
    my (@reviewType) = split (",", $args{jobreview});

    #
    # Start the list of users who recieve all job emails.
    #
    foreach my $reviewType (@reviewType) {

        #
        # Parse out the actual review from the token specifying
        # review type.
        #
        my ($review, $type) = split (":", $reviewType);

        my (@reviewerList);
        my (@reviewers) = $p4->Reviews($review);
        foreach my $reviewer (@reviewers) {
            my ($email) = (split / /, $reviewer)[1];
            $email =~ s/^\<|\>$//g;
            my ($name) = (split /\(/, $reviewer)[1];
            $name =~ s/^\(|\)$//g;
            push(@reviewerList, "$name <$email>");
        }

        if ($type) {
            $reviewerList{$type} = \@reviewerList;
        } else {
            $type = 'review_all_type';
            push (@{$reviewerList{$type}}, @reviewerList);
        }
        print "Job Reviewers ('$type'):\n\t", join "\n\t", @reviewerList, "\n\n" if $args{debug};
    }

    #
    # Bcc the admin if set.
    #
    my ($bccadmin);
    $bccadmin = $args{admin} if $args{bccadmin};

    #
    # Obtain a list of jobs modified since the last check.
    #
    my (@jobs) = $p4->Jobs('-e', "Last_Modified > $lastReport");
    Dumpvalue->new->dumpValue(\@jobs) if $args{debug};

    #
    # Figure out the fields that need to be listed in the body of the email.
    #
    my ($jobSpec)  = jobSpec($p4, %args);

    #
    # Send mail to the affected person.
    #
    if ($args{mailtofields}) {
        my @fields = map { /^\s?(.+)\$?$/ } split /,/, $args{mailtofields};

        foreach my $job (@jobs) {
            my (%views);

            #
            # Create the notification list based upon the fields of user info.
            #
            foreach my $field (@fields) {
                if (exists $job->{$field}) {
                    my ($user) = $p4->FetchUser($job->{$field});
                    $views{"$user->{FullName} <$user->{Email}>"} = 1;
                } else {
                    print STDERR "The field '$field' does not exist within the Job Specification.\n";
                    sendMail( smtp    => $args{smtpserver},
                              to      => $args{admin},
                              debug   => $args{debug},
                              from    => 'Perforce Job Notification <perforce@reshape.com>',
                              subject => "Incorrect 'field' specified in 'mailtofields'.",
                              message => "The field '$field' does not exist in the Job Specification.\n"
                            );
                    return 0;
                }
            }
            print "Added users for Job $job->{Job}:\n\t ", join "\n\t", keys(%views), "\n\n" if $args{debug};

            #
            # Add the users to the send to list for the appropriate type of job.
            #
            my ($specialReview);
            if ($args{reviewkey}) {
                foreach my $key (keys (%reviewerList)) {
                    print "Job Review Key: $job->{$args{reviewkey}}\nJob Type: $key\n" if $args{debug};
                    if ($job->{$args{reviewkey}} eq $key) {
                        print "They Match!\n" if $args{debug};
                        $specialReview = $key;
                        last;
                    }
                }
            }
            if (not $specialReview) {
                $specialReview = 'review_all_type';
            }

            #
            # Make sure each email address is unique.
            #
            foreach my $user (@{$reviewerList{$specialReview}}) {
                print "Real Email List Creation: >>>>> $user\n" if $args{debug};
                $views{$user} = 1;
            }
            my (@views) = keys %views;
            undef @views if $args{debug};

            #
            # Create the job description email body.
            #
            my ($desc) = jobDescription(job => $job, spec => $jobSpec);

            my $out = sendMail( smtp    => $args{smtpserver},
                                to      => \@views,
                                debug   => $args{debug},
                                bcc     => $bccadmin,
                                from    => 'Perforce Job Notification <perforce@reshape.com>',
                                subject => "PERFORCE$args{server} job $job->{Job} for review",
                                message => $desc
                              );
            if ($out != 1) {
                print STDERR "Unable to open a connection to the SMTP server '$args{smtpserver}': $out\n";
                return 0;
            }

            my $out = $p4->Counter('p4job' , $number);
            print "Increment Job Counter Value: $out\n" if defined $args{debug};
            print "New Counter Value: ", $p4->Counter('p4job'), "\n\n" if defined $args{debug};
        }
    }

    return 1;
}

#***************************************************************************
#
#     Function : parseConfig
#       Author : Jeremy Russell
#         Date : November 28, 2001
#
#  Description : Parse the configuration file to get the default values.
#
#
#***************************************************************************
sub parseConfig {
    my ($args) = @_;

    if (-f $args->{file}) {

        my ($out) = open(FH, "$args->{file}");
        return "Unable to open the configuration file '$args->{config}': $!n" unless defined $out;
        my (@config) = <FH>;
        close(fh);

        print "Configuration Values:\n" if defined $args->{debug};
        foreach my $var (@config) {
            next if $var =~ /^#/;
            chomp $var;
            my ($key, $value) = $var =~ m/^([^=]+)=(.+)/;
            $args->{$key} = $value unless exists $args->{$key};
            print "\t$key => $value\n" if defined $args->{debug};
        }
    } else {
        return "The configuration file '$args->{config}' does not exist.\n";
    }
    print "\n" if defined $args->{debug};

    return 1;
}


#***************************************************************************
#
#     Function : perforceDate
#       Author : Jeremy Russell
#         Date : Decemeber 3, 2001
#
#  Description : Return a string with Perforce style date string.
#
#
#***************************************************************************
sub perforceDate {
    my ($lastReport) = @_;

    return (1900 + (localtime($lastReport))[5]) . '/' . sprintf ("%02d", (localtime($lastReport))[4]) . '/' . sprintf ("%02d", (localtime($lastReport))[3]) . ':' . sprintf ("%02d", (localtime($lastReport))[2]) . ':' .  sprintf ("%02d", (localtime($lastReport))[1]) . ':' . sprintf ("%02d",  (localtime($lastReport))[0]);
}


#***************************************************************************
#
#     Function : jobSpec
#       Author : Jeremy Russell
#         Date : Decemeber 3, 2001
#
#  Description : Return a list of the fields in a job spec.
#
#
#***************************************************************************
sub jobSpec {
    my ($p4) = shift;
    my (%args) = @_;

    my ($jobSpec) = $p4->FetchJobspec();
    if ($args{debug}) {
        Dumpvalue->new->dumpValue($jobSpec);
        print "\n\n";
    }

    my ($order) = 0;
    my (%fields);
    foreach my $field (@{$jobSpec->{Fields}}) {
        my (%x);
        %x = ( type =>  (split / /, $field)[2],
               order => $order
              );
        my $x = (split / /, $field)[1];
        $fields{$x} = \%x;
        $order++;
    }
    if ($args{debug}) {
        print "Job Spec Field List:\n";
        my (@x) = map { $_ = "\t$_ => $fields{$_}->{type} => $fields{$_}->{order}\n" } keys(%fields);
        print join "", @x , "\n\n";
    }

    return \%fields;
}

#***************************************************************************
#
#     Function : jobDescription
#       Author : Jeremy Russell
#         Date : Decemeber 3, 2001
#
#  Description : Return a Job Specification form for the job review
#                email body.
#
#
#***************************************************************************
sub jobDescription {
    my (%args) = @_;

    my (@desc);

    sub by_order {
        $args{spec}->{$a}->{order} <=> $args{spec}->{$b}->{order}
    }
    my (@fields) = sort by_order keys %{$args{spec}};

    foreach my $field (@fields) {
        if ($args{spec}->{$field}->{type} eq 'text') {
            push (@desc, $field . ":\n");
            my (@changeDesc) = split /\n/, $args{job}->{$field};

            foreach my $line (@changeDesc) {
                $line =~ s/^\s+//;
                push (@desc, "\t$line\n");
            }
            push (@desc, "\n");
        } else {
            push (@desc, "$field:\t $args{job}->{$field}\n\n");
        }
    }

    return \@desc;
}

__END__

=head1 NAME

Using  p4review.pl

=head1 SYNOPSIS

p4review.pl
[C<--admin> C<E<lt>admin@email.comE<gt>>]
[C<--bccadmin>]
[C<--debug>]
[C<--help>]
[C<--lastmodified> C<E<lt>job_fieldE<gt>>]
[C<--man>]
[C<--notify> <C<c>|C<j>|C<cj>>]
[C<--password> C<E<lt>passwordE<gt>>]
[C<--port> C<E<lt>server:port<gt>>]
[C<--smtpserver> C<E<lt>smtpserverE<gt>>]
[C<--file> C<E<lt>configfileE<gt>>]]

=head1 OPTION

=over 8

=item C<--admin>

Specify the email of the Perforce administrator.  This person
will recieve all the email sent (so I hope you have good filtering in
your emial client).  The very first thing the script does in C<--debug> mode
 is to send a test message to this mailbox to test the
connection to the SMTP server specified by C<--smtpserver>.

=over 2

=item C<--admin> C<cmteam@yourcompany.com>

The email address is C<cmteam@yourcompany.com>.  All amdinistration
email from the review daemon will go here.

=back

=item C<--bccadmin>

Forces all emails that are sent to be sent to the email address
specified  by C<--admin>.

=item C<--debug>

Prints script debug messages.  Use this mode if you are having problems
running the script and need some meaningful output.  Debug mode sends
all sorts of data to STDOUT.

=item C<--file>

Specify a configuration file.  See the comments below for a config file
specifications and grammer.

=item C<--help>

Print a brief help message and exits.

=item C<--lastmodified>

The name of the field in the jobsec which tracks the
date and time the a job specification was modified.  This is
valid option only when C<--notify> is set to C<j> or C<cj>.

=item C<--notify>

This takes on of three arguemtns.

=over 4

=item C<c>

Review change lists (submissions) in the repository files.

=item C<j>

Review changes to the list of jobs.

=item C<cj>

Review changes lists and changes to jobs.

=back

=item C<--man>

Output a man page.

=item C<--password>

I know, I know...clear text represntation of your Perforce password into
the script.  For those administrators out there with tight control of your servers.

=item C<--port>

Server name and port of the Perforce server to be reviewed.

=item C<--smtpserver>

This specifies the SMTP server that the script will use to send the
email notifications.  It must be a valid SMTP server, otherwise, no email
will be sent.

=back

=head1 DESCRIPTION

This is a perl based Perforce review script.  It is roughly the
same as its python counterpart, which for most purposes runs well.  We needed
a little more sophistication in how jobs were handles however.  The important
and really only significant difference between the python script and this one is
the way in which job reviews are sent.

To get all jobs (which can be burdensome to those who want to see only bugs which
affect only them), this script also uses the string '//depot/jobs' in the 'Reviews'
section of the User Specification.

To get joblists which are directly related to the user, this script uses the
'JobView' section of the User Specification  to determine the review status for
a job to a particluar user.

=head1 REQUIREMENTS

Used modules: Mail::Mailer (uses an SMTP email server), P4, Pod::Usage.

This script requires that Tony Smith's (tony@perforce.com) Perl
Perforce API and his module P4.pm be loaded.  If you are able to run the
'p4review.pl -h', then chances are that you have at least a P4.pm in your
PERL5LIB path.  The Perl Perforce API is available from the Perforce website
L<http://www.perforce.com>.

=head1 CONFIGURATION FILES

A configuration file can be speified instead of a huge
command line set of arguments.  Configuration file
parameters are overridden by the command line arguments.
The configuration takes the following syntax:
C<option=value>.

As will be seen in the example, the option is merely the
full name of any given option excluding C<--help>,
C<--mam>, and C<--debug>.

Try not to leave any leading or trailing whitespace or use
a '=' in the C<value>.  Use the full name of the option
that is top be set in the configuration file.  Short names
will not be recognized.

Example Configuration File:

    smtpserver=smtp.mail.yahoo.com
    admin=mymail@yahoo.com
    port=beyond.perforce.com:1666
    user=admin
    notify=cj
    lastmodified=Last_Modified
    toauthor=1
    bccadmin=1


=head1 AUTHOR

Jeremy Russell

russell_jeremy@yahoo.com