Upgrade to 4.2.8

[usit-rt.git] / local / bin / rt-remind

#!/usr/bin/perl

# RT reminder script
#
# This script will remind people about tickets they have not responded to
# or dealt with in a reasonable length of time. In its normal mode it will
# tell ticket owners about tickets which have exceeded a given priority
# (see the %pri hash below). It also has the ability to tell ticket owners
# about all their open or new tickets (-a), without or with stalled
# tickets (-A).
#
# This is best used with another script to escalate priorities automatically.
#
# The intended use is to run with no flags daily, with the -a flag weekly
# and with the -A flag monthly. Or similar.
#
# Written by T.D.Bishop@kent.ac.uk, July 2003.
# Updated for multiple queues, March 2004.
#   (using patches sent by jtucker@cyberfuse.com, October 2003)
# Updated for RT 3.2.x, November 2004.
#   (using patches sent by petter.reinholdtsen@usit.uio.no, August 2004)
# Updated to only display tickets with a passed or near start date, March 2005.
#   (using patches sent by ray@sysdev.oucs.ox.ac.uk)
#
# Copied from <URL:http://www.cs.kent.ac.uk/people/staff/tdb/rtdev/> and
# modified to fit local needs.
#  - Petter Reinholdtsen 2004-08-31, 2005-05-19


### Configuration

# Global mappings of users to addresses
# This overrides addresses in the RT database
# The most useful case is setting an address for Nobody
#
# Queue specific overrides can be done by using "queue,user"

my(%map) = (
   'Nobody'              => 'RT Nobody <rt-drift@usit.uio.no>',
    'root'               => 'RT root <rt-drift@usit.uio.no>',
);

my(@queues); # do not delete this

# Queues to operate on
#@queues = qw( queue1 queue2 );

# Whether to merge the tickets for all queues into one email per person
# (as opposed to sending an email per person per queue)
my($mergequeues) = 1;

# Each state can have a priority associated with it.
# When a ticket in that state passes the given priority it is added to
# the list to be sent out.
my(%pri) = (
    'new'  => 40,
    'open' => 50,
);

# The length at which lines will be truncated. 80, or thereabouts looks
# best for most people. Setting to 0 will stop lines being truncated.
my($linelen) = 78;

# How many days in the future a ticket's start date should be before
# we ignore it (unless using -A).
my($futuredays) = 7*24*60*60;

# Location of RT's libs and scripts
# Remember to change to correct path on current RT instance
use lib '/www/data/rt/perl/share/perl5';
use lib '/www/data/rt/perl/lib/perl5';
use lib '/www/data/rt/perl/lib64/perl5';
use lib ("/www/var/rt/local/lib", "/www/var/rt/lib");


# Address emails should originate from
my($from) = 'RT reminder <request-tracker@hjelp.uio.no>';

### Code

use strict;
use Carp;
use HTML::Entities;

my($showall) = 0;
my($showmost) = 0;

my $debug = 0; # Enable debugging

# Process command line arguments
foreach(@ARGV) {
    if (/^-a$/) {
        $showmost = 1;
    }
    elsif (/^-A$/) {
        $showall = 1;
    }
    elsif (/^-d$/) {
        $debug = 1;
    }
    else {
        print STDERR "Usage: rt-remind [-a] [-A] [-h]\n";
        print STDERR "   -a  show all open or new tickets\n";
        print STDERR "   -A  show all open, new, stalled or future tickets\n";
        print STDERR "   -d  do not send any emails.  debug mode only\n";
        print STDERR "   -h  show this help\n";
        exit 1;
    }
}

# Pull in the RT stuff
package RT;
use RT::Interface::CLI qw(CleanEnv);

# Clean our the environment
CleanEnv();

# Load the RT configuration
RT::LoadConfig();

# Initialise RT
RT::Init();

# Drop any setgid permissions we might have
#RT::DropSetGIDPermissions();

use RT::Date;
use RT::Queue;
use RT::Queues;
use RT::Tickets;

# Path to sendmail and flags.  Need to set this after RT::Init()
my($sendmail) = "$RT::SendmailPath $RT::SendmailArguments -t";

my(%TicketStore) = ();

if(!@queues) {
    my $queues = new RT::Queues($RT::SystemUser);
    $queues->LimitToEnabled();
    foreach my $queue (@{$queues->ItemsArrayRef()}) {
        push @queues, $queue->Name;
    }
}

foreach my $queuename (@queues) {
    # Load in the queue
    my $queue = new RT::Queue($RT::SystemUser);
    $queue->Load($queuename);

    my $now = new RT::Date($RT::SystemUser);
    $now->SetToNow();

    # Get hold of the tickets we're after, sorted by priority
    my $tickets = new RT::Tickets($RT::SystemUser);
    $tickets->LimitStatus(VALUE => 'new');
    $tickets->LimitStatus(VALUE => 'open');
    $tickets->LimitStatus(VALUE => 'stalled') if $showall;
    $tickets->LimitQueue(VALUE => $queue->Id);
    $tickets->OrderBy(FIELD => 'Priority', ORDER => 'DESC');
    my $user = RT::User->new($RT::SystemUser);

    %TicketStore = () unless $mergequeues;

    # Sort tickets in to lists for each owner
    while (my $Ticket = $tickets->Next) {
        $user->Load($Ticket->Owner);
        my(@emails) = getContacts($Ticket, $user, $queuename);

        # If ticket is over due and owned by someone other than
        # Nobody, remind the queue owners as well.
        if ("Nobody" ne $user->Name and
            $Ticket->DueObj->Unix > 0 and
            $Ticket->DueObj->Unix < time()) {

            $user->Load("Nobody");
            push(@emails, getContacts($Ticket, $user, $queuename))
        }
        my %gotit = ();
        for my $address (@emails) {

            push @{$TicketStore{$address}}, $Ticket
                unless (exists $gotit{$address});
            $gotit{$address} = 1;
        }
    }

    &doMessages($queuename, %TicketStore) unless $mergequeues;
}

&doMessages("All", %TicketStore) if $mergequeues;

# Disconnect before we finish off
$RT::Handle->Disconnect();
exit 0;

sub getGroupMemberAddresses {
    my ($Ticket, $owner, $groupname) = @_;

    print "Looking up members of group '$groupname' for ".$Ticket->id."\n"
        if ($debug);

    use RT::Group;
    my @emails = ();
    my $Group = new RT::Group($RT::SystemUser);
    if ($Group->LoadUserDefinedGroup($groupname) &&
        $Group->MembersObj->Count != 0 ) {

        # Expand recursively all users in the group
        my $UserMembers = $Group->UserMembersObj;

        while (my $member = $UserMembers->Next()) {
            my $address =  $member->EmailAddress;
            if ($address) {
                my $realname = $member->RealName;
                my $a = "\"$realname\" <$address>";
                print "  Found '$a'\n" if ($debug);
                push(@emails, $a);
            }
        }
        return join(",", @emails) if @emails;
    }
    return undef;
}

#
# Look up who to send reminder to for a given ticket.  The mail
# address is constructed based on ticket owner and queue name.
#
sub getContacts {
    my ($Ticket, $owner, $queuename) = @_;

    my($email) = $map{$queuename.",".$owner->Name};
    print "Using contacts from \$map{$queuename,".$owner->Name."} for ".
        $Ticket->Id."\n" if ($debug && $email);
    if ((not defined $email) && ("Nobody" eq $owner->Name)) {
        # check the <queuename>-owners group if the ticket have no owner
        $email =
            getGroupMemberAddresses($Ticket, $owner, "$queuename-owners");
        print "Using contacts from group '$queuename-owners' for ".
            $Ticket->Id."\n" if ($debug && $email);
    }
    $email = $map{$owner->Name} if not defined $email;
    if (not defined $email) {
        my $address = $owner->EmailAddress;
        if ($address) {
            my $realname = $owner->RealName;
            $email = "\"$realname\" <$address>";
        }
    }
    $email = $map{'root'} if not defined $email;

    return split(/\s*,\s*/, $email);
}

# Subroutine to generate messages
sub doMessages() {
    my($queuename, %TicketStore) = @_;
    foreach my $email (sort keys %TicketStore) {
        my($t) =  $TicketStore{$email};
        &doOwner($email, $queuename, @$t);
    }
}

# Subroutine to generate a messages for a given owner and set of tickets.
sub doOwner() {
    my($email, $queuename, @tickets) = @_;
    my $user = RT::User->new($RT::SystemUser);
    my $queue = RT::Queue->new($RT::SystemUser);
    my $subject;
    if ("All" eq $queuename) {
        $subject = "Pending tickets in RT";
    } else {
        $subject = "Pending tickets for queue '$queuename' in RT";
    }
    my($body,$body_html);
	$body_html .= "<p>";

    if($showall) {
        $body .= "This is a summary of all open, new or stalled tickets assigned to:\n";
	$body_html .= "This is a summary of all open, new or stalled tickets assigned to:<br>\n";
    }
    elsif($showmost) {
        $body .= "This is a summary of all open or new tickets assigned to:\n";
	$body_html .= "This is a summary of all open or new tickets assigned to:<br>\n";
    }
    else {
        $body .= "These tickets are now considered important and are assigned to:\n";
	$body_html .= "These tickets are now considered important and are assigned to:<br>\n";
    }
    $body .= "\n  $email\n\n";
    my $email_html = $email;
    $email_html =~ s/(\<|\>)//g;
    $body_html .= "<br>&nbsp;&nbsp;".stripHTML($email)."<br><br>\n";
    # Generate heading
    $body .= sprintf "%6s %4s %3s %-8s %-8s %-10.10s %-30s\n", "Id", "Stat", "Pri", "Created", "Owner", "Queue", "Subject";
    $body_html .= "<\p>";
    $body_html .= "<table>\n";
    $body_html .= "<tr style=\"background-color:lightgray\">\n";
    $body_html .= "<td style=\"text-align:right\">Id</td><td>Stat</td><td>Pri</td><td>Created</td><td>Owner</td><td>Queue</td><td>Subject</td>\n";
    $body_html .= "</tr>\n";

    # We might not want to print the message if there are no tickets
    my($printmsg) = 0;
    # Look through tickets, sorted by priority, highest first
    foreach my $Ticket (sort {$b->Priority <=> $a->Priority } @tickets) {
        my($starts) = new RT::Date($RT::SystemUser);
        $starts->Set(Format => 'sql', Value => $Ticket->Starts);
        # Only add ticket if it's over the priority, or we're in -a or -A
        # AND the ticket start date has passed or is in the next
        # $futuredays days, or we're in -A
        if(($Ticket->Priority > $pri{$Ticket->Status} || $showmost || $showall)
          && ($starts->Diff(time) <= $futuredays || $showall)) {
            $printmsg = 1;
            # Use our own date formatting routine
            my($date) = &formatDate($Ticket->CreatedObj->Unix);
            $user->Load($Ticket->Owner);
	    $queue->Load($Ticket->Queue);
            my($line) = sprintf "%6d %-4s %-3d %8s %-8s %-10.10s %-30s", $Ticket->Id, $Ticket->Status, $Ticket->Priority, $date, $user->Name, $queue->Name, $Ticket->Subject;
            my($line_html) = sprintf "<td><a href=$RT::WebURL%d>%d</a></td><td>%s</td><td>%d</td><td>%s</td><td>%s</td><td>%s</td><td>%s</td><td>", $Ticket->Id, $Ticket->Id, $Ticket->Status, $Ticket->Priority, $date, $user->Name, $queue->Name, $Ticket->Subject;
            # Truncate lines if required
            if($linelen) {
                $line = substr($line, 0, $linelen);
            }
            $body .= "$line\n";
	    $body_html .= "<tr>\n";
	    $body_html .= "$line_html\n";
	    $body_html .= "</tr>\n";
        }
    }
    $body_html .= "</table>";

    my $boundry = "===".time()."===";
    my ($msg);
    $msg .= "From: $from\n";
    $msg .= "To: $email\n";
    $msg .= "Subject: $subject\n";
    $msg .= "MIME-Version: 1.0\n";
    $msg .= "Content-Type: multipart/alternative; boundary=\"$boundry\"\n";
    $msg .= "\n";
    $msg .= "Dersom du kan lese dette taklar ikkje epostlesaren din rfc2046.\n\n";
    $msg .= "--$boundry\n";
    $msg .= "Content-Type: text/plain; charset=\"iso-8859-1\"\n\n";
    $msg .= "$body\n";
    $msg .= "$RT::WebURL\n";
    $msg .= "--$boundry\n";
    $msg .= "Content-Type: text/html; charset=\"iso-8859-1\"\n\n";
    $msg .= "<html>\n";
    $msg .= "$body_html\n";
    $msg .= "<p><a href=\"$RT::WebURL\">$RT::WebURL</a></p>\n";
    $msg .= "</html>\n";
    $msg .= "--$boundry--\n";
    # Send the message
    if($printmsg) {
        if ($debug) {
            print "====== Would call '$sendmail' with this input:\n$msg\n\n";
        } else {
            open(SENDMAIL, "|$sendmail") || die "Error sending mail: $!";
            print SENDMAIL $msg;
            close(SENDMAIL);
        }
    }
}

# Formats a date like: Thu 10-07-03
# Designed to be consice yet useful
sub formatDate() {
    my($unixtime) = @_;
    # Return an empty string if we haven't been given a time
    return "" if $unixtime <= 0;
    my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($unixtime);
    return sprintf "%02d-%02d-%02d", $mday, $mon+1, $year%100;
}

sub stripHTML() {
my $s = shift;
$s =~ s/\>/&gt;/g;
$s =~ s/\</&lt;/g;
return $s;
}