Diff -- /var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com/MODS/PTMatrix/SLA.pm
Diff

/var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com/MODS/PTMatrix/SLA.pm

added on local at 2026-07-01 12:34:24

Added
+212
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 02fbe9700367
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1package MODS::PTMatrix::SLA;
2#======================================================================
3# TaskForge -- SLA tracking
4#
5# Public methods:
6# schema_ready($db, $dbh, $DB) -> 1/0
7# apply_for_task($db, $dbh, $DB, $task_row)
8# -- pick matching policy + insert state
9# mark_response($db, $dbh, $DB, $tid) -- record first response
10# mark_resolved($db, $dbh, $DB, $tid) -- record resolution
11# check_breaches($db, $dbh, $DB) -- mark breaches due NOW (worker)
12# state_for_task($db, $dbh, $DB, $tid) -- pull (state + countdown badge)
13#======================================================================
14use strict; use warnings;
15
16sub new { return bless {}, shift }
17
18sub schema_ready {
19 my ($self, $db, $dbh, $DB) = @_;
20 my $r = $db->db_readwrite($dbh, qq~
21 SELECT COUNT(*) AS n FROM information_schema.TABLES
22 WHERE TABLE_SCHEMA='$DB' AND TABLE_NAME='task_sla_state'
23 ~, $ENV{SCRIPT_NAME}, __LINE__);
24 return ($r && $r->{n}) ? 1 : 0;
25}
26
27# Match a task against policies. Active policies, ordered by priority_order
28# ascending. First matching policy wins. Filters: only_priority is comma list,
29# only_work_item_type is comma list, only_department_id is a single id (or NULL).
30sub apply_for_task {
31 my ($self, $db, $dbh, $DB, $task) = @_;
32 return unless $self->schema_ready($db, $dbh, $DB);
33 return unless $task && $task->{id} && $task->{company_id};
34
35 # Don't double-apply
36 my $existing = $db->db_readwrite($dbh, qq~
37 SELECT id FROM `${DB}`.task_sla_state WHERE task_id='$task->{id}' LIMIT 1
38 ~, $ENV{SCRIPT_NAME}, __LINE__);
39 return if $existing && $existing->{id};
40
41 my @pols = $db->db_readwrite_multiple($dbh, qq~
42 SELECT * FROM `${DB}`.sla_policies
43 WHERE company_id='$task->{company_id}' AND is_active=1
44 ORDER BY priority_order ASC, id ASC
45 ~, $ENV{SCRIPT_NAME}, __LINE__);
46 my $picked;
47 foreach my $p (@pols) {
48 # only_priority filter
49 if ($p->{only_priority} && length $p->{only_priority}) {
50 my %ok = map { lc($_) => 1 } grep { length } split(/,/, $p->{only_priority});
51 next unless $ok{ lc($task->{priority} || '') };
52 }
53 # only_work_item_type filter
54 if ($p->{only_work_item_type} && length $p->{only_work_item_type}) {
55 my %ok = map { lc($_) => 1 } grep { length } split(/,/, $p->{only_work_item_type});
56 next unless $ok{ lc($task->{work_item_type} || 'task') };
57 }
58 # only_department_id filter
59 if ($p->{only_department_id} && $p->{only_department_id} != 0) {
60 next unless ($task->{assigned_department_id} || '') eq $p->{only_department_id};
61 }
62 $picked = $p; last;
63 }
64 return unless $picked;
65
66 my $resp_min = $picked->{response_time_minutes} || 0;
67 my $res_min = $picked->{resolution_time_minutes} || 0;
68 my $resp_sql = $resp_min ? "DATE_ADD(NOW(), INTERVAL $resp_min MINUTE)" : 'NULL';
69 my $res_sql = $res_min ? "DATE_ADD(NOW(), INTERVAL $res_min MINUTE)" : 'NULL';
70
71 $db->db_readwrite($dbh, qq~
72 INSERT INTO `${DB}`.task_sla_state
73 SET task_id='$task->{id}',
74 policy_id='$picked->{id}',
75 started_at=NOW(),
76 response_due_at=$resp_sql,
77 resolution_due_at=$res_sql
78 ~, $ENV{SCRIPT_NAME}, __LINE__);
79}
80
81sub mark_response {
82 my ($self, $db, $dbh, $DB, $tid) = @_;
83 return unless $self->schema_ready($db, $dbh, $DB);
84 $db->db_readwrite($dbh, qq~
85 UPDATE `${DB}`.task_sla_state
86 SET first_response_at = COALESCE(first_response_at, NOW())
87 WHERE task_id='$tid'
88 ~, $ENV{SCRIPT_NAME}, __LINE__);
89}
90
91sub mark_resolved {
92 my ($self, $db, $dbh, $DB, $tid) = @_;
93 return unless $self->schema_ready($db, $dbh, $DB);
94 $db->db_readwrite($dbh, qq~
95 UPDATE `${DB}`.task_sla_state
96 SET resolved_at = COALESCE(resolved_at, NOW())
97 WHERE task_id='$tid'
98 ~, $ENV{SCRIPT_NAME}, __LINE__);
99}
100
101# Worker entry point. Marks any state row whose response/resolution deadline
102# has passed without being met. Returns list of newly-breached task ids
103# (the caller can then fire chat events / notifications).
104sub check_breaches {
105 my ($self, $db, $dbh, $DB) = @_;
106 return () unless $self->schema_ready($db, $dbh, $DB);
107 my @breached;
108
109 # Response breaches: due in past, no first_response, not yet flagged.
110 my @r = $db->db_readwrite_multiple($dbh, qq~
111 SELECT s.task_id, s.policy_id, t.company_id, t.project_id, t.title, t.work_item_type,
112 p.key_prefix, t.ticket_number
113 FROM `${DB}`.task_sla_state s
114 JOIN `${DB}`.tasks t ON t.id = s.task_id
115 JOIN `${DB}`.projects p ON p.id = t.project_id
116 WHERE s.response_due_at IS NOT NULL
117 AND s.response_breached = 0
118 AND s.first_response_at IS NULL
119 AND s.response_due_at <= NOW()
120 ~, $ENV{SCRIPT_NAME}, __LINE__);
121 foreach my $row (@r) {
122 $db->db_readwrite($dbh, qq~
123 UPDATE `${DB}`.task_sla_state
124 SET response_breached=1, response_breached_at=NOW()
125 WHERE task_id='$row->{task_id}'
126 ~, $ENV{SCRIPT_NAME}, __LINE__);
127 push @breached, { %$row, kind => 'response' };
128 }
129
130 my @r2 = $db->db_readwrite_multiple($dbh, qq~
131 SELECT s.task_id, s.policy_id, t.company_id, t.project_id, t.title, t.work_item_type,
132 p.key_prefix, t.ticket_number
133 FROM `${DB}`.task_sla_state s
134 JOIN `${DB}`.tasks t ON t.id = s.task_id
135 JOIN `${DB}`.projects p ON p.id = t.project_id
136 WHERE s.resolution_due_at IS NOT NULL
137 AND s.resolution_breached = 0
138 AND s.resolved_at IS NULL
139 AND s.resolution_due_at <= NOW()
140 ~, $ENV{SCRIPT_NAME}, __LINE__);
141 foreach my $row (@r2) {
142 $db->db_readwrite($dbh, qq~
143 UPDATE `${DB}`.task_sla_state
144 SET resolution_breached=1, resolution_breached_at=NOW()
145 WHERE task_id='$row->{task_id}'
146 ~, $ENV{SCRIPT_NAME}, __LINE__);
147 push @breached, { %$row, kind => 'resolution' };
148 }
149
150 return @breached;
151}
152
153# Returns a hashref for queue/badge rendering. Fields:
154# has_sla, response_pending, response_breached, resolution_pending, resolution_breached,
155# response_label ("2h 14m left" / "Breached 18m ago"), response_class ("ok"/"warn"/"breach")
156sub state_for_task {
157 my ($self, $db, $dbh, $DB, $tid) = @_;
158 return { has_sla => 0 } unless $self->schema_ready($db, $dbh, $DB);
159 my $r = $db->db_readwrite($dbh, qq~
160 SELECT s.*,
161 UNIX_TIMESTAMP(s.response_due_at) - UNIX_TIMESTAMP(NOW()) AS resp_secs,
162 UNIX_TIMESTAMP(s.resolution_due_at) - UNIX_TIMESTAMP(NOW()) AS res_secs
163 FROM `${DB}`.task_sla_state s WHERE s.task_id='$tid' LIMIT 1
164 ~, $ENV{SCRIPT_NAME}, __LINE__);
165 return { has_sla => 0 } unless $r && $r->{id};
166
167 my %out = (
168 has_sla => 1,
169 response_due_at => $r->{response_due_at} || '',
170 resolution_due_at => $r->{resolution_due_at} || '',
171 first_response_at => $r->{first_response_at} || '',
172 resolved_at => $r->{resolved_at} || '',
173 response_breached => $r->{response_breached} ? 1 : 0,
174 resolution_breached=> $r->{resolution_breached} ? 1 : 0,
175 );
176 if ($r->{response_due_at} && !$r->{first_response_at}) {
177 $out{response_pending} = 1;
178 if ($r->{response_breached}) {
179 $out{response_label} = 'Response breached';
180 $out{response_class} = 'breach';
181 } else {
182 my $s = $r->{resp_secs} || 0;
183 $out{response_label} = _fmt_remaining($s) . ' to first response';
184 $out{response_class} = ($s < 3600) ? 'warn' : 'ok';
185 }
186 }
187 if ($r->{resolution_due_at} && !$r->{resolved_at}) {
188 $out{resolution_pending} = 1;
189 if ($r->{resolution_breached}) {
190 $out{resolution_label} = 'Resolution breached';
191 $out{resolution_class} = 'breach';
192 } else {
193 my $s = $r->{res_secs} || 0;
194 $out{resolution_label} = _fmt_remaining($s) . ' to resolution';
195 $out{resolution_class} = ($s < 7200) ? 'warn' : 'ok';
196 }
197 }
198 return \%out;
199}
200
201sub _fmt_remaining {
202 my ($s) = @_;
203 return 'now' if $s == 0;
204 my $abs = abs($s);
205 my $d = int($abs / 86400);
206 my $h = int(($abs % 86400) / 3600);
207 my $m = int(($abs % 3600) / 60);
208 my $str = $d ? "${d}d ${h}h" : ($h ? "${h}h ${m}m" : "${m}m");
209 return ($s < 0 ? "$str ago" : "$str left");
210}
211
2121;
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help