#!/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',
             'client',
             '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->SetClient($args{client}) if $args{client};

    $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};

    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};
#CHECK
        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};

    #
    # Start the list of users who recieve all job emails.
    #
    my (@reviewerList);
    my (@reviewers) = $p4->Reviews($args{jobreview});
    foreach my $reviewer (@reviewers) {
        my ($email) = (split / /, $reviewer)[1];
        $email =~ s/^\<|\>$//g;
        my ($name) = (split /\(/, $reviewer)[1];
        $name =~ s/^\(|\)$//g;
        push(@reviewerList, "$name <$email>");
    }
    print "Generic Job Reviewers:\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";
            %views = map { $_ => 1 } @reviewerList;
            my (@views) = keys %views;
#CHECK
            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 =~ /^#/;
            $var =~ s/\\\=/\%p4reviewequal\%/g;
            my ($key, $value) = split /=/, $var;
            $value =~ s/\%p4reviewequal\%/\\\=/g;
            chomp $value;
            $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 [--help | -? | -h] [--man | -m] [--debug | -d]
            [--smtpserver smtpserver | -s smtpserver]
            [--admin admin | -a admin]
            [--file configfile | -f configfile]

=head1 OPTION

=over 8

=item B<--help | -h | -?>

Print a brief help message and exits.

=item B<--man | -m]>

Output a man page.

=item B<--file | -f>

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

Example:
      -f configfile

=item B<--debug | -d>

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.  One of these days I will make it so you
can set the type of debugging as in "email", "serverconnections",
"parameter lists", or something to that effect.  Right now you get all
the data you ever wanted and more.

If you do end up seperating out the type of debug, please send me the
updated script and I will incorporate the changes.

=item B<--smtpserver | -s  Required Parameter>

This specifies the smtp server that the script will use to send the
email notifications.

Example:
      -s smtp.mail.yahoo.com

=item B<--admin | -a Required Parameter>

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 debug mode
(L<--debug | -d>) is to send a test message to this mailbox to test the
connection to the SMTP server specified by L<--smtpserver (-s)>.

Example:
      -a cmteam@yourcompany.com

=item B<--password | -p>

I know, I know...clear text represntation of your Perforce password into
the script.  Well, if you have a better idea, let me know:
I<E<lt>jrussel@reshape.comE<gt>>.

=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 howerver.  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.

=head2 Needed Packages

Used modules: Getopt::Long, Mail::Mailer (uses smtp), P4, Pod::Usage.

This script requires that Tony Smith's I<E<lt>tony@perforce.comE<gt>> 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>.

Tony is a good guy and very helpful. If I can not help you setup the Perl API,
then Tony surely can.

=head2 Config File

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:
I<option=value>.

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

Try not to leave any leading or trailing whitespace or use
a '=' in the I<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
    client=,yclient
    notify=cj
    lastmodified=Last_Modified
    toauthor=1
    bccadmin=1
=cut