added on local at 2026-07-01 12:34:27
| 1 | package MODS::PTMatrix::Tracking; | |
| 2 | #====================================================================== | |
| 3 | # TaskForge -- Visitor tracking + traffic analytics. | |
| 4 | # | |
| 5 | # Two tables (db_schema.sql section 9): | |
| 6 | # tracking_sessions one row per visitor browser cookie | |
| 7 | # tracking_events append-only firehose of page_view/click/scroll | |
| 8 | # | |
| 9 | # Public API used by: | |
| 10 | # /track.cgi ingest endpoint (POST from /assets/javascript/track.js) | |
| 11 | # /admin_visitors.cgi KPI tiles + globe + audience + sources + live list | |
| 12 | # | |
| 13 | # Schema-readiness is verified at every entry point because | |
| 14 | # DBConnect's error() calls exit() on a missing table -- early-adopter | |
| 15 | # accounts may not have applied the migration yet. | |
| 16 | # | |
| 17 | # Adapted from MODS::WebSTLs::Tracking with: | |
| 18 | # storefront_id -> company_id | |
| 19 | # buyer_account_id-> user_id | |
| 20 | # storefronts -> companies | |
| 21 | # buyer_accounts -> users | |
| 22 | # Chat / push-link / heatmap subsystems removed; those are separate | |
| 23 | # features that can be added later. | |
| 24 | #====================================================================== | |
| 25 | use strict; | |
| 26 | use warnings; | |
| 27 | ||
| 28 | sub new { | |
| 29 | my ($class, %args) = @_; | |
| 30 | return bless({}, $class); | |
| 31 | } | |
| 32 | ||
| 33 | # ---- Schema readiness ------------------------------------------------ | |
| 34 | sub schema_ready { | |
| 35 | my ($self, $db, $dbh, $DB) = @_; | |
| 36 | foreach my $t (qw(tracking_sessions tracking_events)) { | |
| 37 | my $r = $db->db_readwrite($dbh, qq~ | |
| 38 | SELECT COUNT(*) AS n FROM information_schema.tables | |
| 39 | WHERE table_schema='$DB' AND table_name='$t' | |
| 40 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 41 | return 0 unless ($r && $r->{n}); | |
| 42 | } | |
| 43 | return 1; | |
| 44 | } | |
| 45 | ||
| 46 | # Cheap process-scoped check for whether a column exists on a table. | |
| 47 | my %_COL_CACHE; | |
| 48 | sub _has_column { | |
| 49 | my ($self, $db, $dbh, $DB, $table, $col) = @_; | |
| 50 | my $k = "$DB.$table.$col"; | |
| 51 | return $_COL_CACHE{$k} if exists $_COL_CACHE{$k}; | |
| 52 | my $r = $db->db_readwrite($dbh, qq~ | |
| 53 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 54 | WHERE table_schema='$DB' AND table_name='$table' AND column_name='$col' | |
| 55 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 56 | return $_COL_CACHE{$k} = ($r && $r->{n}) ? 1 : 0; | |
| 57 | } | |
| 58 | ||
| 59 | # ---- Session lookup / create ---------------------------------------- | |
| 60 | sub session_by_token { | |
| 61 | my ($self, $db, $dbh, $DB, $token) = @_; | |
| 62 | return undef unless $token; | |
| 63 | $token =~ s/[^a-f0-9-]//g; | |
| 64 | return undef unless length $token == 36; | |
| 65 | return undef unless $self->schema_ready($db, $dbh, $DB); | |
| 66 | my $r = $db->db_readwrite($dbh, qq~ | |
| 67 | SELECT * FROM `${DB}`.tracking_sessions | |
| 68 | WHERE session_token='$token' LIMIT 1 | |
| 69 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 70 | return ($r && $r->{id}) ? $r : undef; | |
| 71 | } | |
| 72 | ||
| 73 | sub create_session { | |
| 74 | my ($self, $db, $dbh, $DB, %a) = @_; | |
| 75 | return 0 unless $self->schema_ready($db, $dbh, $DB); | |
| 76 | my $token = $a{session_token} || ''; | |
| 77 | $token =~ s/[^a-f0-9-]//g; | |
| 78 | return 0 unless length $token == 36; | |
| 79 | ||
| 80 | my %f = $self->_sanitize_fingerprint(\%a); | |
| 81 | ||
| 82 | my $region_set = ''; | |
| 83 | if ($self->region_column_ready($db, $dbh, $DB)) { | |
| 84 | $region_set = ", region=$f{region_q}"; | |
| 85 | } | |
| 86 | ||
| 87 | my $r = $db->db_readwrite($dbh, qq~ | |
| 88 | INSERT INTO `${DB}`.tracking_sessions | |
| 89 | SET session_token='$token', | |
| 90 | company_id=$f{company_sql}, | |
| 91 | user_id=$f{user_sql}, | |
| 92 | ip_address=$f{ip_sql}, | |
| 93 | country=$f{country_q}$region_set, | |
| 94 | os_name=$f{os_name_q}, | |
| 95 | os_version=$f{os_version_q}, | |
| 96 | browser_name=$f{browser_name_q}, | |
| 97 | browser_version=$f{browser_version_q}, | |
| 98 | device_type='$f{device_type}', | |
| 99 | screen_width=$f{screen_w_sql}, | |
| 100 | screen_height=$f{screen_h_sql}, | |
| 101 | viewport_width=$f{viewport_w_sql}, | |
| 102 | viewport_height=$f{viewport_h_sql}, | |
| 103 | color_depth=$f{color_depth_sql}, | |
| 104 | pixel_ratio=$f{pixel_ratio_sql}, | |
| 105 | touch_capable='$f{touch}', | |
| 106 | language=$f{language_q}, | |
| 107 | timezone=$f{timezone_q}, | |
| 108 | user_agent=$f{ua_q}, | |
| 109 | referrer=$f{referrer_q}, | |
| 110 | current_page_path=$f{path_q} | |
| 111 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 112 | my $sid = ($r && $r->{mysql_insertid}) ? $r->{mysql_insertid} : 0; | |
| 113 | return 0 unless $sid; | |
| 114 | ||
| 115 | my $label = 'Visitor #' . $sid; | |
| 116 | $db->db_readwrite($dbh, qq~ | |
| 117 | UPDATE `${DB}`.tracking_sessions | |
| 118 | SET visitor_label='$label' WHERE id='$sid' | |
| 119 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 120 | return $sid; | |
| 121 | } | |
| 122 | ||
| 123 | # Tie a user row to a tracking session (called after login / signup). | |
| 124 | # Also denormalises company_id so per-company analytics don't need a | |
| 125 | # users join. | |
| 126 | sub link_session_to_user { | |
| 127 | my ($self, $db, $dbh, $DB, $token, $user_id, $company_id) = @_; | |
| 128 | return 0 unless $token && $user_id; | |
| 129 | $token =~ s/[^a-f0-9-]//g; | |
| 130 | return 0 unless length $token == 36; | |
| 131 | $user_id =~ s/[^0-9]//g; | |
| 132 | return 0 unless $user_id; | |
| 133 | return 0 unless $self->schema_ready($db, $dbh, $DB); | |
| 134 | ||
| 135 | my $co_sql = 'NULL'; | |
| 136 | if (defined $company_id) { | |
| 137 | my $c = $company_id; $c =~ s/[^0-9]//g; | |
| 138 | $co_sql = $c eq '' ? 'NULL' : "'$c'"; | |
| 139 | } | |
| 140 | $db->db_readwrite($dbh, qq~ | |
| 141 | UPDATE `${DB}`.tracking_sessions | |
| 142 | SET user_id='$user_id', company_id=$co_sql | |
| 143 | WHERE session_token='$token' | |
| 144 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 145 | return 1; | |
| 146 | } | |
| 147 | ||
| 148 | # Classify a session for the admin UI. | |
| 149 | # Returns: { status, status_label, email, display_name, company_name } | |
| 150 | # anonymous = no user_id | |
| 151 | # signed_in = user_id set but no company | |
| 152 | # member = user_id + company_id both set | |
| 153 | sub classify_session { | |
| 154 | my ($self, $db, $dbh, $DB, $session_row) = @_; | |
| 155 | my %out = ( | |
| 156 | status => 'anonymous', | |
| 157 | status_label => 'Anonymous', | |
| 158 | email => '', | |
| 159 | display_name => '', | |
| 160 | company_name => '', | |
| 161 | ); | |
| 162 | return \%out unless $session_row && $session_row->{id}; | |
| 163 | my $uid = $session_row->{user_id}; | |
| 164 | return \%out unless $uid; | |
| 165 | ||
| 166 | my $u = $db->db_readwrite($dbh, qq~ | |
| 167 | SELECT email, display_name, company_id | |
| 168 | FROM `${DB}`.users WHERE id='$uid' LIMIT 1 | |
| 169 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 170 | if ($u && $u->{email}) { | |
| 171 | $out{email} = $u->{email}; | |
| 172 | $out{display_name} = $u->{display_name} || ''; | |
| 173 | my $cid = $u->{company_id} || $session_row->{company_id}; | |
| 174 | if ($cid) { | |
| 175 | my $c = $db->db_readwrite($dbh, qq~ | |
| 176 | SELECT name FROM `${DB}`.companies WHERE id='$cid' LIMIT 1 | |
| 177 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 178 | if ($c && $c->{name}) { | |
| 179 | $out{company_name} = $c->{name}; | |
| 180 | $out{status} = 'member'; | |
| 181 | $out{status_label} = 'Team member'; | |
| 182 | return \%out; | |
| 183 | } | |
| 184 | } | |
| 185 | $out{status} = 'signed_in'; | |
| 186 | $out{status_label} = 'Signed in'; | |
| 187 | } | |
| 188 | return \%out; | |
| 189 | } | |
| 190 | ||
| 191 | sub heartbeat { | |
| 192 | my ($self, $db, $dbh, $DB, $session_id, $page_path) = @_; | |
| 193 | $session_id =~ s/[^0-9]//g; | |
| 194 | return 0 unless $session_id; | |
| 195 | return 0 unless $self->schema_ready($db, $dbh, $DB); | |
| 196 | my $path = defined $page_path ? $page_path : ''; | |
| 197 | $path =~ s/'/''/g; | |
| 198 | $path = substr($path, 0, 500); | |
| 199 | $db->db_readwrite($dbh, qq~ | |
| 200 | UPDATE `${DB}`.tracking_sessions | |
| 201 | SET last_seen_at=NOW(), is_online=1, | |
| 202 | current_page_path='$path' | |
| 203 | WHERE id='$session_id' | |
| 204 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 205 | return 1; | |
| 206 | } | |
| 207 | ||
| 208 | # ---- Event ingest ---------------------------------------------------- | |
| 209 | sub log_event { | |
| 210 | my ($self, $db, $dbh, $DB, %a) = @_; | |
| 211 | return 0 unless $self->schema_ready($db, $dbh, $DB); | |
| 212 | my $sid = $a{session_id}; $sid =~ s/[^0-9]//g if defined $sid; | |
| 213 | return 0 unless $sid; | |
| 214 | ||
| 215 | my %type_ok = map { $_ => 1 } qw(page_view click form_submit scroll signup login custom); | |
| 216 | my $type = $a{event_type} || 'page_view'; | |
| 217 | return 0 unless $type_ok{$type}; | |
| 218 | ||
| 219 | my $co = defined $a{company_id} ? $a{company_id} : ''; | |
| 220 | $co =~ s/[^0-9]//g; | |
| 221 | my $co_sql = $co eq '' ? 'NULL' : "'$co'"; | |
| 222 | ||
| 223 | my $path = defined $a{page_path} ? $a{page_path} : ''; | |
| 224 | $path =~ s/'/''/g; $path = substr($path, 0, 500); | |
| 225 | ||
| 226 | my $sel = defined $a{element_selector} ? $a{element_selector} : ''; | |
| 227 | $sel =~ s/'/''/g; $sel = substr($sel, 0, 500); | |
| 228 | my $sel_sql = length $sel ? "'$sel'" : 'NULL'; | |
| 229 | ||
| 230 | my $x = defined $a{x_pct} ? $a{x_pct} : ''; | |
| 231 | $x =~ s/[^0-9.]//g; | |
| 232 | my $x_sql = length $x ? "'$x'" : 'NULL'; | |
| 233 | ||
| 234 | my $y = defined $a{y_pct} ? $a{y_pct} : ''; | |
| 235 | $y =~ s/[^0-9.]//g; | |
| 236 | my $y_sql = length $y ? "'$y'" : 'NULL'; | |
| 237 | ||
| 238 | my $ox = defined $a{offset_x_pct} ? $a{offset_x_pct} : ''; | |
| 239 | $ox =~ s/[^0-9.]//g; | |
| 240 | my $ox_sql = length $ox ? "'$ox'" : 'NULL'; | |
| 241 | ||
| 242 | my $oy = defined $a{offset_y_pct} ? $a{offset_y_pct} : ''; | |
| 243 | $oy =~ s/[^0-9.]//g; | |
| 244 | my $oy_sql = length $oy ? "'$oy'" : 'NULL'; | |
| 245 | ||
| 246 | my $scroll = defined $a{scroll_pct} ? $a{scroll_pct} : ''; | |
| 247 | $scroll =~ s/[^0-9]//g; | |
| 248 | my $scroll_sql = length $scroll ? "'$scroll'" : 'NULL'; | |
| 249 | ||
| 250 | my $meta = defined $a{metadata} ? $a{metadata} : ''; | |
| 251 | $meta =~ s/'/''/g; $meta = substr($meta, 0, 500); | |
| 252 | my $meta_sql = length $meta ? "'$meta'" : 'NULL'; | |
| 253 | ||
| 254 | $db->db_readwrite($dbh, qq~ | |
| 255 | INSERT INTO `${DB}`.tracking_events | |
| 256 | SET session_id='$sid', | |
| 257 | company_id=$co_sql, | |
| 258 | event_type='$type', | |
| 259 | page_path='$path', | |
| 260 | element_selector=$sel_sql, | |
| 261 | x_pct=$x_sql, | |
| 262 | y_pct=$y_sql, | |
| 263 | offset_x_pct=$ox_sql, | |
| 264 | offset_y_pct=$oy_sql, | |
| 265 | scroll_pct=$scroll_sql, | |
| 266 | metadata=$meta_sql | |
| 267 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 268 | return 1; | |
| 269 | } | |
| 270 | ||
| 271 | # ---- Admin: live visitor list --------------------------------------- | |
| 272 | sub live_visitors { | |
| 273 | my ($self, $db, $dbh, $DB, $limit, $co_id) = @_; | |
| 274 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 275 | $limit ||= 50; | |
| 276 | $limit =~ s/[^0-9]//g; $limit = 50 unless $limit; | |
| 277 | ||
| 278 | my $co_where = ''; | |
| 279 | if (defined $co_id && $co_id =~ /^\d+$/ && $co_id > 0) { | |
| 280 | $co_where = " AND company_id='$co_id' "; | |
| 281 | } | |
| 282 | ||
| 283 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 284 | SELECT id, session_token, visitor_label, user_id, company_id, | |
| 285 | os_name, os_version, browser_name, browser_version, | |
| 286 | device_type, screen_width, screen_height, | |
| 287 | viewport_width, viewport_height, | |
| 288 | language, timezone, country, city, | |
| 289 | current_page_path, first_seen_at, last_seen_at, | |
| 290 | TIMESTAMPDIFF(SECOND, last_seen_at, NOW()) AS idle_seconds | |
| 291 | FROM `${DB}`.tracking_sessions | |
| 292 | WHERE last_seen_at >= DATE_SUB(NOW(), INTERVAL 2 MINUTE) | |
| 293 | $co_where | |
| 294 | ORDER BY last_seen_at DESC | |
| 295 | LIMIT $limit | |
| 296 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 297 | } | |
| 298 | ||
| 299 | sub session_recent_events { | |
| 300 | my ($self, $db, $dbh, $DB, $session_id, $limit) = @_; | |
| 301 | $session_id =~ s/[^0-9]//g; | |
| 302 | return () unless $session_id; | |
| 303 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 304 | $limit ||= 20; | |
| 305 | $limit =~ s/[^0-9]//g; $limit = 20 unless $limit; | |
| 306 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 307 | SELECT id, event_type, page_path, element_selector, | |
| 308 | occurred_at, | |
| 309 | TIMESTAMPDIFF(SECOND, occurred_at, NOW()) AS ago_seconds | |
| 310 | FROM `${DB}`.tracking_events | |
| 311 | WHERE session_id='$session_id' | |
| 312 | ORDER BY occurred_at DESC | |
| 313 | LIMIT $limit | |
| 314 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 315 | } | |
| 316 | ||
| 317 | # ---- Admin: KPI tiles ----------------------------------------------- | |
| 318 | sub overview_kpis { | |
| 319 | my ($self, $db, $dbh, $DB) = @_; | |
| 320 | my %k = ( | |
| 321 | visitors_today => 0, page_views_today => 0, | |
| 322 | signups_today => 0, live_now => 0, | |
| 323 | unique_30d => 0, | |
| 324 | ); | |
| 325 | return \%k unless $self->schema_ready($db, $dbh, $DB); | |
| 326 | ||
| 327 | my $r; | |
| 328 | $r = $db->db_readwrite($dbh, qq~ | |
| 329 | SELECT COUNT(DISTINCT session_id) AS n FROM `${DB}`.tracking_events | |
| 330 | WHERE DATE(occurred_at)=CURDATE() | |
| 331 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 332 | $k{visitors_today} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 333 | ||
| 334 | $r = $db->db_readwrite($dbh, qq~ | |
| 335 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_events | |
| 336 | WHERE event_type='page_view' AND DATE(occurred_at)=CURDATE() | |
| 337 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 338 | $k{page_views_today} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 339 | ||
| 340 | $r = $db->db_readwrite($dbh, qq~ | |
| 341 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_events | |
| 342 | WHERE event_type='signup' AND DATE(occurred_at)=CURDATE() | |
| 343 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 344 | $k{signups_today} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 345 | ||
| 346 | $r = $db->db_readwrite($dbh, qq~ | |
| 347 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_sessions | |
| 348 | WHERE last_seen_at >= DATE_SUB(NOW(), INTERVAL 2 MINUTE) | |
| 349 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 350 | $k{live_now} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 351 | ||
| 352 | $r = $db->db_readwrite($dbh, qq~ | |
| 353 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_sessions | |
| 354 | WHERE first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 355 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 356 | $k{unique_30d} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 357 | ||
| 358 | return \%k; | |
| 359 | } | |
| 360 | ||
| 361 | sub top_pages { | |
| 362 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 363 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 364 | $limit ||= 10; | |
| 365 | $limit =~ s/[^0-9]//g; $limit = 10 unless $limit; | |
| 366 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 367 | SELECT page_path, COUNT(*) AS views | |
| 368 | FROM `${DB}`.tracking_events | |
| 369 | WHERE event_type='page_view' | |
| 370 | AND occurred_at >= DATE_SUB(NOW(), INTERVAL 7 DAY) | |
| 371 | GROUP BY page_path | |
| 372 | ORDER BY views DESC | |
| 373 | LIMIT $limit | |
| 374 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 375 | } | |
| 376 | ||
| 377 | # ---- Traffic summary (platform-wide or per-company) ----------------- | |
| 378 | sub _co_filter { | |
| 379 | my ($alias, $cid) = @_; | |
| 380 | return '' unless defined $cid && $cid =~ /^\d+$/ && $cid > 0; | |
| 381 | return " AND $alias.company_id='$cid' "; | |
| 382 | } | |
| 383 | ||
| 384 | sub traffic_summary { | |
| 385 | my ($self, $db, $dbh, $DB, $co_id) = @_; | |
| 386 | my %k = ( | |
| 387 | visitors_today=>0, visitors_mtd=>0, visitors_30d=>0, | |
| 388 | page_views_mtd=>0, live_now=>0, countries_count=>0, | |
| 389 | ); | |
| 390 | return \%k unless $self->schema_ready($db, $dbh, $DB); | |
| 391 | ||
| 392 | my $co_s = _co_filter('s', $co_id); | |
| 393 | my $co_e = _co_filter('e', $co_id); | |
| 394 | ||
| 395 | my $r; | |
| 396 | $r = $db->db_readwrite($dbh, qq~ | |
| 397 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_sessions s | |
| 398 | WHERE DATE(s.first_seen_at)=CURDATE() $co_s | |
| 399 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 400 | $k{visitors_today} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 401 | ||
| 402 | $r = $db->db_readwrite($dbh, qq~ | |
| 403 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_sessions s | |
| 404 | WHERE YEAR(s.first_seen_at)=YEAR(NOW()) | |
| 405 | AND MONTH(s.first_seen_at)=MONTH(NOW()) | |
| 406 | $co_s | |
| 407 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 408 | $k{visitors_mtd} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 409 | ||
| 410 | $r = $db->db_readwrite($dbh, qq~ | |
| 411 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_sessions s | |
| 412 | WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 413 | $co_s | |
| 414 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 415 | $k{visitors_30d} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 416 | ||
| 417 | $r = $db->db_readwrite($dbh, qq~ | |
| 418 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_events e | |
| 419 | WHERE e.event_type='page_view' | |
| 420 | AND YEAR(e.occurred_at)=YEAR(NOW()) | |
| 421 | AND MONTH(e.occurred_at)=MONTH(NOW()) | |
| 422 | $co_e | |
| 423 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 424 | $k{page_views_mtd} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 425 | ||
| 426 | $r = $db->db_readwrite($dbh, qq~ | |
| 427 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_sessions s | |
| 428 | WHERE s.last_seen_at >= DATE_SUB(NOW(), INTERVAL 2 MINUTE) | |
| 429 | $co_s | |
| 430 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 431 | $k{live_now} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 432 | ||
| 433 | $r = $db->db_readwrite($dbh, qq~ | |
| 434 | SELECT COUNT(DISTINCT s.country) AS n FROM `${DB}`.tracking_sessions s | |
| 435 | WHERE s.country IS NOT NULL AND s.country<>'' | |
| 436 | AND s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 437 | $co_s | |
| 438 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 439 | $k{countries_count} = ($r && $r->{n}) ? $r->{n} : 0; | |
| 440 | ||
| 441 | return \%k; | |
| 442 | } | |
| 443 | ||
| 444 | sub traffic_breakdown { | |
| 445 | my ($self, $db, $dbh, $DB, $col, $co_id, $limit) = @_; | |
| 446 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 447 | my %ok = ( | |
| 448 | browser_name=>1, os_name=>1, device_type=>1, | |
| 449 | country=>1, language=>1, timezone=>1, | |
| 450 | ); | |
| 451 | return () unless $ok{$col}; | |
| 452 | $limit ||= 12; | |
| 453 | $limit =~ s/[^0-9]//g; $limit = 12 unless $limit; | |
| 454 | ||
| 455 | my $co_s = _co_filter('s', $co_id); | |
| 456 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 457 | SELECT $col AS label, COUNT(*) AS n | |
| 458 | FROM `${DB}`.tracking_sessions s | |
| 459 | WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 460 | AND $col IS NOT NULL AND $col<>'' | |
| 461 | $co_s | |
| 462 | GROUP BY $col | |
| 463 | ORDER BY n DESC | |
| 464 | LIMIT $limit | |
| 465 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 466 | } | |
| 467 | ||
| 468 | sub traffic_screen_breakdown { | |
| 469 | my ($self, $db, $dbh, $DB, $co_id, $limit) = @_; | |
| 470 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 471 | $limit ||= 8; | |
| 472 | $limit =~ s/[^0-9]//g; $limit = 8 unless $limit; | |
| 473 | my $co_s = _co_filter('s', $co_id); | |
| 474 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 475 | SELECT CONCAT(s.screen_width, 'x', s.screen_height) AS label, COUNT(*) AS n | |
| 476 | FROM `${DB}`.tracking_sessions s | |
| 477 | WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 478 | AND s.screen_width IS NOT NULL AND s.screen_width > 0 | |
| 479 | AND s.screen_height IS NOT NULL AND s.screen_height > 0 | |
| 480 | $co_s | |
| 481 | GROUP BY s.screen_width, s.screen_height | |
| 482 | ORDER BY n DESC | |
| 483 | LIMIT $limit | |
| 484 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 485 | } | |
| 486 | ||
| 487 | sub traffic_pixel_ratio_breakdown { | |
| 488 | my ($self, $db, $dbh, $DB, $co_id) = @_; | |
| 489 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 490 | my $co_s = _co_filter('s', $co_id); | |
| 491 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 492 | SELECT | |
| 493 | CASE | |
| 494 | WHEN s.pixel_ratio IS NULL THEN 'Unknown' | |
| 495 | WHEN s.pixel_ratio < 1.25 THEN 'Standard (1x)' | |
| 496 | WHEN s.pixel_ratio < 1.75 THEN 'HiDPI (1.5x)' | |
| 497 | WHEN s.pixel_ratio < 2.5 THEN 'Retina (2x)' | |
| 498 | WHEN s.pixel_ratio < 3.5 THEN 'Mobile HiDPI (3x)' | |
| 499 | ELSE 'Ultra HiDPI (4x+)' | |
| 500 | END AS label, | |
| 501 | COUNT(*) AS n | |
| 502 | FROM `${DB}`.tracking_sessions s | |
| 503 | WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 504 | $co_s | |
| 505 | GROUP BY label | |
| 506 | ORDER BY n DESC | |
| 507 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 508 | } | |
| 509 | ||
| 510 | sub traffic_referrer_breakdown { | |
| 511 | my ($self, $db, $dbh, $DB, $co_id, $limit) = @_; | |
| 512 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 513 | $limit ||= 8; $limit =~ s/[^0-9]//g; $limit = 8 unless $limit; | |
| 514 | my $co_s = _co_filter('s', $co_id); | |
| 515 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 516 | SELECT | |
| 517 | CASE | |
| 518 | WHEN s.referrer IS NULL OR s.referrer='' THEN 'Direct (typed or bookmark)' | |
| 519 | ELSE REPLACE( | |
| 520 | SUBSTRING_INDEX(SUBSTRING_INDEX(s.referrer, '://', -1), '/', 1), | |
| 521 | 'www.', '') | |
| 522 | END AS label, | |
| 523 | COUNT(*) AS n | |
| 524 | FROM `${DB}`.tracking_sessions s | |
| 525 | WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 526 | $co_s | |
| 527 | GROUP BY label | |
| 528 | ORDER BY n DESC | |
| 529 | LIMIT $limit | |
| 530 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 531 | } | |
| 532 | ||
| 533 | sub traffic_referrer_paginated { | |
| 534 | my ($self, $db, $dbh, $DB, $co_id, $window_days, $offset, $limit) = @_; | |
| 535 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 536 | $window_days = 30 unless defined $window_days; | |
| 537 | $window_days =~ s/[^0-9]//g; $window_days = 30 unless length $window_days; | |
| 538 | $offset ||= 0; $offset =~ s/[^0-9]//g; $offset = 0 unless length $offset; | |
| 539 | $limit ||= 25; $limit =~ s/[^0-9]//g; $limit = 25 unless length $limit; | |
| 540 | $limit = 200 if $limit > 200; | |
| 541 | ||
| 542 | my $co_s = _co_filter('s', $co_id); | |
| 543 | my $date_filter = $window_days | |
| 544 | ? "AND s.first_seen_at >= DATE_SUB(NOW(), INTERVAL $window_days DAY)" | |
| 545 | : ''; | |
| 546 | ||
| 547 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 548 | SELECT | |
| 549 | CASE | |
| 550 | WHEN s.referrer IS NULL OR s.referrer='' THEN '(Direct / Typed-in)' | |
| 551 | ELSE LOWER(REPLACE( | |
| 552 | SUBSTRING_INDEX(SUBSTRING_INDEX(s.referrer, '://', -1), '/', 1), | |
| 553 | 'www.', '')) | |
| 554 | END AS label, | |
| 555 | COUNT(*) AS n | |
| 556 | FROM `${DB}`.tracking_sessions s | |
| 557 | WHERE 1=1 | |
| 558 | $date_filter | |
| 559 | $co_s | |
| 560 | GROUP BY label | |
| 561 | ORDER BY n DESC, label ASC | |
| 562 | LIMIT $limit OFFSET $offset | |
| 563 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 564 | } | |
| 565 | ||
| 566 | sub traffic_referrer_count { | |
| 567 | my ($self, $db, $dbh, $DB, $co_id, $window_days) = @_; | |
| 568 | return 0 unless $self->schema_ready($db, $dbh, $DB); | |
| 569 | $window_days = 30 unless defined $window_days; | |
| 570 | $window_days =~ s/[^0-9]//g; $window_days = 30 unless length $window_days; | |
| 571 | ||
| 572 | my $co_s = _co_filter('s', $co_id); | |
| 573 | my $date_filter = $window_days | |
| 574 | ? "AND s.first_seen_at >= DATE_SUB(NOW(), INTERVAL $window_days DAY)" | |
| 575 | : ''; | |
| 576 | ||
| 577 | my $r = $db->db_readwrite($dbh, qq~ | |
| 578 | SELECT COUNT(DISTINCT | |
| 579 | CASE | |
| 580 | WHEN s.referrer IS NULL OR s.referrer='' THEN '(Direct / Typed-in)' | |
| 581 | ELSE LOWER(REPLACE( | |
| 582 | SUBSTRING_INDEX(SUBSTRING_INDEX(s.referrer, '://', -1), '/', 1), | |
| 583 | 'www.', '')) | |
| 584 | END | |
| 585 | ) AS n | |
| 586 | FROM `${DB}`.tracking_sessions s | |
| 587 | WHERE 1=1 | |
| 588 | $date_filter | |
| 589 | $co_s | |
| 590 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 591 | return ($r && $r->{n}) ? $r->{n} : 0; | |
| 592 | } | |
| 593 | ||
| 594 | sub traffic_hour_breakdown { | |
| 595 | my ($self, $db, $dbh, $DB, $co_id, $limit) = @_; | |
| 596 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 597 | $limit ||= 8; $limit =~ s/[^0-9]//g; $limit = 8 unless $limit; | |
| 598 | my $co_s = _co_filter('s', $co_id); | |
| 599 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 600 | SELECT | |
| 601 | CASE HOUR(s.first_seen_at) | |
| 602 | WHEN 0 THEN '12 AM' WHEN 1 THEN '1 AM' WHEN 2 THEN '2 AM' | |
| 603 | WHEN 3 THEN '3 AM' WHEN 4 THEN '4 AM' WHEN 5 THEN '5 AM' | |
| 604 | WHEN 6 THEN '6 AM' WHEN 7 THEN '7 AM' WHEN 8 THEN '8 AM' | |
| 605 | WHEN 9 THEN '9 AM' WHEN 10 THEN '10 AM' WHEN 11 THEN '11 AM' | |
| 606 | WHEN 12 THEN '12 PM' WHEN 13 THEN '1 PM' WHEN 14 THEN '2 PM' | |
| 607 | WHEN 15 THEN '3 PM' WHEN 16 THEN '4 PM' WHEN 17 THEN '5 PM' | |
| 608 | WHEN 18 THEN '6 PM' WHEN 19 THEN '7 PM' WHEN 20 THEN '8 PM' | |
| 609 | WHEN 21 THEN '9 PM' WHEN 22 THEN '10 PM' WHEN 23 THEN '11 PM' | |
| 610 | END AS label, | |
| 611 | COUNT(*) AS n | |
| 612 | FROM `${DB}`.tracking_sessions s | |
| 613 | WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 614 | $co_s | |
| 615 | GROUP BY HOUR(s.first_seen_at), label | |
| 616 | ORDER BY n DESC | |
| 617 | LIMIT $limit | |
| 618 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 619 | } | |
| 620 | ||
| 621 | sub traffic_touch_breakdown { | |
| 622 | my ($self, $db, $dbh, $DB, $co_id) = @_; | |
| 623 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 624 | my $co_s = _co_filter('s', $co_id); | |
| 625 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 626 | SELECT CASE WHEN s.touch_capable=1 THEN 'Touch device' | |
| 627 | ELSE 'Mouse + keyboard' END AS label, | |
| 628 | COUNT(*) AS n | |
| 629 | FROM `${DB}`.tracking_sessions s | |
| 630 | WHERE s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 631 | $co_s | |
| 632 | GROUP BY label | |
| 633 | ORDER BY n DESC | |
| 634 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 635 | } | |
| 636 | ||
| 637 | # ---- Country centroid lookup for the globe widget ------------------- | |
| 638 | my %COUNTRY_CENTROIDS = ( | |
| 639 | US => [ 39.5, -98.5, 'United States' ], | |
| 640 | CA => [ 56.1, -106.3, 'Canada' ], | |
| 641 | MX => [ 23.6, -102.5, 'Mexico' ], | |
| 642 | GT => [ 15.8, -90.2, 'Guatemala' ], | |
| 643 | CR => [ 9.7, -83.7, 'Costa Rica' ], | |
| 644 | PA => [ 8.5, -80.7, 'Panama' ], | |
| 645 | CU => [ 21.5, -77.7, 'Cuba' ], | |
| 646 | DO => [ 18.7, -70.1, 'Dominican Republic' ], | |
| 647 | BR => [ -14.2, -51.9, 'Brazil' ], | |
| 648 | AR => [ -38.4, -63.6, 'Argentina' ], | |
| 649 | CL => [ -35.6, -71.5, 'Chile' ], | |
| 650 | CO => [ 4.6, -74.0, 'Colombia' ], | |
| 651 | PE => [ -9.2, -75.0, 'Peru' ], | |
| 652 | VE => [ 6.4, -66.6, 'Venezuela' ], | |
| 653 | EC => [ -1.8, -78.2, 'Ecuador' ], | |
| 654 | UY => [ -32.5, -55.8, 'Uruguay' ], | |
| 655 | GB => [ 55.4, -3.4, 'United Kingdom' ], | |
| 656 | IE => [ 53.4, -8.2, 'Ireland' ], | |
| 657 | FR => [ 46.2, 2.2, 'France' ], | |
| 658 | DE => [ 51.2, 10.4, 'Germany' ], | |
| 659 | NL => [ 52.1, 5.3, 'Netherlands' ], | |
| 660 | BE => [ 50.5, 4.5, 'Belgium' ], | |
| 661 | LU => [ 49.8, 6.1, 'Luxembourg' ], | |
| 662 | CH => [ 46.8, 8.2, 'Switzerland' ], | |
| 663 | AT => [ 47.5, 14.6, 'Austria' ], | |
| 664 | IT => [ 41.9, 12.6, 'Italy' ], | |
| 665 | ES => [ 40.5, -3.7, 'Spain' ], | |
| 666 | PT => [ 39.4, -8.2, 'Portugal' ], | |
| 667 | DK => [ 56.3, 9.5, 'Denmark' ], | |
| 668 | NO => [ 60.5, 8.5, 'Norway' ], | |
| 669 | SE => [ 60.1, 18.6, 'Sweden' ], | |
| 670 | FI => [ 61.9, 25.7, 'Finland' ], | |
| 671 | PL => [ 51.9, 19.1, 'Poland' ], | |
| 672 | CZ => [ 49.8, 15.5, 'Czechia' ], | |
| 673 | SK => [ 48.7, 19.7, 'Slovakia' ], | |
| 674 | HU => [ 47.2, 19.5, 'Hungary' ], | |
| 675 | RO => [ 45.9, 25.0, 'Romania' ], | |
| 676 | BG => [ 42.7, 25.5, 'Bulgaria' ], | |
| 677 | GR => [ 39.1, 21.8, 'Greece' ], | |
| 678 | UA => [ 48.4, 31.2, 'Ukraine' ], | |
| 679 | RU => [ 61.5, 105.3, 'Russia' ], | |
| 680 | TR => [ 38.9, 35.2, 'Turkey' ], | |
| 681 | IL => [ 31.0, 34.9, 'Israel' ], | |
| 682 | SA => [ 23.9, 45.1, 'Saudi Arabia' ], | |
| 683 | AE => [ 23.4, 53.8, 'United Arab Emirates' ], | |
| 684 | IR => [ 32.4, 53.7, 'Iran' ], | |
| 685 | PK => [ 30.4, 69.3, 'Pakistan' ], | |
| 686 | IN => [ 20.6, 78.9, 'India' ], | |
| 687 | BD => [ 23.7, 90.4, 'Bangladesh' ], | |
| 688 | LK => [ 7.9, 80.8, 'Sri Lanka' ], | |
| 689 | NP => [ 28.4, 84.1, 'Nepal' ], | |
| 690 | CN => [ 35.9, 104.2, 'China' ], | |
| 691 | JP => [ 36.2, 138.3, 'Japan' ], | |
| 692 | KR => [ 35.9, 127.8, 'South Korea' ], | |
| 693 | TW => [ 23.7, 121.0, 'Taiwan' ], | |
| 694 | HK => [ 22.4, 114.1, 'Hong Kong' ], | |
| 695 | SG => [ 1.4, 103.8, 'Singapore' ], | |
| 696 | MY => [ 4.2, 101.9, 'Malaysia' ], | |
| 697 | TH => [ 15.9, 100.9, 'Thailand' ], | |
| 698 | VN => [ 14.1, 108.3, 'Vietnam' ], | |
| 699 | PH => [ 12.9, 121.8, 'Philippines' ], | |
| 700 | ID => [ -0.8, 113.9, 'Indonesia' ], | |
| 701 | AU => [ -25.3, 133.8, 'Australia' ], | |
| 702 | NZ => [ -40.9, 174.9, 'New Zealand' ], | |
| 703 | ZA => [ -30.6, 22.9, 'South Africa' ], | |
| 704 | NG => [ 9.1, 8.7, 'Nigeria' ], | |
| 705 | EG => [ 26.8, 30.8, 'Egypt' ], | |
| 706 | MA => [ 31.8, -7.1, 'Morocco' ], | |
| 707 | KE => [ -0.0, 37.9, 'Kenya' ], | |
| 708 | ET => [ 9.1, 40.5, 'Ethiopia' ], | |
| 709 | GH => [ 7.9, -1.0, 'Ghana' ], | |
| 710 | DZ => [ 28.0, 1.7, 'Algeria' ], | |
| 711 | TN => [ 33.9, 9.5, 'Tunisia' ], | |
| 712 | ); | |
| 713 | ||
| 714 | sub country_centroid { | |
| 715 | my ($self, $code) = @_; | |
| 716 | return undef unless defined $code; | |
| 717 | $code = uc $code; | |
| 718 | return $COUNTRY_CENTROIDS{$code}; | |
| 719 | } | |
| 720 | ||
| 721 | sub traffic_by_country { | |
| 722 | my ($self, $db, $dbh, $DB, $co_id, $limit) = @_; | |
| 723 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 724 | $limit ||= 80; | |
| 725 | $limit =~ s/[^0-9]//g; $limit = 80 unless $limit; | |
| 726 | ||
| 727 | my $co_s = _co_filter('s', $co_id); | |
| 728 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 729 | SELECT s.country AS country, COUNT(*) AS n | |
| 730 | FROM `${DB}`.tracking_sessions s | |
| 731 | WHERE s.country IS NOT NULL AND s.country<>'' | |
| 732 | AND s.first_seen_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 733 | $co_s | |
| 734 | GROUP BY s.country | |
| 735 | ORDER BY n DESC | |
| 736 | LIMIT $limit | |
| 737 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 738 | } | |
| 739 | ||
| 740 | # Daily series. `visitors` = anonymous; `users` = sessions with user_id. | |
| 741 | sub daily_visitor_series { | |
| 742 | my ($self, $db, $dbh, $DB, $co_id, $days) = @_; | |
| 743 | $days ||= 30; | |
| 744 | $days =~ s/[^0-9]//g; $days = 30 unless $days; | |
| 745 | $days = 365 if $days > 365; | |
| 746 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 747 | ||
| 748 | my $co_s = _co_filter('s', $co_id); | |
| 749 | my $co_e = _co_filter('e', $co_id); | |
| 750 | ||
| 751 | my @days_back; | |
| 752 | my $now = time; | |
| 753 | for (my $i = $days - 1; $i >= 0; $i--) { | |
| 754 | my @t = localtime($now - $i * 86400); | |
| 755 | push @days_back, sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]); | |
| 756 | } | |
| 757 | ||
| 758 | my @s_rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 759 | SELECT DATE(s.first_seen_at) AS d, | |
| 760 | COUNT(*) AS visitors, | |
| 761 | COUNT(DISTINCT s.session_token) AS uniques, | |
| 762 | SUM(CASE WHEN s.user_id IS NOT NULL THEN 1 ELSE 0 END) AS users | |
| 763 | FROM `${DB}`.tracking_sessions s | |
| 764 | WHERE s.first_seen_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY) | |
| 765 | $co_s | |
| 766 | GROUP BY DATE(s.first_seen_at) | |
| 767 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 768 | my %s_by = map { ($_->{d} || '') => $_ } @s_rows; | |
| 769 | ||
| 770 | my @e_rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 771 | SELECT DATE(e.occurred_at) AS d, COUNT(*) AS page_views | |
| 772 | FROM `${DB}`.tracking_events e | |
| 773 | WHERE e.event_type='page_view' | |
| 774 | AND e.occurred_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY) | |
| 775 | $co_e | |
| 776 | GROUP BY DATE(e.occurred_at) | |
| 777 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 778 | my %e_by = map { ($_->{d} || '') => $_ } @e_rows; | |
| 779 | ||
| 780 | my @out; | |
| 781 | foreach my $ymd (@days_back) { | |
| 782 | my $s = $s_by{$ymd} || {}; | |
| 783 | my $e = $e_by{$ymd} || {}; | |
| 784 | push @out, { | |
| 785 | date => $ymd, | |
| 786 | visitors => ($s->{visitors} || 0) - ($s->{users} || 0), | |
| 787 | users => $s->{users} || 0, | |
| 788 | total => $s->{visitors} || 0, | |
| 789 | unique_visitors => $s->{uniques} || 0, | |
| 790 | page_views => $e->{page_views} || 0, | |
| 791 | }; | |
| 792 | } | |
| 793 | return @out; | |
| 794 | } | |
| 795 | ||
| 796 | # Aggregate totals for the trailing window. Returns hashref: | |
| 797 | # { total_visits, unique_visitors, total_users, unique_users, | |
| 798 | # total_pageviews, anon_visits } | |
| 799 | sub visitor_totals { | |
| 800 | my ($self, $db, $dbh, $DB, $co_id, $days) = @_; | |
| 801 | $days ||= 30; | |
| 802 | $days =~ s/[^0-9]//g; $days = 30 unless $days; | |
| 803 | my %k = ( | |
| 804 | total_visits=>0, unique_visitors=>0, | |
| 805 | total_users=>0, unique_users=>0, | |
| 806 | total_pageviews=>0, anon_visits=>0, | |
| 807 | ); | |
| 808 | return \%k unless $self->schema_ready($db, $dbh, $DB); | |
| 809 | ||
| 810 | my $co_s = _co_filter('s', $co_id); | |
| 811 | my $co_e = _co_filter('e', $co_id); | |
| 812 | ||
| 813 | my $r = $db->db_readwrite($dbh, qq~ | |
| 814 | SELECT | |
| 815 | COUNT(*) AS total_visits, | |
| 816 | COUNT(DISTINCT s.session_token) AS unique_visitors, | |
| 817 | SUM(CASE WHEN s.user_id IS NOT NULL THEN 1 ELSE 0 END) AS total_users, | |
| 818 | COUNT(DISTINCT s.user_id) AS unique_users | |
| 819 | FROM `${DB}`.tracking_sessions s | |
| 820 | WHERE s.first_seen_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY) | |
| 821 | $co_s | |
| 822 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 823 | if ($r) { | |
| 824 | $k{total_visits} = $r->{total_visits} || 0; | |
| 825 | $k{unique_visitors} = $r->{unique_visitors} || 0; | |
| 826 | $k{total_users} = $r->{total_users} || 0; | |
| 827 | $k{unique_users} = $r->{unique_users} || 0; | |
| 828 | $k{anon_visits} = $k{total_visits} - $k{total_users}; | |
| 829 | } | |
| 830 | ||
| 831 | my $r2 = $db->db_readwrite($dbh, qq~ | |
| 832 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_events e | |
| 833 | WHERE e.event_type='page_view' | |
| 834 | AND e.occurred_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY) | |
| 835 | $co_e | |
| 836 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 837 | $k{total_pageviews} = ($r2 && $r2->{n}) ? $r2->{n} : 0; | |
| 838 | ||
| 839 | return \%k; | |
| 840 | } | |
| 841 | ||
| 842 | sub top_pages_window { | |
| 843 | my ($self, $db, $dbh, $DB, $co_id, $days, $limit) = @_; | |
| 844 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 845 | $days ||= 30; $days =~ s/[^0-9]//g; $days = 30 unless $days; | |
| 846 | $limit ||= 15; $limit =~ s/[^0-9]//g; $limit = 15 unless $limit; | |
| 847 | ||
| 848 | my $co_e = _co_filter('e', $co_id); | |
| 849 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 850 | SELECT e.page_path, COUNT(*) AS views, | |
| 851 | COUNT(DISTINCT e.session_id) AS uniques | |
| 852 | FROM `${DB}`.tracking_events e | |
| 853 | WHERE e.event_type='page_view' | |
| 854 | AND e.occurred_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY) | |
| 855 | $co_e | |
| 856 | GROUP BY e.page_path | |
| 857 | ORDER BY views DESC | |
| 858 | LIMIT $limit | |
| 859 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 860 | } | |
| 861 | ||
| 862 | # Bucket page paths into "sections" (first segment of URL). Returns | |
| 863 | # rows of {section, views, uniques}. | |
| 864 | sub traffic_by_section { | |
| 865 | my ($self, $db, $dbh, $DB, $co_id, $days) = @_; | |
| 866 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 867 | $days ||= 30; $days =~ s/[^0-9]//g; $days = 30 unless $days; | |
| 868 | ||
| 869 | my $co_e = _co_filter('e', $co_id); | |
| 870 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 871 | SELECT e.page_path, e.session_id | |
| 872 | FROM `${DB}`.tracking_events e | |
| 873 | WHERE e.event_type='page_view' | |
| 874 | AND e.occurred_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY) | |
| 875 | $co_e | |
| 876 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 877 | ||
| 878 | my %bucket; | |
| 879 | foreach my $r (@rows) { | |
| 880 | my $p = $r->{page_path} || '/'; | |
| 881 | $p =~ s/[?#].*$//; | |
| 882 | my $section; | |
| 883 | if ($p =~ m{^/+([^/]+)}) { | |
| 884 | $section = '/' . $1; | |
| 885 | } else { | |
| 886 | $section = '/'; | |
| 887 | } | |
| 888 | $bucket{$section} ||= { views => 0, sessions => {} }; | |
| 889 | $bucket{$section}->{views}++; | |
| 890 | $bucket{$section}->{sessions}->{ $r->{session_id} || '' } = 1; | |
| 891 | } | |
| 892 | ||
| 893 | my @out; | |
| 894 | foreach my $sec (sort { $bucket{$b}->{views} <=> $bucket{$a}->{views} } keys %bucket) { | |
| 895 | push @out, { | |
| 896 | section => $sec, | |
| 897 | views => $bucket{$sec}->{views}, | |
| 898 | uniques => scalar(keys %{ $bucket{$sec}->{sessions} }), | |
| 899 | }; | |
| 900 | } | |
| 901 | return @out; | |
| 902 | } | |
| 903 | ||
| 904 | sub region_column_ready { | |
| 905 | my ($self, $db, $dbh, $DB) = @_; | |
| 906 | return $self->{_region_ready} if exists $self->{_region_ready}; | |
| 907 | my $r = $db->db_readwrite($dbh, qq~ | |
| 908 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 909 | WHERE table_schema='$DB' AND table_name='tracking_sessions' | |
| 910 | AND column_name='region' | |
| 911 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 912 | $self->{_region_ready} = ($r && $r->{n}) ? 1 : 0; | |
| 913 | return $self->{_region_ready}; | |
| 914 | } | |
| 915 | ||
| 916 | sub traffic_by_region { | |
| 917 | my ($self, $db, $dbh, $DB, $country_code, $co_id, $days, $limit, $days_to) = @_; | |
| 918 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 919 | return () unless $self->region_column_ready($db, $dbh, $DB); | |
| 920 | ||
| 921 | $country_code = uc(defined $country_code ? $country_code : ''); | |
| 922 | $country_code =~ s/[^A-Z]//g; | |
| 923 | return () unless $country_code; | |
| 924 | ||
| 925 | $limit ||= 15; $limit =~ s/[^0-9]//g; $limit = 15 unless $limit; | |
| 926 | my $co_s = _co_filter('s', $co_id); | |
| 927 | my $dw_s = _date_where($days, $days_to, 's.first_seen_at'); | |
| 928 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 929 | SELECT s.region AS region, COUNT(*) AS n | |
| 930 | FROM `${DB}`.tracking_sessions s | |
| 931 | WHERE s.country='$country_code' | |
| 932 | AND s.region IS NOT NULL AND s.region<>'' | |
| 933 | $dw_s | |
| 934 | $co_s | |
| 935 | GROUP BY s.region | |
| 936 | ORDER BY n DESC | |
| 937 | LIMIT $limit | |
| 938 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 939 | } | |
| 940 | ||
| 941 | sub daily_series_for_country { | |
| 942 | my ($self, $db, $dbh, $DB, $country_code, $co_id, $days, $days_to) = @_; | |
| 943 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 944 | $country_code = uc(defined $country_code ? $country_code : ''); | |
| 945 | $country_code =~ s/[^A-Z]//g; | |
| 946 | return () unless $country_code; | |
| 947 | my ($from, $to) = _date_bounds($days, $days_to); | |
| 948 | ||
| 949 | my $co_s = _co_filter('s', $co_id); | |
| 950 | my $dw_s = _date_where($from, $to, 's.first_seen_at'); | |
| 951 | ||
| 952 | my @days_back; | |
| 953 | my $now = time; | |
| 954 | for (my $i = $from; $i >= $to; $i--) { | |
| 955 | my @t = localtime($now - $i * 86400); | |
| 956 | push @days_back, sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]); | |
| 957 | } | |
| 958 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 959 | SELECT DATE(s.first_seen_at) AS d, COUNT(*) AS n | |
| 960 | FROM `${DB}`.tracking_sessions s | |
| 961 | WHERE s.country='$country_code' | |
| 962 | $dw_s | |
| 963 | $co_s | |
| 964 | GROUP BY DATE(s.first_seen_at) | |
| 965 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 966 | my %by = map { ($_->{d} || '') => $_->{n} } @rows; | |
| 967 | ||
| 968 | my @out; | |
| 969 | foreach my $ymd (@days_back) { | |
| 970 | push @out, { date => $ymd, visitors => ($by{$ymd} || 0) }; | |
| 971 | } | |
| 972 | return @out; | |
| 973 | } | |
| 974 | ||
| 975 | sub _region_clause { | |
| 976 | my ($region) = @_; | |
| 977 | return '' unless defined $region && length $region; | |
| 978 | my $r = $region; | |
| 979 | $r =~ s/'/''/g; | |
| 980 | $r = substr($r, 0, 80); | |
| 981 | return " AND s.region='$r' "; | |
| 982 | } | |
| 983 | ||
| 984 | sub _date_bounds { | |
| 985 | my ($days_from, $days_to) = @_; | |
| 986 | $days_from = 30 unless defined $days_from && $days_from =~ /^\d+$/; | |
| 987 | $days_to = 0 unless defined $days_to && $days_to =~ /^\d+$/; | |
| 988 | $days_from = 365 if $days_from > 365; | |
| 989 | $days_to = 365 if $days_to > 365; | |
| 990 | ($days_from, $days_to) = ($days_to, $days_from) if $days_to > $days_from; | |
| 991 | return ($days_from, $days_to); | |
| 992 | } | |
| 993 | ||
| 994 | sub _date_where { | |
| 995 | my ($days_from, $days_to, $col) = @_; | |
| 996 | $col ||= 's.first_seen_at'; | |
| 997 | ($days_from, $days_to) = _date_bounds($days_from, $days_to); | |
| 998 | return " AND DATE($col) >= DATE_SUB(CURDATE(), INTERVAL $days_from DAY) " . | |
| 999 | " AND DATE($col) <= DATE_SUB(CURDATE(), INTERVAL $days_to DAY) "; | |
| 1000 | } | |
| 1001 | ||
| 1002 | sub country_traffic_summary { | |
| 1003 | my ($self, $db, $dbh, $DB, $country_code, $region, $days, $days_to, $co_id) = @_; | |
| 1004 | my %k = ( | |
| 1005 | total_visits=>0, unique_visitors=>0, | |
| 1006 | total_users=>0, unique_users=>0, | |
| 1007 | total_pageviews=>0, anon_visits=>0, | |
| 1008 | ); | |
| 1009 | return \%k unless $self->schema_ready($db, $dbh, $DB); | |
| 1010 | $country_code = uc(defined $country_code ? $country_code : ''); | |
| 1011 | $country_code =~ s/[^A-Z]//g; | |
| 1012 | return \%k unless $country_code; | |
| 1013 | my $rc = _region_clause($region); | |
| 1014 | my $dw_s = _date_where($days, $days_to, 's.first_seen_at'); | |
| 1015 | my $dw_e = _date_where($days, $days_to, 'e.occurred_at'); | |
| 1016 | my $co_s = _co_filter('s', $co_id); | |
| 1017 | ||
| 1018 | my $r = $db->db_readwrite($dbh, qq~ | |
| 1019 | SELECT | |
| 1020 | COUNT(*) AS total_visits, | |
| 1021 | COUNT(DISTINCT s.session_token) AS unique_visitors, | |
| 1022 | SUM(CASE WHEN s.user_id IS NOT NULL THEN 1 ELSE 0 END) AS total_users, | |
| 1023 | COUNT(DISTINCT s.user_id) AS unique_users | |
| 1024 | FROM `${DB}`.tracking_sessions s | |
| 1025 | WHERE s.country='$country_code' | |
| 1026 | $dw_s | |
| 1027 | $rc | |
| 1028 | $co_s | |
| 1029 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 1030 | if ($r) { | |
| 1031 | $k{total_visits} = $r->{total_visits} || 0; | |
| 1032 | $k{unique_visitors} = $r->{unique_visitors} || 0; | |
| 1033 | $k{total_users} = $r->{total_users} || 0; | |
| 1034 | $k{unique_users} = $r->{unique_users} || 0; | |
| 1035 | $k{anon_visits} = $k{total_visits} - $k{total_users}; | |
| 1036 | } | |
| 1037 | ||
| 1038 | my $r2 = $db->db_readwrite($dbh, qq~ | |
| 1039 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_events e | |
| 1040 | JOIN `${DB}`.tracking_sessions s ON s.id = e.session_id | |
| 1041 | WHERE e.event_type='page_view' | |
| 1042 | AND s.country='$country_code' | |
| 1043 | $dw_e | |
| 1044 | $rc | |
| 1045 | $co_s | |
| 1046 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 1047 | $k{total_pageviews} = ($r2 && $r2->{n}) ? $r2->{n} : 0; | |
| 1048 | ||
| 1049 | return \%k; | |
| 1050 | } | |
| 1051 | ||
| 1052 | sub country_top_cities { | |
| 1053 | my ($self, $db, $dbh, $DB, $country_code, $region, $days, $limit, $days_to, $co_id) = @_; | |
| 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 | $limit ||= 10; $limit =~ s/[^0-9]//g; $limit = 10 unless $limit; | |
| 1059 | my $rc = _region_clause($region); | |
| 1060 | my $dw_s = _date_where($days, $days_to, 's.first_seen_at'); | |
| 1061 | my $co_s = _co_filter('s', $co_id); | |
| 1062 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 1063 | SELECT s.city AS city, COUNT(*) AS n | |
| 1064 | FROM `${DB}`.tracking_sessions s | |
| 1065 | WHERE s.country='$country_code' | |
| 1066 | AND s.city IS NOT NULL AND s.city<>'' | |
| 1067 | $dw_s | |
| 1068 | $rc | |
| 1069 | $co_s | |
| 1070 | GROUP BY s.city | |
| 1071 | ORDER BY n DESC | |
| 1072 | LIMIT $limit | |
| 1073 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 1074 | } | |
| 1075 | ||
| 1076 | sub country_breakdown { | |
| 1077 | my ($self, $db, $dbh, $DB, $country_code, $region, $col, $days, $limit, $days_to, $co_id) = @_; | |
| 1078 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 1079 | my %ok = (browser_name=>1, os_name=>1, device_type=>1, language=>1, timezone=>1); | |
| 1080 | return () unless $ok{$col}; | |
| 1081 | $country_code = uc(defined $country_code ? $country_code : ''); | |
| 1082 | $country_code =~ s/[^A-Z]//g; | |
| 1083 | return () unless $country_code; | |
| 1084 | $limit ||= 8; $limit =~ s/[^0-9]//g; $limit = 8 unless $limit; | |
| 1085 | my $rc = _region_clause($region); | |
| 1086 | my $dw_s = _date_where($days, $days_to, 's.first_seen_at'); | |
| 1087 | my $co_s = _co_filter('s', $co_id); | |
| 1088 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 1089 | SELECT s.$col AS label, COUNT(*) AS n | |
| 1090 | FROM `${DB}`.tracking_sessions s | |
| 1091 | WHERE s.country='$country_code' | |
| 1092 | AND s.$col IS NOT NULL AND s.$col<>'' | |
| 1093 | $dw_s | |
| 1094 | $rc | |
| 1095 | $co_s | |
| 1096 | GROUP BY s.$col | |
| 1097 | ORDER BY n DESC | |
| 1098 | LIMIT $limit | |
| 1099 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 1100 | } | |
| 1101 | ||
| 1102 | sub country_top_pages { | |
| 1103 | my ($self, $db, $dbh, $DB, $country_code, $region, $days, $limit, $days_to, $co_id) = @_; | |
| 1104 | return () unless $self->schema_ready($db, $dbh, $DB); | |
| 1105 | $country_code = uc(defined $country_code ? $country_code : ''); | |
| 1106 | $country_code =~ s/[^A-Z]//g; | |
| 1107 | return () unless $country_code; | |
| 1108 | $limit ||= 10; $limit =~ s/[^0-9]//g; $limit = 10 unless $limit; | |
| 1109 | my $rc = _region_clause($region); | |
| 1110 | my $dw_e = _date_where($days, $days_to, 'e.occurred_at'); | |
| 1111 | my $co_s = _co_filter('s', $co_id); | |
| 1112 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 1113 | SELECT e.page_path, COUNT(*) AS views | |
| 1114 | FROM `${DB}`.tracking_events e | |
| 1115 | JOIN `${DB}`.tracking_sessions s ON s.id = e.session_id | |
| 1116 | WHERE e.event_type='page_view' | |
| 1117 | AND s.country='$country_code' | |
| 1118 | $dw_e | |
| 1119 | $rc | |
| 1120 | $co_s | |
| 1121 | GROUP BY e.page_path | |
| 1122 | ORDER BY views DESC | |
| 1123 | LIMIT $limit | |
| 1124 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 1125 | } | |
| 1126 | ||
| 1127 | sub country_total_visits { | |
| 1128 | my ($self, $db, $dbh, $DB, $country_code, $co_id, $days) = @_; | |
| 1129 | return 0 unless $self->schema_ready($db, $dbh, $DB); | |
| 1130 | $country_code = uc(defined $country_code ? $country_code : ''); | |
| 1131 | $country_code =~ s/[^A-Z]//g; | |
| 1132 | return 0 unless $country_code; | |
| 1133 | $days ||= 30; $days =~ s/[^0-9]//g; $days = 30 unless $days; | |
| 1134 | my $co_s = _co_filter('s', $co_id); | |
| 1135 | my $r = $db->db_readwrite($dbh, qq~ | |
| 1136 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_sessions s | |
| 1137 | WHERE s.country='$country_code' | |
| 1138 | AND s.first_seen_at >= DATE_SUB(CURDATE(), INTERVAL $days DAY) | |
| 1139 | $co_s | |
| 1140 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 1141 | return ($r && $r->{n}) ? $r->{n} : 0; | |
| 1142 | } | |
| 1143 | ||
| 1144 | # ---- Fingerprint sanitization for create_session -------------------- | |
| 1145 | sub _sanitize_fingerprint { | |
| 1146 | my ($self, $a) = @_; | |
| 1147 | my %f; | |
| 1148 | ||
| 1149 | my %device_ok = map { $_ => 1 } qw(desktop tablet mobile tv bot unknown); | |
| 1150 | $f{device_type} = $a->{device_type}; | |
| 1151 | $f{device_type} = 'unknown' unless $f{device_type} && $device_ok{$f{device_type}}; | |
| 1152 | ||
| 1153 | $f{touch} = ($a->{touch_capable} && $a->{touch_capable} ne '0') ? 1 : 0; | |
| 1154 | ||
| 1155 | $f{os_name_q} = _qstr_trunc($a->{os_name}, 40); | |
| 1156 | $f{os_version_q} = _qstr_trunc($a->{os_version}, 40); | |
| 1157 | $f{browser_name_q} = _qstr_trunc($a->{browser_name}, 40); | |
| 1158 | $f{browser_version_q} = _qstr_trunc($a->{browser_version}, 40); | |
| 1159 | $f{language_q} = _qstr_trunc($a->{language}, 16); | |
| 1160 | $f{timezone_q} = _qstr_trunc($a->{timezone}, 64); | |
| 1161 | $f{ua_q} = _qstr_trunc($a->{user_agent}, 500); | |
| 1162 | $f{referrer_q} = _qstr_trunc($a->{referrer}, 500); | |
| 1163 | $f{path_q} = _qstr_trunc($a->{current_page_path}, 500); | |
| 1164 | ||
| 1165 | my $cc = ''; | |
| 1166 | if (defined $a->{country} && $a->{country} =~ /\S/) { | |
| 1167 | $cc = uc(substr($a->{country}, 0, 2)); | |
| 1168 | $cc =~ s/[^A-Z]//g; | |
| 1169 | } | |
| 1170 | if (!$cc && defined $a->{timezone}) { | |
| 1171 | $cc = _country_from_timezone($a->{timezone}) || ''; | |
| 1172 | } | |
| 1173 | $f{country_q} = length $cc ? "'$cc'" : 'NULL'; | |
| 1174 | ||
| 1175 | my $rg = ''; | |
| 1176 | if (defined $a->{region} && $a->{region} =~ /\S/) { | |
| 1177 | $rg = $a->{region}; | |
| 1178 | } elsif ($cc eq 'US' && defined $a->{timezone}) { | |
| 1179 | $rg = _us_state_from_timezone($a->{timezone}) || ''; | |
| 1180 | } | |
| 1181 | if (length $rg) { | |
| 1182 | $rg =~ s/'/''/g; | |
| 1183 | $rg = substr($rg, 0, 80); | |
| 1184 | $f{region_q} = "'$rg'"; | |
| 1185 | } else { | |
| 1186 | $f{region_q} = 'NULL'; | |
| 1187 | } | |
| 1188 | ||
| 1189 | foreach my $k (qw(screen_w screen_h viewport_w viewport_h color_depth)) { | |
| 1190 | my $src = $a->{$k}; | |
| 1191 | $src = '' unless defined $src; | |
| 1192 | $src =~ s/[^0-9]//g; | |
| 1193 | $f{"${k}_sql"} = length $src ? "'$src'" : 'NULL'; | |
| 1194 | } | |
| 1195 | my $pr = defined $a->{pixel_ratio} ? $a->{pixel_ratio} : ''; | |
| 1196 | $pr =~ s/[^0-9.]//g; | |
| 1197 | $f{pixel_ratio_sql} = length $pr ? "'$pr'" : 'NULL'; | |
| 1198 | ||
| 1199 | my $co = defined $a->{company_id} ? $a->{company_id} : ''; | |
| 1200 | $co =~ s/[^0-9]//g; | |
| 1201 | $f{company_sql} = $co eq '' ? 'NULL' : "'$co'"; | |
| 1202 | ||
| 1203 | my $user = defined $a->{user_id} ? $a->{user_id} : ''; | |
| 1204 | $user =~ s/[^0-9]//g; | |
| 1205 | $f{user_sql} = $user eq '' ? 'NULL' : "'$user'"; | |
| 1206 | ||
| 1207 | my $ip = defined $a->{ip_address} ? $a->{ip_address} : ''; | |
| 1208 | $ip =~ s/[^0-9a-fA-F.:]//g; | |
| 1209 | $ip = substr($ip, 0, 45); | |
| 1210 | $f{ip_sql} = length $ip ? "'$ip'" : 'NULL'; | |
| 1211 | ||
| 1212 | return %f; | |
| 1213 | } | |
| 1214 | ||
| 1215 | sub _qstr_trunc { | |
| 1216 | my ($s, $max) = @_; | |
| 1217 | return 'NULL' unless defined $s && length $s; | |
| 1218 | $s =~ s/[\r\n]+/ /g; | |
| 1219 | $s =~ s/'/''/g; | |
| 1220 | $s = substr($s, 0, $max); | |
| 1221 | return "'$s'"; | |
| 1222 | } | |
| 1223 | ||
| 1224 | # ---- IANA timezone -> ISO-2 country code lookup --------------------- | |
| 1225 | my %TZ2CC = ( | |
| 1226 | 'America/Adak' => 'US', 'America/Anchorage' => 'US', | |
| 1227 | 'America/Boise' => 'US', 'America/Chicago' => 'US', | |
| 1228 | 'America/Denver' => 'US', 'America/Detroit' => 'US', | |
| 1229 | 'America/Indiana/Indianapolis'=> 'US', 'America/Indianapolis' => 'US', | |
| 1230 | 'America/Juneau' => 'US', 'America/Kentucky/Louisville' => 'US', | |
| 1231 | 'America/Los_Angeles' => 'US', 'America/Menominee' => 'US', | |
| 1232 | 'America/Metlakatla' => 'US', 'America/New_York' => 'US', | |
| 1233 | 'America/Nome' => 'US', 'America/Phoenix' => 'US', | |
| 1234 | 'America/Sitka' => 'US', 'America/Yakutat' => 'US', | |
| 1235 | 'Pacific/Honolulu' => 'US', | |
| 1236 | 'US/Eastern' => 'US', 'US/Central' => 'US', 'US/Mountain' => 'US', | |
| 1237 | 'US/Pacific' => 'US', 'US/Alaska' => 'US', 'US/Hawaii' => 'US', | |
| 1238 | 'US/Arizona' => 'US', 'US/Samoa' => 'US', | |
| 1239 | 'America/Toronto' => 'CA', 'America/Vancouver' => 'CA', | |
| 1240 | 'America/Edmonton' => 'CA', 'America/Winnipeg' => 'CA', | |
| 1241 | 'America/Halifax' => 'CA', 'America/Montreal' => 'CA', | |
| 1242 | 'America/Regina' => 'CA', 'America/St_Johns' => 'CA', | |
| 1243 | 'America/Mexico_City' => 'MX', 'America/Tijuana' => 'MX', | |
| 1244 | 'America/Monterrey' => 'MX', 'America/Cancun' => 'MX', | |
| 1245 | 'America/Guatemala' => 'GT', 'America/Belize' => 'BZ', | |
| 1246 | 'America/El_Salvador' => 'SV', 'America/Tegucigalpa'=> 'HN', | |
| 1247 | 'America/Managua' => 'NI', 'America/Costa_Rica' => 'CR', | |
| 1248 | 'America/Panama' => 'PA', 'America/Havana' => 'CU', | |
| 1249 | 'America/Santo_Domingo' => 'DO', 'America/Port-au-Prince' => 'HT', | |
| 1250 | 'America/Puerto_Rico' => 'PR', | |
| 1251 | 'America/Sao_Paulo' => 'BR', 'America/Recife' => 'BR', | |
| 1252 | 'America/Manaus' => 'BR', 'America/Bahia' => 'BR', | |
| 1253 | 'America/Fortaleza' => 'BR', 'America/Belem' => 'BR', | |
| 1254 | 'America/Argentina/Buenos_Aires' => 'AR', 'America/Argentina/Cordoba' => 'AR', | |
| 1255 | 'America/Buenos_Aires' => 'AR', | |
| 1256 | 'America/Santiago' => 'CL', 'America/Lima' => 'PE', | |
| 1257 | 'America/Bogota' => 'CO', 'America/Caracas' => 'VE', | |
| 1258 | 'America/Guayaquil' => 'EC', 'America/Montevideo' => 'UY', | |
| 1259 | 'America/Asuncion' => 'PY', 'America/La_Paz' => 'BO', | |
| 1260 | 'Europe/London' => 'GB', 'Europe/Dublin' => 'IE', | |
| 1261 | 'Europe/Paris' => 'FR', 'Europe/Berlin' => 'DE', | |
| 1262 | 'Europe/Amsterdam'=> 'NL', 'Europe/Brussels' => 'BE', | |
| 1263 | 'Europe/Luxembourg'=>'LU', 'Europe/Zurich' => 'CH', | |
| 1264 | 'Europe/Vienna' => 'AT', 'Europe/Rome' => 'IT', | |
| 1265 | 'Europe/Madrid' => 'ES', 'Europe/Lisbon' => 'PT', | |
| 1266 | 'Europe/Copenhagen'=>'DK', 'Europe/Oslo' => 'NO', | |
| 1267 | 'Europe/Stockholm'=> 'SE', 'Europe/Helsinki' => 'FI', | |
| 1268 | 'Europe/Warsaw' => 'PL', 'Europe/Prague' => 'CZ', | |
| 1269 | 'Europe/Bratislava'=>'SK', 'Europe/Budapest' => 'HU', | |
| 1270 | 'Europe/Bucharest'=> 'RO', 'Europe/Sofia' => 'BG', | |
| 1271 | 'Europe/Athens' => 'GR', 'Europe/Kiev' => 'UA', | |
| 1272 | 'Europe/Kyiv' => 'UA', 'Europe/Moscow' => 'RU', | |
| 1273 | 'Europe/Istanbul' => 'TR', 'Europe/Belgrade' => 'RS', | |
| 1274 | 'Europe/Tallinn' => 'EE', 'Europe/Riga' => 'LV', | |
| 1275 | 'Europe/Vilnius' => 'LT', 'Europe/Reykjavik'=> 'IS', | |
| 1276 | 'Asia/Jerusalem' => 'IL', 'Asia/Tel_Aviv' => 'IL', | |
| 1277 | 'Asia/Riyadh' => 'SA', 'Asia/Dubai' => 'AE', | |
| 1278 | 'Asia/Qatar' => 'QA', 'Asia/Kuwait' => 'KW', | |
| 1279 | 'Asia/Bahrain' => 'BH', 'Asia/Muscat' => 'OM', | |
| 1280 | 'Asia/Tehran' => 'IR', 'Asia/Baghdad' => 'IQ', | |
| 1281 | 'Asia/Beirut' => 'LB', 'Asia/Amman' => 'JO', | |
| 1282 | 'Africa/Cairo' => 'EG', 'Africa/Casablanca'=>'MA', | |
| 1283 | 'Africa/Algiers' => 'DZ', 'Africa/Tunis' => 'TN', | |
| 1284 | 'Africa/Johannesburg' => 'ZA', 'Africa/Lagos' => 'NG', | |
| 1285 | 'Africa/Nairobi' => 'KE', 'Africa/Accra' => 'GH', | |
| 1286 | 'Africa/Addis_Ababa' => 'ET', 'Africa/Dakar' => 'SN', | |
| 1287 | 'Asia/Kolkata' => 'IN', 'Asia/Calcutta' => 'IN', | |
| 1288 | 'Asia/Karachi' => 'PK', 'Asia/Dhaka' => 'BD', | |
| 1289 | 'Asia/Colombo' => 'LK', 'Asia/Kathmandu' => 'NP', | |
| 1290 | 'Asia/Tokyo' => 'JP', 'Asia/Seoul' => 'KR', | |
| 1291 | 'Asia/Taipei' => 'TW', 'Asia/Hong_Kong' => 'HK', | |
| 1292 | 'Asia/Shanghai' => 'CN', 'Asia/Beijing' => 'CN', | |
| 1293 | 'Asia/Macau' => 'MO', 'Asia/Ulaanbaatar'=>'MN', | |
| 1294 | 'Asia/Singapore' => 'SG', 'Asia/Kuala_Lumpur'=>'MY', | |
| 1295 | 'Asia/Bangkok' => 'TH', 'Asia/Ho_Chi_Minh' => 'VN', | |
| 1296 | 'Asia/Jakarta' => 'ID', 'Asia/Manila' => 'PH', | |
| 1297 | 'Asia/Yangon' => 'MM', 'Asia/Phnom_Penh' => 'KH', | |
| 1298 | 'Australia/Sydney' => 'AU', 'Australia/Melbourne'=> 'AU', | |
| 1299 | 'Australia/Brisbane' => 'AU', 'Australia/Perth' => 'AU', | |
| 1300 | 'Australia/Adelaide' => 'AU', 'Australia/Darwin' => 'AU', | |
| 1301 | 'Australia/Hobart' => 'AU', | |
| 1302 | 'Pacific/Auckland' => 'NZ', 'Pacific/Fiji' => 'FJ', | |
| 1303 | ); | |
| 1304 | ||
| 1305 | sub _country_from_timezone { | |
| 1306 | my ($tz) = @_; | |
| 1307 | return undef unless defined $tz && length $tz; | |
| 1308 | $tz =~ s/^\s+|\s+$//g; | |
| 1309 | return $TZ2CC{$tz} if exists $TZ2CC{$tz}; | |
| 1310 | return undef; | |
| 1311 | } | |
| 1312 | ||
| 1313 | my %TZ2US_STATE = ( | |
| 1314 | 'America/Adak' => 'Alaska', | |
| 1315 | 'America/Anchorage' => 'Alaska', | |
| 1316 | 'America/Boise' => 'Idaho', | |
| 1317 | 'America/Chicago' => 'Illinois', | |
| 1318 | 'America/Denver' => 'Colorado', | |
| 1319 | 'America/Detroit' => 'Michigan', | |
| 1320 | 'America/Indiana/Indianapolis' => 'Indiana', | |
| 1321 | 'America/Indianapolis' => 'Indiana', | |
| 1322 | 'America/Juneau' => 'Alaska', | |
| 1323 | 'America/Kentucky/Louisville' => 'Kentucky', | |
| 1324 | 'America/Los_Angeles' => 'California', | |
| 1325 | 'America/Menominee' => 'Michigan', | |
| 1326 | 'America/Metlakatla' => 'Alaska', | |
| 1327 | 'America/New_York' => 'New York', | |
| 1328 | 'America/Nome' => 'Alaska', | |
| 1329 | 'America/Phoenix' => 'Arizona', | |
| 1330 | 'America/Sitka' => 'Alaska', | |
| 1331 | 'America/Yakutat' => 'Alaska', | |
| 1332 | 'Pacific/Honolulu' => 'Hawaii', | |
| 1333 | 'US/Eastern' => 'New York', | |
| 1334 | 'US/Central' => 'Illinois', | |
| 1335 | 'US/Mountain' => 'Colorado', | |
| 1336 | 'US/Pacific' => 'California', | |
| 1337 | 'US/Alaska' => 'Alaska', | |
| 1338 | 'US/Hawaii' => 'Hawaii', | |
| 1339 | 'US/Arizona' => 'Arizona', | |
| 1340 | ); | |
| 1341 | ||
| 1342 | sub _us_state_from_timezone { | |
| 1343 | my ($tz) = @_; | |
| 1344 | return undef unless defined $tz && length $tz; | |
| 1345 | $tz =~ s/^\s+|\s+$//g; | |
| 1346 | return $TZ2US_STATE{$tz}; | |
| 1347 | } | |
| 1348 | ||
| 1349 | # Backfill country for sessions that have a timezone but no country. | |
| 1350 | # Idempotent; only touches rows where country IS NULL. | |
| 1351 | sub backfill_country_from_timezone { | |
| 1352 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 1353 | return 0 unless $self->schema_ready($db, $dbh, $DB); | |
| 1354 | $limit ||= 500; $limit =~ s/[^0-9]//g; $limit = 500 unless $limit; | |
| 1355 | my $region_ready = $self->region_column_ready($db, $dbh, $DB); | |
| 1356 | ||
| 1357 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 1358 | SELECT id, timezone FROM `${DB}`.tracking_sessions | |
| 1359 | WHERE (country IS NULL OR country='') | |
| 1360 | AND timezone IS NOT NULL AND timezone<>'' | |
| 1361 | LIMIT $limit | |
| 1362 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 1363 | my $n = 0; | |
| 1364 | foreach my $r (@rows) { | |
| 1365 | my $cc = _country_from_timezone($r->{timezone}); | |
| 1366 | next unless $cc; | |
| 1367 | $cc = uc($cc); $cc =~ s/[^A-Z]//g; | |
| 1368 | next unless length($cc) == 2; | |
| 1369 | my $extra = ''; | |
| 1370 | if ($region_ready && $cc eq 'US') { | |
| 1371 | my $st = _us_state_from_timezone($r->{timezone}); | |
| 1372 | if ($st) { | |
| 1373 | my $sq = $st; $sq =~ s/'/''/g; $sq = substr($sq, 0, 80); | |
| 1374 | $extra = ", region='$sq'"; | |
| 1375 | } | |
| 1376 | } | |
| 1377 | $db->db_readwrite($dbh, qq~ | |
| 1378 | UPDATE `${DB}`.tracking_sessions SET country='$cc'$extra WHERE id='$r->{id}' | |
| 1379 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 1380 | $n++; | |
| 1381 | } | |
| 1382 | ||
| 1383 | if ($region_ready) { | |
| 1384 | my @us_rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 1385 | SELECT id, timezone FROM `${DB}`.tracking_sessions | |
| 1386 | WHERE country='US' | |
| 1387 | AND (region IS NULL OR region='') | |
| 1388 | AND timezone IS NOT NULL AND timezone<>'' | |
| 1389 | LIMIT $limit | |
| 1390 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 1391 | foreach my $r (@us_rows) { | |
| 1392 | my $st = _us_state_from_timezone($r->{timezone}); | |
| 1393 | next unless $st; | |
| 1394 | my $sq = $st; $sq =~ s/'/''/g; $sq = substr($sq, 0, 80); | |
| 1395 | $db->db_readwrite($dbh, qq~ | |
| 1396 | UPDATE `${DB}`.tracking_sessions SET region='$sq' WHERE id='$r->{id}' | |
| 1397 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 1398 | $n++; | |
| 1399 | } | |
| 1400 | } | |
| 1401 | ||
| 1402 | return $n; | |
| 1403 | } | |
| 1404 | ||
| 1405 | # Lightweight UA fallback when client JS didn't pass OS/browser. | |
| 1406 | sub parse_ua { | |
| 1407 | my ($self, $ua) = @_; | |
| 1408 | return ({}) unless defined $ua && length $ua; | |
| 1409 | my %r; | |
| 1410 | if ($ua =~ /Windows NT 10/i) { $r{os_name} = 'Windows'; $r{os_version} = '10/11'; } | |
| 1411 | elsif ($ua =~ /Windows NT ([\d.]+)/i) { $r{os_name} = 'Windows'; $r{os_version} = $1; } | |
| 1412 | elsif ($ua =~ /Mac OS X ([\d_]+)/i) { (my $v = $1) =~ tr/_/./; $r{os_name} = 'macOS'; $r{os_version} = $v; } | |
| 1413 | elsif ($ua =~ /iPhone|iPad|iPod/i) { $r{os_name} = 'iOS'; $r{os_version} = ($ua =~ /OS ([\d_]+)/ ? do { (my $v = $1) =~ tr/_/./; $v } : ''); } | |
| 1414 | elsif ($ua =~ /Android ([\d.]+)/i) { $r{os_name} = 'Android'; $r{os_version} = $1; } | |
| 1415 | elsif ($ua =~ /Linux/i) { $r{os_name} = 'Linux'; $r{os_version} = ''; } | |
| 1416 | else { $r{os_name} = ''; $r{os_version} = ''; } | |
| 1417 | if ($ua =~ /Edg\/([\d.]+)/) { $r{browser_name} = 'Edge'; $r{browser_version} = $1; } | |
| 1418 | elsif ($ua =~ /OPR\/([\d.]+)/) { $r{browser_name} = 'Opera'; $r{browser_version} = $1; } | |
| 1419 | elsif ($ua =~ /Firefox\/([\d.]+)/) { $r{browser_name} = 'Firefox'; $r{browser_version} = $1; } | |
| 1420 | elsif ($ua =~ /Chrome\/([\d.]+)/) { $r{browser_name} = 'Chrome'; $r{browser_version} = $1; } | |
| 1421 | elsif ($ua =~ /Safari\/([\d.]+).*Version\/([\d.]+)/) { $r{browser_name} = 'Safari'; $r{browser_version} = $2; } | |
| 1422 | elsif ($ua =~ /Safari/) { $r{browser_name} = 'Safari'; $r{browser_version} = ''; } | |
| 1423 | else { $r{browser_name} = ''; $r{browser_version} = ''; } | |
| 1424 | if ($ua =~ /iPad|Tablet/i) { $r{device_type} = 'tablet'; } | |
| 1425 | elsif ($ua =~ /iPhone|Android.*Mobile|Mobile/i) { $r{device_type} = 'mobile'; } | |
| 1426 | elsif ($ua =~ /bot|crawl|spider/i) { $r{device_type} = 'bot'; } | |
| 1427 | else { $r{device_type} = 'desktop'; } | |
| 1428 | return \%r; | |
| 1429 | } | |
| 1430 | ||
| 1431 | 1; |