[Bps-public-commit] r19409 - in RT-Extension-SLA: lib/RT/Extension/SLA t
ruz at bestpractical.com
ruz at bestpractical.com
Sat May 2 18:49:35 EDT 2009
Author: ruz
Date: Sat May 2 18:49:34 2009
New Revision: 19409
Modified:
RT-Extension-SLA/lib/RT/Extension/SLA.pm
RT-Extension-SLA/lib/RT/Extension/SLA/Report.pm
RT-Extension-SLA/t/basics.t
Log:
* another round, close to something testable
Modified: RT-Extension-SLA/lib/RT/Extension/SLA.pm
==============================================================================
--- RT-Extension-SLA/lib/RT/Extension/SLA.pm (original)
+++ RT-Extension-SLA/lib/RT/Extension/SLA.pm Sat May 2 18:49:34 2009
@@ -14,6 +14,14 @@
RT extension to implement automated due dates using service levels.
+=head1 UPGRADING
+
+On upgrade you shouldn't run 'make initdb'.
+
+If you were using 0.02 or older version of this extension with
+RT 3.8.1 then you have to uninstall that manually. List of files
+you can find in the MANIFEST.
+
=head1 INSTALL
=over 4
@@ -45,7 +53,7 @@
controlled in the RT's config using option C<%RT::ServiceAgreements>
and C<%RT::ServiceBusinessHours>. For example:
- %RT::ServiceAgreements = (
+ Set( %ServiceAgreements,
Default => '4h',
QueueDefault => {
'Incident' => '2h',
@@ -248,7 +256,7 @@
In the config you can set one or more work schedules. Use the following
format:
- %RT::ServiceBusinessHours = (
+ Set( %ServiceBusinessHours,
'Default' => {
... description ...
},
@@ -274,7 +282,7 @@
then %RT::ServiceBusinessHours should have the corresponding definition:
- %RT::ServiceBusinessHours = (
+ Set( %ServiceBusinessHours,
'work just in Monday' => {
1 => { Name => 'Monday', Start => '9:00', End => '18:00' },
},
@@ -286,14 +294,14 @@
In the config you can set per queue defaults, using:
- %RT::ServiceAgreements = (
+ Set( %ServiceAgreements,
Default => 'global default level of service',
QueueDefault => {
'queue name' => 'default value for this queue',
...
},
...
- };
+ );
=head2 Access control
@@ -427,6 +435,12 @@
return $RT::ServiceAgreements{'Default'};
}
+sub ReportOnTicket {
+ my $self = shift;
+ my $id = shift;
+
+}
+
=head1 TODO
* [implemented, TODO: tests for options in the config] default SLA for queues
Modified: RT-Extension-SLA/lib/RT/Extension/SLA/Report.pm
==============================================================================
--- RT-Extension-SLA/lib/RT/Extension/SLA/Report.pm (original)
+++ RT-Extension-SLA/lib/RT/Extension/SLA/Report.pm Sat May 2 18:49:34 2009
@@ -4,13 +4,29 @@
package RT::Extension::SLA::Report;
-sub new {}
+sub new {
+ my $proto = shift;
+ my $self = bless {}, ref($proto)||$proto;
+ return $self->init( @_ );
+}
-sub init {}
+sub init {
+ my $self = shift;
+ my %args = (Ticket => undef, @_);
+ $self->{'Ticket'} = $args{'Ticket'} || die "boo";
+ $self->{'State'} = {};
+ $self->{'Stats'} = [];
+ return $self;
+}
sub State {
my $self = shift;
- return $self->{State} ||= {};
+ return $self->{State};
+}
+
+sub Stats {
+ my $self = shift;
+ return $self->{Stats};
}
{ my $cache;
@@ -33,9 +49,9 @@
return $cache;
} }
-sub Drive {
+sub Run {
my $self = shift;
- my $txns = shift;
+ my $txns = shift || $self->{'Ticket'}->Transactions;
my $state = $self->State;
my $handler = $self->Handlers;
@@ -53,20 +69,18 @@
}
next unless $h;
- $self->$h( Transaction => $txn, State => $state );
+ $self->$h( Ticket => $self->{'Ticket'}, Transaction => $txn, State => $state );
}
+ return $self;
}
sub OnCreate {
my $self = shift;
my %args = ( Ticket => undef, Transaction => undef, State => undef, @_);
- my $level = $self->InitialServiceLevel( $args{'Ticket'} );
-
my $state = $args{'State'};
%$state = ();
- $state->{'level'} = $level;
- $state->{'transaction'} = $args{'Transaction'};
+ $state->{'level'} = $self->InitialServiceLevel( $args{'Ticket'} );
$state->{'requestors'} = [ $self->InitialRequestors( $args{'Ticket'} ) ];
$state->{'owner'} = $self->InitialOwner( $args{'Ticket'} );
return;
@@ -88,7 +102,76 @@
sub OnResponse {
my $self = shift;
- my $self
+ my %args = ( Ticket => undef, Transaction => undef, State => undef, @_);
+
+ my $txn = $args{'Transaction'};
+ unless ( $args{'State'}->{'level'} ) {
+ $RT::Logger->debug('No service level -> ignore txn #'. $txn->id );
+ return;
+ }
+
+ my $act = $args{'State'}->{'act'};
+ if ( $self->IsRequestorsAct( $txn ) ) {
+ if ( $act && $act->{'requestor'} ) {
+ # several requestors' acts in a row don't move deadlines
+ return;
+ }
+ $act ||= $args{'State'}->{'act'} = {};
+
+ $act->{'requestor'} = 1;
+ $act->{'acted'} = $txn->CreatedObj->Unix;
+ } else {
+ unless ( $act ) {
+ die "not yet implemented";
+ }
+ unless ( $act->{'requestor'} ) {
+ # check keep in loop
+ my $deadline = RT::Extension::SLA->Due(
+ Type => 'KeepInLoop',
+ Level => $args{'State'}->{'level'},
+ Time => $args{'State'}->{'acted'},
+ );
+ unless ( defined $deadline ) {
+ $RT::Logger->debug( "Multiple non-requestors replies in a raw, without keep in loop deadline");
+ return;
+ }
+ # keep in loop
+ my $failed = $txn->CreatedObj->Unix > $deadline? 1 : 0;
+ my $owner = $args{'State'}->{'owner'} == $txn->Creator? 1 : 0;
+ my $stat = {
+ type => 'KeepInLoop',
+ owner => $args{'State'}->{'owner'},
+ failed => $failed,
+ owner_act => $owner,
+ shift => $txn->CreatedObj->Unix - $deadline,
+ };
+ push @{ $self->Stats }, $stat;
+ }
+ else {
+ # check response
+ my $deadline = RT::Extension::SLA->Due(
+ Type => 'Response',
+ Level => $args{'State'}->{'level'},
+ Time => $args{'State'}->{'acted'},
+ );
+ unless ( defined $deadline ) {
+ $RT::Logger->debug( "Non-requestors' reply after requestors', without response deadline");
+ return;
+ }
+
+ # repsonse
+ my $failed = $txn->CreatedObj->Unix > $deadline? 1 : 0;
+ my $owner = $args{'State'}->{'owner'} == $txn->Creator? 1 : 0;
+ my $stat = {
+ type => 'KeepInLoop',
+ owner => $args{'State'}->{'owner'},
+ failed => $failed,
+ owner_act => $owner,
+ shift => $txn->CreatedObj->Unix - $deadline,
+ };
+ push @{ $self->Stats }, $stat;
+ }
+ }
}
sub IsRequestorsAct {
@@ -107,7 +190,7 @@
$cgm->LoadByCols( GroupId => $id, MemberId => $actor, Disabled => 0 );
return 1 if $cgm->id;
}
- return 1;
+ return 0;
}
sub InitialServiceLevel {
@@ -147,11 +230,10 @@
sub InitialOwner {
my $self = shift;
- my $ticket = shift;
-
+ my %args = (Ticket => undef, @_);
return $self->InitialValue(
%args,
- Current => $ticket->Owner,
+ Current => $args{'Ticket'}->Owner,
Criteria => { 'Set', 'Owner' },
);
}
@@ -174,7 +256,7 @@
my $self = shift;
my %args = (Ticket => undef, Criteria => undef, Order => 'ASC', @_);
- my $txns = $ticket->Transactions;
+ my $txns = $args{'Ticket'}->Transactions;
my $clause = 'ByTypeAndField';
while ( my ($type, $field) = each %{ $args{'Criteria'} } ) {
Modified: RT-Extension-SLA/t/basics.t
==============================================================================
--- RT-Extension-SLA/t/basics.t (original)
+++ RT-Extension-SLA/t/basics.t Sat May 2 18:49:34 2009
@@ -3,9 +3,10 @@
use strict;
use warnings;
-use Test::More tests => 1;
+use Test::More tests => 2;
use_ok 'RT::Extension::SLA';
+use_ok 'RT::Extension::SLA::Report';
1;
More information about the Bps-public-commit
mailing list