Diff -- /var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/MetaAdmin/CannedReplies.pm
Diff
/var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/MetaAdmin/CannedReplies.pm
added on local at 2026-07-10 14:01:50
Added
+242
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to acc10f1016a2
to acc10f1016a2
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.| 1 | package MODS::MetaAdmin::CannedReplies; | |
| 2 | #====================================================================== | |
| 3 | # Meta-Admin -- canned support-reply templates. | |
| 4 | # | |
| 5 | # Operator picks a template from a dropdown on the /support.cgi thread | |
| 6 | # detail; body is server-side token-expanded against thread context and | |
| 7 | # dropped into the reply textarea (still editable before send). | |
| 8 | # | |
| 9 | # Templates live in Meta-Admin's own DB (canned_templates table). Auto- | |
| 10 | # ack (scheduled fire) will read from the same table later. | |
| 11 | # | |
| 12 | # Supported merge tokens (see also the SQL migration file header): | |
| 13 | # {customer_name}, {customer_first}, {customer_email}, | |
| 14 | # {subject}, {site_name}, {days_since_open}, | |
| 15 | # {other_open_thread_count}, {other_open_thread_subjects} | |
| 16 | #====================================================================== | |
| 17 | use strict; | |
| 18 | use warnings; | |
| 19 | use MODS::DBConnect; | |
| 20 | use MODS::MetaAdmin::SiteConn; | |
| 21 | ||
| 22 | sub new { | |
| 23 | my ($class) = @_; | |
| 24 | return bless({ | |
| 25 | db => MODS::DBConnect->new, | |
| 26 | sc => MODS::MetaAdmin::SiteConn->new, | |
| 27 | err => '', | |
| 28 | }, $class); | |
| 29 | } | |
| 30 | ||
| 31 | sub last_error { return $_[0]->{err} || ''; } | |
| 32 | ||
| 33 | #--------------------------------------------------------------------- | |
| 34 | # list({ active_only }) -> arrayref of { id, name, description, body, | |
| 35 | # sort_order, is_active, | |
| 36 | # created_at, updated_at } | |
| 37 | #--------------------------------------------------------------------- | |
| 38 | sub list { | |
| 39 | my ($self, %a) = @_; | |
| 40 | my $active_only = exists $a{active_only} ? $a{active_only} : 0; | |
| 41 | my $where = $active_only ? 'WHERE is_active=1' : ''; | |
| 42 | my $dbh = $self->{db}->db_connect; | |
| 43 | return [] unless $dbh; | |
| 44 | my @rows = $self->{db}->db_readwrite_multiple($dbh, qq~ | |
| 45 | SELECT id, name, description, body, sort_order, is_active, | |
| 46 | created_at, updated_at | |
| 47 | FROM canned_templates | |
| 48 | $where | |
| 49 | ORDER BY sort_order, id | |
| 50 | ~, __FILE__, __LINE__); | |
| 51 | $self->{db}->db_disconnect($dbh); | |
| 52 | return \@rows; | |
| 53 | } | |
| 54 | ||
| 55 | #--------------------------------------------------------------------- | |
| 56 | # get($id) -> single row hashref or undef | |
| 57 | #--------------------------------------------------------------------- | |
| 58 | sub get { | |
| 59 | my ($self, $id) = @_; | |
| 60 | $id = int($id || 0); | |
| 61 | return undef unless $id > 0; | |
| 62 | my $dbh = $self->{db}->db_connect; | |
| 63 | return undef unless $dbh; | |
| 64 | my $r = $self->{db}->db_readwrite($dbh, qq~ | |
| 65 | SELECT id, name, description, body, sort_order, is_active, | |
| 66 | created_at, updated_at | |
| 67 | FROM canned_templates | |
| 68 | WHERE id = $id | |
| 69 | LIMIT 1 | |
| 70 | ~, __FILE__, __LINE__); | |
| 71 | $self->{db}->db_disconnect($dbh); | |
| 72 | return $r; | |
| 73 | } | |
| 74 | ||
| 75 | #--------------------------------------------------------------------- | |
| 76 | # save({ id?, name, description, body, sort_order, is_active }) | |
| 77 | # id omitted -> insert; id set -> update. | |
| 78 | # Returns the id on success, undef on failure. | |
| 79 | #--------------------------------------------------------------------- | |
| 80 | sub save { | |
| 81 | my ($self, %a) = @_; | |
| 82 | my $id = int($a{id} || 0); | |
| 83 | my $name = defined $a{name} ? $a{name} : ''; | |
| 84 | my $desc = defined $a{description} ? $a{description} : ''; | |
| 85 | my $body = defined $a{body} ? $a{body} : ''; | |
| 86 | my $sort_ord = int($a{sort_order} || 100); | |
| 87 | my $active = ($a{is_active} // 1) ? 1 : 0; | |
| 88 | ||
| 89 | unless (length $name && length $body) { | |
| 90 | $self->{err} = 'name and body are required'; | |
| 91 | return undef; | |
| 92 | } | |
| 93 | ||
| 94 | my $dbh = $self->{db}->db_connect; | |
| 95 | return undef unless $dbh; | |
| 96 | my $name_q = $dbh->quote($name); | |
| 97 | my $desc_q = $dbh->quote($desc); | |
| 98 | my $body_q = $dbh->quote($body); | |
| 99 | ||
| 100 | if ($id > 0) { | |
| 101 | $self->{db}->db_readwrite($dbh, qq~ | |
| 102 | UPDATE canned_templates | |
| 103 | SET name = $name_q, | |
| 104 | description = $desc_q, | |
| 105 | body = $body_q, | |
| 106 | sort_order = $sort_ord, | |
| 107 | is_active = $active | |
| 108 | WHERE id = $id | |
| 109 | LIMIT 1 | |
| 110 | ~, __FILE__, __LINE__); | |
| 111 | } else { | |
| 112 | $self->{db}->db_readwrite($dbh, qq~ | |
| 113 | INSERT INTO canned_templates | |
| 114 | (name, description, body, sort_order, is_active, created_at) | |
| 115 | VALUES | |
| 116 | ($name_q, $desc_q, $body_q, $sort_ord, $active, NOW()) | |
| 117 | ~, __FILE__, __LINE__); | |
| 118 | my $r = $self->{db}->db_readwrite($dbh, | |
| 119 | "SELECT LAST_INSERT_ID() AS id", __FILE__, __LINE__); | |
| 120 | $id = $r && $r->{id} ? $r->{id} : 0; | |
| 121 | } | |
| 122 | $self->{db}->db_disconnect($dbh); | |
| 123 | return $id; | |
| 124 | } | |
| 125 | ||
| 126 | #--------------------------------------------------------------------- | |
| 127 | # toggle_active($id) -> flips is_active. Returns 1/0. | |
| 128 | #--------------------------------------------------------------------- | |
| 129 | sub toggle_active { | |
| 130 | my ($self, $id) = @_; | |
| 131 | $id = int($id || 0); | |
| 132 | return 0 unless $id > 0; | |
| 133 | my $dbh = $self->{db}->db_connect; | |
| 134 | return 0 unless $dbh; | |
| 135 | $self->{db}->db_readwrite($dbh, qq~ | |
| 136 | UPDATE canned_templates SET is_active = 1 - is_active | |
| 137 | WHERE id = $id LIMIT 1 | |
| 138 | ~, __FILE__, __LINE__); | |
| 139 | $self->{db}->db_disconnect($dbh); | |
| 140 | return 1; | |
| 141 | } | |
| 142 | ||
| 143 | #--------------------------------------------------------------------- | |
| 144 | # thread_context($thread_hashref) -> hashref of expansion values. | |
| 145 | # Feed it the {thread => ..} half of MODS::MetaAdmin::SupportInbox::get_thread | |
| 146 | # plus (optionally) the messages array. Handles the {other_open_thread_*} | |
| 147 | # lookup by re-querying the site for the customer's other open threads. | |
| 148 | #--------------------------------------------------------------------- | |
| 149 | sub thread_context { | |
| 150 | my ($self, $thread) = @_; | |
| 151 | my %ctx = ( | |
| 152 | customer_name => '', | |
| 153 | customer_first => '', | |
| 154 | customer_email => '', | |
| 155 | subject => '', | |
| 156 | site_name => '', | |
| 157 | days_since_open => 0, | |
| 158 | other_open_thread_count => 0, | |
| 159 | other_open_thread_subjects => '', | |
| 160 | ); | |
| 161 | return \%ctx unless $thread && ref $thread eq 'HASH'; | |
| 162 | ||
| 163 | $ctx{customer_email} = $thread->{customer_email} || ''; | |
| 164 | my $name = $thread->{customer_name} || $thread->{customer_email} || ''; | |
| 165 | # Strip anything after " (" (like "Shawn (Platform Owner)") | |
| 166 | $name =~ s/\s*\(.*//; | |
| 167 | $ctx{customer_name} = $name; | |
| 168 | my ($first) = split(/\s+/, $name); | |
| 169 | $ctx{customer_first} = $first || $name; | |
| 170 | ||
| 171 | $ctx{subject} = $thread->{subject} || ''; | |
| 172 | $ctx{site_name} = $thread->{display_name} || $thread->{slug} || ''; | |
| 173 | ||
| 174 | # Days since opened | |
| 175 | if ($thread->{created_at} && $thread->{created_at} =~ /^(\d{4})-(\d{2})-(\d{2})/) { | |
| 176 | require Time::Local; | |
| 177 | my $epoch = eval { Time::Local::timelocal(0, 0, 0, $3, $2 - 1, $1 - 1900) } || 0; | |
| 178 | $ctx{days_since_open} = $epoch ? int((time - $epoch) / 86400) : 0; | |
| 179 | } | |
| 180 | ||
| 181 | # Other open threads by same customer on the same site. | |
| 182 | my $slug = $thread->{slug} || ''; | |
| 183 | my $tid = int($thread->{id} || 0); | |
| 184 | my $cust = int($thread->{customer_user_id} || 0); | |
| 185 | if ($slug && $tid && $cust) { | |
| 186 | # Column names differ per site (opened_by_user_id on PT vs | |
| 187 | # customer_user_id elsewhere) -- ask SupportInbox for the adapter. | |
| 188 | require MODS::MetaAdmin::SupportInbox; | |
| 189 | # We don't want to instantiate SupportInbox just to peek at the | |
| 190 | # adapter table, so read the columns via a defensive query that | |
| 191 | # handles both column names. Simplest: try customer_user_id first, | |
| 192 | # fall back to opened_by_user_id. | |
| 193 | my $rows = $self->{sc}->query_many($slug, qq~ | |
| 194 | SELECT id, subject | |
| 195 | FROM support_threads | |
| 196 | WHERE id != $tid | |
| 197 | AND status IN ('open','waiting_admin','waiting_customer','answered') | |
| 198 | AND (customer_user_id = $cust | |
| 199 | OR opened_by_user_id = $cust) | |
| 200 | ORDER BY last_message_at DESC | |
| 201 | LIMIT 5 | |
| 202 | ~) || []; | |
| 203 | # Above uses OR against maybe-missing columns; sites that lack one | |
| 204 | # will error the whole query. Guard: on failure, try each column | |
| 205 | # separately. | |
| 206 | if (!@$rows && $self->{sc}->last_error) { | |
| 207 | $rows = $self->{sc}->query_many($slug, qq~ | |
| 208 | SELECT id, subject FROM support_threads | |
| 209 | WHERE id != $tid AND customer_user_id = $cust | |
| 210 | AND status IN ('open','waiting_admin','waiting_customer') | |
| 211 | ORDER BY last_message_at DESC LIMIT 5 | |
| 212 | ~) || []; | |
| 213 | } | |
| 214 | if (!@$rows) { | |
| 215 | $rows = $self->{sc}->query_many($slug, qq~ | |
| 216 | SELECT id, subject FROM support_threads | |
| 217 | WHERE id != $tid AND opened_by_user_id = $cust | |
| 218 | AND status IN ('open','answered') | |
| 219 | ORDER BY last_message_at DESC LIMIT 5 | |
| 220 | ~) || []; | |
| 221 | } | |
| 222 | $ctx{other_open_thread_count} = scalar @$rows; | |
| 223 | $ctx{other_open_thread_subjects} = join(', ', | |
| 224 | map { '"' . ($_->{subject} || '(no subject)') . '"' } @$rows); | |
| 225 | } | |
| 226 | return \%ctx; | |
| 227 | } | |
| 228 | ||
| 229 | #--------------------------------------------------------------------- | |
| 230 | # expand($body, $ctx) -> string with {token} placeholders replaced. | |
| 231 | # Unknown tokens left as-is so misspellings stay visible. | |
| 232 | #--------------------------------------------------------------------- | |
| 233 | sub expand { | |
| 234 | my ($self, $body, $ctx) = @_; | |
| 235 | return '' unless defined $body; | |
| 236 | $ctx ||= {}; | |
| 237 | my $out = $body; | |
| 238 | $out =~ s/\{([a-z_]+)\}/ exists $ctx->{$1} ? $ctx->{$1} : "{$1}" /ge; | |
| 239 | return $out; | |
| 240 | } | |
| 241 | ||
| 242 | 1; |