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
+0
lines
Removed
-0
lines
Context
321
unchanged
Blobs
from 5c77a781b4b5
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.
11package MODS::MetaAdmin::SupportInbox;
22#======================================================================
33# Meta-Admin -- cross-site customer-support inbox.
44#
55# 6 of the 7 sister sites share an identical support_threads +
66# support_messages schema plus an identical MODS::<Site>::Support
77# module signature. We read via SiteConn (READ-ONLY portfolio DB
88# adapter) and reply via HMAC-signed HTTP POST to each site's
99# /support_meta_send.cgi endpoint -- so bookkeeping (unread flags,
1010# status flip, last_message_at) lives with each site's own Support.pm.
1111#
1212# Sites in scope: webstls, affsoft, shopcart, repricer, abforge,
1313# contactforge (STANDARD schema); ptmatrix (adapted -- column renames
1414# + different status enum + no Support.pm).
1515#======================================================================
1616use strict;
1717use warnings;
1818use Digest::SHA qw(hmac_sha256_hex sha256_hex);
1919use JSON::PP;
2020
2121use MODS::MetaAdmin::SiteConn;
2222use MODS::MetaAdmin::Config;
2323
2424# Per-site adapter: column names in that site's support_threads/messages
2525# tables, plus how to normalize its status enum onto the standard set.
2626# Standard schema is: customer_user_id, admin_unread, customer_unread,
2727# sender_role, status IN (open,waiting_admin,waiting_customer,resolved,closed).
2828my %STANDARD_ADAPTER = (
2929 thread_customer_col => 'customer_user_id',
3030 thread_status_col => 'status',
3131 thread_admin_unread => 'admin_unread',
3232 thread_cust_unread => 'customer_unread',
3333 thread_extra_cols => 'priority',
3434 message_sender_col => 'sender_role',
3535 admin_sender_value => 'admin',
3636 status_map => { open => 'open', waiting_admin => 'waiting_admin',
3737 waiting_customer => 'waiting_customer',
3838 resolved => 'resolved', closed => 'closed' },
3939 status_reverse => { open => 'open', waiting_admin => 'waiting_admin',
4040 waiting_customer => 'waiting_customer',
4141 resolved => 'resolved', closed => 'closed' },
4242);
4343my %PTMATRIX_ADAPTER = (
4444 thread_customer_col => 'opened_by_user_id',
4545 thread_status_col => 'status',
4646 thread_admin_unread => 'admin_unread',
4747 thread_cust_unread => 'user_unread',
4848 thread_extra_cols => "'normal' AS priority",
4949 message_sender_col => 'sender_kind',
5050 admin_sender_value => 'admin',
5151 # PT enum is open|answered|closed. Map onto the standard names so
5252 # the UI status pill CSS + filter chips keep working.
5353 status_map => { open => 'waiting_admin', answered => 'waiting_customer',
5454 closed => 'closed' },
5555 # For a filter like `?status=waiting_admin`, translate back to PT's
5656 # native value before the SQL clause.
5757 status_reverse => { open => 'open', waiting_admin => 'open',
5858 waiting_customer => 'answered',
5959 resolved => 'closed', closed => 'closed' },
6060);
6161my %SITE_ADAPTER = (
6262 webstls => \%STANDARD_ADAPTER,
6363 affsoft => \%STANDARD_ADAPTER,
6464 shopcart => \%STANDARD_ADAPTER,
6565 repricer => \%STANDARD_ADAPTER,
6666 abforge => \%STANDARD_ADAPTER,
6767 contactforge => \%STANDARD_ADAPTER,
6868 ptmatrix => \%PTMATRIX_ADAPTER,
6969);
7070my @UNIFIED_SITES = sort keys %SITE_ADAPTER;
7171
7272sub new {
7373 my ($class) = @_;
7474 return bless({
7575 sc => MODS::MetaAdmin::SiteConn->new,
7676 cfg => MODS::MetaAdmin::Config->new,
7777 err => '',
7878 }, $class);
7979}
8080
8181sub last_error { return $_[0]->{err} || ''; }
8282
8383sub supported_slugs { return \@UNIFIED_SITES; }
8484
8585# Accessor for other modules that need to walk the per-site column mapping
8686# (e.g. MODS::MetaAdmin::AutoAck's discovery + reverify queries).
8787sub adapter_for {
8888 my ($self_or_class, $slug) = @_;
8989 return $SITE_ADAPTER{$slug};
9090}
9191
9292#---------------------------------------------------------------------
9393# list_threads({ status, days, site, limit })
9494# status: undef|'open'|'waiting_admin'|'waiting_customer'|'closed'
9595# days: integer (rolling window on last_message_at); default 90
9696# site: optional single slug to filter
9797# limit: cap per site (default 100)
9898#
9999# Returns arrayref of { slug, display_name, brand_color, id, subject,
100100# status, priority, admin_unread, customer_unread, created_at,
101101# last_message_at, customer_email, customer_name, preview }.
102102# Sorted by last_message_at DESC across ALL sites.
103103#---------------------------------------------------------------------
104104sub list_threads {
105105 my ($self, %a) = @_;
106106 my $days = ($a{days} && $a{days} =~ /^\d+$/) ? $a{days} : 90;
107107 my $status = defined($a{status}) ? $a{status} : '';
108108 my $limit = ($a{limit} && $a{limit} =~ /^\d+$/) ? $a{limit} : 100;
109109 my $only = $a{site} || '';
110110
111111 my $sites = $self->{sc}->list_sites(active => 1);
112112 my @out;
113113 foreach my $srow (@$sites) {
114114 my $slug = $srow->{slug} or next;
115115 my $ad = $SITE_ADAPTER{$slug} or next;
116116 next if $only && $only ne $slug;
117117
118118 # Translate the requested status filter into the site's native
119119 # enum via its status_reverse map.
120120 my $st_clause = '';
121121 if ($status eq 'unresolved') {
122122 # Anything the admin still owes a reply on -- native mapping
123123 # differs per site (standard has 2 such statuses, PT has 1).
124124 my %native;
125125 $native{$ad->{status_reverse}{open}} = 1;
126126 $native{$ad->{status_reverse}{waiting_admin}} = 1;
127127 $st_clause = "AND t.$ad->{thread_status_col} IN ("
128128 . join(',', map "'$_'", sort keys %native) . ')';
129129 } elsif ($status && exists $ad->{status_reverse}{$status}) {
130130 my $native = $ad->{status_reverse}{$status};
131131 $st_clause = "AND t.$ad->{thread_status_col} = '$native'";
132132 }
133133
134134 # Preview = first 200 chars of the latest message on each thread.
135135 my $sql = qq~
136136 SELECT t.id, t.subject, t.$ad->{thread_status_col} AS status,
137137 $ad->{thread_extra_cols},
138138 t.$ad->{thread_admin_unread} AS admin_unread,
139139 t.$ad->{thread_cust_unread} AS customer_unread,
140140 t.created_at, t.last_message_at,
141141 UNIX_TIMESTAMP(t.created_at) AS created_epoch,
142142 UNIX_TIMESTAMP(t.last_message_at) AS last_message_epoch,
143143 u.email AS customer_email,
144144 u.display_name AS customer_name,
145145 (SELECT LEFT(m.body, 200) FROM support_messages m
146146 WHERE m.thread_id = t.id
147147 ORDER BY m.id DESC LIMIT 1) AS preview,
148148 (SELECT m.$ad->{message_sender_col} FROM support_messages m
149149 WHERE m.thread_id = t.id
150150 ORDER BY m.id DESC LIMIT 1) AS last_sender
151151 FROM support_threads t
152152 LEFT JOIN users u ON u.id = t.$ad->{thread_customer_col}
153153 WHERE (t.last_message_at IS NULL
154154 OR t.last_message_at >= DATE_SUB(NOW(), INTERVAL $days DAY))
155155 $st_clause
156156 ORDER BY t.last_message_at DESC, t.id DESC
157157 LIMIT $limit
158158 ~;
159159
160160 my $rows = $self->{sc}->query_many($slug, $sql) || [];
161161 foreach my $r (@$rows) {
162162 $r->{slug} = $slug;
163163 $r->{display_name} = $srow->{display_name};
164164 $r->{brand_color} = $srow->{brand_color} || '#807aa8';
165165 $r->{display_url} = $srow->{display_url} || '';
166166 $r->{preview} //= '';
167167 $r->{preview} =~ s/\s+/ /g;
168168 $r->{preview} = substr($r->{preview}, 0, 140);
169169 # Normalize native status → standard name for the UI pill CSS.
170170 $r->{status_native} = $r->{status};
171171 $r->{status} = $ad->{status_map}{$r->{status}} || $r->{status};
172172 push @out, $r;
173173 }
174174 }
175175
176176 # Merge sort by last_message_at DESC (empty string sorts last)
177177 @out = sort {
178178 ($b->{last_message_at} || '') cmp ($a->{last_message_at} || '')
179179 } @out;
180180 return \@out;
181181}
182182
183183#---------------------------------------------------------------------
184184# get_thread($slug, $thread_id) -> { thread => {..}, messages => [..] }
185185# Undef on missing / unsupported / DB error.
186186#---------------------------------------------------------------------
187187sub get_thread {
188188 my ($self, $slug, $tid) = @_;
189189 $tid = int($tid || 0);
190190 return undef unless $tid > 0;
191191 my $ad = $SITE_ADAPTER{$slug} or return undef;
192192
193193 my $srow = $self->{sc}->row_for_slug($slug) or do {
194194 $self->{err} = "unknown site: $slug"; return undef;
195195 };
196196 my $sites = $self->{sc}->list_sites(active => 1);
197197 my ($site_meta) = grep { $_->{slug} eq $slug } @$sites;
198198
199199 my $tsql = qq~
200200 SELECT t.id, t.subject, t.created_at, t.last_message_at,
201201 UNIX_TIMESTAMP(t.created_at) AS created_epoch,
202202 UNIX_TIMESTAMP(t.last_message_at) AS last_message_epoch,
203203 t.$ad->{thread_status_col} AS status,
204204 t.$ad->{thread_admin_unread} AS admin_unread,
205205 t.$ad->{thread_cust_unread} AS customer_unread,
206206 $ad->{thread_extra_cols},
207207 t.$ad->{thread_customer_col} AS customer_user_id,
208208 u.email AS customer_email,
209209 u.display_name AS customer_name
210210 FROM support_threads t
211211 LEFT JOIN users u ON u.id = t.$ad->{thread_customer_col}
212212 WHERE t.id = $tid
213213 LIMIT 1
214214 ~;
215215 my $thread = $self->{sc}->query_one($slug, $tsql);
216216 unless ($thread) {
217217 $self->{err} = 'thread not found';
218218 return undef;
219219 }
220220 $thread->{slug} = $slug;
221221 $thread->{display_name} = $site_meta ? $site_meta->{display_name} : $slug;
222222 $thread->{brand_color} = $site_meta ? $site_meta->{brand_color} : '#807aa8';
223223 $thread->{display_url} = $site_meta ? $site_meta->{display_url} : '';
224224 $thread->{status_native} = $thread->{status};
225225 $thread->{status} = $ad->{status_map}{$thread->{status}} || $thread->{status};
226226
227227 # Sender kind normalization: PT uses 'user' -> we render as 'customer'.
228228 my $msql = qq~
229229 SELECT m.id, m.thread_id, m.sender_user_id,
230230 m.$ad->{message_sender_col} AS sender_role,
231231 m.body, m.created_at,
232232 UNIX_TIMESTAMP(m.created_at) AS created_epoch,
233233 u.email AS sender_email,
234234 u.display_name AS sender_name
235235 FROM support_messages m
236236 LEFT JOIN users u ON u.id = m.sender_user_id
237237 WHERE m.thread_id = $tid
238238 ORDER BY m.id ASC
239239 ~;
240240 my $msgs = $self->{sc}->query_many($slug, $msql) || [];
241241 foreach my $m (@$msgs) {
242242 $m->{sender_role} = 'customer' if $m->{sender_role} eq 'user';
243243 }
244244
245245 return { thread => $thread, messages => $msgs };
246246}
247247
248248#---------------------------------------------------------------------
249249# post_reply($slug, $thread_id, $body) -> ($ok, $error_or_message_id)
250250#
251251# HMAC-signs the payload and POSTs to https://<site>/support_meta_send.cgi.
252252# The site's endpoint verifies the signature and calls its own
253253# Support::send_message -- so unread flags, status flips and
254254# last_message_at bookkeeping all happen the same way as a native reply.
255255#---------------------------------------------------------------------
256256sub post_reply {
257257 my ($self, $slug, $tid, $body) = @_;
258258 $tid = int($tid || 0);
259259 $body //= '';
260260 return (0, 'missing_thread_id') unless $tid > 0;
261261 return (0, 'empty_body') unless length $body;
262262 return (0, 'unsupported_site') unless exists $SITE_ADAPTER{$slug};
263263
264264 my $sites = $self->{sc}->list_sites(active => 1);
265265 my ($site_meta) = grep { $_->{slug} eq $slug } @$sites;
266266 unless ($site_meta && $site_meta->{display_url}) {
267267 return (0, 'no_display_url_for_site');
268268 }
269269 my $url = $site_meta->{display_url};
270270 $url =~ s{/$}{};
271271 $url .= '/support_meta_send.cgi';
272272
273273 my $secret = $self->{cfg}->settings('meta_admin_hmac_secret') || '';
274274 return (0, 'no_local_secret') unless length($secret) >= 32;
275275
276276 my $ts = time;
277277 my $body_hash = sha256_hex($body);
278278 my $sig = hmac_sha256_hex("$ts.$tid.$body_hash", $secret);
279279
280280 my $json = encode_json({ ts => $ts + 0, thread_id => $tid + 0, body => $body });
281281
282282 # Shell out to curl -- LWP::Protocol::https isn't installed on this box
283283 # and curl is universally present on Plesk servers. Pipe JSON via stdin
284284 # so it never appears in the process arg list (safer than -d '...' for
285285 # bodies that could contain shell metacharacters).
286286 my $url_q = $url; $url_q =~ s/'/'\\''/g;
287287 my $sig_q = $sig; $sig_q =~ s/'/'\\''/g;
288288 my $cmd = "curl -sS -X POST --max-time 15 --data-binary \@- "
289289 . "-H 'Content-Type: application/json' "
290290 . "-H 'X-Meta-Sig: $sig_q' "
291291 . "-w '\\n__STATUS__%{http_code}' "
292292 . "'$url_q'";
293293
294294 my $out = eval {
295295 require IPC::Open2;
296296 my ($rdr, $wtr);
297297 my $child = IPC::Open2::open2($rdr, $wtr, $cmd);
298298 print $wtr $json;
299299 close $wtr;
300300 local $/;
301301 my $r = <$rdr>;
302302 close $rdr;
303303 waitpid($child, 0);
304304 $r;
305305 };
306306 if ($@ || !defined $out) {
307307 return (0, 'curl_pipe_failed: ' . ($@ || 'no output'));
308308 }
309309
310310 my $http_code = 0;
311311 if ($out =~ s/\n__STATUS__(\d+)\s*$//s) { $http_code = $1 + 0; }
312312
313313 my $body_out = eval { decode_json($out || '{}') } || {};
314314 if ($http_code == 200 && $body_out->{ok}) {
315315 return (1, $body_out->{message_id} || 0);
316316 }
317317 my $why = $body_out->{error} || "http_$http_code";
318318 return (0, $why);
319319}
320320
3213211;