Diff -- /var/www/vhosts/3dshawn.com/abforge.3dshawn.com/MODS/ABForge/Tracking.pm
Diff

/var/www/vhosts/3dshawn.com/abforge.3dshawn.com/MODS/ABForge/Tracking.pm

added on local at 2026-07-06 01:16:31

Added
+2497
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 4308315f1ac8
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::ABForge::Tracking;
2#======================================================================
3# ABForge - Visitor tracking, heatmaps, admin chat, link push.
4#
5# Five tables backing this module (db_schema.sql section 12.55):
6# mkt_tracking_sessions, mkt_tracking_events, mkt_support_chats,
7# mkt_support_chat_messages, mkt_support_push_links
8#
9# Public API used by:
10# /_track.cgi ingest endpoint (POST from client tracker)
11# /_track_poll.cgi long-poll endpoint (visitor pulls chat msgs +
12# queued push-links)
13# /admin_visitors.cgi live list + heatmaps + per-visitor detail
14# /admin_chat.cgi conversation list + thread
15# /admin_tracking_action.cgi send chat msg, push link, close chat,
16# set admin online status
17#
18# Schema-readiness is verified at every entry point because DBConnect's
19# error() calls exit() on a missing table -- early-adopter accounts may
20# not have run the latest db_schema.sql yet.
21#======================================================================
22use strict;
23use warnings;
24
25sub new {
26 my ($class, %args) = @_;
27 return bless({}, $class);
28}
29
30# ---- Schema readiness ------------------------------------------------
31sub schema_ready {
32 my ($self, $db, $dbh, $DB) = @_;
33 foreach my $t (qw(mkt_tracking_sessions mkt_tracking_events mkt_support_chats mkt_support_chat_messages mkt_support_push_links)) {
34 my $r = $db->db_readwrite($dbh, qq~
35 SELECT COUNT(*) AS n FROM information_schema.tables
36 WHERE table_schema='$DB' AND table_name='$t'
37 ~, $ENV{SCRIPT_NAME}, __LINE__);
38 return 0 unless ($r && $r->{n});
39 }
40 return 1;
41}
42
43# Cheap process-scoped check for whether a column exists on a table.
44# Cached per-process so we don't hit information_schema on every event
45# write. Used to guard new columns rolled out ahead of the user's ALTER.
46my %_COL_CACHE;
47sub _has_column {
48 my ($self, $db, $dbh, $DB, $table, $col) = @_;
49 my $k = "$DB.$table.$col";
50 return $_COL_CACHE{$k} if exists $_COL_CACHE{$k};
51 my $r = $db->db_readwrite($dbh, qq~
52 SELECT COUNT(*) AS n FROM information_schema.columns
53 WHERE table_schema='$DB' AND table_name='$table' AND column_name='$col'
54 ~, $ENV{SCRIPT_NAME}, __LINE__);
55 return $_COL_CACHE{$k} = ($r && $r->{n}) ? 1 : 0;
56}
57
58# ---- Session lookup / create ----------------------------------------
59# Find a session by token (UUID set on the visitor cookie). Returns
60# the row hashref or undef.
61sub session_by_token {
62 my ($self, $db, $dbh, $DB, $token) = @_;
63 return undef unless $token;
64 $token =~ s/[^a-f0-9-]//g;
65 return undef unless length $token == 36;
66 return undef unless $self->schema_ready($db, $dbh, $DB);
67 my $r = $db->db_readwrite($dbh, qq~
68 SELECT * FROM `${DB}`.mkt_tracking_sessions
69 WHERE session_token='$token' LIMIT 1
70 ~, $ENV{SCRIPT_NAME}, __LINE__);
71 return ($r && $r->{id}) ? $r : undef;
72}
73
74# Insert a new session row. Caller passes a UUID token (generated client-
75# side and stored as a cookie) plus optional fingerprint fields.
76sub create_session {
77 my ($self, $db, $dbh, $DB, %a) = @_;
78 return 0 unless $self->schema_ready($db, $dbh, $DB);
79 # --- phase5-tracking-exclusion :: 2026-07-02 ---
80 return 0 if _phase5_ip_excluded($db, $dbh, $DB);
81 my $token = $a{session_token} || '';
82 $token =~ s/[^a-f0-9-]//g;
83 return 0 unless length $token == 36;
84
85 my %f = $self->_sanitize_fingerprint(\%a);
86
87 # Visitor label is auto-generated from the row id; we set it after
88 # INSERT in a second pass since we need mysql_insertid first.
89 # Region column was added in a later migration -- write to it only
90 # when present so installs that haven't run the ALTER yet still work.
91 my $region_set = '';
92 if ($self->region_column_ready($db, $dbh, $DB)) {
93 $region_set = ", region=$f{region_q}";
94 }
95
96 # site_id linkage was added 2026-07-05 for customer-facing analytics.cgi.
97 # Guarded with _has_column so pre-migration deploys keep working.
98 my $site_set = '';
99 if (defined $a{site_id} && $a{site_id} =~ /^\d+$/ && $a{site_id} > 0
100 && $self->_has_column($db, $dbh, $DB, 'mkt_tracking_sessions', 'site_id')) {
101 $site_set = ", site_id='$a{site_id}'";
102 }
103
104 my $r = $db->db_readwrite($dbh, qq~
105 INSERT INTO `${DB}`.mkt_tracking_sessions
106 SET session_token='$token',
107 storefront_id=$f{storefront_sql},
108 buyer_account_id=$f{buyer_sql},
109 ip_address=$f{ip_sql},
110 country=$f{country_q}$region_set$site_set,
111 os_name=$f{os_name_q},
112 os_version=$f{os_version_q},
113 browser_name=$f{browser_name_q},
114 browser_version=$f{browser_version_q},
115 device_type='$f{device_type}',
116 screen_width=$f{screen_w_sql},
117 screen_height=$f{screen_h_sql},
118 viewport_width=$f{viewport_w_sql},
119 viewport_height=$f{viewport_h_sql},
120 color_depth=$f{color_depth_sql},
121 pixel_ratio=$f{pixel_ratio_sql},
122 touch_capable='$f{touch}',
123 language=$f{language_q},
124 timezone=$f{timezone_q},
125 user_agent=$f{ua_q},
126 referrer=$f{referrer_q},
127 current_page_path=$f{path_q}
128 ~, $ENV{SCRIPT_NAME}, __LINE__);
129 my $sid = ($r && $r->{mysql_insertid}) ? $r->{mysql_insertid} : 0;
130 return 0 unless $sid;
131
132 my $label = 'Visitor #' . $sid;
133 $db->db_readwrite($dbh, qq~
134 UPDATE `${DB}`.mkt_tracking_sessions
135 SET visitor_label='$label' WHERE id='$sid'
136 ~, $ENV{SCRIPT_NAME}, __LINE__);
137 return $sid;
138}
139
140# Refresh last_seen_at + current page on every event. Cheap UPDATE.
141# Tie a buyer_account row to a tracking session (called after login/signup).
142# All buyer-facing pages share the abforge_track cookie, so we look up
143# the session by token rather than the URL.
144sub link_session_to_buyer {
145 my ($self, $db, $dbh, $DB, $token, $buyer_account_id) = @_;
146 return 0 unless $token && $buyer_account_id;
147 $token =~ s/[^a-f0-9-]//g;
148 return 0 unless length $token == 36;
149 $buyer_account_id =~ s/[^0-9]//g;
150 return 0 unless $buyer_account_id;
151 return 0 unless $self->schema_ready($db, $dbh, $DB);
152 $db->db_readwrite($dbh, qq~
153 UPDATE `${DB}`.mkt_tracking_sessions
154 SET buyer_account_id='$buyer_account_id'
155 WHERE session_token='$token'
156 ~, $ENV{SCRIPT_NAME}, __LINE__);
157 return 1;
158}
159
160# Classify a session for the admin UI.
161# Returns a hashref:
162# { status: 'guest' | 'lead' | 'customer',
163# status_label: 'Guest' | 'Lead' | 'Customer',
164# email: 'jane@example.com' or '',
165# total_orders: int (paid orders by this buyer),
166# ltv_cents: int (sum of paid orders) }
167#
168# - guest = no buyer_account_id (just browsing, never signed in)
169# - lead = buyer_account_id set, but zero paid orders
170# - customer = buyer_account_id set + at least one paid order
171sub classify_session {
172 my ($self, $db, $dbh, $DB, $session_row) = @_;
173 my %out = (
174 status => 'guest',
175 status_label => 'Guest',
176 email => '',
177 total_orders => 0,
178 ltv_cents => 0,
179 );
180 return \%out unless $session_row && $session_row->{id};
181 my $bid = $session_row->{buyer_account_id};
182 return \%out unless $bid;
183
184 # Look up buyer email
185 my $b = $db->db_readwrite($dbh, qq~
186 SELECT email FROM `${DB}`.buyer_accounts WHERE id='$bid' LIMIT 1
187 ~, $ENV{SCRIPT_NAME}, __LINE__);
188 if ($b && $b->{email}) {
189 $out{email} = $b->{email};
190 }
191
192 # Count paid orders + LTV by buyer_account_id (when orders table
193 # exists; guarded to handle early-adopter installs).
194 my $has_orders = $db->db_readwrite($dbh, qq~
195 SELECT COUNT(*) AS n FROM information_schema.tables
196 WHERE table_schema='$DB' AND table_name='orders'
197 ~, $ENV{SCRIPT_NAME}, __LINE__);
198 if ($has_orders && $has_orders->{n}) {
199 my $stats = $db->db_readwrite($dbh, qq~
200 SELECT COUNT(*) AS n, COALESCE(SUM(total_amount_cents),0) AS s
201 FROM `${DB}`.orders
202 WHERE buyer_account_id='$bid' AND status='paid'
203 ~, $ENV{SCRIPT_NAME}, __LINE__);
204 $out{total_orders} = ($stats && $stats->{n}) ? $stats->{n} : 0;
205 $out{ltv_cents} = ($stats && $stats->{s}) ? $stats->{s} : 0;
206 }
207
208 if ($out{total_orders} > 0) {
209 $out{status} = 'customer';
210 $out{status_label} = 'Customer';
211 } else {
212 $out{status} = 'lead';
213 $out{status_label} = 'Lead';
214 }
215 return \%out;
216}
217
218sub heartbeat {
219 my ($self, $db, $dbh, $DB, $session_id, $page_path) = @_;
220 $session_id =~ s/[^0-9]//g;
221 return 0 unless $session_id;
222 return 0 unless $self->schema_ready($db, $dbh, $DB);
223 my $path = defined $page_path ? $page_path : '';
224 $path =~ s/'/''/g;
225 $path = substr($path, 0, 500);
226 $db->db_readwrite($dbh, qq~
227 UPDATE `${DB}`.mkt_tracking_sessions
228 SET last_seen_at=NOW(), is_online=1,
229 current_page_path='$path'
230 WHERE id='$session_id'
231 ~, $ENV{SCRIPT_NAME}, __LINE__);
232 return 1;
233}
234
235# ---- Event ingest ----------------------------------------------------
236sub log_event {
237 my ($self, $db, $dbh, $DB, %a) = @_;
238 return 0 unless $self->schema_ready($db, $dbh, $DB);
239 # --- phase5-tracking-exclusion :: 2026-07-02 ---
240 return 0 if _phase5_ip_excluded($db, $dbh, $DB);
241 my $sid = $a{session_id}; $sid =~ s/[^0-9]//g if defined $sid;
242 return 0 unless $sid;
243
244 my %type_ok = map { $_ => 1 } qw(page_view click add_to_cart purchase heatmap scroll form_submit custom);
245 my $type = $a{event_type} || 'page_view';
246 return 0 unless $type_ok{$type};
247
248 my $store = defined $a{storefront_id} ? $a{storefront_id} : '';
249 $store =~ s/[^0-9]//g;
250 my $store_sql = $store eq '' ? 'NULL' : "'$store'";
251
252 my $path = defined $a{page_path} ? $a{page_path} : '';
253 $path =~ s/'/''/g; $path = substr($path, 0, 500);
254
255 my $sel = defined $a{element_selector} ? $a{element_selector} : '';
256 $sel =~ s/'/''/g; $sel = substr($sel, 0, 500);
257 my $sel_sql = length $sel ? "'$sel'" : 'NULL';
258
259 my $x = defined $a{x_pct} ? $a{x_pct} : '';
260 $x =~ s/[^0-9.]//g;
261 my $x_sql = length $x ? "'$x'" : 'NULL';
262
263 my $y = defined $a{y_pct} ? $a{y_pct} : '';
264 $y =~ s/[^0-9.]//g;
265 my $y_sql = length $y ? "'$y'" : 'NULL';
266
267 # Element-relative offsets (fraction 0.0000-1.0000). Together with
268 # element_selector these let the heatmap stay anchored to the actual
269 # DOM element across viewport-width / reflow changes -- whereas
270 # x_pct/y_pct above only stay correct at the original viewport.
271 my $ox = defined $a{offset_x_pct} ? $a{offset_x_pct} : '';
272 $ox =~ s/[^0-9.]//g;
273 my $ox_sql = length $ox ? "'$ox'" : 'NULL';
274
275 my $oy = defined $a{offset_y_pct} ? $a{offset_y_pct} : '';
276 $oy =~ s/[^0-9.]//g;
277 my $oy_sql = length $oy ? "'$oy'" : 'NULL';
278
279 my $scroll = defined $a{scroll_pct} ? $a{scroll_pct} : '';
280 $scroll =~ s/[^0-9]//g;
281 my $scroll_sql = length $scroll ? "'$scroll'" : 'NULL';
282
283 my $meta = defined $a{metadata} ? $a{metadata} : '';
284 $meta =~ s/'/''/g; $meta = substr($meta, 0, 500);
285 my $meta_sql = length $meta ? "'$meta'" : 'NULL';
286
287 # offset_x_pct / offset_y_pct are guarded so the code is safe to
288 # ship before the user runs the ALTER. Once the columns exist
289 # they're picked up automatically (process cache).
290 my $offset_sql = '';
291 if ($self->_has_column($db, $dbh, $DB, 'mkt_tracking_events', 'offset_x_pct')) {
292 $offset_sql = ",\n offset_x_pct=$ox_sql,\n offset_y_pct=$oy_sql";
293 }
294
295 $db->db_readwrite($dbh, qq~
296 INSERT INTO `${DB}`.mkt_tracking_events
297 SET session_id='$sid',
298 storefront_id=$store_sql,
299 event_type='$type',
300 page_path='$path',
301 element_selector=$sel_sql,
302 x_pct=$x_sql,
303 y_pct=$y_sql$offset_sql,
304 scroll_pct=$scroll_sql,
305 metadata=$meta_sql
306 ~, $ENV{SCRIPT_NAME}, __LINE__);
307 return 1;
308}
309
310# ---- Ingest dispatcher (called from /c.cgi) --------------------------
311# Accepts the raw JSON body posted by t.js. Resolves the site by public
312# token (k), finds-or-creates the visitor session (s), stamps site_id
313# on new sessions, then dispatches on the event type (t):
314# pv -> page_view row + fingerprint on session create
315# hb -> heartbeat (touches last_seen_at + current_page_path)
316# click -> click event row
317# form_submit -> form_submit event row
318# custom/rage_click -> custom event row (metadata carries the name)
319# hm -> heatmap event row (offset_x_pct/offset_y_pct)
320# Returns a JSON-serializable hashref.
321sub ingest {
322 my ($self, $dbh, $DB, $body) = @_;
323 my $db = MODS::DBConnect->new;
324
325 return { ok => 0, error => 'no_body' } unless ref $body eq 'HASH';
326
327 my $key = defined $body->{k} ? $body->{k} : '';
328 my $sid = defined $body->{s} ? $body->{s} : '';
329 my $t = lc(defined $body->{t} ? $body->{t} : 'pv');
330 my $p = defined $body->{p} ? $body->{p} : '';
331
332 $key =~ s/[^A-Za-z0-9]//g;
333 return { ok => 0, error => 'bad_key' } unless length($key) >= 8 && length($key) <= 40;
334
335 # Resolve the site by public_token. Bail if unknown so we don't
336 # accumulate orphan rows when a customer accidentally leaves an
337 # old snippet in place after rotating tokens.
338 my $site = $db->db_readwrite($dbh, qq~
339 SELECT id, user_id FROM `${DB}`.sites WHERE public_token='$key' LIMIT 1
340 ~, $ENV{SCRIPT_NAME}, __LINE__);
341 return { ok => 0, error => 'unknown_key' } unless $site && $site->{id};
342 my $site_id = $site->{id};
343
344 $sid =~ s/[^a-f0-9-]//g;
345 return { ok => 0, error => 'bad_sid' } unless length($sid) == 36;
346
347 # Find-or-create session row for this token.
348 my $session = $self->session_by_token($db, $dbh, $DB, $sid);
349 my $session_row_id = 0;
350 if ($session && $session->{id}) {
351 $session_row_id = $session->{id};
352 } else {
353 # t.js uses screen_width/viewport_width; _sanitize_fingerprint
354 # reads screen_w/viewport_w. Rename on the way in so the
355 # fingerprint columns actually populate.
356 my %args = (
357 session_token => $sid,
358 site_id => $site_id,
359 current_page_path => $p,
360 os_name => $body->{os_name},
361 os_version => $body->{os_version},
362 browser_name => $body->{browser_name},
363 browser_version => $body->{browser_version},
364 device_type => $body->{device_type},
365 touch_capable => $body->{touch_capable},
366 language => $body->{language},
367 timezone => $body->{timezone},
368 screen_w => $body->{screen_width},
369 screen_h => $body->{screen_height},
370 viewport_w => $body->{viewport_width},
371 viewport_h => $body->{viewport_height},
372 color_depth => $body->{color_depth},
373 pixel_ratio => $body->{pixel_ratio},
374 user_agent => $ENV{HTTP_USER_AGENT} || '',
375 referrer => $body->{r} || $body->{referrer} || '',
376 ip_address => (split /\s*,\s*/, ($ENV{HTTP_X_FORWARDED_FOR} || $ENV{REMOTE_ADDR} || ''))[0] || '',
377 );
378 $session_row_id = $self->create_session($db, $dbh, $DB, %args);
379 return { ok => 0, error => 'session_create_failed' } unless $session_row_id;
380 }
381
382 # Dispatch on event type.
383 if ($t eq 'pv') {
384 # Bump last_seen_at + current_page_path on returning visits so the
385 # session "moves" through the funnel like a live visitor.
386 $self->heartbeat($db, $dbh, $DB, $session_row_id, $p) if $session;
387 my $ok = $self->log_event($db, $dbh, $DB,
388 session_id => $session_row_id,
389 event_type => 'page_view',
390 page_path => $p,
391 );
392 return { ok => $ok ? 1 : 0, sid => $session_row_id, site => $site_id };
393 }
394 if ($t eq 'hb') {
395 my $ok = $self->heartbeat($db, $dbh, $DB, $session_row_id, $p);
396 return { ok => $ok ? 1 : 0, sid => $session_row_id, site => $site_id };
397 }
398 if ($t eq 'click' || $t eq 'form_submit') {
399 my $ok = $self->log_event($db, $dbh, $DB,
400 session_id => $session_row_id,
401 event_type => $t,
402 page_path => $p,
403 element_selector => $body->{sel},
404 x_pct => $body->{x},
405 y_pct => $body->{y},
406 );
407 return { ok => $ok ? 1 : 0, sid => $session_row_id };
408 }
409 if ($t eq 'custom' || $t eq 'rage_click') {
410 my $name = ($t eq 'rage_click') ? 'rage_click' : ($body->{name} || 'custom');
411 my $ok = $self->log_event($db, $dbh, $DB,
412 session_id => $session_row_id,
413 event_type => 'custom',
414 page_path => $p,
415 metadata => $name,
416 );
417 return { ok => $ok ? 1 : 0, sid => $session_row_id };
418 }
419 if ($t eq 'hm') {
420 my $ok = $self->log_event($db, $dbh, $DB,
421 session_id => $session_row_id,
422 event_type => 'heatmap',
423 page_path => $p,
424 element_selector => $body->{sel},
425 x_pct => $body->{x},
426 y_pct => $body->{y},
427 offset_x_pct => $body->{ox},
428 offset_y_pct => $body->{oy},
429 );
430 return { ok => $ok ? 1 : 0, sid => $session_row_id };
431 }
432
433 return { ok => 0, error => 'unknown_event', t => $t };
434}
435
436# ---- Admin: live visitor list ---------------------------------------
437sub live_visitors {
438 my ($self, $db, $dbh, $DB, $limit, $sf_id) = @_;
439 return () unless $self->schema_ready($db, $dbh, $DB);
440 $limit ||= 50;
441 $limit =~ s/[^0-9]//g; $limit = 50 unless $limit;
442
443 # Optional storefront filter (customer-side traffic_reports.cgi).
444 # Admin call sites pass no $sf_id and get every storefront.
445 my $sf_where = '';
446 if (defined $sf_id && $sf_id =~ /^\d+$/ && $sf_id > 0) {
447 $sf_where = " AND storefront_id='$sf_id' ";
448 }
449
450 # "Live" = seen in the last 2 minutes.
451 return $db->db_readwrite_multiple($dbh, qq~
452 SELECT id, session_token, visitor_label, storefront_id,
453 os_name, os_version, browser_name, browser_version,
454 device_type, screen_width, screen_height,
455 viewport_width, viewport_height,
456 language, timezone, country, city,
457 current_page_path, first_seen_at, last_seen_at,
458 TIMESTAMPDIFF(SECOND, last_seen_at, NOW()) AS idle_seconds
459 FROM `${DB}`.mkt_tracking_sessions
460 WHERE last_seen_at >= DATE_SUB(NOW(), INTERVAL 2 MINUTE)
461 $sf_where
462 ORDER BY last_seen_at DESC
463 LIMIT $limit
464 ~, $ENV{SCRIPT_NAME}, __LINE__);
465}
466
467sub session_recent_events {
468 my ($self, $db, $dbh, $DB, $session_id, $limit) = @_;
469 $session_id =~ s/[^0-9]//g;
470 return () unless $session_id;
471 return () unless $self->schema_ready($db, $dbh, $DB);
472 $limit ||= 20;
473 $limit =~ s/[^0-9]//g; $limit = 20 unless $limit;
474 return $db->db_readwrite_multiple($dbh, qq~
475 SELECT id, event_type, page_path, element_selector,
476 occurred_at,
477 TIMESTAMPDIFF(SECOND, occurred_at, NOW()) AS ago_seconds
478 FROM `${DB}`.mkt_tracking_events
479 WHERE session_id='$session_id'
480 ORDER BY occurred_at DESC
481 LIMIT $limit
482 ~, $ENV{SCRIPT_NAME}, __LINE__);
483}
484
485# ---- Admin: analytics aggregates ------------------------------------
486sub overview_kpis {
487 my ($self, $db, $dbh, $DB) = @_;
488 my %k = (
489 visitors_today => 0,
490 page_views_today => 0,
491 purchases_today => 0,
492 live_now => 0,
493 unique_30d => 0,
494 );
495 return \%k unless $self->schema_ready($db, $dbh, $DB);
496
497 my $r;
498 $r = $db->db_readwrite($dbh, qq~
499 SELECT COUNT(DISTINCT session_id) AS n FROM `${DB}`.mkt_tracking_events
500 WHERE DATE(occurred_at)=CURDATE()
501 ~, $ENV{SCRIPT_NAME}, __LINE__);
502 $k{visitors_today} = ($r && $r->{n}) ? $r->{n} : 0;
503
504 $r = $db->db_readwrite($dbh, qq~
505 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_events
506 WHERE event_type='page_view' AND DATE(occurred_at)=CURDATE()
507 ~, $ENV{SCRIPT_NAME}, __LINE__);
508 $k{page_views_today} = ($r && $r->{n}) ? $r->{n} : 0;
509
510 $r = $db->db_readwrite($dbh, qq~
511 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_events
512 WHERE event_type='purchase' AND DATE(occurred_at)=CURDATE()
513 ~, $ENV{SCRIPT_NAME}, __LINE__);
514 $k{purchases_today} = ($r && $r->{n}) ? $r->{n} : 0;
515
516 $r = $db->db_readwrite($dbh, qq~
517 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_sessions
518 WHERE last_seen_at >= DATE_SUB(NOW(), INTERVAL 2 MINUTE)
519 ~, $ENV{SCRIPT_NAME}, __LINE__);
520 $k{live_now} = ($r && $r->{n}) ? $r->{n} : 0;
521
522 $r = $db->db_readwrite($dbh, qq~
523 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_sessions
524 WHERE first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
525 ~, $ENV{SCRIPT_NAME}, __LINE__);
526 $k{unique_30d} = ($r && $r->{n}) ? $r->{n} : 0;
527
528 return \%k;
529}
530
531sub top_pages {
532 my ($self, $db, $dbh, $DB, $limit) = @_;
533 return () unless $self->schema_ready($db, $dbh, $DB);
534 $limit ||= 10;
535 $limit =~ s/[^0-9]//g; $limit = 10 unless $limit;
536 return $db->db_readwrite_multiple($dbh, qq~
537 SELECT page_path, COUNT(*) AS views
538 FROM `${DB}`.mkt_tracking_events
539 WHERE event_type='page_view'
540 AND occurred_at >= DATE_SUB(NOW(), INTERVAL 7 DAY)
541 GROUP BY page_path
542 ORDER BY views DESC
543 LIMIT $limit
544 ~, $ENV{SCRIPT_NAME}, __LINE__);
545}
546
547# ---- Traffic summary (admin + per-storefront) -----------------------
548# Both the admin Visitors page and per-seller storefront analytics
549# pull from the same set of helpers. Passing a storefront_id scopes
550# every query to that store; omit it for platform-wide numbers.
551#
552# All counts use mkt_tracking_sessions for "visitors" (one row per session)
553# and mkt_tracking_events for "page views" / orders. Returns simple
554# hashref/arrayref shapes the template loops can render directly.
555
556sub _sf_filter {
557 my ($alias, $sid) = @_;
558 return '' unless defined $sid && $sid =~ /^\d+$/ && $sid > 0;
559 return " AND $alias.storefront_id='$sid' ";
560}
561
562# Month-to-date + last-30d KPIs. Optional $sf_id scopes to one store.
563sub traffic_summary {
564 my ($self, $db, $dbh, $DB, $sf_id) = @_;
565 my %k = (
566 visitors_today => 0,
567 visitors_mtd => 0,
568 visitors_30d => 0,
569 page_views_mtd => 0,
570 live_now => 0,
571 countries_count => 0,
572 );
573 return \%k unless $self->schema_ready($db, $dbh, $DB);
574
575 my $sf_session = _sf_filter('s', $sf_id);
576 my $sf_event = _sf_filter('e', $sf_id);
577
578 my $r;
579 $r = $db->db_readwrite($dbh, qq~
580 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_sessions s
581 WHERE DATE(s.first_seen_at)=CURDATE() $sf_session
582 ~, $ENV{SCRIPT_NAME}, __LINE__);
583 $k{visitors_today} = ($r && $r->{n}) ? $r->{n} : 0;
584
585 $r = $db->db_readwrite($dbh, qq~
586 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_sessions s
587 WHERE YEAR(s.first_seen_at)=YEAR(NOW())
588 AND MONTH(s.first_seen_at)=MONTH(NOW())
589 $sf_session
590 ~, $ENV{SCRIPT_NAME}, __LINE__);
591 $k{visitors_mtd} = ($r && $r->{n}) ? $r->{n} : 0;
592
593 $r = $db->db_readwrite($dbh, qq~
594 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_sessions s
595 WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
596 $sf_session
597 ~, $ENV{SCRIPT_NAME}, __LINE__);
598 $k{visitors_30d} = ($r && $r->{n}) ? $r->{n} : 0;
599
600 $r = $db->db_readwrite($dbh, qq~
601 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_events e
602 WHERE e.event_type='page_view'
603 AND YEAR(e.occurred_at)=YEAR(NOW())
604 AND MONTH(e.occurred_at)=MONTH(NOW())
605 $sf_event
606 ~, $ENV{SCRIPT_NAME}, __LINE__);
607 $k{page_views_mtd} = ($r && $r->{n}) ? $r->{n} : 0;
608
609 $r = $db->db_readwrite($dbh, qq~
610 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_sessions s
611 WHERE s.last_seen_at >= DATE_SUB(NOW(), INTERVAL 2 MINUTE)
612 $sf_session
613 ~, $ENV{SCRIPT_NAME}, __LINE__);
614 $k{live_now} = ($r && $r->{n}) ? $r->{n} : 0;
615
616 $r = $db->db_readwrite($dbh, qq~
617 SELECT COUNT(DISTINCT s.country) AS n FROM `${DB}`.mkt_tracking_sessions s
618 WHERE s.country IS NOT NULL AND s.country<>''
619 AND s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
620 $sf_session
621 ~, $ENV{SCRIPT_NAME}, __LINE__);
622 $k{countries_count} = ($r && $r->{n}) ? $r->{n} : 0;
623
624 return \%k;
625}
626
627# Generic breakdown by a single mkt_tracking_sessions column. $col must be
628# one of the safe-listed names; anything else returns an empty list to
629# avoid SQL injection.
630sub traffic_breakdown {
631 my ($self, $db, $dbh, $DB, $col, $sf_id, $limit) = @_;
632 return () unless $self->schema_ready($db, $dbh, $DB);
633 my %ok = (
634 browser_name => 1, os_name => 1, device_type => 1,
635 country => 1, language => 1, timezone => 1,
636 );
637 return () unless $ok{$col};
638 $limit ||= 12;
639 $limit =~ s/[^0-9]//g; $limit = 12 unless $limit;
640
641 my $sf_session = _sf_filter('s', $sf_id);
642 return $db->db_readwrite_multiple($dbh, qq~
643 SELECT $col AS label, COUNT(*) AS n
644 FROM `${DB}`.mkt_tracking_sessions s
645 WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
646 AND $col IS NOT NULL AND $col<>''
647 $sf_session
648 GROUP BY $col
649 ORDER BY n DESC
650 LIMIT $limit
651 ~, $ENV{SCRIPT_NAME}, __LINE__);
652}
653
654# Platform-wide screen-resolution breakdown. Same idea as
655# country_screen_breakdown but with no country filter -- the
656# fingerprint summary on /admin_visitors.cgi reads this directly.
657sub traffic_screen_breakdown {
658 my ($self, $db, $dbh, $DB, $sf_id, $limit) = @_;
659 return () unless $self->schema_ready($db, $dbh, $DB);
660 $limit ||= 8;
661 $limit =~ s/[^0-9]//g; $limit = 8 unless $limit;
662 my $sf_session = _sf_filter('s', $sf_id);
663 return $db->db_readwrite_multiple($dbh, qq~
664 SELECT CONCAT(s.screen_width, 'x', s.screen_height) AS label, COUNT(*) AS n
665 FROM `${DB}`.mkt_tracking_sessions s
666 WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
667 AND s.screen_width IS NOT NULL AND s.screen_width > 0
668 AND s.screen_height IS NOT NULL AND s.screen_height > 0
669 $sf_session
670 GROUP BY s.screen_width, s.screen_height
671 ORDER BY n DESC
672 LIMIT $limit
673 ~, $ENV{SCRIPT_NAME}, __LINE__);
674}
675
676# Pixel ratio (display density) breakdown. The column is DECIMAL so
677# we bucket it into human-readable groups: 1x (standard), 1.5x,
678# 2x (Retina), 3x (mobile HiDPI), 4x+ (rare). Helps make design
679# decisions about hi-res asset shipping.
680sub traffic_pixel_ratio_breakdown {
681 my ($self, $db, $dbh, $DB, $sf_id) = @_;
682 return () unless $self->schema_ready($db, $dbh, $DB);
683 my $sf_session = _sf_filter('s', $sf_id);
684 return $db->db_readwrite_multiple($dbh, qq~
685 SELECT
686 CASE
687 WHEN s.pixel_ratio IS NULL THEN 'Unknown'
688 WHEN s.pixel_ratio < 1.25 THEN 'Standard (1x)'
689 WHEN s.pixel_ratio < 1.75 THEN 'HiDPI (1.5x)'
690 WHEN s.pixel_ratio < 2.5 THEN 'Retina (2x)'
691 WHEN s.pixel_ratio < 3.5 THEN 'Mobile HiDPI (3x)'
692 ELSE 'Ultra HiDPI (4x+)'
693 END AS label,
694 COUNT(*) AS n
695 FROM `${DB}`.mkt_tracking_sessions s
696 WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
697 $sf_session
698 GROUP BY label
699 ORDER BY n DESC
700 ~, $ENV{SCRIPT_NAME}, __LINE__);
701}
702
703# Traffic source breakdown -- extracts host from the referrer URL.
704# Empty / NULL referrer becomes "Direct (typed or bookmark)". Hosts
705# stripped of "www." for cleaner bucketing.
706sub traffic_referrer_breakdown {
707 my ($self, $db, $dbh, $DB, $sf_id, $limit) = @_;
708 return () unless $self->schema_ready($db, $dbh, $DB);
709 $limit ||= 8; $limit =~ s/[^0-9]//g; $limit = 8 unless $limit;
710 my $sf_session = _sf_filter('s', $sf_id);
711 return $db->db_readwrite_multiple($dbh, qq~
712 SELECT
713 CASE
714 WHEN s.referrer IS NULL OR s.referrer='' THEN 'Direct (typed or bookmark)'
715 ELSE REPLACE(
716 SUBSTRING_INDEX(SUBSTRING_INDEX(s.referrer, '://', -1), '/', 1),
717 'www.', '')
718 END AS label,
719 COUNT(*) AS n
720 FROM `${DB}`.mkt_tracking_sessions s
721 WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
722 $sf_session
723 GROUP BY label
724 ORDER BY n DESC
725 LIMIT $limit
726 ~, $ENV{SCRIPT_NAME}, __LINE__);
727}
728
729# Paginated traffic-source list. Same domain-extraction logic as
730# traffic_referrer_breakdown but with offset/limit + configurable window
731# for the "Sources" tab on traffic_reports.cgi + admin_traffic.cgi.
732# $window_days: 7/30/90/0 (0 = all-time, no date filter).
733sub traffic_referrer_paginated {
734 my ($self, $db, $dbh, $DB, $sf_id, $window_days, $offset, $limit) = @_;
735 return () unless $self->schema_ready($db, $dbh, $DB);
736 $window_days = 30 unless defined $window_days;
737 $window_days =~ s/[^0-9]//g; $window_days = 30 unless length $window_days;
738 $offset ||= 0; $offset =~ s/[^0-9]//g; $offset = 0 unless length $offset;
739 $limit ||= 25; $limit =~ s/[^0-9]//g; $limit = 25 unless length $limit;
740 $limit = 200 if $limit > 200;
741
742 my $sf_session = _sf_filter('s', $sf_id);
743 my $date_filter = $window_days
744 ? "AND s.first_seen_at >= DATE_SUB(NOW(), INTERVAL $window_days DAY)"
745 : '';
746
747 return $db->db_readwrite_multiple($dbh, qq~
748 SELECT
749 CASE
750 WHEN s.referrer IS NULL OR s.referrer='' THEN '(Direct / Typed-in)'
751 ELSE LOWER(REPLACE(
752 SUBSTRING_INDEX(SUBSTRING_INDEX(s.referrer, '://', -1), '/', 1),
753 'www.', ''))
754 END AS label,
755 COUNT(*) AS n
756 FROM `${DB}`.mkt_tracking_sessions s
757 WHERE 1=1
758 $date_filter
759 $sf_session
760 GROUP BY label
761 ORDER BY n DESC, label ASC
762 LIMIT $limit OFFSET $offset
763 ~, $ENV{SCRIPT_NAME}, __LINE__);
764}
765
766# Count of distinct referrer-domain buckets in the window. Used to
767# compute total pages for traffic_referrer_paginated.
768sub traffic_referrer_count {
769 my ($self, $db, $dbh, $DB, $sf_id, $window_days) = @_;
770 return 0 unless $self->schema_ready($db, $dbh, $DB);
771 $window_days = 30 unless defined $window_days;
772 $window_days =~ s/[^0-9]//g; $window_days = 30 unless length $window_days;
773
774 my $sf_session = _sf_filter('s', $sf_id);
775 my $date_filter = $window_days
776 ? "AND s.first_seen_at >= DATE_SUB(NOW(), INTERVAL $window_days DAY)"
777 : '';
778
779 my $r = $db->db_readwrite($dbh, qq~
780 SELECT COUNT(DISTINCT
781 CASE
782 WHEN s.referrer IS NULL OR s.referrer='' THEN '(Direct / Typed-in)'
783 ELSE LOWER(REPLACE(
784 SUBSTRING_INDEX(SUBSTRING_INDEX(s.referrer, '://', -1), '/', 1),
785 'www.', ''))
786 END
787 ) AS n
788 FROM `${DB}`.mkt_tracking_sessions s
789 WHERE 1=1
790 $date_filter
791 $sf_session
792 ~, $ENV{SCRIPT_NAME}, __LINE__);
793 return ($r && $r->{n}) ? $r->{n} : 0;
794}
795
796# Hour-of-day activity. HOUR() pulls 0-23 from first_seen_at; we map
797# to a 12h-am/pm bucket for readable labels.
798sub traffic_hour_breakdown {
799 my ($self, $db, $dbh, $DB, $sf_id, $limit) = @_;
800 return () unless $self->schema_ready($db, $dbh, $DB);
801 $limit ||= 8; $limit =~ s/[^0-9]//g; $limit = 8 unless $limit;
802 my $sf_session = _sf_filter('s', $sf_id);
803 return $db->db_readwrite_multiple($dbh, qq~
804 SELECT
805 CASE HOUR(s.first_seen_at)
806 WHEN 0 THEN '12 AM' WHEN 1 THEN '1 AM' WHEN 2 THEN '2 AM'
807 WHEN 3 THEN '3 AM' WHEN 4 THEN '4 AM' WHEN 5 THEN '5 AM'
808 WHEN 6 THEN '6 AM' WHEN 7 THEN '7 AM' WHEN 8 THEN '8 AM'
809 WHEN 9 THEN '9 AM' WHEN 10 THEN '10 AM' WHEN 11 THEN '11 AM'
810 WHEN 12 THEN '12 PM' WHEN 13 THEN '1 PM' WHEN 14 THEN '2 PM'
811 WHEN 15 THEN '3 PM' WHEN 16 THEN '4 PM' WHEN 17 THEN '5 PM'
812 WHEN 18 THEN '6 PM' WHEN 19 THEN '7 PM' WHEN 20 THEN '8 PM'
813 WHEN 21 THEN '9 PM' WHEN 22 THEN '10 PM' WHEN 23 THEN '11 PM'
814 END AS label,
815 COUNT(*) AS n
816 FROM `${DB}`.mkt_tracking_sessions s
817 WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
818 $sf_session
819 GROUP BY HOUR(s.first_seen_at), label
820 ORDER BY n DESC
821 LIMIT $limit
822 ~, $ENV{SCRIPT_NAME}, __LINE__);
823}
824
825# Touchscreen vs non-touchscreen split. Returns rows with label
826# "Touch device" / "Mouse + keyboard" so the template can render them
827# verbatim. Stored as TINYINT(1) so CASE keeps the bucket label clean.
828sub traffic_touch_breakdown {
829 my ($self, $db, $dbh, $DB, $sf_id) = @_;
830 return () unless $self->schema_ready($db, $dbh, $DB);
831 my $sf_session = _sf_filter('s', $sf_id);
832 return $db->db_readwrite_multiple($dbh, qq~
833 SELECT CASE WHEN s.touch_capable=1 THEN 'Touch device'
834 ELSE 'Mouse + keyboard' END AS label,
835 COUNT(*) AS n
836 FROM `${DB}`.mkt_tracking_sessions s
837 WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
838 $sf_session
839 GROUP BY label
840 ORDER BY n DESC
841 ~, $ENV{SCRIPT_NAME}, __LINE__);
842}
843
844# Country centroid coordinates for the traffic globe / map. ISO-2 code
845# => [lat, lng, full name]. Centroids are approximate -- they only need
846# to be close enough that the dot lands inside the right country on the
847# 800x400 equirectangular projection used by the globe widget.
848my %COUNTRY_CENTROIDS = (
849 US => [ 39.5, -98.5, 'United States' ],
850 CA => [ 56.1, -106.3, 'Canada' ],
851 MX => [ 23.6, -102.5, 'Mexico' ],
852 GT => [ 15.8, -90.2, 'Guatemala' ],
853 CR => [ 9.7, -83.7, 'Costa Rica' ],
854 PA => [ 8.5, -80.7, 'Panama' ],
855 CU => [ 21.5, -77.7, 'Cuba' ],
856 DO => [ 18.7, -70.1, 'Dominican Republic' ],
857 BR => [ -14.2, -51.9, 'Brazil' ],
858 AR => [ -38.4, -63.6, 'Argentina' ],
859 CL => [ -35.6, -71.5, 'Chile' ],
860 CO => [ 4.6, -74.0, 'Colombia' ],
861 PE => [ -9.2, -75.0, 'Peru' ],
862 VE => [ 6.4, -66.6, 'Venezuela' ],
863 EC => [ -1.8, -78.2, 'Ecuador' ],
864 UY => [ -32.5, -55.8, 'Uruguay' ],
865 GB => [ 55.4, -3.4, 'United Kingdom' ],
866 IE => [ 53.4, -8.2, 'Ireland' ],
867 FR => [ 46.2, 2.2, 'France' ],
868 DE => [ 51.2, 10.4, 'Germany' ],
869 NL => [ 52.1, 5.3, 'Netherlands' ],
870 BE => [ 50.5, 4.5, 'Belgium' ],
871 LU => [ 49.8, 6.1, 'Luxembourg' ],
872 CH => [ 46.8, 8.2, 'Switzerland' ],
873 AT => [ 47.5, 14.6, 'Austria' ],
874 IT => [ 41.9, 12.6, 'Italy' ],
875 ES => [ 40.5, -3.7, 'Spain' ],
876 PT => [ 39.4, -8.2, 'Portugal' ],
877 DK => [ 56.3, 9.5, 'Denmark' ],
878 NO => [ 60.5, 8.5, 'Norway' ],
879 SE => [ 60.1, 18.6, 'Sweden' ],
880 FI => [ 61.9, 25.7, 'Finland' ],
881 PL => [ 51.9, 19.1, 'Poland' ],
882 CZ => [ 49.8, 15.5, 'Czechia' ],
883 SK => [ 48.7, 19.7, 'Slovakia' ],
884 HU => [ 47.2, 19.5, 'Hungary' ],
885 RO => [ 45.9, 25.0, 'Romania' ],
886 BG => [ 42.7, 25.5, 'Bulgaria' ],
887 GR => [ 39.1, 21.8, 'Greece' ],
888 UA => [ 48.4, 31.2, 'Ukraine' ],
889 RU => [ 61.5, 105.3, 'Russia' ],
890 TR => [ 38.9, 35.2, 'Turkey' ],
891 IL => [ 31.0, 34.9, 'Israel' ],
892 SA => [ 23.9, 45.1, 'Saudi Arabia' ],
893 AE => [ 23.4, 53.8, 'United Arab Emirates' ],
894 IR => [ 32.4, 53.7, 'Iran' ],
895 PK => [ 30.4, 69.3, 'Pakistan' ],
896 IN => [ 20.6, 78.9, 'India' ],
897 BD => [ 23.7, 90.4, 'Bangladesh' ],
898 LK => [ 7.9, 80.8, 'Sri Lanka' ],
899 NP => [ 28.4, 84.1, 'Nepal' ],
900 CN => [ 35.9, 104.2, 'China' ],
901 JP => [ 36.2, 138.3, 'Japan' ],
902 KR => [ 35.9, 127.8, 'South Korea' ],
903 TW => [ 23.7, 121.0, 'Taiwan' ],
904 HK => [ 22.4, 114.1, 'Hong Kong' ],
905 SG => [ 1.4, 103.8, 'Singapore' ],
906 MY => [ 4.2, 101.9, 'Malaysia' ],
907 TH => [ 15.9, 100.9, 'Thailand' ],
908 VN => [ 14.1, 108.3, 'Vietnam' ],
909 PH => [ 12.9, 121.8, 'Philippines' ],
910 ID => [ -0.8, 113.9, 'Indonesia' ],
911 AU => [ -25.3, 133.8, 'Australia' ],
912 NZ => [ -40.9, 174.9, 'New Zealand' ],
913 ZA => [ -30.6, 22.9, 'South Africa' ],
914 NG => [ 9.1, 8.7, 'Nigeria' ],
915 EG => [ 26.8, 30.8, 'Egypt' ],
916 MA => [ 31.8, -7.1, 'Morocco' ],
917 KE => [ -0.0, 37.9, 'Kenya' ],
918 ET => [ 9.1, 40.5, 'Ethiopia' ],
919 GH => [ 7.9, -1.0, 'Ghana' ],
920 DZ => [ 28.0, 1.7, 'Algeria' ],
921 TN => [ 33.9, 9.5, 'Tunisia' ],
922);
923
924sub country_centroid {
925 my ($self, $code) = @_;
926 return undef unless defined $code;
927 $code = uc $code;
928 return $COUNTRY_CENTROIDS{$code};
929}
930
931# Per-country visitor counts (30d). Returns rows of {country, n}.
932sub traffic_by_country {
933 my ($self, $db, $dbh, $DB, $sf_id, $limit) = @_;
934 return () unless $self->schema_ready($db, $dbh, $DB);
935 $limit ||= 80;
936 $limit =~ s/[^0-9]//g; $limit = 80 unless $limit;
937
938 my $sf_session = _sf_filter('s', $sf_id);
939 return $db->db_readwrite_multiple($dbh, qq~
940 SELECT s.country AS country, COUNT(*) AS n
941 FROM `${DB}`.mkt_tracking_sessions s
942 WHERE s.country IS NOT NULL AND s.country<>''
943 AND s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
944 $sf_session
945 GROUP BY s.country
946 ORDER BY n DESC
947 LIMIT $limit
948 ~, $ENV{SCRIPT_NAME}, __LINE__);
949}
950
951# Daily visitor series for the trailing N days. Returns one row per
952# calendar day with sessions, users, page-views, and a per-day
953# unique-visitor count. Days with zero activity still appear (we left-
954# join against a generated date sequence) so the line chart never
955# renders gaps.
956#
957# `visitors` = sessions whose first_seen_at falls on that date
958# `users` = sessions with buyer_account_id set (logged-in)
959# `unique_visitors` = distinct session_token seen that date
960# `page_views` = COUNT(*) from mkt_tracking_events where event_type=page_view
961sub daily_visitor_series {
962 my ($self, $db, $dbh, $DB, $sf_id, $days) = @_;
963 $days ||= 30;
964 $days =~ s/[^0-9]//g; $days = 30 unless $days;
965 $days = 365 if $days > 365;
966 return () unless $self->schema_ready($db, $dbh, $DB);
967
968 my $sf_s = _sf_filter('s', $sf_id);
969 my $sf_e = _sf_filter('e', $sf_id);
970
971 # Build the trailing-N-days date list in Perl rather than relying
972 # on a sequence-generating SQL trick that's portable across the
973 # MariaDB 5.5 / MySQL 5.5 baseline.
974 my @days_back;
975 my $now = time;
976 for (my $i = $days - 1; $i >= 0; $i--) {
977 my @t = localtime($now - $i * 86400);
978 my $ymd = sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]);
979 push @days_back, $ymd;
980 }
981
982 # One round-trip for sessions started per day (visitors + users +
983 # uniques) and another for page-views. Group-by date.
984 my @s_rows = $db->db_readwrite_multiple($dbh, qq~
985 SELECT DATE(s.first_seen_at) AS d,
986 COUNT(*) AS visitors,
987 COUNT(DISTINCT s.session_token) AS uniques,
988 SUM(CASE WHEN s.buyer_account_id IS NOT NULL THEN 1 ELSE 0 END) AS users
989 FROM `${DB}`.mkt_tracking_sessions s
990 WHERE s.first_seen_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY)
991 $sf_s
992 GROUP BY DATE(s.first_seen_at)
993 ~, $ENV{SCRIPT_NAME}, __LINE__);
994 my %s_by = map { ($_->{d} || '') => $_ } @s_rows;
995
996 my @e_rows = $db->db_readwrite_multiple($dbh, qq~
997 SELECT DATE(e.occurred_at) AS d, COUNT(*) AS page_views
998 FROM `${DB}`.mkt_tracking_events e
999 WHERE e.event_type='page_view'
1000 AND e.occurred_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY)
1001 $sf_e
1002 GROUP BY DATE(e.occurred_at)
1003 ~, $ENV{SCRIPT_NAME}, __LINE__);
1004 my %e_by = map { ($_->{d} || '') => $_ } @e_rows;
1005
1006 my @out;
1007 foreach my $ymd (@days_back) {
1008 my $s = $s_by{$ymd} || {};
1009 my $e = $e_by{$ymd} || {};
1010 push @out, {
1011 date => $ymd,
1012 visitors => ($s->{visitors} || 0) - ($s->{users} || 0),
1013 users => $s->{users} || 0,
1014 total => $s->{visitors} || 0,
1015 unique_visitors => $s->{uniques} || 0,
1016 page_views => $e->{page_views} || 0,
1017 };
1018 }
1019 return @out;
1020}
1021
1022# Aggregate totals for the same trailing window. Returns a hashref:
1023# { total_visits, unique_visitors, total_users, unique_users,
1024# total_pageviews, anon_visits }
1025# anon_visits = visits with no buyer_account_id (true anonymous)
1026# total_users = sessions WHERE buyer_account_id IS NOT NULL
1027# unique_users = distinct buyer_account_id
1028sub visitor_totals {
1029 my ($self, $db, $dbh, $DB, $sf_id, $days) = @_;
1030 $days ||= 30;
1031 $days =~ s/[^0-9]//g; $days = 30 unless $days;
1032 my %k = (
1033 total_visits=>0, unique_visitors=>0,
1034 total_users=>0, unique_users=>0,
1035 total_pageviews=>0, anon_visits=>0,
1036 );
1037 return \%k unless $self->schema_ready($db, $dbh, $DB);
1038
1039 my $sf_s = _sf_filter('s', $sf_id);
1040 my $sf_e = _sf_filter('e', $sf_id);
1041
1042 my $r = $db->db_readwrite($dbh, qq~
1043 SELECT
1044 COUNT(*) AS total_visits,
1045 COUNT(DISTINCT s.session_token) AS unique_visitors,
1046 SUM(CASE WHEN s.buyer_account_id IS NOT NULL THEN 1 ELSE 0 END) AS total_users,
1047 COUNT(DISTINCT s.buyer_account_id) AS unique_users
1048 FROM `${DB}`.mkt_tracking_sessions s
1049 WHERE s.first_seen_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY)
1050 $sf_s
1051 ~, $ENV{SCRIPT_NAME}, __LINE__);
1052 if ($r) {
1053 $k{total_visits} = $r->{total_visits} || 0;
1054 $k{unique_visitors} = $r->{unique_visitors} || 0;
1055 $k{total_users} = $r->{total_users} || 0;
1056 $k{unique_users} = $r->{unique_users} || 0;
1057 $k{anon_visits} = $k{total_visits} - $k{total_users};
1058 }
1059
1060 my $r2 = $db->db_readwrite($dbh, qq~
1061 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_events e
1062 WHERE e.event_type='page_view'
1063 AND e.occurred_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY)
1064 $sf_e
1065 ~, $ENV{SCRIPT_NAME}, __LINE__);
1066 $k{total_pageviews} = ($r2 && $r2->{n}) ? $r2->{n} : 0;
1067
1068 return \%k;
1069}
1070
1071# Top N most-visited page paths over the trailing window. The page
1072# path is stored verbatim (includes query string), so two URLs to the
1073# same CGI with different params count separately -- which is usually
1074# what an admin wants for "where is traffic landing?".
1075sub top_pages_window {
1076 my ($self, $db, $dbh, $DB, $sf_id, $days, $limit) = @_;
1077 return () unless $self->schema_ready($db, $dbh, $DB);
1078 $days ||= 30; $days =~ s/[^0-9]//g; $days = 30 unless $days;
1079 $limit ||= 15; $limit =~ s/[^0-9]//g; $limit = 15 unless $limit;
1080
1081 my $sf_e = _sf_filter('e', $sf_id);
1082 return $db->db_readwrite_multiple($dbh, qq~
1083 SELECT e.page_path, COUNT(*) AS views,
1084 COUNT(DISTINCT e.session_id) AS uniques
1085 FROM `${DB}`.mkt_tracking_events e
1086 WHERE e.event_type='page_view'
1087 AND e.occurred_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY)
1088 $sf_e
1089 GROUP BY e.page_path
1090 ORDER BY views DESC
1091 LIMIT $limit
1092 ~, $ENV{SCRIPT_NAME}, __LINE__);
1093}
1094
1095# Bucket page paths into "sections" (the first path segment, no query
1096# string). Returns rows of {section, views, uniques} sorted by views.
1097# Done in Perl after a single SELECT to keep the SQL portable.
1098sub traffic_by_section {
1099 my ($self, $db, $dbh, $DB, $sf_id, $days) = @_;
1100 return () unless $self->schema_ready($db, $dbh, $DB);
1101 $days ||= 30; $days =~ s/[^0-9]//g; $days = 30 unless $days;
1102
1103 my $sf_e = _sf_filter('e', $sf_id);
1104 my @rows = $db->db_readwrite_multiple($dbh, qq~
1105 SELECT e.page_path, e.session_id
1106 FROM `${DB}`.mkt_tracking_events e
1107 WHERE e.event_type='page_view'
1108 AND e.occurred_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY)
1109 $sf_e
1110 ~, $ENV{SCRIPT_NAME}, __LINE__);
1111
1112 my %bucket; # section => { views => N, sessions => {sid=>1,...} }
1113 foreach my $r (@rows) {
1114 my $p = $r->{page_path} || '/';
1115 # Drop query string + fragment.
1116 $p =~ s/[?#].*$//;
1117 # First segment after the leading slash, kept with the slash for
1118 # display ("/store.cgi", "/admin_billing.cgi", "/" for root).
1119 my $section;
1120 if ($p =~ m{^/+([^/]+)}) {
1121 $section = '/' . $1;
1122 } else {
1123 $section = '/';
1124 }
1125 $bucket{$section} ||= { views => 0, sessions => {} };
1126 $bucket{$section}->{views}++;
1127 $bucket{$section}->{sessions}->{ $r->{session_id} || '' } = 1;
1128 }
1129
1130 my @out;
1131 foreach my $sec (sort { $bucket{$b}->{views} <=> $bucket{$a}->{views} } keys %bucket) {
1132 push @out, {
1133 section => $sec,
1134 views => $bucket{$sec}->{views},
1135 uniques => scalar(keys %{ $bucket{$sec}->{sessions} }),
1136 };
1137 }
1138 return @out;
1139}
1140
1141# Has the optional `region` column been added to mkt_tracking_sessions
1142# yet? Used by the country drill-down. Returns 0 on un-migrated
1143# installs so the page renders the friendly "no region data" panel
1144# instead of erroring on a missing column.
1145sub region_column_ready {
1146 my ($self, $db, $dbh, $DB) = @_;
1147 return $self->{_region_ready} if exists $self->{_region_ready};
1148 my $r = $db->db_readwrite($dbh, qq~
1149 SELECT COUNT(*) AS n FROM information_schema.columns
1150 WHERE table_schema='$DB' AND table_name='mkt_tracking_sessions'
1151 AND column_name='region'
1152 ~, $ENV{SCRIPT_NAME}, __LINE__);
1153 $self->{_region_ready} = ($r && $r->{n}) ? 1 : 0;
1154 return $self->{_region_ready};
1155}
1156
1157# Top regions / states inside a single country, 30-day window. Empty
1158# list when the region column isn't migrated or when no rows have a
1159# region filled in -- the template renders an explanatory panel in
1160# that case rather than a broken bar chart.
1161sub traffic_by_region {
1162 my ($self, $db, $dbh, $DB, $country_code, $sf_id, $days, $limit, $days_to) = @_;
1163 return () unless $self->schema_ready($db, $dbh, $DB);
1164 return () unless $self->region_column_ready($db, $dbh, $DB);
1165
1166 $country_code = uc(defined $country_code ? $country_code : '');
1167 $country_code =~ s/[^A-Z]//g;
1168 return () unless $country_code;
1169
1170 $limit ||= 15; $limit =~ s/[^0-9]//g; $limit = 15 unless $limit;
1171 my $sf_s = _sf_filter('s', $sf_id);
1172 my $dw_s = _date_where($days, $days_to, 's.first_seen_at');
1173 return $db->db_readwrite_multiple($dbh, qq~
1174 SELECT s.region AS region, COUNT(*) AS n
1175 FROM `${DB}`.mkt_tracking_sessions s
1176 WHERE s.country='$country_code'
1177 AND s.region IS NOT NULL AND s.region<>''
1178 $dw_s
1179 $sf_s
1180 GROUP BY s.region
1181 ORDER BY n DESC
1182 LIMIT $limit
1183 ~, $ENV{SCRIPT_NAME}, __LINE__);
1184}
1185
1186# 30-day daily series scoped to a single country. Same shape as
1187# daily_visitor_series but with an extra WHERE clause. We only need
1188# the `visitors` count per day for the drill-down chart (no separate
1189# users line at this zoom level).
1190sub daily_series_for_country {
1191 my ($self, $db, $dbh, $DB, $country_code, $sf_id, $days, $days_to) = @_;
1192 return () unless $self->schema_ready($db, $dbh, $DB);
1193 $country_code = uc(defined $country_code ? $country_code : '');
1194 $country_code =~ s/[^A-Z]//g;
1195 return () unless $country_code;
1196 my ($from, $to) = _date_bounds($days, $days_to);
1197
1198 my $sf_s = _sf_filter('s', $sf_id);
1199 my $dw_s = _date_where($from, $to, 's.first_seen_at');
1200
1201 my @days_back;
1202 my $now = time;
1203 for (my $i = $from; $i >= $to; $i--) {
1204 my @t = localtime($now - $i * 86400);
1205 push @days_back, sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]);
1206 }
1207 my @rows = $db->db_readwrite_multiple($dbh, qq~
1208 SELECT DATE(s.first_seen_at) AS d, COUNT(*) AS n
1209 FROM `${DB}`.mkt_tracking_sessions s
1210 WHERE s.country='$country_code'
1211 $dw_s
1212 $sf_s
1213 GROUP BY DATE(s.first_seen_at)
1214 ~, $ENV{SCRIPT_NAME}, __LINE__);
1215 my %by = map { ($_->{d} || '') => $_->{n} } @rows;
1216
1217 my @out;
1218 foreach my $ymd (@days_back) {
1219 push @out, { date => $ymd, visitors => ($by{$ymd} || 0) };
1220 }
1221 return @out;
1222}
1223
1224# ---- Country / region detail (used by the click-to-drill modal) -----
1225# All of these accept an optional $region argument so a state click in
1226# the US can scope the totals to that state once mkt_tracking_sessions.region
1227# starts getting populated. Empty region == country-wide.
1228
1229sub _region_clause {
1230 my ($region) = @_;
1231 return '' unless defined $region && length $region;
1232 my $r = $region;
1233 $r =~ s/'/''/g;
1234 $r = substr($r, 0, 80);
1235 return " AND s.region='$r' ";
1236}
1237
1238# Normalize a (days_from, days_to) pair where each is "N days ago".
1239# days_from is the older bound (e.g. 30 = 30 days ago), days_to is the
1240# newer bound (e.g. 0 = today). Returns ($from, $to) sorted so from>=to,
1241# both clamped to [0, 365]. Used by every detail-modal helper so the
1242# date slider can scope each query.
1243sub _date_bounds {
1244 my ($days_from, $days_to) = @_;
1245 $days_from = 30 unless defined $days_from && $days_from =~ /^\d+$/;
1246 $days_to = 0 unless defined $days_to && $days_to =~ /^\d+$/;
1247 $days_from = 365 if $days_from > 365;
1248 $days_to = 365 if $days_to > 365;
1249 ($days_from, $days_to) = ($days_to, $days_from) if $days_to > $days_from;
1250 return ($days_from, $days_to);
1251}
1252
1253# SQL fragment scoping a query's date column to the window. Returns
1254# "AND <col> >= ... AND <col> <= ..." (note: leading AND so callers
1255# can drop it straight into an existing WHERE).
1256sub _date_where {
1257 my ($days_from, $days_to, $col) = @_;
1258 $col ||= 's.first_seen_at';
1259 ($days_from, $days_to) = _date_bounds($days_from, $days_to);
1260 return " AND DATE($col) >= DATE_SUB(CURDATE(), INTERVAL $days_from DAY) " .
1261 " AND DATE($col) <= DATE_SUB(CURDATE(), INTERVAL $days_to DAY) ";
1262}
1263
1264# Full traffic summary for a single country (or state). Mirrors
1265# visitor_totals but with a country/region filter. Returns hashref:
1266# { total_visits, unique_visitors, total_users, unique_users,
1267# total_pageviews, anon_visits }
1268sub country_traffic_summary {
1269 my ($self, $db, $dbh, $DB, $country_code, $region, $days, $days_to, $sf_id) = @_;
1270 my %k = (
1271 total_visits=>0, unique_visitors=>0,
1272 total_users=>0, unique_users=>0,
1273 total_pageviews=>0, anon_visits=>0,
1274 );
1275 return \%k unless $self->schema_ready($db, $dbh, $DB);
1276 $country_code = uc(defined $country_code ? $country_code : '');
1277 $country_code =~ s/[^A-Z]//g;
1278 return \%k unless $country_code;
1279 my $rc = _region_clause($region);
1280 my $dw_s = _date_where($days, $days_to, 's.first_seen_at');
1281 my $dw_e = _date_where($days, $days_to, 'e.occurred_at');
1282 my $sf_s = _sf_filter('s', $sf_id);
1283
1284 my $r = $db->db_readwrite($dbh, qq~
1285 SELECT
1286 COUNT(*) AS total_visits,
1287 COUNT(DISTINCT s.session_token) AS unique_visitors,
1288 SUM(CASE WHEN s.buyer_account_id IS NOT NULL THEN 1 ELSE 0 END) AS total_users,
1289 COUNT(DISTINCT s.buyer_account_id) AS unique_users
1290 FROM `${DB}`.mkt_tracking_sessions s
1291 WHERE s.country='$country_code'
1292 $dw_s
1293 $rc
1294 $sf_s
1295 ~, $ENV{SCRIPT_NAME}, __LINE__);
1296 if ($r) {
1297 $k{total_visits} = $r->{total_visits} || 0;
1298 $k{unique_visitors} = $r->{unique_visitors} || 0;
1299 $k{total_users} = $r->{total_users} || 0;
1300 $k{unique_users} = $r->{unique_users} || 0;
1301 $k{anon_visits} = $k{total_visits} - $k{total_users};
1302 }
1303
1304 my $r2 = $db->db_readwrite($dbh, qq~
1305 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_events e
1306 JOIN `${DB}`.mkt_tracking_sessions s ON s.id = e.session_id
1307 WHERE e.event_type='page_view'
1308 AND s.country='$country_code'
1309 $dw_e
1310 $rc
1311 $sf_s
1312 ~, $ENV{SCRIPT_NAME}, __LINE__);
1313 $k{total_pageviews} = ($r2 && $r2->{n}) ? $r2->{n} : 0;
1314
1315 return \%k;
1316}
1317
1318# Top N cities seen for this country/region in the window.
1319sub country_top_cities {
1320 my ($self, $db, $dbh, $DB, $country_code, $region, $days, $limit, $days_to, $sf_id) = @_;
1321 return () unless $self->schema_ready($db, $dbh, $DB);
1322 $country_code = uc(defined $country_code ? $country_code : '');
1323 $country_code =~ s/[^A-Z]//g;
1324 return () unless $country_code;
1325 $limit ||= 10; $limit =~ s/[^0-9]//g; $limit = 10 unless $limit;
1326 my $rc = _region_clause($region);
1327 my $dw_s = _date_where($days, $days_to, 's.first_seen_at');
1328 my $sf_s = _sf_filter('s', $sf_id);
1329 return $db->db_readwrite_multiple($dbh, qq~
1330 SELECT s.city AS city, COUNT(*) AS n
1331 FROM `${DB}`.mkt_tracking_sessions s
1332 WHERE s.country='$country_code'
1333 AND s.city IS NOT NULL AND s.city<>''
1334 $dw_s
1335 $rc
1336 $sf_s
1337 GROUP BY s.city
1338 ORDER BY n DESC
1339 LIMIT $limit
1340 ~, $ENV{SCRIPT_NAME}, __LINE__);
1341}
1342
1343# Generic fingerprint breakdown for a country/region (browser_name,
1344# os_name, device_type, language).
1345sub country_breakdown {
1346 my ($self, $db, $dbh, $DB, $country_code, $region, $col, $days, $limit, $days_to, $sf_id) = @_;
1347 return () unless $self->schema_ready($db, $dbh, $DB);
1348 my %ok = (browser_name=>1, os_name=>1, device_type=>1, language=>1, timezone=>1);
1349 return () unless $ok{$col};
1350 $country_code = uc(defined $country_code ? $country_code : '');
1351 $country_code =~ s/[^A-Z]//g;
1352 return () unless $country_code;
1353 $limit ||= 8; $limit =~ s/[^0-9]//g; $limit = 8 unless $limit;
1354 my $rc = _region_clause($region);
1355 my $dw_s = _date_where($days, $days_to, 's.first_seen_at');
1356 my $sf_s = _sf_filter('s', $sf_id);
1357 return $db->db_readwrite_multiple($dbh, qq~
1358 SELECT s.$col AS label, COUNT(*) AS n
1359 FROM `${DB}`.mkt_tracking_sessions s
1360 WHERE s.country='$country_code'
1361 AND s.$col IS NOT NULL AND s.$col<>''
1362 $dw_s
1363 $rc
1364 $sf_s
1365 GROUP BY s.$col
1366 ORDER BY n DESC
1367 LIMIT $limit
1368 ~, $ENV{SCRIPT_NAME}, __LINE__);
1369}
1370
1371# Screen-resolution breakdown for a country/region. screen_width and
1372# screen_height are stored separately so we concat them as the bucket
1373# label here. NULLs / zero rows are excluded so the bars don't reflect
1374# bot traffic.
1375sub country_screen_breakdown {
1376 my ($self, $db, $dbh, $DB, $country_code, $region, $days, $limit, $days_to, $sf_id) = @_;
1377 return () unless $self->schema_ready($db, $dbh, $DB);
1378 $country_code = uc(defined $country_code ? $country_code : '');
1379 $country_code =~ s/[^A-Z]//g;
1380 return () unless $country_code;
1381 $limit ||= 8; $limit =~ s/[^0-9]//g; $limit = 8 unless $limit;
1382 my $rc = _region_clause($region);
1383 my $dw_s = _date_where($days, $days_to, 's.first_seen_at');
1384 my $sf_s = _sf_filter('s', $sf_id);
1385 return $db->db_readwrite_multiple($dbh, qq~
1386 SELECT CONCAT(s.screen_width, 'x', s.screen_height) AS label, COUNT(*) AS n
1387 FROM `${DB}`.mkt_tracking_sessions s
1388 WHERE s.country='$country_code'
1389 AND s.screen_width IS NOT NULL AND s.screen_width > 0
1390 AND s.screen_height IS NOT NULL AND s.screen_height > 0
1391 $dw_s
1392 $rc
1393 $sf_s
1394 GROUP BY s.screen_width, s.screen_height
1395 ORDER BY n DESC
1396 LIMIT $limit
1397 ~, $ENV{SCRIPT_NAME}, __LINE__);
1398}
1399
1400# Top pages visited from this country/region.
1401sub country_top_pages {
1402 my ($self, $db, $dbh, $DB, $country_code, $region, $days, $limit, $days_to, $sf_id) = @_;
1403 return () unless $self->schema_ready($db, $dbh, $DB);
1404 $country_code = uc(defined $country_code ? $country_code : '');
1405 $country_code =~ s/[^A-Z]//g;
1406 return () unless $country_code;
1407 $limit ||= 10; $limit =~ s/[^0-9]//g; $limit = 10 unless $limit;
1408 my $rc = _region_clause($region);
1409 my $dw_e = _date_where($days, $days_to, 'e.occurred_at');
1410 my $sf_s = _sf_filter('s', $sf_id);
1411 return $db->db_readwrite_multiple($dbh, qq~
1412 SELECT e.page_path, COUNT(*) AS views
1413 FROM `${DB}`.mkt_tracking_events e
1414 JOIN `${DB}`.mkt_tracking_sessions s ON s.id = e.session_id
1415 WHERE e.event_type='page_view'
1416 AND s.country='$country_code'
1417 $dw_e
1418 $rc
1419 $sf_s
1420 GROUP BY e.page_path
1421 ORDER BY views DESC
1422 LIMIT $limit
1423 ~, $ENV{SCRIPT_NAME}, __LINE__);
1424}
1425
1426# Single-number: total visits to a country in the trailing window.
1427sub country_total_visits {
1428 my ($self, $db, $dbh, $DB, $country_code, $sf_id, $days) = @_;
1429 return 0 unless $self->schema_ready($db, $dbh, $DB);
1430 $country_code = uc(defined $country_code ? $country_code : '');
1431 $country_code =~ s/[^A-Z]//g;
1432 return 0 unless $country_code;
1433 $days ||= 30; $days =~ s/[^0-9]//g; $days = 30 unless $days;
1434 my $sf_s = _sf_filter('s', $sf_id);
1435 my $r = $db->db_readwrite($dbh, qq~
1436 SELECT COUNT(*) AS n FROM `${DB}`.mkt_tracking_sessions s
1437 WHERE s.country='$country_code'
1438 AND s.first_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY)
1439 $sf_s
1440 ~, $ENV{SCRIPT_NAME}, __LINE__);
1441 return ($r && $r->{n}) ? $r->{n} : 0;
1442}
1443
1444# Closed chats grouped by calendar day, most-recent first. Used by the
1445# admin Chat console "Concluded chats" daily-trend bar chart. Returns
1446# one row per day that had at least one closure within the trailing
1447# $days window; days with zero are filled in by the caller so the
1448# chart axis stays continuous.
1449sub chats_closed_by_day {
1450 my ($self, $db, $dbh, $DB, $days) = @_;
1451 return () unless $self->schema_ready($db, $dbh, $DB);
1452 $days ||= 30;
1453 $days =~ s/[^0-9]//g; $days = 30 unless $days;
1454 return $db->db_readwrite_multiple($dbh, qq~
1455 SELECT DATE(closed_at) AS d,
1456 COUNT(*) AS n
1457 FROM `${DB}`.mkt_support_chats
1458 WHERE status IN ('closed','archived')
1459 AND closed_at IS NOT NULL
1460 AND closed_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY)
1461 GROUP BY DATE(closed_at)
1462 ORDER BY d DESC
1463 ~, $ENV{SCRIPT_NAME}, __LINE__);
1464}
1465
1466# Individual chats closed within the trailing $days, with the minimum
1467# fields needed for the daily-trend drilldown overlay (date bucket,
1468# visitor label, deep link to the conversation in the console).
1469sub chats_closed_list {
1470 my ($self, $db, $dbh, $DB, $days) = @_;
1471 return () unless $self->schema_ready($db, $dbh, $DB);
1472 $days ||= 30;
1473 $days =~ s/[^0-9]//g; $days = 30 unless $days;
1474 return $db->db_readwrite_multiple($dbh, qq~
1475 SELECT c.id AS id,
1476 DATE(c.closed_at) AS d,
1477 DATE_FORMAT(c.closed_at, '%H:%i') AS hm,
1478 COALESCE(NULLIF(s.visitor_label,''), CONCAT('Visitor #', c.id)) AS label,
1479 c.status AS status
1480 FROM `${DB}`.mkt_support_chats c
1481 LEFT JOIN `${DB}`.mkt_tracking_sessions s ON s.id = c.session_id
1482 WHERE c.status IN ('closed','archived')
1483 AND c.closed_at IS NOT NULL
1484 AND c.closed_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY)
1485 ORDER BY c.closed_at DESC
1486 ~, $ENV{SCRIPT_NAME}, __LINE__);
1487}
1488
1489# Closed chats grouped by year-month, most-recent first. Used by the
1490# admin Chat console "Resolved per month" summary tile.
1491sub chats_closed_by_month {
1492 my ($self, $db, $dbh, $DB, $months) = @_;
1493 return () unless $self->schema_ready($db, $dbh, $DB);
1494 $months ||= 6;
1495 $months =~ s/[^0-9]//g; $months = 6 unless $months;
1496 return $db->db_readwrite_multiple($dbh, qq~
1497 SELECT DATE_FORMAT(closed_at, '%Y-%m') AS ym,
1498 DATE_FORMAT(closed_at, '%b %Y') AS ym_label,
1499 COUNT(*) AS n
1500 FROM `${DB}`.mkt_support_chats
1501 WHERE status IN ('closed','archived')
1502 AND closed_at IS NOT NULL
1503 AND closed_at >= DATE_SUB(CURDATE(), INTERVAL $months MONTH)
1504 GROUP BY ym, ym_label
1505 ORDER BY ym DESC
1506 ~, $ENV{SCRIPT_NAME}, __LINE__);
1507}
1508
1509# Aggregated click hot-spots per page-path for the heatmap overlay.
1510# Returns selector + offset fractions when those columns exist so the
1511# renderer can re-anchor each dot to its DOM element at view time.
1512# element_selector is an original column so we always select it -- the
1513# renderer can anchor to element center (0.5, 0.5) even when offset
1514# columns haven't been added to the schema yet (pre-ALTER deploys).
1515# Falls back to x_pct/y_pct (viewport-relative) for rows with neither.
1516sub heatmap_dots {
1517 my ($self, $db, $dbh, $DB, $page_path, $limit, $storefront_id) = @_;
1518 return () unless $self->schema_ready($db, $dbh, $DB);
1519 $page_path = '' unless defined $page_path;
1520 $page_path =~ s/'/''/g;
1521 $page_path = substr($page_path, 0, 500);
1522 $limit ||= 500;
1523 $limit =~ s/[^0-9]//g; $limit = 500 unless $limit;
1524
1525 # Optional storefront filter so sellers only see their own dots.
1526 # NULL/empty = no filter (platform-wide; used by /admin_heatmap).
1527 my $store_where = '';
1528 if (defined $storefront_id && $storefront_id ne '') {
1529 my $sid = $storefront_id; $sid =~ s/[^0-9]//g;
1530 $store_where = "AND storefront_id='$sid' " if length $sid;
1531 }
1532
1533 my $offset_cols = '';
1534 if ($self->_has_column($db, $dbh, $DB, 'mkt_tracking_events', 'offset_x_pct')) {
1535 $offset_cols = ', offset_x_pct, offset_y_pct';
1536 }
1537 return $db->db_readwrite_multiple($dbh, qq~
1538 SELECT x_pct, y_pct, element_selector$offset_cols
1539 FROM `${DB}`.mkt_tracking_events
1540 WHERE event_type IN ('click','heatmap')
1541 AND page_path='$page_path'
1542 $store_where
1543 AND x_pct IS NOT NULL AND y_pct IS NOT NULL
1544 ORDER BY occurred_at DESC
1545 LIMIT $limit
1546 ~, $ENV{SCRIPT_NAME}, __LINE__);
1547}
1548
1549# Pages ranked by click activity for the heatmap list view. Returns
1550# rows of {page_path, clicks, sessions} -- "clicks" = total click
1551# events on that page, "sessions" = distinct sessions that clicked.
1552sub heatmap_top_pages {
1553 my ($self, $db, $dbh, $DB, $days, $limit, $storefront_id) = @_;
1554 return () unless $self->schema_ready($db, $dbh, $DB);
1555 $days ||= 30; $days =~ s/[^0-9]//g; $days = 30 unless $days;
1556 $limit ||= 50; $limit =~ s/[^0-9]//g; $limit = 50 unless $limit;
1557 my $store_where = '';
1558 if (defined $storefront_id && $storefront_id ne '') {
1559 my $sid = $storefront_id; $sid =~ s/[^0-9]//g;
1560 $store_where = "AND storefront_id='$sid' " if length $sid;
1561 }
1562 return $db->db_readwrite_multiple($dbh, qq~
1563 SELECT page_path,
1564 COUNT(*) AS clicks,
1565 COUNT(DISTINCT session_id) AS sessions
1566 FROM `${DB}`.mkt_tracking_events
1567 WHERE event_type IN ('click','heatmap')
1568 AND occurred_at >= DATE_SUB(NOW(), INTERVAL $days DAY)
1569 $store_where
1570 AND x_pct IS NOT NULL AND y_pct IS NOT NULL
1571 GROUP BY page_path
1572 ORDER BY clicks DESC
1573 LIMIT $limit
1574 ~, $ENV{SCRIPT_NAME}, __LINE__);
1575}
1576
1577# Scroll-depth distribution for a single page-path. The tracker fires
1578# 'scroll' events with the visitor's max scroll % so we aggregate by
1579# session: each session contributes its highest scroll_pct, then we
1580# bucket into 0-10/10-20/.../90-100 deciles for the histogram.
1581sub scroll_depth_distribution {
1582 my ($self, $db, $dbh, $DB, $page_path, $days, $storefront_id) = @_;
1583 return () unless $self->schema_ready($db, $dbh, $DB);
1584 $page_path = '' unless defined $page_path;
1585 $page_path =~ s/'/''/g;
1586 $page_path = substr($page_path, 0, 500);
1587 $days ||= 30; $days =~ s/[^0-9]//g; $days = 30 unless $days;
1588
1589 my $store_where = '';
1590 if (defined $storefront_id && $storefront_id ne '') {
1591 my $sid = $storefront_id; $sid =~ s/[^0-9]//g;
1592 $store_where = "AND storefront_id='$sid' " if length $sid;
1593 }
1594
1595 my @raw = $db->db_readwrite_multiple($dbh, qq~
1596 SELECT MAX(scroll_pct) AS m
1597 FROM `${DB}`.mkt_tracking_events
1598 WHERE event_type='scroll'
1599 AND page_path='$page_path'
1600 $store_where
1601 AND scroll_pct IS NOT NULL
1602 AND occurred_at >= DATE_SUB(NOW(), INTERVAL $days DAY)
1603 GROUP BY session_id
1604 ~, $ENV{SCRIPT_NAME}, __LINE__);
1605
1606 # 10 buckets, 0-9 inclusive, each 10% of page height.
1607 my @buckets = (0) x 10;
1608 foreach my $r (@raw) {
1609 my $m = $r->{m} || 0;
1610 $m = 100 if $m > 100;
1611 my $idx = int($m / 10);
1612 $idx = 9 if $idx > 9;
1613 $buckets[$idx]++;
1614 }
1615 my @out;
1616 for (my $i = 0; $i < 10; $i++) {
1617 my $lo = $i * 10;
1618 my $hi = $i * 10 + 9;
1619 $hi = 100 if $i == 9;
1620 push @out, {
1621 range => $lo . '-' . $hi . '%',
1622 lo => $lo,
1623 hi => $hi,
1624 count => $buckets[$i],
1625 };
1626 }
1627 return @out;
1628}
1629
1630# Approximate "typical visitor viewport height" for a storefront/page.
1631# Used by the heatmap scroll-depth pin overlay: a `scroll_pct` of 30%
1632# does NOT mean the visitor only saw 30% of the page -- they also saw
1633# their entire visible viewport below scrollY. So the line that marks
1634# "how far down visitors really saw" sits at
1635# `(pct * (pageHeight - viewport)) / 100 + viewport`. This helper
1636# returns the median viewport_height from real visitor sessions, so
1637# the math reflects how YOUR audience actually browses. Falls back to
1638# 900 (~typical 1080p chrome) when there's no session data yet.
1639sub typical_viewport_height {
1640 my ($self, $db, $dbh, $DB, $storefront_id, $page_path) = @_;
1641 return 900 unless $self->schema_ready($db, $dbh, $DB);
1642
1643 my $store_where = '';
1644 if (defined $storefront_id && $storefront_id ne '') {
1645 my $sid = $storefront_id; $sid =~ s/[^0-9]//g;
1646 $store_where = "AND s.storefront_id='$sid' " if length $sid;
1647 }
1648 my $page_join_where = '';
1649 if (defined $page_path && length $page_path) {
1650 my $p = $page_path; $p =~ s/'/''/g; $p = substr($p, 0, 500);
1651 # Limit to sessions that actually viewed the page in question,
1652 # so the viewport reflects buyers who scrolled THIS page rather
1653 # than every page on the storefront.
1654 $page_join_where = "AND s.id IN (SELECT DISTINCT session_id FROM `${DB}`.mkt_tracking_events WHERE page_path='$p')";
1655 }
1656
1657 # MariaDB 5.5-friendly median: order rows by viewport_height and
1658 # pick the middle one. We pull a capped sample (top 500 sessions)
1659 # since exact precision isn't needed -- the value just calibrates
1660 # where the depth line sits visually.
1661 my @rows = $db->db_readwrite_multiple($dbh, qq~
1662 SELECT s.viewport_height AS vh
1663 FROM `${DB}`.mkt_tracking_sessions s
1664 WHERE s.viewport_height IS NOT NULL
1665 AND s.viewport_height >= 400
1666 AND s.viewport_height <= 4000
1667 $store_where
1668 $page_join_where
1669 ORDER BY s.viewport_height ASC
1670 LIMIT 500
1671 ~, $ENV{SCRIPT_NAME}, __LINE__);
1672
1673 return 900 unless scalar @rows;
1674 my $mid = int(scalar(@rows) / 2);
1675 my $v = $rows[$mid]->{vh} || 900;
1676 return $v;
1677}
1678
1679# Single-page rollup for the heatmap detail view.
1680# { page_path, clicks, sessions, page_views, avg_scroll, max_scroll }
1681sub heatmap_page_summary {
1682 my ($self, $db, $dbh, $DB, $page_path, $days, $storefront_id) = @_;
1683 return {} unless $self->schema_ready($db, $dbh, $DB);
1684 $page_path = '' unless defined $page_path;
1685 $page_path =~ s/'/''/g;
1686 $page_path = substr($page_path, 0, 500);
1687 $days ||= 30; $days =~ s/[^0-9]//g; $days = 30 unless $days;
1688
1689 my $store_where = '';
1690 if (defined $storefront_id && $storefront_id ne '') {
1691 my $sid = $storefront_id; $sid =~ s/[^0-9]//g;
1692 $store_where = "AND storefront_id='$sid' " if length $sid;
1693 }
1694
1695 my $r = $db->db_readwrite($dbh, qq~
1696 SELECT
1697 SUM(CASE WHEN event_type IN ('click','heatmap') THEN 1 ELSE 0 END) AS clicks,
1698 COUNT(DISTINCT CASE WHEN event_type IN ('click','heatmap') THEN session_id END) AS sessions,
1699 SUM(CASE WHEN event_type='page_view' THEN 1 ELSE 0 END) AS page_views
1700 FROM `${DB}`.mkt_tracking_events
1701 WHERE page_path='$page_path'
1702 $store_where
1703 AND occurred_at >= DATE_SUB(NOW(), INTERVAL $days DAY)
1704 ~, $ENV{SCRIPT_NAME}, __LINE__);
1705 my %out = (
1706 clicks => ($r && $r->{clicks}) ? $r->{clicks} : 0,
1707 sessions => ($r && $r->{sessions}) ? $r->{sessions} : 0,
1708 page_views => ($r && $r->{page_views}) ? $r->{page_views} : 0,
1709 avg_scroll => 0,
1710 max_scroll => 0,
1711 );
1712 my $r2 = $db->db_readwrite($dbh, qq~
1713 SELECT AVG(m) AS a, MAX(m) AS x FROM (
1714 SELECT MAX(scroll_pct) AS m
1715 FROM `${DB}`.mkt_tracking_events
1716 WHERE event_type='scroll'
1717 AND page_path='$page_path'
1718 AND scroll_pct IS NOT NULL
1719 AND occurred_at >= DATE_SUB(NOW(), INTERVAL $days DAY)
1720 GROUP BY session_id
1721 ) t
1722 ~, $ENV{SCRIPT_NAME}, __LINE__);
1723 if ($r2) {
1724 $out{avg_scroll} = $r2->{a} ? int($r2->{a} + 0.5) : 0;
1725 $out{max_scroll} = $r2->{x} ? int($r2->{x}) : 0;
1726 }
1727 return \%out;
1728}
1729
1730# ---- Chat ------------------------------------------------------------
1731# Find the most recent chat for this visitor regardless of status. If
1732# the latest chat is closed or archived, reactivate it before returning
1733# the id -- that way an archived conversation pops back into the admin
1734# Active list the moment the visitor types again. Only when no chat
1735# exists do we create a fresh row.
1736sub get_or_create_chat {
1737 my ($self, $db, $dbh, $DB, $session_id) = @_;
1738 $session_id =~ s/[^0-9]//g;
1739 return 0 unless $session_id;
1740 return 0 unless $self->schema_ready($db, $dbh, $DB);
1741 my $r = $db->db_readwrite($dbh, qq~
1742 SELECT id, status FROM `${DB}`.mkt_support_chats
1743 WHERE session_id='$session_id'
1744 ORDER BY last_message_at DESC LIMIT 1
1745 ~, $ENV{SCRIPT_NAME}, __LINE__);
1746 if ($r && $r->{id}) {
1747 if (($r->{status} || '') ne 'open') {
1748 $db->db_readwrite($dbh, qq~
1749 UPDATE `${DB}`.mkt_support_chats
1750 SET status='open', closed_at=NULL
1751 WHERE id='$r->{id}'
1752 ~, $ENV{SCRIPT_NAME}, __LINE__);
1753 $self->post_chat_message($db, $dbh, $DB,
1754 chat_id => $r->{id},
1755 from_role => 'system',
1756 body => 'Conversation reopened by visitor.',
1757 );
1758 }
1759 return $r->{id};
1760 }
1761 my $ins = $db->db_readwrite($dbh, qq~
1762 INSERT INTO `${DB}`.mkt_support_chats SET session_id='$session_id'
1763 ~, $ENV{SCRIPT_NAME}, __LINE__);
1764 return ($ins && $ins->{mysql_insertid}) ? $ins->{mysql_insertid} : 0;
1765}
1766
1767sub post_chat_message {
1768 my ($self, $db, $dbh, $DB, %a) = @_;
1769 return 0 unless $self->schema_ready($db, $dbh, $DB);
1770 my $chat = $a{chat_id}; $chat =~ s/[^0-9]//g;
1771 return 0 unless $chat;
1772 my $body = defined $a{body} ? $a{body} : '';
1773 $body =~ s/^\s+|\s+$//g;
1774 return 0 unless length $body;
1775 $body =~ s/'/''/g;
1776 $body = substr($body, 0, 4000);
1777
1778 my $role = $a{from_role} || 'visitor';
1779 my %role_ok = (visitor=>1, admin=>1, system=>1);
1780 return 0 unless $role_ok{$role};
1781
1782 my $admin_uid = defined $a{admin_user_id} ? $a{admin_user_id} : '';
1783 $admin_uid =~ s/[^0-9]//g;
1784 my $admin_sql = $admin_uid eq '' ? 'NULL' : "'$admin_uid'";
1785
1786 $db->db_readwrite($dbh, qq~
1787 INSERT INTO `${DB}`.mkt_support_chat_messages
1788 SET chat_id='$chat', from_role='$role',
1789 admin_user_id=$admin_sql, body='$body'
1790 ~, $ENV{SCRIPT_NAME}, __LINE__);
1791
1792 # Bump unread counters on the chat row.
1793 my $unread_col = ($role eq 'visitor') ? 'unread_for_admin' : 'unread_for_visitor';
1794 $db->db_readwrite($dbh, qq~
1795 UPDATE `${DB}`.mkt_support_chats
1796 SET last_message_at=NOW(),
1797 $unread_col = $unread_col + 1
1798 WHERE id='$chat'
1799 ~, $ENV{SCRIPT_NAME}, __LINE__);
1800 return 1;
1801}
1802
1803# Visitor clicked "End" in their chat widget. Drops a system message
1804# in the thread so the admin can see it ended on the visitor's side,
1805# then flips the chat row to closed. Re-opening on visitor's next page
1806# load is fine -- get_or_create_chat() will spin up a fresh chat row.
1807sub end_chat_by_visitor {
1808 my ($self, $db, $dbh, $DB, $chat_id) = @_;
1809 return 0 unless $self->schema_ready($db, $dbh, $DB);
1810 $chat_id =~ s/[^0-9]//g;
1811 return 0 unless $chat_id;
1812
1813 $self->post_chat_message($db, $dbh, $DB,
1814 chat_id => $chat_id,
1815 from_role => 'system',
1816 body => 'Visitor ended the conversation.',
1817 );
1818 $db->db_readwrite($dbh, qq~
1819 UPDATE `${DB}`.mkt_support_chats
1820 SET status='closed', closed_at=NOW()
1821 WHERE id='$chat_id'
1822 ~, $ENV{SCRIPT_NAME}, __LINE__);
1823 return 1;
1824}
1825
1826sub chat_messages {
1827 my ($self, $db, $dbh, $DB, $chat_id, $limit) = @_;
1828 $chat_id =~ s/[^0-9]//g;
1829 return () unless $chat_id;
1830 return () unless $self->schema_ready($db, $dbh, $DB);
1831 $limit ||= 200;
1832 $limit =~ s/[^0-9]//g; $limit = 200 unless $limit;
1833 return $db->db_readwrite_multiple($dbh, qq~
1834 SELECT id, from_role, admin_user_id, body, sent_at, read_at
1835 FROM `${DB}`.mkt_support_chat_messages
1836 WHERE chat_id='$chat_id'
1837 ORDER BY sent_at ASC
1838 LIMIT $limit
1839 ~, $ENV{SCRIPT_NAME}, __LINE__);
1840}
1841
1842sub mark_chat_read {
1843 my ($self, $db, $dbh, $DB, $chat_id, $reader) = @_;
1844 $chat_id =~ s/[^0-9]//g;
1845 return 0 unless $chat_id;
1846 return 0 unless $self->schema_ready($db, $dbh, $DB);
1847 my $col = ($reader eq 'admin') ? 'unread_for_admin' : 'unread_for_visitor';
1848 $db->db_readwrite($dbh, qq~
1849 UPDATE `${DB}`.mkt_support_chats SET $col=0 WHERE id='$chat_id'
1850 ~, $ENV{SCRIPT_NAME}, __LINE__);
1851 return 1;
1852}
1853
1854# Admin chat list -- one row per chat with summary fields. Supports
1855# status filtering (active|closed|archived|all) and free-text search
1856# across visitor label, buyer email, and any message body in the chat.
1857sub admin_chat_list {
1858 my ($self, $db, $dbh, $DB, %opts) = @_;
1859 return () unless $self->schema_ready($db, $dbh, $DB);
1860 my $limit = $opts{limit} || 100;
1861 $limit =~ s/[^0-9]//g; $limit = 100 unless $limit;
1862 my $filter = $opts{filter} || 'active';
1863 my %filter_sql = (
1864 active => "c.status='open'",
1865 closed => "c.status='closed'",
1866 archived => "c.status='archived'",
1867 all => "1=1",
1868 );
1869 my $where_status = $filter_sql{$filter} || $filter_sql{active};
1870
1871 my $search = defined $opts{search} ? $opts{search} : '';
1872 $search =~ s/^\s+|\s+$//g;
1873 my $search_clause = '';
1874 if (length $search) {
1875 my $q = $search;
1876 $q =~ s/'/''/g;
1877 $q = substr($q, 0, 100);
1878 # Match label, buyer email, and any message body in this chat.
1879 $search_clause = qq~
1880 AND (
1881 s.visitor_label LIKE '%$q%'
1882 OR EXISTS (SELECT 1 FROM `${DB}`.buyer_accounts b
1883 WHERE b.id = s.buyer_account_id
1884 AND b.email LIKE '%$q%')
1885 OR EXISTS (SELECT 1 FROM `${DB}`.mkt_support_chat_messages m
1886 WHERE m.chat_id = c.id
1887 AND m.body LIKE '%$q%')
1888 )
1889 ~;
1890 }
1891
1892 return $db->db_readwrite_multiple($dbh, qq~
1893 SELECT c.id AS chat_id, c.session_id, c.status,
1894 c.last_message_at, c.closed_at, c.unread_for_admin,
1895 s.visitor_label, s.os_name, s.browser_name,
1896 s.device_type, s.current_page_path, s.is_online,
1897 TIMESTAMPDIFF(SECOND, s.last_seen_at, NOW()) AS idle_seconds,
1898 (SELECT body FROM `${DB}`.mkt_support_chat_messages
1899 WHERE chat_id=c.id
1900 ORDER BY sent_at DESC LIMIT 1) AS last_body,
1901 (SELECT from_role FROM `${DB}`.mkt_support_chat_messages
1902 WHERE chat_id=c.id
1903 ORDER BY sent_at DESC LIMIT 1) AS last_from
1904 FROM `${DB}`.mkt_support_chats c
1905 JOIN `${DB}`.mkt_tracking_sessions s ON s.id = c.session_id
1906 WHERE $where_status
1907 $search_clause
1908 ORDER BY c.last_message_at DESC
1909 LIMIT $limit
1910 ~, $ENV{SCRIPT_NAME}, __LINE__);
1911}
1912
1913# Counts per status -- powers the filter-tab badges. Returns a hashref:
1914# { active => N, closed => N, archived => N, all => N }
1915sub chat_counts_by_status {
1916 my ($self, $db, $dbh, $DB) = @_;
1917 my %out = (active=>0, closed=>0, archived=>0, all=>0);
1918 return \%out unless $self->schema_ready($db, $dbh, $DB);
1919 my @rows = $db->db_readwrite_multiple($dbh, qq~
1920 SELECT status, COUNT(*) AS n FROM `${DB}`.mkt_support_chats GROUP BY status
1921 ~, $ENV{SCRIPT_NAME}, __LINE__);
1922 foreach my $r (@rows) {
1923 my $st = $r->{status} || '';
1924 my $n = $r->{n} || 0;
1925 $out{active} = $n if $st eq 'open';
1926 $out{closed} = $n if $st eq 'closed';
1927 $out{archived} = $n if $st eq 'archived';
1928 $out{all} += $n;
1929 }
1930 return \%out;
1931}
1932
1933# Admin closes the chat -- audit trail in the thread, then status=closed.
1934sub close_chat_by_admin {
1935 my ($self, $db, $dbh, $DB, $chat_id, $admin_user_id) = @_;
1936 return 0 unless $self->schema_ready($db, $dbh, $DB);
1937 $chat_id =~ s/[^0-9]//g;
1938 return 0 unless $chat_id;
1939 $self->post_chat_message($db, $dbh, $DB,
1940 chat_id => $chat_id,
1941 from_role => 'system',
1942 admin_user_id => $admin_user_id,
1943 body => 'Admin closed the conversation.',
1944 );
1945 $db->db_readwrite($dbh, qq~
1946 UPDATE `${DB}`.mkt_support_chats
1947 SET status='closed', closed_at=NOW()
1948 WHERE id='$chat_id'
1949 ~, $ENV{SCRIPT_NAME}, __LINE__);
1950 return 1;
1951}
1952
1953# Admin archives -- hides from the default Active view but the row is
1954# still queryable. Visitor typing reopens automatically.
1955sub archive_chat_by_admin {
1956 my ($self, $db, $dbh, $DB, $chat_id, $admin_user_id) = @_;
1957 return 0 unless $self->schema_ready($db, $dbh, $DB);
1958 $chat_id =~ s/[^0-9]//g;
1959 return 0 unless $chat_id;
1960 $self->post_chat_message($db, $dbh, $DB,
1961 chat_id => $chat_id,
1962 from_role => 'system',
1963 admin_user_id => $admin_user_id,
1964 body => 'Conversation archived.',
1965 );
1966 $db->db_readwrite($dbh, qq~
1967 UPDATE `${DB}`.mkt_support_chats
1968 SET status='archived', closed_at=NOW()
1969 WHERE id='$chat_id'
1970 ~, $ENV{SCRIPT_NAME}, __LINE__);
1971 return 1;
1972}
1973
1974# Admin reopens a closed/archived chat manually.
1975sub reopen_chat_by_admin {
1976 my ($self, $db, $dbh, $DB, $chat_id, $admin_user_id) = @_;
1977 return 0 unless $self->schema_ready($db, $dbh, $DB);
1978 $chat_id =~ s/[^0-9]//g;
1979 return 0 unless $chat_id;
1980 $db->db_readwrite($dbh, qq~
1981 UPDATE `${DB}`.mkt_support_chats
1982 SET status='open', closed_at=NULL
1983 WHERE id='$chat_id'
1984 ~, $ENV{SCRIPT_NAME}, __LINE__);
1985 $self->post_chat_message($db, $dbh, $DB,
1986 chat_id => $chat_id,
1987 from_role => 'system',
1988 admin_user_id => $admin_user_id,
1989 body => 'Admin reopened the conversation.',
1990 );
1991 return 1;
1992}
1993
1994# ---- Push links ------------------------------------------------------
1995sub push_link {
1996 my ($self, $db, $dbh, $DB, %a) = @_;
1997 return 0 unless $self->schema_ready($db, $dbh, $DB);
1998 my $sid = $a{session_id}; $sid =~ s/[^0-9]//g;
1999 return 0 unless $sid;
2000 my $url = defined $a{url} ? $a{url} : '';
2001 $url =~ s/^\s+|\s+$//g;
2002 return 0 unless $url =~ m{^https?://}i || $url =~ m{^/};
2003 $url =~ s/'/''/g; $url = substr($url, 0, 500);
2004
2005 my $label = defined $a{label} ? $a{label} : '';
2006 $label =~ s/'/''/g; $label = substr($label, 0, 200);
2007 my $label_sql = length $label ? "'$label'" : 'NULL';
2008
2009 my $mode = $a{open_mode} || 'new_tab';
2010 my %mode_ok = (new_tab=>1, same_tab=>1, popup=>1);
2011 $mode = 'new_tab' unless $mode_ok{$mode};
2012
2013 my $admin_uid = defined $a{admin_user_id} ? $a{admin_user_id} : '';
2014 $admin_uid =~ s/[^0-9]//g;
2015 my $admin_sql = $admin_uid eq '' ? 'NULL' : "'$admin_uid'";
2016
2017 $db->db_readwrite($dbh, qq~
2018 INSERT INTO `${DB}`.mkt_support_push_links
2019 SET session_id='$sid', admin_user_id=$admin_sql,
2020 url='$url', label=$label_sql, open_mode='$mode'
2021 ~, $ENV{SCRIPT_NAME}, __LINE__);
2022
2023 # Also drop a chat message into the active conversation so:
2024 # - the visitor sees a clickable link in their chat widget
2025 # (popup blockers silently kill window.open() in setInterval
2026 # callbacks, so the auto-open above is best-effort only)
2027 # - the admin sees what they pushed echo back in their own
2028 # thread view on the next 6s refresh -- confirmation that
2029 # the push went through.
2030 # Unescape the SQL-escaped label/url for the human-readable
2031 # message body (we'll re-escape it for the INSERT below).
2032 my $disp_url = $url; $disp_url =~ s/''/'/g;
2033 my $disp_label = $label; $disp_label =~ s/''/'/g;
2034 my $chat = $db->db_readwrite($dbh, qq~
2035 SELECT id FROM `${DB}`.mkt_support_chats
2036 WHERE session_id='$sid' AND status='open'
2037 ORDER BY started_at DESC LIMIT 1
2038 ~, $ENV{SCRIPT_NAME}, __LINE__);
2039 if ($chat && $chat->{id}) {
2040 my $cid = $chat->{id};
2041 my $body_text = length $disp_label
2042 ? "I'd like you to check out $disp_label: $disp_url"
2043 : "I'd like you to check out this link: $disp_url";
2044 my $body_sql = $body_text;
2045 $body_sql =~ s/'/''/g;
2046 $db->db_readwrite($dbh, qq~
2047 INSERT INTO `${DB}`.mkt_support_chat_messages
2048 SET chat_id='$cid',
2049 from_role='admin',
2050 admin_user_id=$admin_sql,
2051 body='$body_sql'
2052 ~, $ENV{SCRIPT_NAME}, __LINE__);
2053 $db->db_readwrite($dbh, qq~
2054 UPDATE `${DB}`.mkt_support_chats
2055 SET last_message_at=NOW(),
2056 unread_for_visitor = unread_for_visitor + 1
2057 WHERE id='$cid'
2058 ~, $ENV{SCRIPT_NAME}, __LINE__);
2059 }
2060 return 1;
2061}
2062
2063# Visitor's long-poll endpoint asks "give me anything new for me":
2064# new chat messages from admin + new pushed links. Marks them
2065# delivered so they don't get returned twice.
2066sub poll_for_visitor {
2067 my ($self, $db, $dbh, $DB, $session_id) = @_;
2068 $session_id =~ s/[^0-9]//g;
2069 return { messages => [], pushes => [] } unless $session_id;
2070 return { messages => [], pushes => [] } unless $self->schema_ready($db, $dbh, $DB);
2071
2072 # Active chat for this session
2073 my $chat = $db->db_readwrite($dbh, qq~
2074 SELECT id FROM `${DB}`.mkt_support_chats
2075 WHERE session_id='$session_id' AND status='open'
2076 ORDER BY started_at DESC LIMIT 1
2077 ~, $ENV{SCRIPT_NAME}, __LINE__);
2078 my @msgs;
2079 if ($chat && $chat->{id}) {
2080 @msgs = $db->db_readwrite_multiple($dbh, qq~
2081 SELECT id, body, sent_at
2082 FROM `${DB}`.mkt_support_chat_messages
2083 WHERE chat_id='$chat->{id}'
2084 AND from_role='admin'
2085 AND delivered_at IS NULL
2086 ORDER BY sent_at ASC
2087 ~, $ENV{SCRIPT_NAME}, __LINE__);
2088 if (@msgs) {
2089 my $ids = join(',', map { "'$_->{id}'" } @msgs);
2090 $db->db_readwrite($dbh, qq~
2091 UPDATE `${DB}`.mkt_support_chat_messages
2092 SET delivered_at=NOW()
2093 WHERE id IN ($ids)
2094 ~, $ENV{SCRIPT_NAME}, __LINE__);
2095 }
2096 }
2097
2098 my @pushes = $db->db_readwrite_multiple($dbh, qq~
2099 SELECT id, url, label, open_mode
2100 FROM `${DB}`.mkt_support_push_links
2101 WHERE session_id='$session_id' AND delivered_at IS NULL
2102 ORDER BY pushed_at ASC
2103 ~, $ENV{SCRIPT_NAME}, __LINE__);
2104 if (@pushes) {
2105 my $ids = join(',', map { "'$_->{id}'" } @pushes);
2106 $db->db_readwrite($dbh, qq~
2107 UPDATE `${DB}`.mkt_support_push_links
2108 SET delivered_at=NOW()
2109 WHERE id IN ($ids)
2110 ~, $ENV{SCRIPT_NAME}, __LINE__);
2111 }
2112 return { messages => \@msgs, pushes => \@pushes };
2113}
2114
2115# ---- Admin online status (lives in platform_settings) ---------------
2116sub set_admin_online {
2117 my ($self, $db, $dbh, $DB, $on, $uid) = @_;
2118 # Reuse platform_settings via SEO module's set_platform_setting
2119 # rather than duplicating logic.
2120 require MODS::ABForge::SEO;
2121 my $seo = MODS::ABForge::SEO->new;
2122 return $seo->set_platform_setting($db, $dbh, $DB, 'support.admin_online',
2123 $on ? '1' : '0', $uid);
2124}
2125
2126sub admin_online {
2127 my ($self, $db, $dbh, $DB) = @_;
2128 require MODS::ABForge::SEO;
2129 my $seo = MODS::ABForge::SEO->new;
2130 return 0 unless $seo->platform_settings_ready($db, $dbh, $DB);
2131 my $r = $db->db_readwrite($dbh, qq~
2132 SELECT setting_value FROM `${DB}`.platform_settings
2133 WHERE setting_key='support.admin_online' LIMIT 1
2134 ~, $ENV{SCRIPT_NAME}, __LINE__);
2135 return ($r && $r->{setting_value} eq '1') ? 1 : 0;
2136}
2137
2138# ---- Fingerprint sanitization ---------------------------------------
2139sub _sanitize_fingerprint {
2140 my ($self, $a) = @_;
2141 my %f;
2142
2143 my %device_ok = map { $_ => 1 } qw(desktop tablet mobile tv bot unknown);
2144 $f{device_type} = $a->{device_type};
2145 $f{device_type} = 'unknown' unless $f{device_type} && $device_ok{$f{device_type}};
2146
2147 $f{touch} = ($a->{touch_capable} && $a->{touch_capable} ne '0') ? 1 : 0;
2148
2149 $f{os_name_q} = _qstr_trunc($a->{os_name}, 40);
2150 $f{os_version_q} = _qstr_trunc($a->{os_version}, 40);
2151 $f{browser_name_q} = _qstr_trunc($a->{browser_name}, 40);
2152 $f{browser_version_q} = _qstr_trunc($a->{browser_version}, 40);
2153 $f{language_q} = _qstr_trunc($a->{language}, 16);
2154 $f{timezone_q} = _qstr_trunc($a->{timezone}, 64);
2155 $f{ua_q} = _qstr_trunc($a->{user_agent}, 500);
2156 $f{referrer_q} = _qstr_trunc($a->{referrer}, 500);
2157 $f{path_q} = _qstr_trunc($a->{current_page_path}, 500);
2158
2159 # Derive ISO-2 country from IANA timezone (e.g. America/Denver -> US).
2160 # We pick the timezone path because it's collected client-side on
2161 # every page load and is reliable for ~95% of real visitors -- IP
2162 # geolocation would be more accurate but needs a GeoIP dataset.
2163 # Caller can override by passing an explicit country.
2164 my $cc = '';
2165 if (defined $a->{country} && $a->{country} =~ /\S/) {
2166 $cc = uc(substr($a->{country}, 0, 2));
2167 $cc =~ s/[^A-Z]//g;
2168 }
2169 if (!$cc && defined $a->{timezone}) {
2170 $cc = _country_from_timezone($a->{timezone}) || '';
2171 }
2172 $f{country_q} = length $cc ? "'$cc'" : 'NULL';
2173
2174 # Region (state) -- caller can supply explicitly; otherwise we
2175 # derive a best-guess from the IANA timezone when the country
2176 # is US (only one for which we have a state lookup right now).
2177 my $rg = '';
2178 if (defined $a->{region} && $a->{region} =~ /\S/) {
2179 $rg = $a->{region};
2180 } elsif ($cc eq 'US' && defined $a->{timezone}) {
2181 $rg = _us_state_from_timezone($a->{timezone}) || '';
2182 }
2183 if (length $rg) {
2184 $rg =~ s/'/''/g;
2185 $rg = substr($rg, 0, 80);
2186 $f{region_q} = "'$rg'";
2187 } else {
2188 $f{region_q} = 'NULL';
2189 }
2190
2191 foreach my $k (qw(screen_w screen_h viewport_w viewport_h color_depth)) {
2192 my $src = $a->{$k};
2193 $src = '' unless defined $src;
2194 $src =~ s/[^0-9]//g;
2195 $f{"${k}_sql"} = length $src ? "'$src'" : 'NULL';
2196 }
2197 my $pr = defined $a->{pixel_ratio} ? $a->{pixel_ratio} : '';
2198 $pr =~ s/[^0-9.]//g;
2199 $f{pixel_ratio_sql} = length $pr ? "'$pr'" : 'NULL';
2200
2201 my $store = defined $a->{storefront_id} ? $a->{storefront_id} : '';
2202 $store =~ s/[^0-9]//g;
2203 $f{storefront_sql} = $store eq '' ? 'NULL' : "'$store'";
2204
2205 my $buyer = defined $a->{buyer_account_id} ? $a->{buyer_account_id} : '';
2206 $buyer =~ s/[^0-9]//g;
2207 $f{buyer_sql} = $buyer eq '' ? 'NULL' : "'$buyer'";
2208
2209 # Store IP as a plain string (VARCHAR(45) handles full IPv6). We
2210 # used to wrap in INET6_ATON() but that function isn't installed on
2211 # every MariaDB build, so storing text keeps the platform portable.
2212 my $ip = defined $a->{ip_address} ? $a->{ip_address} : '';
2213 $ip =~ s/[^0-9a-fA-F.:]//g;
2214 $ip = substr($ip, 0, 45);
2215 $f{ip_sql} = length $ip ? "'$ip'" : 'NULL';
2216
2217 return %f;
2218}
2219
2220sub _qstr_trunc {
2221 my ($s, $max) = @_;
2222 return 'NULL' unless defined $s && length $s;
2223 $s =~ s/[\r\n]+/ /g;
2224 $s =~ s/'/''/g;
2225 $s = substr($s, 0, $max);
2226 return "'$s'";
2227}
2228
2229# ---- IANA timezone -> ISO-2 country code lookup ---------------------
2230# Covers the timezones we see most of the time -- enough to populate
2231# the world map for the long tail. Multi-country timezones (e.g.
2232# Europe/Zurich is fine for CH, but Etc/UTC is not assignable) return
2233# undef and the caller treats that as "unknown".
2234my %TZ2CC = (
2235 # North America
2236 'America/Adak' => 'US', 'America/Anchorage' => 'US',
2237 'America/Boise' => 'US', 'America/Chicago' => 'US',
2238 'America/Denver' => 'US', 'America/Detroit' => 'US',
2239 'America/Indiana/Indianapolis'=> 'US', 'America/Indianapolis' => 'US',
2240 'America/Juneau' => 'US', 'America/Kentucky/Louisville' => 'US',
2241 'America/Los_Angeles' => 'US', 'America/Menominee' => 'US',
2242 'America/Metlakatla' => 'US', 'America/New_York' => 'US',
2243 'America/Nome' => 'US', 'America/Phoenix' => 'US',
2244 'America/Sitka' => 'US', 'America/Yakutat' => 'US',
2245 'Pacific/Honolulu' => 'US',
2246 'US/Eastern' => 'US', 'US/Central' => 'US', 'US/Mountain' => 'US',
2247 'US/Pacific' => 'US', 'US/Alaska' => 'US', 'US/Hawaii' => 'US',
2248 'US/Arizona' => 'US', 'US/Samoa' => 'US',
2249 'America/Toronto' => 'CA', 'America/Vancouver' => 'CA',
2250 'America/Edmonton' => 'CA', 'America/Winnipeg' => 'CA',
2251 'America/Halifax' => 'CA', 'America/Montreal' => 'CA',
2252 'America/Regina' => 'CA', 'America/St_Johns' => 'CA',
2253 'America/Mexico_City' => 'MX', 'America/Tijuana' => 'MX',
2254 'America/Monterrey' => 'MX', 'America/Cancun' => 'MX',
2255 'America/Guatemala' => 'GT', 'America/Belize' => 'BZ',
2256 'America/El_Salvador' => 'SV', 'America/Tegucigalpa'=> 'HN',
2257 'America/Managua' => 'NI', 'America/Costa_Rica' => 'CR',
2258 'America/Panama' => 'PA', 'America/Havana' => 'CU',
2259 'America/Santo_Domingo' => 'DO', 'America/Port-au-Prince' => 'HT',
2260 'America/Puerto_Rico' => 'PR',
2261 # South America
2262 'America/Sao_Paulo' => 'BR', 'America/Recife' => 'BR',
2263 'America/Manaus' => 'BR', 'America/Bahia' => 'BR',
2264 'America/Fortaleza' => 'BR', 'America/Belem' => 'BR',
2265 'America/Argentina/Buenos_Aires' => 'AR', 'America/Argentina/Cordoba' => 'AR',
2266 'America/Buenos_Aires' => 'AR',
2267 'America/Santiago' => 'CL', 'America/Lima' => 'PE',
2268 'America/Bogota' => 'CO', 'America/Caracas' => 'VE',
2269 'America/Guayaquil' => 'EC', 'America/Montevideo' => 'UY',
2270 'America/Asuncion' => 'PY', 'America/La_Paz' => 'BO',
2271 # Europe
2272 'Europe/London' => 'GB', 'Europe/Dublin' => 'IE',
2273 'Europe/Paris' => 'FR', 'Europe/Berlin' => 'DE',
2274 'Europe/Amsterdam'=> 'NL', 'Europe/Brussels' => 'BE',
2275 'Europe/Luxembourg'=>'LU', 'Europe/Zurich' => 'CH',
2276 'Europe/Vienna' => 'AT', 'Europe/Rome' => 'IT',
2277 'Europe/Madrid' => 'ES', 'Europe/Lisbon' => 'PT',
2278 'Europe/Copenhagen'=>'DK', 'Europe/Oslo' => 'NO',
2279 'Europe/Stockholm'=> 'SE', 'Europe/Helsinki' => 'FI',
2280 'Europe/Warsaw' => 'PL', 'Europe/Prague' => 'CZ',
2281 'Europe/Bratislava'=>'SK', 'Europe/Budapest' => 'HU',
2282 'Europe/Bucharest'=> 'RO', 'Europe/Sofia' => 'BG',
2283 'Europe/Athens' => 'GR', 'Europe/Kiev' => 'UA',
2284 'Europe/Kyiv' => 'UA', 'Europe/Moscow' => 'RU',
2285 'Europe/Istanbul' => 'TR', 'Europe/Belgrade' => 'RS',
2286 'Europe/Tallinn' => 'EE', 'Europe/Riga' => 'LV',
2287 'Europe/Vilnius' => 'LT', 'Europe/Reykjavik'=> 'IS',
2288 # Middle East / North Africa
2289 'Asia/Jerusalem' => 'IL', 'Asia/Tel_Aviv' => 'IL',
2290 'Asia/Riyadh' => 'SA', 'Asia/Dubai' => 'AE',
2291 'Asia/Qatar' => 'QA', 'Asia/Kuwait' => 'KW',
2292 'Asia/Bahrain' => 'BH', 'Asia/Muscat' => 'OM',
2293 'Asia/Tehran' => 'IR', 'Asia/Baghdad' => 'IQ',
2294 'Asia/Beirut' => 'LB', 'Asia/Amman' => 'JO',
2295 'Africa/Cairo' => 'EG', 'Africa/Casablanca'=>'MA',
2296 'Africa/Algiers' => 'DZ', 'Africa/Tunis' => 'TN',
2297 # Sub-Saharan Africa
2298 'Africa/Johannesburg' => 'ZA', 'Africa/Lagos' => 'NG',
2299 'Africa/Nairobi' => 'KE', 'Africa/Accra' => 'GH',
2300 'Africa/Addis_Ababa' => 'ET', 'Africa/Dakar' => 'SN',
2301 # South Asia
2302 'Asia/Kolkata' => 'IN', 'Asia/Calcutta' => 'IN',
2303 'Asia/Karachi' => 'PK', 'Asia/Dhaka' => 'BD',
2304 'Asia/Colombo' => 'LK', 'Asia/Kathmandu' => 'NP',
2305 # East Asia
2306 'Asia/Tokyo' => 'JP', 'Asia/Seoul' => 'KR',
2307 'Asia/Taipei' => 'TW', 'Asia/Hong_Kong' => 'HK',
2308 'Asia/Shanghai' => 'CN', 'Asia/Beijing' => 'CN',
2309 'Asia/Macau' => 'MO', 'Asia/Ulaanbaatar'=>'MN',
2310 # Southeast Asia
2311 'Asia/Singapore' => 'SG', 'Asia/Kuala_Lumpur'=>'MY',
2312 'Asia/Bangkok' => 'TH', 'Asia/Ho_Chi_Minh' => 'VN',
2313 'Asia/Jakarta' => 'ID', 'Asia/Manila' => 'PH',
2314 'Asia/Yangon' => 'MM', 'Asia/Phnom_Penh' => 'KH',
2315 # Oceania
2316 'Australia/Sydney' => 'AU', 'Australia/Melbourne'=> 'AU',
2317 'Australia/Brisbane' => 'AU', 'Australia/Perth' => 'AU',
2318 'Australia/Adelaide' => 'AU', 'Australia/Darwin' => 'AU',
2319 'Australia/Hobart' => 'AU',
2320 'Pacific/Auckland' => 'NZ', 'Pacific/Fiji' => 'FJ',
2321);
2322
2323sub _country_from_timezone {
2324 my ($tz) = @_;
2325 return undef unless defined $tz && length $tz;
2326 $tz =~ s/^\s+|\s+$//g;
2327 return $TZ2CC{$tz} if exists $TZ2CC{$tz};
2328 # Some browsers report just the offset like "Etc/GMT+8" -- unmappable.
2329 return undef;
2330}
2331
2332# Best-guess US state from an IANA timezone. The four main zones
2333# (Pacific/Mountain/Central/Eastern) span multiple states, so for
2334# those we return the most-populous state in the zone. The single-
2335# state IANA zones (Anchorage, Phoenix, Detroit, Honolulu, etc.)
2336# return the actual state -- those are exact.
2337my %TZ2US_STATE = (
2338 'America/Adak' => 'Alaska',
2339 'America/Anchorage' => 'Alaska',
2340 'America/Boise' => 'Idaho',
2341 'America/Chicago' => 'Illinois',
2342 'America/Denver' => 'Colorado',
2343 'America/Detroit' => 'Michigan',
2344 'America/Indiana/Indianapolis' => 'Indiana',
2345 'America/Indiana/Knox' => 'Indiana',
2346 'America/Indiana/Marengo' => 'Indiana',
2347 'America/Indiana/Petersburg' => 'Indiana',
2348 'America/Indiana/Tell_City' => 'Indiana',
2349 'America/Indiana/Vevay' => 'Indiana',
2350 'America/Indiana/Vincennes' => 'Indiana',
2351 'America/Indiana/Winamac' => 'Indiana',
2352 'America/Indianapolis' => 'Indiana',
2353 'America/Juneau' => 'Alaska',
2354 'America/Kentucky/Louisville' => 'Kentucky',
2355 'America/Kentucky/Monticello' => 'Kentucky',
2356 'America/Los_Angeles' => 'California',
2357 'America/Menominee' => 'Michigan',
2358 'America/Metlakatla' => 'Alaska',
2359 'America/New_York' => 'New York',
2360 'America/Nome' => 'Alaska',
2361 'America/North_Dakota/Beulah' => 'North Dakota',
2362 'America/North_Dakota/Center' => 'North Dakota',
2363 'America/North_Dakota/New_Salem' => 'North Dakota',
2364 'America/Phoenix' => 'Arizona',
2365 'America/Sitka' => 'Alaska',
2366 'America/Yakutat' => 'Alaska',
2367 'Pacific/Honolulu' => 'Hawaii',
2368 'US/Eastern' => 'New York',
2369 'US/Central' => 'Illinois',
2370 'US/Mountain' => 'Colorado',
2371 'US/Pacific' => 'California',
2372 'US/Alaska' => 'Alaska',
2373 'US/Hawaii' => 'Hawaii',
2374 'US/Arizona' => 'Arizona',
2375 'US/Samoa' => 'American Samoa',
2376);
2377
2378sub _us_state_from_timezone {
2379 my ($tz) = @_;
2380 return undef unless defined $tz && length $tz;
2381 $tz =~ s/^\s+|\s+$//g;
2382 return $TZ2US_STATE{$tz};
2383}
2384
2385# Backfill country for existing sessions that have a timezone but no
2386# country yet. Cheap one-shot called by /admin_visitors.cgi on each
2387# page load (idempotent); the WHERE clause keeps it from touching rows
2388# already populated. Cost is O(rows-with-null-country) per call,
2389# which is small since the cron-style guard kicks in.
2390sub backfill_country_from_timezone {
2391 my ($self, $db, $dbh, $DB, $limit) = @_;
2392 return 0 unless $self->schema_ready($db, $dbh, $DB);
2393 $limit ||= 500; $limit =~ s/[^0-9]//g; $limit = 500 unless $limit;
2394 my $region_ready = $self->region_column_ready($db, $dbh, $DB);
2395
2396 # Pass 1: rows missing country but having timezone.
2397 my @rows = $db->db_readwrite_multiple($dbh, qq~
2398 SELECT id, timezone FROM `${DB}`.mkt_tracking_sessions
2399 WHERE (country IS NULL OR country='')
2400 AND timezone IS NOT NULL AND timezone<>''
2401 LIMIT $limit
2402 ~, $ENV{SCRIPT_NAME}, __LINE__);
2403 my $n = 0;
2404 foreach my $r (@rows) {
2405 my $cc = _country_from_timezone($r->{timezone});
2406 next unless $cc;
2407 $cc = uc($cc); $cc =~ s/[^A-Z]//g;
2408 next unless length($cc) == 2;
2409 my $extra = '';
2410 if ($region_ready && $cc eq 'US') {
2411 my $st = _us_state_from_timezone($r->{timezone});
2412 if ($st) {
2413 my $sq = $st; $sq =~ s/'/''/g; $sq = substr($sq, 0, 80);
2414 $extra = ", region='$sq'";
2415 }
2416 }
2417 $db->db_readwrite($dbh, qq~
2418 UPDATE `${DB}`.mkt_tracking_sessions SET country='$cc'$extra WHERE id='$r->{id}'
2419 ~, $ENV{SCRIPT_NAME}, __LINE__);
2420 $n++;
2421 }
2422
2423 # Pass 2: rows that already have country='US' but blank region.
2424 # Covers the case where country was populated before the region
2425 # column even existed.
2426 if ($region_ready) {
2427 my @us_rows = $db->db_readwrite_multiple($dbh, qq~
2428 SELECT id, timezone FROM `${DB}`.mkt_tracking_sessions
2429 WHERE country='US'
2430 AND (region IS NULL OR region='')
2431 AND timezone IS NOT NULL AND timezone<>''
2432 LIMIT $limit
2433 ~, $ENV{SCRIPT_NAME}, __LINE__);
2434 foreach my $r (@us_rows) {
2435 my $st = _us_state_from_timezone($r->{timezone});
2436 next unless $st;
2437 my $sq = $st; $sq =~ s/'/''/g; $sq = substr($sq, 0, 80);
2438 $db->db_readwrite($dbh, qq~
2439 UPDATE `${DB}`.mkt_tracking_sessions SET region='$sq' WHERE id='$r->{id}'
2440 ~, $ENV{SCRIPT_NAME}, __LINE__);
2441 $n++;
2442 }
2443 }
2444
2445 return $n;
2446}
2447
2448# ---- Lightweight User-Agent parser ----------------------------------
2449# Just enough heuristics to extract OS + browser when the client JS
2450# doesn't pass them in. Real parsing happens client-side via navigator.
2451sub parse_ua {
2452 my ($self, $ua) = @_;
2453 return ({}) unless defined $ua && length $ua;
2454 my %r;
2455 # OS
2456 if ($ua =~ /Windows NT 10/i) { $r{os_name} = 'Windows'; $r{os_version} = '10/11'; }
2457 elsif ($ua =~ /Windows NT ([\d.]+)/i) { $r{os_name} = 'Windows'; $r{os_version} = $1; }
2458 elsif ($ua =~ /Mac OS X ([\d_]+)/i) { (my $v = $1) =~ tr/_/./; $r{os_name} = 'macOS'; $r{os_version} = $v; }
2459 elsif ($ua =~ /iPhone|iPad|iPod/i) { $r{os_name} = 'iOS'; $r{os_version} = ($ua =~ /OS ([\d_]+)/ ? do { (my $v = $1) =~ tr/_/./; $v } : ''); }
2460 elsif ($ua =~ /Android ([\d.]+)/i) { $r{os_name} = 'Android'; $r{os_version} = $1; }
2461 elsif ($ua =~ /Linux/i) { $r{os_name} = 'Linux'; $r{os_version} = ''; }
2462 else { $r{os_name} = ''; $r{os_version} = ''; }
2463 # Browser - check Edge before Chrome before Safari
2464 if ($ua =~ /Edg\/([\d.]+)/) { $r{browser_name} = 'Edge'; $r{browser_version} = $1; }
2465 elsif ($ua =~ /OPR\/([\d.]+)/) { $r{browser_name} = 'Opera'; $r{browser_version} = $1; }
2466 elsif ($ua =~ /Firefox\/([\d.]+)/) { $r{browser_name} = 'Firefox'; $r{browser_version} = $1; }
2467 elsif ($ua =~ /Chrome\/([\d.]+)/) { $r{browser_name} = 'Chrome'; $r{browser_version} = $1; }
2468 elsif ($ua =~ /Safari\/([\d.]+).*Version\/([\d.]+)/) { $r{browser_name} = 'Safari'; $r{browser_version} = $2; }
2469 elsif ($ua =~ /Safari/) { $r{browser_name} = 'Safari'; $r{browser_version} = ''; }
2470 else { $r{browser_name} = ''; $r{browser_version} = ''; }
2471 # Device type
2472 if ($ua =~ /iPad|Tablet/i) { $r{device_type} = 'tablet'; }
2473 elsif ($ua =~ /iPhone|Android.*Mobile|Mobile/i) { $r{device_type} = 'mobile'; }
2474 elsif ($ua =~ /bot|crawl|spider/i) { $r{device_type} = 'bot'; }
2475 else { $r{device_type} = 'desktop'; }
2476 return \%r;
2477}
2478
2479
2480# --- phase5-tracking-exclusion :: 2026-07-02 ---
2481# Return 1 if caller's IP matches any active tracking_exclusions row.
2482# Checked at both create_session and log_event so both new-session and
2483# ongoing-session inserts are gated.
2484sub _phase5_ip_excluded {
2485 my ($db, $dbh, $DB) = @_;
2486 my $ip = $ENV{HTTP_X_FORWARDED_FOR} || $ENV{REMOTE_ADDR} || '';
2487 $ip =~ s/,.*$//; $ip =~ s/\s+//g;
2488 $ip =~ s/[^0-9a-fA-F:.]//g;
2489 return 0 unless length $ip;
2490 my $r = $db->db_readwrite($dbh, qq~
2491 SELECT id FROM ``.tracking_exclusions
2492 WHERE active=1 AND ip='$ip' LIMIT 1
2493 ~, $ENV{SCRIPT_NAME}, __LINE__);
2494 return ($r && $r->{id}) ? 1 : 0;
2495}
2496
24971;
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help