added on local at 2026-07-01 15:02:56
| 1 | package MODS::ContactForge::Support; | |
| 2 | #====================================================================== | |
| 3 | # ContactForge -- customer <-> platform-admin support messaging. | |
| 4 | # | |
| 5 | # Two-table model: | |
| 6 | # support_threads -- one row per conversation (ticket OR live chat) | |
| 7 | # support_messages -- one row per individual message in a thread | |
| 8 | # | |
| 9 | # `type` distinguishes async tickets ('ticket') from live chat | |
| 10 | # sessions ('chat'). Same data shape; the UI just polls faster when | |
| 11 | # `chat_started_at` is set. An admin invites a customer to chat from | |
| 12 | # any ticket; the customer accepts and we flip type='chat' and start | |
| 13 | # the chat clock. When either side ends it we set chat_ended_at and | |
| 14 | # the thread reverts to an async ticket. | |
| 15 | # | |
| 16 | # Roles: | |
| 17 | # - sender_role='customer' -- the user who opened the ticket | |
| 18 | # - sender_role='admin' -- platform admin replying (users.is_admin=1) | |
| 19 | # - sender_role='system' -- auto-generated message (e.g., "chat invitation sent") | |
| 20 | # | |
| 21 | # This module is the single source of truth for thread CRUD. Both | |
| 22 | # support.cgi (customer side) and admin_messages.cgi (admin side) | |
| 23 | # call into it, plus support_send.cgi (the shared POST handler) and | |
| 24 | # support_poll.cgi (the AJAX poll for live updates). | |
| 25 | #====================================================================== | |
| 26 | use strict; | |
| 27 | use warnings; | |
| 28 | ||
| 29 | sub new { | |
| 30 | my ($class) = @_; | |
| 31 | return bless({}, $class); | |
| 32 | } | |
| 33 | ||
| 34 | sub _esc { | |
| 35 | my $s = shift; $s = '' unless defined $s; | |
| 36 | $s =~ s/\\/\\\\/g; | |
| 37 | $s =~ s/'/''/g; | |
| 38 | return $s; | |
| 39 | } | |
| 40 | ||
| 41 | sub _intify { | |
| 42 | my $n = shift; $n = '' unless defined $n; | |
| 43 | $n =~ s/[^0-9]//g; | |
| 44 | return $n; | |
| 45 | } | |
| 46 | ||
| 47 | #------------------------------------------------------------------- | |
| 48 | # create_thread: customer opens a new support thread. | |
| 49 | # args: { user_id, subject, body, priority? } | |
| 50 | # returns thread_id on success, undef on failure. | |
| 51 | #------------------------------------------------------------------- | |
| 52 | sub create_thread { | |
| 53 | my ($self, $db, $dbh, $DB, $args) = @_; | |
| 54 | my $uid = _intify($args->{user_id}); | |
| 55 | return undef unless $uid; | |
| 56 | ||
| 57 | my $subject = $args->{subject} || 'Support request'; | |
| 58 | $subject = substr($subject, 0, 200); | |
| 59 | my $body = $args->{body} || ''; | |
| 60 | return undef unless length $body; | |
| 61 | my $priority = ($args->{priority} && $args->{priority} =~ /^(low|normal|high|urgent)$/) | |
| 62 | ? $args->{priority} : 'normal'; | |
| 63 | ||
| 64 | my $subj_sql = _esc($subject); | |
| 65 | my $body_sql = _esc($body); | |
| 66 | ||
| 67 | # Create the thread first. admin_unread=1 because a brand-new | |
| 68 | # ticket counts as one unread item from the admin's perspective. | |
| 69 | $db->db_readwrite($dbh, qq~ | |
| 70 | INSERT INTO `${DB}`.support_threads SET | |
| 71 | customer_user_id = '$uid', | |
| 72 | type = 'ticket', | |
| 73 | status = 'waiting_admin', | |
| 74 | subject = '$subj_sql', | |
| 75 | priority = '$priority', | |
| 76 | customer_unread = 0, | |
| 77 | admin_unread = 1, | |
| 78 | created_at = NOW(), | |
| 79 | last_message_at = NOW() | |
| 80 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 81 | ||
| 82 | my $row = $db->db_readwrite($dbh, | |
| 83 | qq~SELECT id FROM `${DB}`.support_threads | |
| 84 | WHERE customer_user_id='$uid' ORDER BY id DESC LIMIT 1~, | |
| 85 | $ENV{SCRIPT_NAME}, __LINE__); | |
| 86 | my $tid = ($row && $row->{id}) ? $row->{id} : 0; | |
| 87 | return undef unless $tid; | |
| 88 | ||
| 89 | # Drop the customer's opening message in. | |
| 90 | $db->db_readwrite($dbh, qq~ | |
| 91 | INSERT INTO `${DB}`.support_messages SET | |
| 92 | thread_id = '$tid', | |
| 93 | sender_role = 'customer', | |
| 94 | sender_user_id = '$uid', | |
| 95 | body = '$body_sql' | |
| 96 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 97 | ||
| 98 | return $tid; | |
| 99 | } | |
| 100 | ||
| 101 | #------------------------------------------------------------------- | |
| 102 | # send_message: append a message to an existing thread. | |
| 103 | # args: { thread_id, sender_role, sender_user_id, body } | |
| 104 | # sender_role must be 'customer' | 'admin' | 'system'. The unread | |
| 105 | # counters on the thread get bumped on the OPPOSITE side -- a | |
| 106 | # customer message bumps admin_unread, an admin message bumps | |
| 107 | # customer_unread, system messages bump both so each side sees the | |
| 108 | # notification. | |
| 109 | #------------------------------------------------------------------- | |
| 110 | sub send_message { | |
| 111 | my ($self, $db, $dbh, $DB, $args) = @_; | |
| 112 | my $tid = _intify($args->{thread_id}); | |
| 113 | my $sender_role = lc($args->{sender_role} || ''); | |
| 114 | my $sender_uid = _intify($args->{sender_user_id}); | |
| 115 | my $body = $args->{body} || ''; | |
| 116 | return undef unless $tid && $sender_role =~ /^(customer|admin|system)$/ && length $body; | |
| 117 | ||
| 118 | my $body_sql = _esc($body); | |
| 119 | my $sender_sql = $sender_uid ? "'$sender_uid'" : 'NULL'; | |
| 120 | $db->db_readwrite($dbh, qq~ | |
| 121 | INSERT INTO `${DB}`.support_messages SET | |
| 122 | thread_id = '$tid', | |
| 123 | sender_role = '$sender_role', | |
| 124 | sender_user_id = $sender_sql, | |
| 125 | body = '$body_sql' | |
| 126 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 127 | ||
| 128 | # Counter + status bookkeeping on the thread row. | |
| 129 | my $bump_admin = ($sender_role eq 'customer' || $sender_role eq 'system') ? 1 : 0; | |
| 130 | my $bump_customer = ($sender_role eq 'admin' || $sender_role eq 'system') ? 1 : 0; | |
| 131 | my $new_status = | |
| 132 | ($sender_role eq 'customer') ? "'waiting_admin'" | |
| 133 | : ($sender_role eq 'admin') ? "'waiting_customer'" | |
| 134 | : "status"; # 'system' doesn't change status | |
| 135 | $db->db_readwrite($dbh, qq~ | |
| 136 | UPDATE `${DB}`.support_threads | |
| 137 | SET last_message_at = NOW(), | |
| 138 | admin_unread = admin_unread + $bump_admin, | |
| 139 | customer_unread = customer_unread + $bump_customer, | |
| 140 | status = $new_status | |
| 141 | WHERE id = '$tid' | |
| 142 | LIMIT 1 | |
| 143 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 144 | ||
| 145 | # Return the new message id so callers can echo it back to the | |
| 146 | # poll endpoint as `last_seen_id`. | |
| 147 | my $row = $db->db_readwrite($dbh, | |
| 148 | qq~SELECT id FROM `${DB}`.support_messages | |
| 149 | WHERE thread_id='$tid' ORDER BY id DESC LIMIT 1~, | |
| 150 | $ENV{SCRIPT_NAME}, __LINE__); | |
| 151 | return ($row && $row->{id}) ? $row->{id} : 0; | |
| 152 | } | |
| 153 | ||
| 154 | #------------------------------------------------------------------- | |
| 155 | # load_thread: full thread row + ownership check. | |
| 156 | # Returns the thread hashref (undef if missing). | |
| 157 | #------------------------------------------------------------------- | |
| 158 | sub load_thread { | |
| 159 | my ($self, $db, $dbh, $DB, $tid) = @_; | |
| 160 | $tid = _intify($tid); return undef unless $tid; | |
| 161 | return $db->db_readwrite($dbh, | |
| 162 | qq~SELECT * FROM `${DB}`.support_threads WHERE id='$tid' LIMIT 1~, | |
| 163 | $ENV{SCRIPT_NAME}, __LINE__); | |
| 164 | } | |
| 165 | ||
| 166 | #------------------------------------------------------------------- | |
| 167 | # load_messages: every message in a thread, oldest -> newest. Optional | |
| 168 | # `since_id` returns only messages with id > N (used by the AJAX poll). | |
| 169 | #------------------------------------------------------------------- | |
| 170 | sub load_messages { | |
| 171 | my ($self, $db, $dbh, $DB, $tid, $since_id) = @_; | |
| 172 | $tid = _intify($tid); return [] unless $tid; | |
| 173 | $since_id = _intify($since_id); | |
| 174 | my $since_clause = $since_id ? "AND id > '$since_id'" : ''; | |
| 175 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 176 | SELECT m.id, m.thread_id, m.sender_role, m.sender_user_id, | |
| 177 | m.body, m.created_at, | |
| 178 | u.display_name AS sender_name, u.email AS sender_email | |
| 179 | FROM `${DB}`.support_messages m | |
| 180 | LEFT JOIN `${DB}`.users u ON u.id = m.sender_user_id | |
| 181 | WHERE m.thread_id = '$tid' $since_clause | |
| 182 | ORDER BY m.id ASC | |
| 183 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 184 | return \@rows; | |
| 185 | } | |
| 186 | ||
| 187 | #------------------------------------------------------------------- | |
| 188 | # list_threads_for_admin: every thread on the platform, with most- | |
| 189 | # recent message at top. Supports a `status` filter. | |
| 190 | #------------------------------------------------------------------- | |
| 191 | sub list_threads_for_admin { | |
| 192 | my ($self, $db, $dbh, $DB, $args) = @_; | |
| 193 | my $status = $args->{status} || ''; | |
| 194 | $status =~ s/[^a-z_]//g; | |
| 195 | my $where = '1=1'; | |
| 196 | if ($status && $status =~ /^(open|waiting_admin|waiting_customer|resolved|closed)$/) { | |
| 197 | $where .= " AND t.status='$status'"; | |
| 198 | } | |
| 199 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 200 | SELECT t.id, t.customer_user_id, t.type, t.status, t.subject, | |
| 201 | t.priority, t.assigned_admin_id, t.chat_invited_at, | |
| 202 | t.chat_started_at, t.chat_ended_at, t.admin_unread, | |
| 203 | t.customer_unread, t.created_at, t.last_message_at, | |
| 204 | u.display_name AS customer_name, u.email AS customer_email | |
| 205 | FROM `${DB}`.support_threads t | |
| 206 | JOIN `${DB}`.users u ON u.id = t.customer_user_id | |
| 207 | WHERE $where | |
| 208 | ORDER BY (t.admin_unread > 0) DESC, | |
| 209 | t.last_message_at DESC, | |
| 210 | t.id DESC | |
| 211 | LIMIT 200 | |
| 212 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 213 | return \@rows; | |
| 214 | } | |
| 215 | ||
| 216 | #------------------------------------------------------------------- | |
| 217 | # list_threads_for_customer: this customer's own threads. | |
| 218 | #------------------------------------------------------------------- | |
| 219 | sub list_threads_for_customer { | |
| 220 | my ($self, $db, $dbh, $DB, $uid) = @_; | |
| 221 | $uid = _intify($uid); return [] unless $uid; | |
| 222 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 223 | SELECT id, type, status, subject, priority, chat_invited_at, | |
| 224 | chat_started_at, chat_ended_at, customer_unread, | |
| 225 | created_at, last_message_at | |
| 226 | FROM `${DB}`.support_threads | |
| 227 | WHERE customer_user_id='$uid' | |
| 228 | ORDER BY last_message_at DESC, id DESC | |
| 229 | LIMIT 50 | |
| 230 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 231 | return \@rows; | |
| 232 | } | |
| 233 | ||
| 234 | #------------------------------------------------------------------- | |
| 235 | # mark_read: zero out unread counter on a side after they view the | |
| 236 | # thread. side is 'customer' or 'admin'. | |
| 237 | #------------------------------------------------------------------- | |
| 238 | sub mark_read { | |
| 239 | my ($self, $db, $dbh, $DB, $tid, $side) = @_; | |
| 240 | $tid = _intify($tid); return unless $tid; | |
| 241 | my $col = ($side eq 'admin') ? 'admin_unread' : 'customer_unread'; | |
| 242 | $db->db_readwrite($dbh, | |
| 243 | qq~UPDATE `${DB}`.support_threads SET $col=0 WHERE id='$tid' LIMIT 1~, | |
| 244 | $ENV{SCRIPT_NAME}, __LINE__); | |
| 245 | } | |
| 246 | ||
| 247 | #------------------------------------------------------------------- | |
| 248 | # unread_counts_for_admin: total threads with admin_unread>0. Used by | |
| 249 | # the sidebar badge. | |
| 250 | #------------------------------------------------------------------- | |
| 251 | sub unread_counts_for_admin { | |
| 252 | my ($self, $db, $dbh, $DB) = @_; | |
| 253 | my $r = $db->db_readwrite($dbh, | |
| 254 | qq~SELECT COUNT(*) AS n FROM `${DB}`.support_threads WHERE admin_unread > 0~, | |
| 255 | $ENV{SCRIPT_NAME}, __LINE__); | |
| 256 | return ($r && $r->{n}) ? $r->{n} : 0; | |
| 257 | } | |
| 258 | ||
| 259 | sub unread_counts_for_customer { | |
| 260 | my ($self, $db, $dbh, $DB, $uid) = @_; | |
| 261 | $uid = _intify($uid); return 0 unless $uid; | |
| 262 | my $r = $db->db_readwrite($dbh, | |
| 263 | qq~SELECT COUNT(*) AS n FROM `${DB}`.support_threads | |
| 264 | WHERE customer_user_id='$uid' AND customer_unread > 0~, | |
| 265 | $ENV{SCRIPT_NAME}, __LINE__); | |
| 266 | return ($r && $r->{n}) ? $r->{n} : 0; | |
| 267 | } | |
| 268 | ||
| 269 | #------------------------------------------------------------------- | |
| 270 | # invite_to_chat / accept_chat / end_chat: live-chat lifecycle. | |
| 271 | # An admin can invite a customer to upgrade a ticket thread to live | |
| 272 | # chat. The customer either accepts (chat_started_at is set, type | |
| 273 | # flips to 'chat') or ignores it. Either side can end an active chat, | |
| 274 | # which clears chat_started_at and stamps chat_ended_at -- the thread | |
| 275 | # reverts to an async ticket but keeps the chat transcript inline. | |
| 276 | #------------------------------------------------------------------- | |
| 277 | sub invite_to_chat { | |
| 278 | my ($self, $db, $dbh, $DB, $tid, $admin_uid) = @_; | |
| 279 | $tid = _intify($tid); return 0 unless $tid; | |
| 280 | $admin_uid = _intify($admin_uid); | |
| 281 | $db->db_readwrite($dbh, qq~ | |
| 282 | UPDATE `${DB}`.support_threads | |
| 283 | SET chat_invited_at = NOW(), | |
| 284 | assigned_admin_id = '$admin_uid' | |
| 285 | WHERE id='$tid' LIMIT 1 | |
| 286 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 287 | # System message in the thread tells the customer about the invite. | |
| 288 | $self->send_message($db, $dbh, $DB, { | |
| 289 | thread_id => $tid, | |
| 290 | sender_role => 'system', | |
| 291 | body => 'The support team has invited you to a live chat. ' | |
| 292 | . 'Accept to start chatting in real time, or keep replying ' | |
| 293 | . 'here for an async ticket.', | |
| 294 | }); | |
| 295 | return 1; | |
| 296 | } | |
| 297 | ||
| 298 | sub accept_chat { | |
| 299 | my ($self, $db, $dbh, $DB, $tid) = @_; | |
| 300 | $tid = _intify($tid); return 0 unless $tid; | |
| 301 | $db->db_readwrite($dbh, qq~ | |
| 302 | UPDATE `${DB}`.support_threads | |
| 303 | SET chat_started_at = NOW(), | |
| 304 | chat_ended_at = NULL, | |
| 305 | type = 'chat' | |
| 306 | WHERE id='$tid' AND chat_invited_at IS NOT NULL | |
| 307 | LIMIT 1 | |
| 308 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 309 | $self->send_message($db, $dbh, $DB, { | |
| 310 | thread_id => $tid, | |
| 311 | sender_role => 'system', | |
| 312 | body => 'Live chat started. Messages here are now delivered in real time.', | |
| 313 | }); | |
| 314 | return 1; | |
| 315 | } | |
| 316 | ||
| 317 | sub end_chat { | |
| 318 | my ($self, $db, $dbh, $DB, $tid) = @_; | |
| 319 | $tid = _intify($tid); return 0 unless $tid; | |
| 320 | $db->db_readwrite($dbh, qq~ | |
| 321 | UPDATE `${DB}`.support_threads | |
| 322 | SET chat_ended_at = NOW(), | |
| 323 | chat_started_at = NULL, | |
| 324 | type = 'ticket' | |
| 325 | WHERE id='$tid' LIMIT 1 | |
| 326 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 327 | $self->send_message($db, $dbh, $DB, { | |
| 328 | thread_id => $tid, | |
| 329 | sender_role => 'system', | |
| 330 | body => 'Live chat ended. The conversation continues here as an async ticket.', | |
| 331 | }); | |
| 332 | return 1; | |
| 333 | } | |
| 334 | ||
| 335 | #------------------------------------------------------------------- | |
| 336 | # set_status: admin-only -- change a thread's status (e.g. mark resolved). | |
| 337 | #------------------------------------------------------------------- | |
| 338 | sub set_status { | |
| 339 | my ($self, $db, $dbh, $DB, $tid, $status) = @_; | |
| 340 | $tid = _intify($tid); return 0 unless $tid; | |
| 341 | return 0 unless $status =~ /^(open|waiting_admin|waiting_customer|resolved|closed)$/; | |
| 342 | my $resolved_set = ($status eq 'resolved') ? ", resolved_at = NOW()" : ''; | |
| 343 | $db->db_readwrite($dbh, qq~ | |
| 344 | UPDATE `${DB}`.support_threads | |
| 345 | SET status = '$status' $resolved_set | |
| 346 | WHERE id='$tid' LIMIT 1 | |
| 347 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 348 | return 1; | |
| 349 | } | |
| 350 | ||
| 351 | 1; |