Diff -- /var/www/vhosts/3dshawn.com/repricer.3dshawn.com/MODS/RePricer/Tracking.pm
Diff

/var/www/vhosts/3dshawn.com/repricer.3dshawn.com/MODS/RePricer/Tracking.pm

added on local at 2026-07-01 21:47:15

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