Diff -- /var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/MetaAdmin/SupportInbox.pm

O Operator
Diff

/var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/MetaAdmin/SupportInbox.pm

added on local at 2026-07-11 08:07:43

Added
+321
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 5c77a781b4b5
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::MetaAdmin::SupportInbox;
2#======================================================================
3# Meta-Admin -- cross-site customer-support inbox.
4#
5# 6 of the 7 sister sites share an identical support_threads +
6# support_messages schema plus an identical MODS::<Site>::Support
7# module signature. We read via SiteConn (READ-ONLY portfolio DB
8# adapter) and reply via HMAC-signed HTTP POST to each site's
9# /support_meta_send.cgi endpoint -- so bookkeeping (unread flags,
10# status flip, last_message_at) lives with each site's own Support.pm.
11#
12# Sites in scope: webstls, affsoft, shopcart, repricer, abforge,
13# contactforge (STANDARD schema); ptmatrix (adapted -- column renames
14# + different status enum + no Support.pm).
15#======================================================================
16use strict;
17use warnings;
18use Digest::SHA qw(hmac_sha256_hex sha256_hex);
19use JSON::PP;
20
21use MODS::MetaAdmin::SiteConn;
22use MODS::MetaAdmin::Config;
23
24# Per-site adapter: column names in that site's support_threads/messages
25# tables, plus how to normalize its status enum onto the standard set.
26# Standard schema is: customer_user_id, admin_unread, customer_unread,
27# sender_role, status IN (open,waiting_admin,waiting_customer,resolved,closed).
28my %STANDARD_ADAPTER = (
29 thread_customer_col => 'customer_user_id',
30 thread_status_col => 'status',
31 thread_admin_unread => 'admin_unread',
32 thread_cust_unread => 'customer_unread',
33 thread_extra_cols => 'priority',
34 message_sender_col => 'sender_role',
35 admin_sender_value => 'admin',
36 status_map => { open => 'open', waiting_admin => 'waiting_admin',
37 waiting_customer => 'waiting_customer',
38 resolved => 'resolved', closed => 'closed' },
39 status_reverse => { open => 'open', waiting_admin => 'waiting_admin',
40 waiting_customer => 'waiting_customer',
41 resolved => 'resolved', closed => 'closed' },
42);
43my %PTMATRIX_ADAPTER = (
44 thread_customer_col => 'opened_by_user_id',
45 thread_status_col => 'status',
46 thread_admin_unread => 'admin_unread',
47 thread_cust_unread => 'user_unread',
48 thread_extra_cols => "'normal' AS priority",
49 message_sender_col => 'sender_kind',
50 admin_sender_value => 'admin',
51 # PT enum is open|answered|closed. Map onto the standard names so
52 # the UI status pill CSS + filter chips keep working.
53 status_map => { open => 'waiting_admin', answered => 'waiting_customer',
54 closed => 'closed' },
55 # For a filter like `?status=waiting_admin`, translate back to PT's
56 # native value before the SQL clause.
57 status_reverse => { open => 'open', waiting_admin => 'open',
58 waiting_customer => 'answered',
59 resolved => 'closed', closed => 'closed' },
60);
61my %SITE_ADAPTER = (
62 webstls => \%STANDARD_ADAPTER,
63 affsoft => \%STANDARD_ADAPTER,
64 shopcart => \%STANDARD_ADAPTER,
65 repricer => \%STANDARD_ADAPTER,
66 abforge => \%STANDARD_ADAPTER,
67 contactforge => \%STANDARD_ADAPTER,
68 ptmatrix => \%PTMATRIX_ADAPTER,
69);
70my @UNIFIED_SITES = sort keys %SITE_ADAPTER;
71
72sub new {
73 my ($class) = @_;
74 return bless({
75 sc => MODS::MetaAdmin::SiteConn->new,
76 cfg => MODS::MetaAdmin::Config->new,
77 err => '',
78 }, $class);
79}
80
81sub last_error { return $_[0]->{err} || ''; }
82
83sub supported_slugs { return \@UNIFIED_SITES; }
84
85# Accessor for other modules that need to walk the per-site column mapping
86# (e.g. MODS::MetaAdmin::AutoAck's discovery + reverify queries).
87sub adapter_for {
88 my ($self_or_class, $slug) = @_;
89 return $SITE_ADAPTER{$slug};
90}
91
92#---------------------------------------------------------------------
93# list_threads({ status, days, site, limit })
94# status: undef|'open'|'waiting_admin'|'waiting_customer'|'closed'
95# days: integer (rolling window on last_message_at); default 90
96# site: optional single slug to filter
97# limit: cap per site (default 100)
98#
99# Returns arrayref of { slug, display_name, brand_color, id, subject,
100# status, priority, admin_unread, customer_unread, created_at,
101# last_message_at, customer_email, customer_name, preview }.
102# Sorted by last_message_at DESC across ALL sites.
103#---------------------------------------------------------------------
104sub list_threads {
105 my ($self, %a) = @_;
106 my $days = ($a{days} && $a{days} =~ /^\d+$/) ? $a{days} : 90;
107 my $status = defined($a{status}) ? $a{status} : '';
108 my $limit = ($a{limit} && $a{limit} =~ /^\d+$/) ? $a{limit} : 100;
109 my $only = $a{site} || '';
110
111 my $sites = $self->{sc}->list_sites(active => 1);
112 my @out;
113 foreach my $srow (@$sites) {
114 my $slug = $srow->{slug} or next;
115 my $ad = $SITE_ADAPTER{$slug} or next;
116 next if $only && $only ne $slug;
117
118 # Translate the requested status filter into the site's native
119 # enum via its status_reverse map.
120 my $st_clause = '';
121 if ($status eq 'unresolved') {
122 # Anything the admin still owes a reply on -- native mapping
123 # differs per site (standard has 2 such statuses, PT has 1).
124 my %native;
125 $native{$ad->{status_reverse}{open}} = 1;
126 $native{$ad->{status_reverse}{waiting_admin}} = 1;
127 $st_clause = "AND t.$ad->{thread_status_col} IN ("
128 . join(',', map "'$_'", sort keys %native) . ')';
129 } elsif ($status && exists $ad->{status_reverse}{$status}) {
130 my $native = $ad->{status_reverse}{$status};
131 $st_clause = "AND t.$ad->{thread_status_col} = '$native'";
132 }
133
134 # Preview = first 200 chars of the latest message on each thread.
135 my $sql = qq~
136 SELECT t.id, t.subject, t.$ad->{thread_status_col} AS status,
137 $ad->{thread_extra_cols},
138 t.$ad->{thread_admin_unread} AS admin_unread,
139 t.$ad->{thread_cust_unread} AS customer_unread,
140 t.created_at, t.last_message_at,
141 UNIX_TIMESTAMP(t.created_at) AS created_epoch,
142 UNIX_TIMESTAMP(t.last_message_at) AS last_message_epoch,
143 u.email AS customer_email,
144 u.display_name AS customer_name,
145 (SELECT LEFT(m.body, 200) FROM support_messages m
146 WHERE m.thread_id = t.id
147 ORDER BY m.id DESC LIMIT 1) AS preview,
148 (SELECT m.$ad->{message_sender_col} FROM support_messages m
149 WHERE m.thread_id = t.id
150 ORDER BY m.id DESC LIMIT 1) AS last_sender
151 FROM support_threads t
152 LEFT JOIN users u ON u.id = t.$ad->{thread_customer_col}
153 WHERE (t.last_message_at IS NULL
154 OR t.last_message_at >= DATE_SUB(NOW(), INTERVAL $days DAY))
155 $st_clause
156 ORDER BY t.last_message_at DESC, t.id DESC
157 LIMIT $limit
158 ~;
159
160 my $rows = $self->{sc}->query_many($slug, $sql) || [];
161 foreach my $r (@$rows) {
162 $r->{slug} = $slug;
163 $r->{display_name} = $srow->{display_name};
164 $r->{brand_color} = $srow->{brand_color} || '#807aa8';
165 $r->{display_url} = $srow->{display_url} || '';
166 $r->{preview} //= '';
167 $r->{preview} =~ s/\s+/ /g;
168 $r->{preview} = substr($r->{preview}, 0, 140);
169 # Normalize native status → standard name for the UI pill CSS.
170 $r->{status_native} = $r->{status};
171 $r->{status} = $ad->{status_map}{$r->{status}} || $r->{status};
172 push @out, $r;
173 }
174 }
175
176 # Merge sort by last_message_at DESC (empty string sorts last)
177 @out = sort {
178 ($b->{last_message_at} || '') cmp ($a->{last_message_at} || '')
179 } @out;
180 return \@out;
181}
182
183#---------------------------------------------------------------------
184# get_thread($slug, $thread_id) -> { thread => {..}, messages => [..] }
185# Undef on missing / unsupported / DB error.
186#---------------------------------------------------------------------
187sub get_thread {
188 my ($self, $slug, $tid) = @_;
189 $tid = int($tid || 0);
190 return undef unless $tid > 0;
191 my $ad = $SITE_ADAPTER{$slug} or return undef;
192
193 my $srow = $self->{sc}->row_for_slug($slug) or do {
194 $self->{err} = "unknown site: $slug"; return undef;
195 };
196 my $sites = $self->{sc}->list_sites(active => 1);
197 my ($site_meta) = grep { $_->{slug} eq $slug } @$sites;
198
199 my $tsql = qq~
200 SELECT t.id, t.subject, t.created_at, t.last_message_at,
201 UNIX_TIMESTAMP(t.created_at) AS created_epoch,
202 UNIX_TIMESTAMP(t.last_message_at) AS last_message_epoch,
203 t.$ad->{thread_status_col} AS status,
204 t.$ad->{thread_admin_unread} AS admin_unread,
205 t.$ad->{thread_cust_unread} AS customer_unread,
206 $ad->{thread_extra_cols},
207 t.$ad->{thread_customer_col} AS customer_user_id,
208 u.email AS customer_email,
209 u.display_name AS customer_name
210 FROM support_threads t
211 LEFT JOIN users u ON u.id = t.$ad->{thread_customer_col}
212 WHERE t.id = $tid
213 LIMIT 1
214 ~;
215 my $thread = $self->{sc}->query_one($slug, $tsql);
216 unless ($thread) {
217 $self->{err} = 'thread not found';
218 return undef;
219 }
220 $thread->{slug} = $slug;
221 $thread->{display_name} = $site_meta ? $site_meta->{display_name} : $slug;
222 $thread->{brand_color} = $site_meta ? $site_meta->{brand_color} : '#807aa8';
223 $thread->{display_url} = $site_meta ? $site_meta->{display_url} : '';
224 $thread->{status_native} = $thread->{status};
225 $thread->{status} = $ad->{status_map}{$thread->{status}} || $thread->{status};
226
227 # Sender kind normalization: PT uses 'user' -> we render as 'customer'.
228 my $msql = qq~
229 SELECT m.id, m.thread_id, m.sender_user_id,
230 m.$ad->{message_sender_col} AS sender_role,
231 m.body, m.created_at,
232 UNIX_TIMESTAMP(m.created_at) AS created_epoch,
233 u.email AS sender_email,
234 u.display_name AS sender_name
235 FROM support_messages m
236 LEFT JOIN users u ON u.id = m.sender_user_id
237 WHERE m.thread_id = $tid
238 ORDER BY m.id ASC
239 ~;
240 my $msgs = $self->{sc}->query_many($slug, $msql) || [];
241 foreach my $m (@$msgs) {
242 $m->{sender_role} = 'customer' if $m->{sender_role} eq 'user';
243 }
244
245 return { thread => $thread, messages => $msgs };
246}
247
248#---------------------------------------------------------------------
249# post_reply($slug, $thread_id, $body) -> ($ok, $error_or_message_id)
250#
251# HMAC-signs the payload and POSTs to https://<site>/support_meta_send.cgi.
252# The site's endpoint verifies the signature and calls its own
253# Support::send_message -- so unread flags, status flips and
254# last_message_at bookkeeping all happen the same way as a native reply.
255#---------------------------------------------------------------------
256sub post_reply {
257 my ($self, $slug, $tid, $body) = @_;
258 $tid = int($tid || 0);
259 $body //= '';
260 return (0, 'missing_thread_id') unless $tid > 0;
261 return (0, 'empty_body') unless length $body;
262 return (0, 'unsupported_site') unless exists $SITE_ADAPTER{$slug};
263
264 my $sites = $self->{sc}->list_sites(active => 1);
265 my ($site_meta) = grep { $_->{slug} eq $slug } @$sites;
266 unless ($site_meta && $site_meta->{display_url}) {
267 return (0, 'no_display_url_for_site');
268 }
269 my $url = $site_meta->{display_url};
270 $url =~ s{/$}{};
271 $url .= '/support_meta_send.cgi';
272
273 my $secret = $self->{cfg}->settings('meta_admin_hmac_secret') || '';
274 return (0, 'no_local_secret') unless length($secret) >= 32;
275
276 my $ts = time;
277 my $body_hash = sha256_hex($body);
278 my $sig = hmac_sha256_hex("$ts.$tid.$body_hash", $secret);
279
280 my $json = encode_json({ ts => $ts + 0, thread_id => $tid + 0, body => $body });
281
282 # Shell out to curl -- LWP::Protocol::https isn't installed on this box
283 # and curl is universally present on Plesk servers. Pipe JSON via stdin
284 # so it never appears in the process arg list (safer than -d '...' for
285 # bodies that could contain shell metacharacters).
286 my $url_q = $url; $url_q =~ s/'/'\\''/g;
287 my $sig_q = $sig; $sig_q =~ s/'/'\\''/g;
288 my $cmd = "curl -sS -X POST --max-time 15 --data-binary \@- "
289 . "-H 'Content-Type: application/json' "
290 . "-H 'X-Meta-Sig: $sig_q' "
291 . "-w '\\n__STATUS__%{http_code}' "
292 . "'$url_q'";
293
294 my $out = eval {
295 require IPC::Open2;
296 my ($rdr, $wtr);
297 my $child = IPC::Open2::open2($rdr, $wtr, $cmd);
298 print $wtr $json;
299 close $wtr;
300 local $/;
301 my $r = <$rdr>;
302 close $rdr;
303 waitpid($child, 0);
304 $r;
305 };
306 if ($@ || !defined $out) {
307 return (0, 'curl_pipe_failed: ' . ($@ || 'no output'));
308 }
309
310 my $http_code = 0;
311 if ($out =~ s/\n__STATUS__(\d+)\s*$//s) { $http_code = $1 + 0; }
312
313 my $body_out = eval { decode_json($out || '{}') } || {};
314 if ($http_code == 200 && $body_out->{ok}) {
315 return (1, $body_out->{message_id} || 0);
316 }
317 my $why = $body_out->{error} || "http_$http_code";
318 return (0, $why);
319}
320
3211;