#!/usr/bin/perl
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2024 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 strict;
use warnings;
use Carp;

# fix lib paths, some may be relative
BEGIN { # BEGIN RT CMD BOILERPLATE
    require File::Spec;
    require Cwd;
    my @libs = ("lib", "local/lib");
    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 RT;

use Getopt::Long;

use RT::Interface::CLI qw(GetCurrentUser Init loc);

my ( $search, $condition, $actions, $search_arg, $condition_arg, $actions_arg,
     $template, $template_id, $transaction, $transaction_type, $reload_ticket, $verbose,
     $max_processes, $max_tickets_per_process, $dryrun );

my %OPT = (
    "search=s"           => \$search,
    "search-arg=s"       => \$search_arg,
    "condition=s"        => \$condition,
    "condition-arg=s"    => \$condition_arg,
    "action-arg=s@"      => \$actions_arg,
    "action=s@"          => \$actions,
    "template=s"         => \$template,
    "template-id=s"      => \$template_id,
    "transaction=s"      => \$transaction,
    "transaction-type=s" => \$transaction_type,
    "reload-ticket"      => \$reload_ticket,
    "max-processes=i"    => \$max_processes,
    "max-tickets-per-process=i" => \$max_tickets_per_process,
    "verbose|v"          => \$verbose,
    "dry-run"            => \$dryrun,
);

Init( %OPT );

require RT::Tickets;
require RT::Template;

#Get the current user all loaded
my $CurrentUser = GetCurrentUser();

unless ( $CurrentUser->Id ) {
    print loc("No RT user found. Please consult your RT administrator.") . "\n";
    exit(1);
}

unless ( $search && $actions ) {
    Pod::Usage::pod2usage({ verbose => 2});
    exit(0);
}

$transaction = lc( $transaction||'' );
if ( $transaction && $transaction !~ /^(first|all|last)$/i ) {
    print STDERR loc("--transaction argument could be only 'first', 'last' or 'all'");
    exit 1;
}

if ( $template && $template_id ) {
    print STDERR loc("--template-id is deprecated argument and can not be used with --template");
    exit 1;
}
elsif ( $template_id ) {
# don't warn
    $template = $template_id;
}

# We _must_ have a search object
load_module($search);
for my $action (@$actions) {
    load_module($action);
}
load_module($condition) if ($condition);

my $void_scrip = RT::Scrip->new( $CurrentUser );
my $void_scrip_action = RT::ScripAction->new( $CurrentUser );

#At the appointed time:

#find a bunch of tickets
my $tickets = RT::Tickets->new($CurrentUser);
$search  = $search->new(
    TicketsObj  => $tickets,
    Argument    => $search_arg,
    CurrentUser => $CurrentUser
);
$search->Prepare();

if ($max_processes) {
    $max_tickets_per_process ||= 100;
    require Parallel::ForkManager;
    my $pm         = Parallel::ForkManager->new($max_processes);
    my @ticket_ids = map { $_->Id } @{ $tickets->ItemsArrayRef };

    # DB connection couldn't be shared between processes
    $RT::Handle->Disconnect;

    while (@ticket_ids) {
        my @ids = splice @ticket_ids, 0, $max_tickets_per_process;
        my $pid = $pm->start and next;

        # Reconnect to DB and initialize logging in each child
        $RT::Handle->Connect;
        RT->Config->Set( 'LogToFile',      RT->Config->Get('LogToSTDERR') );
        RT->Config->Set( 'LogToFileNamed', 'rt-crontool-' . time . "-$$.log" );
        undef $RT::Logger;
        RT::InitLogging();

        for my $id (@ids) {
            my $ticket = RT::Ticket->new($CurrentUser);
            $ticket->Load($id);
            process_ticket($ticket);
        }
        $pm->finish;
    }
    $pm->wait_all_children;
}
else {

    #for each ticket we've found
    while ( my $ticket = $tickets->Next() ) {
        process_ticket($ticket);
    }
}

sub process_ticket {
    my $ticket = shift;
    $ticket->Load($ticket->Id) if $reload_ticket;
    print $ticket->Id() . ":\n" if ($verbose);

    my $template_obj = get_template( $ticket );

    if ( $transaction ) {
        my $txns = get_transactions($ticket);
        my $found = 0;
        while ( my $txn = $txns->Next ) {
            print "\t".loc("Using transaction #[_1]...", $txn->id)."\n"
                if $verbose;
            process($ticket, $txn, $template_obj);
            $found = 1;
        }
        print "\t".loc("Couldn't find suitable transaction, skipping")."\n"
            if $verbose && !$found;
    } else {
        print "\t".loc("Processing without transaction, some conditions and actions may fail. Consider using --transaction argument")."\n"
            if $verbose;

        process($ticket, undef, $template_obj);
    }
}

sub process {
    my $ticket = shift;
    my $transaction = shift;
    my $template_obj = shift;

    # perform some more advanced check
    if ($condition) {
        my $condition_obj = $condition->new(
            TransactionObj => $transaction,
            TicketObj      => $ticket,
            ScripObj       => $void_scrip,
            TemplateObj    => $template_obj,
            Argument       => $condition_arg,
            CurrentUser    => $CurrentUser,
        );

        # if the condition doesn't apply, get out of here

        return unless $condition_obj->IsApplicable;
        print "\t".loc("Condition matches...")."\n" if $verbose;
    }

    my $i = 0;
    for my $action (@$actions) {

        # Given the current index of the actions array, see
        # if there is still a corresponding element in the
        # actions_arg array. If so, then use that argument,
        # else use undef.
        my $action_argument = ($i <= $#$actions_arg) ? $actions_arg->[$i] : undef;
        $i++;

        # When running multiple actions, reload the template object each time
        # to avoid re-using previous values for To, Cc, Bcc, etc.
        my $action_template_obj = get_template( $ticket );

        # prepare our action
        my $action_obj = $action->new(
            TicketObj      => $ticket,
            TransactionObj => $transaction,
            TemplateObj    => $action_template_obj,
            Argument       => $action_argument,
            ScripObj       => $void_scrip,
            ScripActionObj => $void_scrip_action,
            CurrentUser    => $CurrentUser,
        );

        # if our preparation failed, move onto the next action
        next unless $action_obj->Prepare;
        print "\t".loc("Action prepared...")."\n" if $verbose;

        next if $dryrun;
        # commit our action.
        next unless $action_obj->Commit;
        print "\t".loc("Action committed.")."\n" if $verbose;
    }
}

# =head2 get_transactions
# 
# Takes ticket and returns L<RT::Transactions> object with transactions
# of the ticket according to command line arguments C<--transaction>
# and <--transaction-type>.
# 
# =cut

sub get_transactions {
    my $ticket = shift;
    my $txns = $ticket->Transactions;
    my $order = $transaction eq 'last'? 'DESC': 'ASC';
    $txns->OrderByCols(
        { FIELD => 'Created', ORDER => $order },
        { FIELD => 'id', ORDER => $order },
    );
    if ( $transaction_type ) {
        $transaction_type =~ s/^\s+//;
        $transaction_type =~ s/\s+$//;
        foreach my $type ( split /\s*,\s*/, $transaction_type ) {
            $txns->Limit( FIELD => 'Type', VALUE => $type, ENTRYAGGREGATOR => 'OR' );
        }
    }
    $txns->RowsPerPage(1) unless $transaction eq 'all';
    return $txns;
}

# =head2 get_template
# 
# Takes a ticket and returns a template according to command line options.
# 
# =cut

sub get_template {
    my $ticket = shift;
    return undef unless $template;

    unless ( $template =~ /\D/ ) {
        # by id
        my $template_obj = RT::Template->new( RT->SystemUser );
        $template_obj->Load( $template );
        die "Failed to load template '$template'"
            unless $template_obj->id;
        return $template_obj;
    }

    my $queue = $ticket->Queue;

    my $res = RT::Template->new( RT->SystemUser );
    $res->LoadQueueTemplate( Queue => $queue, Name => $template );
    unless ( $res->id ) {
        $res->LoadGlobalTemplate( $template );
        die "Failed to load template '$template', either for queue #$queue or global"
            unless $res->id;
    }
    return $res;
}


# =head2 load_module
# 
# Loads a perl module, dying nicely if it can't find it.
# 
# =cut

sub load_module {
    my $modname = shift;
    unless (RT::StaticUtil::RequireModule($modname)) {
        my $error = $@;
        die loc( "Failed to load module [_1]. ([_2])", $modname, $error );
    }

}

__END__

=head1 NAME

rt-crontool - a tool to act on tickets from an external scheduling tool

=head1 SYNOPSIS

    # find all active tickets in the queue 'general' and set their priority to 99 if they are overdue:
    rt-crontool \
      --search RT::Search::ActiveTicketsInQueue  --search-arg general \
      --condition RT::Condition::Overdue \
      --action RT::Action::SetPriority --action-arg 99 \
      --verbose

    # Escalate tickets
      rt-crontool \
        --search RT::Search::ActiveTicketsInQueue  --search-arg general \
        --action RT::Action::EscalatePriority

    # Process tickets in parallel
      rt-crontool \
        --search RT::Search::ActiveTicketsInQueue  --search-arg general \
        --action RT::Action::SomeTimeConsumingAction
        --max-processes 10 --max-tickets-per-process 100

    # Combine multiple actions:
    # Find all tickets that are 'new' or 'stalled' and set their priority to 99 if they are overdue
    # also, escalate them and set their status to open:
      rt-crontool \
        --search RT::Search::FromSQL \
        --search-arg "(Status='new' OR Status = 'stalled')" \
        --condition RT::Condition::Overdue \
        --action RT::Action::SetPriority \
        --action-arg 99 \
        --action RT::Action::LinearEscalate \
        --action-arg "RecordTransaction: 1" \
        --action RT::Action::SetStatus \
        --action-arg open

=head1 DESCRIPTION

This script is a tool to act on tickets from an external scheduling tool, such
as cron.

Security:

This tool allows the user to run arbitrary Perl modules from within RT. If
this tool were setgid, a hostile local user could use this tool to gain
administrative access to RT. It is incredibly important that non-privileged
users not be allowed to run this tool. It is suggested that you create a
non-privileged Unix user with the correct group membership and RT access to
run this tool.


=head1 OPTIONS

=over

=item search 

Specify the search module you want to use

=item search-arg 

An argument to pass to --search

=item condition

Specify the condition module you want to use

=item condition-arg

An argument to pass to --condition

=item action 

Specify the action module you want to use.

This option may be repeated to apply multiple actions to found tickets.

=item action-arg

An argument to pass to --action.

This option may be repeated to pass corresponding arguments to
multiple calls of --action. In this case, each --action-arg option
must come after the --action argument it applies to. Actions with
no --action-arg must come at the end.

=item template

Specify name or id of template(s) you want to use

=item transaction

Specify if you want to use either 'first', 'last' or 'all' transactions


=item transaction-type

Specify the comma separated list of transactions' types you want to use

=item reload-ticket

Reload ticket before processing in tickets iteration. This is to refresh
ticket metadata, which is useful especially for long-running jobs.

=item max-processes

Specify the max number of children to maintain. This implies parallel
processing, which is false by default.

=item max-tickets-per-process

Specify the max number of tickets to process in each child. Only take effect with --max-processes.
Default is 100.

=item log

Adjust LogToSTDERR config option

=item verbose

Output status updates to STDOUT

=item dry-run

Actions are composed of 2 parts: "Prepare" and "Commit".  C<dry-run>
skips the "Commit" part.

=back

