path: root/rt/sbin/rt-email-digest.in

#!@PERL@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2019 Best Practical Solutions, LLC
#                                          <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
#
# LICENSE:
#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
#
#
# CONTRIBUTION SUBMISSION POLICY:
#
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
#
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}
use warnings;
use strict;

BEGIN { # BEGIN RT CMD BOILERPLATE
    require File::Spec;
    require Cwd;
    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
    my $bin_path;

    for my $lib (@libs) {
        unless ( File::Spec->file_name_is_absolute($lib) ) {
            $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
        }
        unshift @INC, $lib;
    }

}

use Date::Format qw( strftime );
use Getopt::Long;
use RT;
use RT::Interface::CLI qw( loc );
use RT::Interface::Email;

RT::LoadConfig();
RT::Init();

sub usage {
    my ($error) = @_;
    print loc("Usage:") . " $0 -m (daily|weekly) [--print] [--help]\n";
    print loc(
        "[_1] is a utility, meant to be run from cron, that dispatches all deferred RT notifications as a per-user digest.",
        $0
    ) . "\n";
    print "\n\t-m, --mode\t"
        . loc("Specify whether this is a daily or weekly run.") . "\n";
    print "\t-p, --print\t"
        . loc("Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent")
        . "\n";
    print "\t-v, --verbose\t" . loc("Give output even on messages successfully sent") . "\n";
    print "\t-h, --help\t" . loc("Print this message") . "\n";

    if ( $error eq 'help' ) {
        exit 0;
    } else {
        print loc("Error") . ": " . loc($error) . "\n";
        exit 1;
    }
}

my ( $frequency, $print, $verbose, $help ) = ( '', '', '', '' );
GetOptions(
    'mode=s' => \$frequency,
    'print'  => \$print,
    'verbose' => \$verbose,
    'help'   => \$help,
);

usage('help') if $help;
usage("Mode argument must be 'daily' or 'weekly'")
    unless $frequency =~ /^(daily|weekly)$/;

run( $frequency, $print );

sub run {
    my $frequency = shift;
    my $print     = shift;

## Find all the tickets that have been modified within the time frame
##    described by $frequency.

    my ( $all_digest, $sent_transactions ) = find_transactions($frequency);

## Iterate through our huge hash constructing the digest message
##    for each user and sending it.

    foreach my $user ( keys %$all_digest ) {
        my ( $contents_list, $contents_body ) = build_digest_for_user( $user, $all_digest->{$user} );
        # Now we have a content head and a content body.  We can send a message.
        if ( send_digest( $user, $contents_list, $contents_body ) ) {
            print "Sent message to $user\n" if $verbose;
            mark_transactions_sent( $frequency, $user, values %{$sent_transactions->{$user}} ) unless ($print);
        } else {
            print "Failed to send message to $user\n";
        }
    }
}
exit 0;

# Subroutines.

sub send_digest {
    my ( $to, $index, $messages ) = @_;

    # Combine the index and the messages.

    my $body = "============== Tickets with activity in the last "
        . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";

    $body .= $index;
    $body .= "\n\n============== Messages recorded in the last "
        . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
    $body .= $messages;

    # Load our template.  If we cannot load the template, abort
    # immediately rather than failing through many loops.
    my $digest_template = RT::Template->new( RT->SystemUser );
    my ( $ret, $msg ) = $digest_template->Load('Email Digest');
    unless ($ret) {
        print loc("Failed to load template")
            . " 'Email Digest': "
            . $msg
            . ".  Cannot continue.\n";
        exit 1;
    }
    ( $ret, $msg ) = $digest_template->Parse( Argument => $body );
    unless ($ret) {
        print loc("Failed to parse template")
            . " 'Email Digest'.  Cannot continue.\n";
        exit 1;
    }

    # Set our sender and recipient.
    $digest_template->MIMEObj->head->replace(
        'From', Encode::encode( "UTF-8", RT::Config->Get('CorrespondAddress') ) );
    $digest_template->MIMEObj->head->replace(
        'To',   Encode::encode( "UTF-8", $to ) );

    if ($print) {
        $digest_template->MIMEObj->print;
        return 1;
    } else {
        return  RT::Interface::Email::SendEmail( Entity      => $digest_template->MIMEObj)
    }
}

# =item mark_transactions_sent( $frequency, $user, @txn_list );
# 
# Takes a frequency string (either 'daily' or 'weekly'), a user  and one or more
# transaction objects as its arguments.  Marks the given deferred
# notifications as sent.
# 
# =cut

sub mark_transactions_sent {
    my ( $freq, $user, @txns ) = @_;
    return unless $freq =~ /(daily|weekly)/;
    return unless @txns;
    foreach my $txn (@txns) {

        # Grab the attribute, mark the "sent" as true, and store the new
        # value.
        if ( my $attr = $txn->FirstAttribute('DeferredRecipients') ) {
            my $deferred = $attr->Content;
            $deferred->{$freq}->{$user}->{'_sent'} = 1;
            $txn->SetAttribute(
                Name        => 'DeferredRecipients',
                Description => 'Deferred recipients for this message',
                Content     => $deferred,
            );
        }
    }
}

sub since_date {
    my $frequency = shift;

    # Specify a short time for digest overlap, in case we aren't starting
    # this process exactly on time.
    my $OVERLAP_HEDGE = -30;

    my $since_date = RT::Date->new( RT->SystemUser );
    $since_date->Set( Format => 'unix', Value => time() );
    if ( $frequency eq 'daily' ) {
        $since_date->AddDays(-1);
    } else {
        $since_date->AddDays(-7);
    }

    $since_date->AddSeconds($OVERLAP_HEDGE);

    return $since_date;
}

sub find_transactions {
    my $frequency  = shift;
    my $since_date = since_date($frequency);

    my $txns = RT::Transactions->new( RT->SystemUser );

    # First limit to recent transactions.
    $txns->Limit(
        FIELD    => 'Created',
        OPERATOR => '>',
        VALUE    => $since_date->ISO
    );

    # Next limit to ticket transactions.
    $txns->Limit(
        FIELD           => 'ObjectType',
        OPERATOR        => '=',
        VALUE           => 'RT::Ticket',
        ENTRYAGGREGATOR => 'AND'
    );
    my $all_digest        = {};
    my $sent_transactions = {};

    while ( my $txn = $txns->Next ) {
        my $ticket = $txn->Ticket;
        my $queue  = $txn->TicketObj->QueueObj->Name;
        # Xxx todo - may clobber if two queues have the same name
        foreach my $user ( $txn->DeferredRecipients($frequency) ) {
            $all_digest->{$user}->{$queue}->{$ticket}->{ $txn->id } = $txn;
            $sent_transactions->{$user}->{ $txn->id } = $txn;
        }
    }

    return ( $all_digest, $sent_transactions );
}

sub build_digest_for_user {
    my $user        = shift;
    my $user_digest = shift;

    my $contents_list = '';    # Holds the digest index.
    my $contents_body = '';    # Holds the digest body.

    # Has the user been disabled since a message was deferred on his/her
    # behalf?
    my $user_obj = RT::User->new( RT->SystemUser );
    $user_obj->LoadByEmail($user);
    if ( $user_obj->PrincipalObj->Disabled ) {
        print STDERR loc("Skipping disabled user") . " $user\n";
        next;
    }

    print loc("Message for user") . " $user:\n\n" if $print;
    foreach my $queue ( keys %$user_digest ) {
        $contents_list .= "Queue $queue:\n";
        $contents_body .= "Queue $queue:\n";
        foreach my $ticket ( sort keys %{ $user_digest->{$queue} } ) {
            my $tkt_txns   = $user_digest->{$queue}->{$ticket};
            my $ticket_obj = RT::Ticket->new( RT->SystemUser );
            $ticket_obj->Load($ticket);

            # Spit out the index entry for this ticket.
            my $ticket_title = sprintf(
                "#%d %s [%s]\t%s\n",
                $ticket, $ticket_obj->Status, $ticket_obj->OwnerObj->Name,
                $ticket_obj->Subject
            );
            $contents_list .= $ticket_title;

            # Spit out the messages for the transactions on this ticket.
            $contents_body .= "\n== $ticket_title\n";
            foreach my $txn ( sort keys %$tkt_txns ) {
                my $top = $tkt_txns->{$txn}->Attachments->First;

                # $top contains the top-most RT::Attachment with our
                # outgoing message.  It may not be the MIME part with
                # the content.  Print a few headers from it for
                # clarity's sake.
                $contents_body .= "From: " . $top->GetHeader('From') . "\n";
                my $date = $top->GetHeader('Date ');
                unless ($date) {
                    my $txn_obj = RT::Transaction->new( RT->SystemUser );
                    $txn_obj->Load($txn);
                    my $date_obj = RT::Date->new( RT->SystemUser );
                    $date_obj->Set(
                        Format => 'sql',
                        Value  => $txn_obj->Created
                    );
                    $date = strftime( '%a, %d %b %Y %H:%M:%S %z',
                        @{ [ localtime( $date_obj->Unix ) ] } );
                }
                $contents_body .= "Date: $date\n\n";
                $contents_body .= $tkt_txns->{$txn}->ContentObj->Content . "\n";
                $contents_body .= "-------\n";
            }    # foreach transaction
        }    # foreach ticket
    }    # foreach queue

    return ( $contents_list, $contents_body );

}

__END__

=head1 NAME

rt-email-digest - dispatch deferred notifications as a per-user digest

=head1 SYNOPSIS

    rt-email-digest -m (daily|weekly) [--print] [--help]

=head1 DESCRIPTION

This script is a tool to dispatch all deferred RT notifications as a per-user
object.

=head1 OPTIONS

=over

=item mode

Specify whether this is a daily or weekly run.

--mode is equal to -m

=item print

Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent

--print is equal to -p

=item help

Print this message

--help is equal to -h

=back