The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use 5.8.0;
use strict;
use warnings;

package RT::Extension::SLA;

our $VERSION = '0.07';

=head1 NAME

RT::Extension::SLA - Service Level Agreements for RT

=head1 DESCRIPTION

RT extension to implement automated due dates using service levels.

=head1 INSTALL

=over 4

=item perl Makefile.PL

=item make

=item make install

=item make initdb (for the first time only)

=item Base configuration

In RT 3.8 and later, you must enable the plugin by adding RT::Extension::SLA
to your @Plugins line (or create one) like:

    Set(@Plugins,(qw(RT::Extension::SLA)));

=back

=head1 UPGRADING

=head2 From versions prior to 0.06

You need to run an upgrade step on your RT database so this extension continues
to work.  Run the following from inside the source of this extension:

    /opt/rt4/sbin/rt-setup-database --action insert --datafile etc/upgrade/0.06/content

It will prompt you for your DBA password and should complete without error.

=head1 CONFIGURATION

Service level agreements of tickets is controlled by an SLA custom field (CF).
This field is created during C<make initdb> step (above) and applied globally.
This CF MUST be of C<select one value> type. Values of the CF define the
service levels.

It's possible to define different set of levels for different
queues. You can create several CFs with the same name and
different set of values. But if you move tickets between
queues a lot then it's going to be a problem and it's preferred
to use B<ONE> SLA custom field.

There is no WebUI in the current version. Almost everything is
controlled in the RT's config using option C<%RT::ServiceAgreements>
and C<%RT::ServiceBusinessHours>. For example:

    %RT::ServiceAgreements = (
        Default => '4h',
        QueueDefault => {
            'Incident' => '2h',
        },
        Levels => {
            '2h' => { Resolve => { RealMinutes => 60*2 } },
            '4h' => { Resolve => { RealMinutes => 60*4 } },
        },
    );

In this example I<Incident> is the name of the queue, and I<2h> is the name of
the SLA which will be applied to this queue by default.

Each service level can be described using several options:
L<Starts|/"Starts (interval, first business minute)">,
L<Resolve|/"Resolve and Response (interval, no defaults)">,
L<Response|/"Resolve and Response (interval, no defaults)">,
L<KeepInLoop|/"Keep in loop (interval, no defaults)">,
L<OutOfHours|/"OutOfHours (struct, no default)">
and L<ServiceBusinessHours|/"Configuring business hours">.

=head2 Starts (interval, first business minute)

By default when a ticket is created Starts date is set to
first business minute after time of creation. In other
words if a ticket is created during business hours then
Starts will be equal to Created time, otherwise Starts will
be beginning of the next business day.

However, if you provide 24/7 support then you most
probably would be interested in Starts to be always equal
to Created time.

Starts option can be used to adjust behaviour. Format
of the option is the same as format for deadlines which
described later in details. RealMinutes, BusinessMinutes
options and OutOfHours modifiers can be used here like
for any other deadline. For example:

    'standard' => {
        # give people 15 minutes
        Starts   => { BusinessMinutes => 15  },
    },

You can still use old option StartImmediately to set
Starts date equal to Created date.

Example:

    '24/7' => {
        StartImmediately => 1,
        Response => { RealMinutes => 30 },
    },

But it's the same as:

    '24/7' => {
        Starts => { RealMinutes => 0 },
        Response => { RealMinutes => 30 },
    },

=head2 Resolve and Response (interval, no defaults)

These two options define deadlines for resolve of a ticket
and reply to customer(requestors) questions accordingly.

You can define them using real time, business or both. Read more
about the latter L<below|/"Using both Resolve and Response in the same level">.

The Due date field is used to store calculated deadlines.

=head3 Resolve

Defines deadline when a ticket should be resolved. This option is
quite simple and straightforward when used without L</Response>.

Example:

    # 8 business hours
    'simple' => { Resolve => 60*8 },
    ...
    # one real week
    'hard' => { Resolve => { RealMinutes => 60*24*7 } },

=head3 Response

In many companies providing support service(s) resolve time
of a ticket is less important than time of response to requestors
from stuff members.

You can use Response option to define such deadlines. When you're
using this option Due time "flips" when requestors and non-requestors
reply to a ticket. We set Due date when a ticket is created, unset
when non-requestor replies... until ticket is closed when ticket's
Due date is also unset.

B<NOTE> that behaviour changes when Resolve and Response options
are combined, read L<below|/"Using both Resolve and Response in the same level">.

As response deadlines are calculated using requestors' activity
so several rules applies to make things sane:

=over 4

=item

If requestor(s) reply multiple times and are ignored then the deadline
is calculated using the oldest requestors' correspondence.

=item

If a ticket has no requestor(s) then it has no response deadline.

=item

If a ticket is created by non-requestor then due date is left unset.

=item

If owner of a ticket is its requestor then his actions are treated
as non-requestors'.

=back

=head3 Using both Resolve and Response in the same level

Resolve and Response can be combined. In such case due date is set
according to the earliest of two deadlines and never is dropped to
'not set'.

If a ticket met its Resolve deadline then due date stops "flipping",
is freezed and the ticket becomes overdue. Before that moment when
non-requestor replies to a ticket, due date is changed to Resolve
deadline instead of 'Not Set', as well this happens when a ticket
is closed. So all the time due date is defined.

Example:

    'standard delivery' => {
        Response => { RealMinutes => 60*1  }, # one hour
        Resolve  => { RealMinutes => 60*24 }, # 24 real hours
    },

A client orders goods and due date of the order is set to the next one
hour, you have this hour to process the order and write a reply.
As soon as goods are delivered you resolve tickets and usually meet
Resolve deadline, but if you don't resolve or user replies then most
probably there are problems with delivery of the goods. And if after
a week you keep replying to the client and always meeting one hour
response deadline that doesn't mean the ticket is not over due.
Due date was frozen 24 hours after creation of the order.

=head3 Using business and real time in one option

It's quite rare situation when people need it, but we've decided
that business is applied first and then real time when deadline
described using both types of time. For example:

    'delivery' => {
        Resolve => { BusinessMinutes => 0, RealMinutes => 60*8 },
    },
    'fast delivery' {
        StartImmediately => 1,
        Resolve => { RealMinutes => 60*8 },
    },

For delivery requests which come into the system during business
hours these levels define the same deadlines, otherwise the first
level set deadline to 8 real hours starting from the next business
day, when tickets with the second level should be resolved in the
next 8 hours after creation.

=head2 Keep in loop (interval, no defaults)

If response deadline is used then Due date is changed to repsonse
deadline or to "Not Set" when staff replies to a ticket. In some
cases you want to keep requestors in loop and keed them up to date
every few hours. KeepInLoop option can be used to achieve this.

    'incident' => {
        Response   => { RealMinutes => 60*1  }, # one hour
        KeepInLoop => { RealMinutes => 60*2 }, # two hours
        Resolve    => { RealMinutes => 60*24 }, # 24 real hours
    },

In the above example Due is set to one hour after creation, reply
of a non-requestor moves Due date two hours forward, requestors'
replies move Due date to one hour and resolve deadine is 24 hours.

=head2 Modifying Agreements

=head3 OutOfHours (struct, no default)

Out of hours modifier. Adds more real or business minutes to resolve
and/or reply options if event happens out of business hours, read also
</"Configuring business hours"> below.

Example:
    
    'level x' => {
        OutOfHours => { Resolve => { RealMinutes => +60*24 } },
        Resolve    => { RealMinutes => 60*24 },
    },

If a request comes into the system during night then supporters have two
hours, otherwise only one.

    'level x' => {
        OutOfHours => { Response => { BusinessMinutes => +60*2 } },
        Resolve    => { BusinessMinutes => 60 },
    },

Supporters have two additional hours in the morning to deal with bunch
of requests that came into the system during the last night.

=head3 IgnoreOnStatuses (array, no default)

Allows you to ignore a deadline when ticket has certain status. Example:

    'level x' => {
        KeepInLoop => { BusinessMinutes => 60, IgnoreOnStatuses => ['stalled'] },
    },

In above example KeepInLoop deadline is ignored if ticket is stalled.

B<NOTE>: When a ticket goes from an ignored status to a normal status, the new
Due date is calculated from the last action (reply, SLA change, etc) which fits
the SLA type (Response, Starts, KeepInLoop, etc).  This means if a ticket in
the above example flips from stalled to open without a reply, the ticket will
probably be overdue.  In most cases this shouldn't be a problem since moving
out of stalled-like statuses is often the result of RT's auto-open on reply
scrip, therefore ensuring there's a new reply to calculate Due from.  The
overall effect is that ignored statuses don't let the Due date drift
arbitrarily, which could wreak havoc on your SLA performance.

=head2 Configuring business hours

In the config you can set one or more work schedules. Use the following
format:

    %RT::ServiceBusinessHours = (
        'Default' => {
            ... description ...
        },
        'Support' => {
            ... description ...
        },
        'Sales' => {
            ... description ...
        },
    );

Read more about how to describe a schedule in L<Business::Hours>.

=head3 Defining different business hours for service levels

Each level supports BusinessHours option to specify your own business
hours.

    'level x' => {
        BusinessHours => 'work just in Monday',
        Resolve    => { BusinessMinutes => 60 },
    },

then %RT::ServiceBusinessHours should have the corresponding definition:

    %RT::ServiceBusinessHours = (
        'work just in Monday' => {
            1 => { Name => 'Monday', Start => '9:00', End => '18:00' },
        },
    );

Default Business Hours setting is in $RT::ServiceBusinessHours{'Default'}.

=head2 Defining service levels per queue

In the config you can set per queue defaults, using:

    %RT::ServiceAgreements = (
        Default => 'global default level of service',
        QueueDefault => {
            'queue name' => 'default value for this queue',
            ...
        },
        ...
    };

=head2 Access control

You can totally hide SLA custom field from users and use per queue
defaults, just revoke SeeCustomField and ModifyCustomField.

If you want people to see the current service level ticket is assigned
to then grant SeeCustomField right.

You may want to allow customers or managers to escalate thier tickets.
Just grant them ModifyCustomField right.

=cut

sub BusinessHours {
    my $self = shift;
    my $name = shift || 'Default';

    require Business::Hours;
    my $res = new Business::Hours;
    $res->business_hours( %{ $RT::ServiceBusinessHours{ $name } } )
        if $RT::ServiceBusinessHours{ $name };
    return $res;
}

sub Agreement {
    my $self = shift;
    my %args = (
        Level => undef,
        Type => 'Response',
        Time => undef,
        Ticket => undef,
        Queue  => undef,
        @_
    );

    my $meta = $RT::ServiceAgreements{'Levels'}{ $args{'Level'} };
    return undef unless $meta;

    if ( exists $meta->{'StartImmediately'} || !defined $meta->{'Starts'} ) {
        $meta->{'Starts'} = {
            delete $meta->{'StartImmediately'}
                ? ( )
                : ( BusinessMinutes => 0 )
            ,
        };
    }

    return undef unless $meta->{ $args{'Type'} };

    my %res;
    if ( ref $meta->{ $args{'Type'} } ) {
        %res = %{ $meta->{ $args{'Type'} } };
    } elsif ( $meta->{ $args{'Type'} } =~ /^\d+$/ ) {
        %res = ( BusinessMinutes => $meta->{ $args{'Type'} } );
    } else {
        $RT::Logger->error("Levels of SLA should be either number or hash ref");
        return undef;
    }

    if ( $args{'Ticket'} && $res{'IgnoreOnStatuses'} ) {
        my $status = $args{'Ticket'}->Status;
        return undef if grep $_ eq $status, @{$res{'IgnoreOnStatuses'}};
    }

    $res{'OutOfHours'} = $meta->{'OutOfHours'}{ $args{'Type'} };

    $args{'Queue'} ||= $args{'Ticket'}->QueueObj if $args{'Ticket'};
    if ( $args{'Queue'} && ref $RT::ServiceAgreements{'QueueDefault'}{ $args{'Queue'}->Name } ) {
        $res{'Timezone'} = $RT::ServiceAgreements{'QueueDefault'}{ $args{'Queue'}->Name }{'Timezone'};
    }
    $res{'Timezone'} ||= $meta->{'Timezone'} || $RT::Timezone;

    $res{'BusinessHours'} = $meta->{'BusinessHours'};

    return \%res;
}

sub Due {
    my $self = shift;
    return $self->CalculateTime( @_ );
}

sub Starts {
    my $self = shift;
    return $self->CalculateTime( @_, Type => 'Starts' );
}

sub CalculateTime {
    my $self = shift;
    my %args = (@_);
    my $agreement = $args{'Agreement'} || $self->Agreement( @_ );
    return undef unless $agreement and ref $agreement eq 'HASH';

    my $res = $args{'Time'};

    my $ok = eval {
        local $ENV{'TZ'} = $ENV{'TZ'};
        if ( $agreement->{'Timezone'} && $agreement->{'Timezone'} ne ($ENV{'TZ'}||'') ) {
            $ENV{'TZ'} = $agreement->{'Timezone'};
            require POSIX; POSIX::tzset();
        }

        my $bhours = $self->BusinessHours( $agreement->{'BusinessHours'} );

        if ( $agreement->{'OutOfHours'} && $bhours->first_after( $res ) != $res ) {
            foreach ( qw(RealMinutes BusinessMinutes) ) {
                next unless my $mod = $agreement->{'OutOfHours'}{ $_ };
                ($agreement->{ $_ } ||= 0) += $mod;
            }
        }

        if ( defined $agreement->{'BusinessMinutes'} ) {
            if ( $agreement->{'BusinessMinutes'} ) {
                $res = $bhours->add_seconds(
                    $res, 60 * $agreement->{'BusinessMinutes'},
                );
            }
            else {
                $res = $bhours->first_after( $res );
            }
        }
        $res += 60 * $agreement->{'RealMinutes'}
            if defined $agreement->{'RealMinutes'};
        1;
    };

    POSIX::tzset() if $agreement->{'Timezone'}
        && $agreement->{'Timezone'} ne ($ENV{'TZ'}||'');
    die $@ unless $ok;

    return $res;
}

sub GetCustomField {
    my $self = shift;
    my %args = (Ticket => undef, CustomField => 'SLA', @_);
    unless ( $args{'Ticket'} ) {
        $args{'Ticket'} = $self->TicketObj if $self->can('TicketObj');
    }
    unless ( $args{'Ticket'} ) {
        return RT::CustomField->new( $RT::SystemUser );
    }
    my $cfs = $args{'Ticket'}->QueueObj->TicketCustomFields;
    $cfs->Limit( FIELD => 'Name', VALUE => $args{'CustomField'} );
    return $cfs->First || RT::CustomField->new( $RT::SystemUser );
}

sub GetDefaultServiceLevel {
    my $self = shift;
    my %args = (Ticket => undef, Queue => undef, @_);
    unless ( $args{'Queue'} || $args{'Ticket'} ) {
        $args{'Ticket'} = $self->TicketObj if $self->can('TicketObj');
    }
    if ( !$args{'Queue'} && $args{'Ticket'} ) {
        $args{'Queue'} = $args{'Ticket'}->QueueObj;
    }
    if ( $args{'Queue'} ) {
        local $@;
        eval { require RT::Queue_SLA };
        if ( $@ ) {
            $RT::Logger->crit("Couldn't load RT::Queue_SLA: $@");
        }
        else {
            return $args{'Queue'}->SLA if $args{'Queue'}->SLA;
        }

        if ( my $info = $RT::ServiceAgreements{'QueueDefault'}{ $args{'Queue'}->Name } ) {
            return $info unless ref $info;
            return $info->{'Level'} || $RT::ServiceAgreements{'Default'};
        }
    }
    return $RT::ServiceAgreements{'Default'};
}

=head1 TODO

    * [implemented, TODO: tests for options in the config] default SLA for queues

    * [implemented, TODO: tests] add support for multiple b-hours definitions,
      this could be very helpfull when you have 24/7 mixed with 8/5 and/or
      something like 8/5+4/2 for different tickets(by requestor, queue or
      something else). So people would be able to handle tickets in the right
      order using Due dates.

    * [not implemented] WebUI

=head1 DESIGN

=head2 Classes

Actions are subclasses of L<RT::Action::SLA> class that is subclass of
L<RT::Extension::SLA> and L<RT::Action> classes.

Conditions are subclasses of L<RT::Condition::SLA> class that is subclass of
L<RT::Extension::SLA> and L<RT::Condition> classes.

L<RT::Extension::SLA> is a base class for all classes in the extension,
it provides access to config, generates L<Business::Hours> objects, and
other things useful for whole extension. As this class is the base for
all actions and conditions then we MUST avoid adding methods which overload
methods in 'RT::{Condition,Action}' RT's modules.

=head1 NOTES

If you run C<make initdb> more than once you will create multiple SLA CFs.  You
can remove these via RT's C<Configuration-E<gt>Global> menu, (both Custom Fields
and Scrips).

=head1 AUTHOR

Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>

=head1 COPYRIGHT

This extension is Copyright (C) 2007-2009 Best Practical Solutions, LLC.

It is freely redistributable under the terms of version 2 of the GNU GPL.

=cut

1;