added on local at 2026-07-01 21:47:14
| 1 | package MODS::RePricer::Stats; | |
| 2 | #====================================================================== | |
| 3 | # RePricer -- traffic analytics rollups for /admin_traffic.cgi. | |
| 4 | # Generated from the canonical PTMatrix-shape Stats.pm template. | |
| 5 | # Queries `tracking_sessions` + `tracking_events` (PTMatrix-style schema). | |
| 6 | #====================================================================== | |
| 7 | use strict; | |
| 8 | use warnings; | |
| 9 | ||
| 10 | sub new { bless {}, shift } | |
| 11 | ||
| 12 | # ---- Range model ---------------------------------------------------- | |
| 13 | sub _range { | |
| 14 | my ($spec) = @_; | |
| 15 | if (ref($spec) eq 'HASH' && $spec->{from} && $spec->{to}) { | |
| 16 | my $f = $spec->{from}; $f =~ s/[^0-9 :-]//g; | |
| 17 | my $t = $spec->{to}; $t =~ s/[^0-9 :-]//g; | |
| 18 | if ($f && $t) { return ("'$f'", "'$t'"); } | |
| 19 | } | |
| 20 | my $d = (defined $spec && !ref($spec) && $spec =~ /^\d+$/) ? int($spec) : 30; | |
| 21 | $d = 1 if $d < 1; | |
| 22 | $d = 730 if $d > 730; | |
| 23 | return ("DATE_SUB(NOW(), INTERVAL $d DAY)", 'NOW()'); | |
| 24 | } | |
| 25 | sub set_range { | |
| 26 | my ($self, $spec) = @_; | |
| 27 | my ($s, $u) = _range($spec); | |
| 28 | $self->{_since} = $s; | |
| 29 | $self->{_until} = $u; | |
| 30 | return $self; | |
| 31 | } | |
| 32 | sub _since { $_[0]->{_since} // 'DATE_SUB(NOW(), INTERVAL 30 DAY)' } | |
| 33 | sub _until { $_[0]->{_until} // 'NOW()' } | |
| 34 | ||
| 35 | # Source classification for the referrer string. Identical to CF. | |
| 36 | sub _classify_source { | |
| 37 | my ($ref_host, $utm_medium) = @_; | |
| 38 | $utm_medium = lc($utm_medium || ''); | |
| 39 | $ref_host = lc($ref_host || ''); | |
| 40 | return 'paid' if $utm_medium =~ /^(cpc|ppc|paid|paidsearch|paid-social|ads?|display)$/; | |
| 41 | return 'email' if $utm_medium eq 'email'; | |
| 42 | return 'email' if $ref_host =~ /(^|\.)mail\./; | |
| 43 | my %search = map { $_ => 1 } qw(google.com google.co.uk google.ca google.de google.fr google.es google.com.au bing.com duckduckgo.com yahoo.com baidu.com yandex.com yandex.ru ecosia.org startpage.com brave.com); | |
| 44 | my %social = map { $_ => 1 } qw(facebook.com m.facebook.com l.facebook.com instagram.com t.co twitter.com x.com linkedin.com lnkd.in reddit.com pinterest.com youtube.com youtu.be tiktok.com threads.net mastodon.social); | |
| 45 | return 'search' if $ref_host && $search{$ref_host}; | |
| 46 | return 'social' if $ref_host && $social{$ref_host}; | |
| 47 | return 'referral' if $ref_host; | |
| 48 | return 'direct'; | |
| 49 | } | |
| 50 | ||
| 51 | # ---- KPIs ------------------------------------------------------------ | |
| 52 | sub kpis { | |
| 53 | my ($self, $db, $dbh, $DB) = @_; | |
| 54 | my $since = $self->_since; my $until = $self->_until; | |
| 55 | my $kpi = {}; | |
| 56 | my $r = $db->db_readwrite($dbh, qq~ | |
| 57 | SELECT COUNT(*) AS pageviews | |
| 58 | FROM `${DB}`.tracking_events | |
| 59 | WHERE event_type='page_view' AND occurred_at BETWEEN $since AND $until | |
| 60 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 61 | $kpi->{pageviews} = ($r && $r->{pageviews}) ? $r->{pageviews} : 0; | |
| 62 | ||
| 63 | $r = $db->db_readwrite($dbh, qq~ | |
| 64 | SELECT COUNT(DISTINCT session_token) AS visitors | |
| 65 | FROM `${DB}`.tracking_sessions | |
| 66 | WHERE last_seen_at BETWEEN $since AND $until | |
| 67 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 68 | $kpi->{visitors} = ($r && $r->{visitors}) ? $r->{visitors} : 0; | |
| 69 | ||
| 70 | # sessions + avg_duration + pv-per-session via derived counts. | |
| 71 | # Bounce: sessions whose pv-count is <= 1. | |
| 72 | $r = $db->db_readwrite($dbh, qq~ | |
| 73 | SELECT COUNT(*) AS sessions, | |
| 74 | AVG(TIMESTAMPDIFF(SECOND, first_seen_at, last_seen_at)) AS avg_seconds | |
| 75 | FROM `${DB}`.tracking_sessions | |
| 76 | WHERE last_seen_at BETWEEN $since AND $until | |
| 77 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 78 | $kpi->{sessions} = ($r && $r->{sessions}) ? $r->{sessions} : 0; | |
| 79 | $kpi->{avg_seconds} = sprintf('%.0f', ($r && $r->{avg_seconds}) || 0); | |
| 80 | ||
| 81 | my $sessions = $kpi->{sessions} || 1; | |
| 82 | $kpi->{pv_per_session} = sprintf('%.2f', $kpi->{pageviews} / $sessions); | |
| 83 | ||
| 84 | my $b = $db->db_readwrite($dbh, qq~ | |
| 85 | SELECT SUM(IF(pv_n<=1,1,0)) AS bounces, COUNT(*) AS total | |
| 86 | FROM ( | |
| 87 | SELECT s.id, (SELECT COUNT(*) FROM `${DB}`.tracking_events e WHERE e.session_id=s.id AND e.event_type='page_view') AS pv_n | |
| 88 | FROM `${DB}`.tracking_sessions s | |
| 89 | WHERE s.last_seen_at BETWEEN $since AND $until | |
| 90 | ) X | |
| 91 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 92 | my $bs = ($b && $b->{bounces}) || 0; | |
| 93 | my $bt = ($b && $b->{total}) || 1; | |
| 94 | $kpi->{bounce_rate} = sprintf('%.1f', 100 * $bs / $bt); | |
| 95 | return $kpi; | |
| 96 | } | |
| 97 | ||
| 98 | # Daily pageviews + visitors series | |
| 99 | sub daily_series { | |
| 100 | my ($self, $db, $dbh, $DB, $days) = @_; | |
| 101 | my $since = $self->_since; my $until = $self->_until; | |
| 102 | $days = int($days || 30); | |
| 103 | my @pv = $db->db_readwrite_multiple($dbh, qq~ | |
| 104 | SELECT DATE(occurred_at) AS d, COUNT(*) AS n | |
| 105 | FROM `${DB}`.tracking_events | |
| 106 | WHERE event_type='page_view' AND occurred_at BETWEEN $since AND $until | |
| 107 | GROUP BY DATE(occurred_at) | |
| 108 | ORDER BY d | |
| 109 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 110 | my @vs = $db->db_readwrite_multiple($dbh, qq~ | |
| 111 | SELECT DATE(last_seen_at) AS d, COUNT(DISTINCT session_token) AS n | |
| 112 | FROM `${DB}`.tracking_sessions | |
| 113 | WHERE last_seen_at BETWEEN $since AND $until | |
| 114 | GROUP BY DATE(last_seen_at) | |
| 115 | ORDER BY d | |
| 116 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 117 | my %pv_by = map { $_->{d} => $_->{n} } @pv; | |
| 118 | my %vs_by = map { $_->{d} => $_->{n} } @vs; | |
| 119 | my (@labels, @pvv, @vsv); | |
| 120 | for (my $i = $days - 1; $i >= 0; $i--) { | |
| 121 | my @t = localtime(time - $i * 86400); | |
| 122 | my $d = sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]); | |
| 123 | push @labels, $d; | |
| 124 | push @pvv, ($pv_by{$d} || 0) + 0; | |
| 125 | push @vsv, ($vs_by{$d} || 0) + 0; | |
| 126 | } | |
| 127 | return { labels => \@labels, pageviews => \@pvv, visitors => \@vsv }; | |
| 128 | } | |
| 129 | ||
| 130 | # Breakdowns -- one per facet | |
| 131 | sub _br { | |
| 132 | my ($self, $db, $dbh, $DB, $col, $lbl, $limit) = @_; | |
| 133 | my $since = $self->_since; my $until = $self->_until; | |
| 134 | $limit = int($limit || 15); | |
| 135 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 136 | SELECT COALESCE(NULLIF($col,''),'Unknown') AS $lbl, | |
| 137 | COUNT(*) AS sessions | |
| 138 | FROM `${DB}`.tracking_sessions | |
| 139 | WHERE last_seen_at BETWEEN $since AND $until | |
| 140 | GROUP BY $col | |
| 141 | ORDER BY sessions DESC LIMIT $limit | |
| 142 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 143 | } | |
| 144 | sub by_browser { | |
| 145 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 146 | return $self->_br($db, $dbh, $DB, 'browser_name', 'browser', $limit); | |
| 147 | } | |
| 148 | sub by_os { | |
| 149 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 150 | return $self->_br($db, $dbh, $DB, 'os_name', 'os', $limit); | |
| 151 | } | |
| 152 | ||
| 153 | sub by_device { | |
| 154 | my ($self, $db, $dbh, $DB) = @_; | |
| 155 | my $since = $self->_since; my $until = $self->_until; | |
| 156 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 157 | SELECT COALESCE(device_type,'unknown') AS device_type, COUNT(*) AS sessions | |
| 158 | FROM `${DB}`.tracking_sessions | |
| 159 | WHERE last_seen_at BETWEEN $since AND $until | |
| 160 | GROUP BY device_type ORDER BY sessions DESC | |
| 161 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 162 | } | |
| 163 | ||
| 164 | sub by_resolution { | |
| 165 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 166 | my $since = $self->_since; my $until = $self->_until; | |
| 167 | $limit = int($limit || 12); | |
| 168 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 169 | SELECT CONCAT(COALESCE(screen_width,'?'),' x ',COALESCE(screen_height,'?')) AS resolution, | |
| 170 | COUNT(*) AS sessions | |
| 171 | FROM `${DB}`.tracking_sessions | |
| 172 | WHERE last_seen_at BETWEEN $since AND $until | |
| 173 | GROUP BY screen_width, screen_height | |
| 174 | ORDER BY sessions DESC LIMIT $limit | |
| 175 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 176 | } | |
| 177 | ||
| 178 | sub by_viewport { | |
| 179 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 180 | my $since = $self->_since; my $until = $self->_until; | |
| 181 | $limit = int($limit || 12); | |
| 182 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 183 | SELECT CONCAT(COALESCE(viewport_width,'?'),' x ',COALESCE(viewport_height,'?')) AS viewport, | |
| 184 | COUNT(*) AS sessions | |
| 185 | FROM `${DB}`.tracking_sessions | |
| 186 | WHERE last_seen_at BETWEEN $since AND $until | |
| 187 | AND viewport_width IS NOT NULL AND viewport_height IS NOT NULL | |
| 188 | GROUP BY viewport_width, viewport_height | |
| 189 | ORDER BY sessions DESC LIMIT $limit | |
| 190 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 191 | } | |
| 192 | ||
| 193 | sub by_touch_capable { | |
| 194 | my ($self, $db, $dbh, $DB) = @_; | |
| 195 | my $since = $self->_since; my $until = $self->_until; | |
| 196 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 197 | SELECT IF(touch_capable=1,'Touch','No touch') AS touch, COUNT(*) AS sessions | |
| 198 | FROM `${DB}`.tracking_sessions | |
| 199 | WHERE last_seen_at BETWEEN $since AND $until | |
| 200 | GROUP BY touch_capable | |
| 201 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 202 | } | |
| 203 | ||
| 204 | sub by_pixel_ratio { | |
| 205 | my ($self, $db, $dbh, $DB) = @_; | |
| 206 | my $since = $self->_since; my $until = $self->_until; | |
| 207 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 208 | SELECT CAST(pixel_ratio AS CHAR(8)) AS pixel_ratio, COUNT(*) AS sessions | |
| 209 | FROM `${DB}`.tracking_sessions | |
| 210 | WHERE last_seen_at BETWEEN $since AND $until AND pixel_ratio IS NOT NULL | |
| 211 | GROUP BY pixel_ratio ORDER BY sessions DESC | |
| 212 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 213 | } | |
| 214 | ||
| 215 | sub by_color_depth { | |
| 216 | my ($self, $db, $dbh, $DB) = @_; | |
| 217 | my $since = $self->_since; my $until = $self->_until; | |
| 218 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 219 | SELECT CONCAT(color_depth,'-bit') AS color_depth, COUNT(*) AS sessions | |
| 220 | FROM `${DB}`.tracking_sessions | |
| 221 | WHERE last_seen_at BETWEEN $since AND $until AND color_depth IS NOT NULL | |
| 222 | GROUP BY color_depth ORDER BY sessions DESC | |
| 223 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 224 | } | |
| 225 | ||
| 226 | sub by_timezone { | |
| 227 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 228 | my $since = $self->_since; my $until = $self->_until; | |
| 229 | $limit = int($limit || 15); | |
| 230 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 231 | SELECT COALESCE(NULLIF(timezone,''),'(unknown)') AS timezone, COUNT(*) AS sessions | |
| 232 | FROM `${DB}`.tracking_sessions | |
| 233 | WHERE last_seen_at BETWEEN $since AND $until | |
| 234 | GROUP BY timezone ORDER BY sessions DESC LIMIT $limit | |
| 235 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 236 | } | |
| 237 | ||
| 238 | # Country breakdowns | |
| 239 | sub by_country { | |
| 240 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 241 | my $since = $self->_since; my $until = $self->_until; | |
| 242 | $limit = int($limit || 50); | |
| 243 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 244 | SELECT COALESCE(country,'') AS country, | |
| 245 | COUNT(DISTINCT session_token) AS visitors, | |
| 246 | COUNT(*) AS sessions | |
| 247 | FROM `${DB}`.tracking_sessions | |
| 248 | WHERE last_seen_at BETWEEN $since AND $until | |
| 249 | GROUP BY country | |
| 250 | ORDER BY visitors DESC LIMIT $limit | |
| 251 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 252 | } | |
| 253 | ||
| 254 | sub by_country_enriched { | |
| 255 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 256 | my $since = $self->_since; my $until = $self->_until; | |
| 257 | $limit = int($limit || 30); | |
| 258 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 259 | SELECT COALESCE(NULLIF(country,''),'(unknown)') AS country, | |
| 260 | COUNT(DISTINCT session_token) AS visitors, | |
| 261 | COUNT(*) AS sessions, | |
| 262 | AVG(TIMESTAMPDIFF(SECOND, first_seen_at, last_seen_at)) AS avg_duration_seconds, | |
| 263 | 0.0 AS bounce_rate, | |
| 264 | 0.0 AS pv_per_session | |
| 265 | FROM `${DB}`.tracking_sessions | |
| 266 | WHERE last_seen_at BETWEEN $since AND $until | |
| 267 | GROUP BY country | |
| 268 | ORDER BY visitors DESC LIMIT $limit | |
| 269 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 270 | } | |
| 271 | ||
| 272 | # Pages | |
| 273 | sub by_page { | |
| 274 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 275 | my $since = $self->_since; my $until = $self->_until; | |
| 276 | $limit = int($limit || 25); | |
| 277 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 278 | SELECT page_path, | |
| 279 | COUNT(*) AS pageviews, | |
| 280 | COUNT(DISTINCT session_id) AS sessions | |
| 281 | FROM `${DB}`.tracking_events | |
| 282 | WHERE event_type='page_view' AND occurred_at BETWEEN $since AND $until | |
| 283 | GROUP BY page_path | |
| 284 | ORDER BY pageviews DESC LIMIT $limit | |
| 285 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 286 | } | |
| 287 | ||
| 288 | sub by_landing_page { | |
| 289 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 290 | my $since = $self->_since; my $until = $self->_until; | |
| 291 | $limit = int($limit || 15); | |
| 292 | # First page-view per session | |
| 293 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 294 | SELECT page_path AS entry_page, | |
| 295 | COUNT(DISTINCT session_id) AS sessions, | |
| 296 | 0 AS bounce_rate | |
| 297 | FROM `${DB}`.tracking_events e1 | |
| 298 | WHERE e1.event_type='page_view' | |
| 299 | AND e1.occurred_at BETWEEN $since AND $until | |
| 300 | AND e1.id = (SELECT MIN(e2.id) FROM `${DB}`.tracking_events e2 | |
| 301 | WHERE e2.session_id=e1.session_id AND e2.event_type='page_view') | |
| 302 | GROUP BY page_path | |
| 303 | ORDER BY sessions DESC LIMIT $limit | |
| 304 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 305 | } | |
| 306 | ||
| 307 | # Sources (referrer based) | |
| 308 | sub by_source { | |
| 309 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 310 | my $since = $self->_since; my $until = $self->_until; | |
| 311 | $limit = int($limit || 12); | |
| 312 | # Derive source_kind in Perl since the PT-shape doesn't store it. | |
| 313 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 314 | SELECT referrer, COUNT(*) AS sessions | |
| 315 | FROM `${DB}`.tracking_sessions | |
| 316 | WHERE last_seen_at BETWEEN $since AND $until | |
| 317 | GROUP BY referrer | |
| 318 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 319 | my %sum; | |
| 320 | foreach my $r (@rows) { | |
| 321 | my $host = ''; | |
| 322 | if ($r->{referrer} && $r->{referrer} =~ m{^https?://([^/]+)}i) { | |
| 323 | $host = lc $1; $host =~ s/^www\.//; | |
| 324 | } | |
| 325 | my $kind = _classify_source($host, ''); | |
| 326 | $sum{$kind} += $r->{sessions}; | |
| 327 | } | |
| 328 | my @out; | |
| 329 | foreach my $k (sort { $sum{$b} <=> $sum{$a} } keys %sum) { | |
| 330 | push @out, { source_kind => $k, sessions => $sum{$k} }; | |
| 331 | last if @out >= $limit; | |
| 332 | } | |
| 333 | return @out; | |
| 334 | } | |
| 335 | ||
| 336 | sub by_referrer_host { | |
| 337 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 338 | my $since = $self->_since; my $until = $self->_until; | |
| 339 | $limit = int($limit || 20); | |
| 340 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 341 | SELECT referrer, COUNT(*) AS sessions | |
| 342 | FROM `${DB}`.tracking_sessions | |
| 343 | WHERE last_seen_at BETWEEN $since AND $until | |
| 344 | AND referrer IS NOT NULL AND referrer<>'' | |
| 345 | GROUP BY referrer | |
| 346 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 347 | my %sum; | |
| 348 | foreach my $r (@rows) { | |
| 349 | my $host = '(direct)'; | |
| 350 | if ($r->{referrer} && $r->{referrer} =~ m{^https?://([^/]+)}i) { | |
| 351 | $host = lc $1; $host =~ s/^www\.//; | |
| 352 | } | |
| 353 | $sum{$host} += $r->{sessions}; | |
| 354 | } | |
| 355 | my @out; | |
| 356 | foreach my $k (sort { $sum{$b} <=> $sum{$a} } keys %sum) { | |
| 357 | push @out, { host => $k, sessions => $sum{$k} }; | |
| 358 | last if @out >= $limit; | |
| 359 | } | |
| 360 | return @out; | |
| 361 | } | |
| 362 | ||
| 363 | # UTM data isn't stored in PT-shape -- placeholder empty list keeps the | |
| 364 | # template happy. | |
| 365 | sub by_utm_campaign { return (); } | |
| 366 | ||
| 367 | # Country centroid lookup for the globe | |
| 368 | my %COUNTRY_CENTROIDS = ( | |
| 369 | US=>[39.5,-98.5,'United States'], CA=>[56.1,-106.3,'Canada'], MX=>[23.6,-102.5,'Mexico'], | |
| 370 | GT=>[15.8,-90.2,'Guatemala'], CR=>[9.7,-83.7,'Costa Rica'], PA=>[8.5,-80.7,'Panama'], | |
| 371 | CU=>[21.5,-77.7,'Cuba'], DO=>[18.7,-70.1,'Dominican Republic'], BR=>[-14.2,-51.9,'Brazil'], | |
| 372 | AR=>[-38.4,-63.6,'Argentina'], CL=>[-35.6,-71.5,'Chile'], CO=>[4.6,-74.0,'Colombia'], | |
| 373 | PE=>[-9.2,-75.0,'Peru'], VE=>[6.4,-66.6,'Venezuela'], EC=>[-1.8,-78.2,'Ecuador'], | |
| 374 | UY=>[-32.5,-55.8,'Uruguay'], GB=>[55.4,-3.4,'United Kingdom'], IE=>[53.4,-8.2,'Ireland'], | |
| 375 | FR=>[46.2,2.2,'France'], DE=>[51.2,10.4,'Germany'], NL=>[52.1,5.3,'Netherlands'], | |
| 376 | BE=>[50.5,4.5,'Belgium'], LU=>[49.8,6.1,'Luxembourg'], CH=>[46.8,8.2,'Switzerland'], | |
| 377 | AT=>[47.5,14.6,'Austria'], IT=>[41.9,12.6,'Italy'], ES=>[40.5,-3.7,'Spain'], | |
| 378 | PT=>[39.4,-8.2,'Portugal'], DK=>[56.3,9.5,'Denmark'], NO=>[60.5,8.5,'Norway'], | |
| 379 | SE=>[60.1,18.6,'Sweden'], FI=>[61.9,25.7,'Finland'], PL=>[51.9,19.1,'Poland'], | |
| 380 | CZ=>[49.8,15.5,'Czechia'], SK=>[48.7,19.7,'Slovakia'], HU=>[47.2,19.5,'Hungary'], | |
| 381 | RO=>[45.9,25.0,'Romania'], BG=>[42.7,25.5,'Bulgaria'], GR=>[39.1,21.8,'Greece'], | |
| 382 | UA=>[48.4,31.2,'Ukraine'], RU=>[61.5,105.3,'Russia'], TR=>[38.9,35.2,'Turkey'], | |
| 383 | IL=>[31.0,34.9,'Israel'], SA=>[23.9,45.1,'Saudi Arabia'], AE=>[23.4,53.8,'United Arab Emirates'], | |
| 384 | IR=>[32.4,53.7,'Iran'], PK=>[30.4,69.3,'Pakistan'], IN=>[20.6,78.9,'India'], | |
| 385 | BD=>[23.7,90.4,'Bangladesh'], LK=>[7.9,80.8,'Sri Lanka'], NP=>[28.4,84.1,'Nepal'], | |
| 386 | CN=>[35.9,104.2,'China'], JP=>[36.2,138.3,'Japan'], KR=>[35.9,127.8,'South Korea'], | |
| 387 | TW=>[23.7,121.0,'Taiwan'], HK=>[22.4,114.1,'Hong Kong'], SG=>[1.4,103.8,'Singapore'], | |
| 388 | MY=>[4.2,101.9,'Malaysia'], TH=>[15.9,100.9,'Thailand'], VN=>[14.1,108.3,'Vietnam'], | |
| 389 | PH=>[12.9,121.8,'Philippines'], ID=>[-0.8,113.9,'Indonesia'], AU=>[-25.3,133.8,'Australia'], | |
| 390 | NZ=>[-40.9,174.9,'New Zealand'], ZA=>[-30.6,22.9,'South Africa'], NG=>[9.1,8.7,'Nigeria'], | |
| 391 | EG=>[26.8,30.8,'Egypt'], MA=>[31.8,-7.1,'Morocco'], KE=>[-0.0,37.9,'Kenya'], | |
| 392 | ET=>[9.1,40.5,'Ethiopia'], GH=>[7.9,-1.0,'Ghana'], DZ=>[28.0,1.7,'Algeria'], | |
| 393 | TN=>[33.9,9.5,'Tunisia'], | |
| 394 | ); | |
| 395 | sub country_centroid { | |
| 396 | my ($self, $code) = @_; | |
| 397 | return undef unless defined $code; | |
| 398 | $code = uc $code; $code =~ s/[^A-Z]//g; | |
| 399 | return undef unless length($code) == 2; | |
| 400 | return $COUNTRY_CENTROIDS{$code}; | |
| 401 | } | |
| 402 | ||
| 403 | # Globe dots: country (CHAR(2)) + centroid lookup | |
| 404 | sub by_country_geo { | |
| 405 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 406 | my $since = $self->_since; my $until = $self->_until; | |
| 407 | $limit = int($limit || 80); | |
| 408 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 409 | SELECT UPPER(country) AS code, | |
| 410 | COUNT(DISTINCT session_token) AS visitors, | |
| 411 | COUNT(*) AS sessions | |
| 412 | FROM `${DB}`.tracking_sessions | |
| 413 | WHERE country IS NOT NULL AND CHAR_LENGTH(country)=2 | |
| 414 | AND last_seen_at BETWEEN $since AND $until | |
| 415 | GROUP BY country | |
| 416 | ORDER BY visitors DESC LIMIT $limit | |
| 417 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 418 | my @out; | |
| 419 | foreach my $r (@rows) { | |
| 420 | my $c = $self->country_centroid($r->{code}); | |
| 421 | next unless $c; | |
| 422 | push @out, { | |
| 423 | code => $r->{code}, name => $c->[2], | |
| 424 | lat => $c->[0], lng => $c->[1], | |
| 425 | visitors => ($r->{visitors} || 0) + 0, | |
| 426 | sessions => ($r->{sessions} || 0) + 0, | |
| 427 | }; | |
| 428 | } | |
| 429 | return @out; | |
| 430 | } | |
| 431 | ||
| 432 | sub country_drill { | |
| 433 | my ($self, $db, $dbh, $DB, $iso) = @_; | |
| 434 | my $since = $self->_since; my $until = $self->_until; | |
| 435 | $iso =~ s/[^A-Za-z]//g if defined $iso; | |
| 436 | return {} unless defined($iso) && length($iso) == 2; | |
| 437 | $iso = uc $iso; | |
| 438 | my @regions = $db->db_readwrite_multiple($dbh, qq~ | |
| 439 | SELECT COALESCE(NULLIF(region,''),'(unknown)') AS region, | |
| 440 | COUNT(DISTINCT session_token) AS visitors, COUNT(*) AS sessions | |
| 441 | FROM `${DB}`.tracking_sessions | |
| 442 | WHERE UPPER(country)='$iso' | |
| 443 | AND last_seen_at BETWEEN $since AND $until | |
| 444 | GROUP BY region ORDER BY visitors DESC LIMIT 25 | |
| 445 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 446 | my @cities = $db->db_readwrite_multiple($dbh, qq~ | |
| 447 | SELECT COALESCE(NULLIF(city,''),'(unknown)') AS city, | |
| 448 | COALESCE(NULLIF(region,''),'') AS region, | |
| 449 | COUNT(DISTINCT session_token) AS visitors, COUNT(*) AS sessions | |
| 450 | FROM `${DB}`.tracking_sessions | |
| 451 | WHERE UPPER(country)='$iso' | |
| 452 | AND last_seen_at BETWEEN $since AND $until | |
| 453 | GROUP BY city, region ORDER BY visitors DESC LIMIT 25 | |
| 454 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 455 | my $tot = $db->db_readwrite($dbh, qq~ | |
| 456 | SELECT COUNT(DISTINCT session_token) AS visitors, COUNT(*) AS sessions | |
| 457 | FROM `${DB}`.tracking_sessions | |
| 458 | WHERE UPPER(country)='$iso' AND last_seen_at BETWEEN $since AND $until | |
| 459 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 460 | return { | |
| 461 | iso => $iso, | |
| 462 | name => ($self->country_centroid($iso) || [0,0,$iso])->[2], | |
| 463 | visitors => ($tot && $tot->{visitors}) ? $tot->{visitors}+0 : 0, | |
| 464 | sessions => ($tot && $tot->{sessions}) ? $tot->{sessions}+0 : 0, | |
| 465 | regions => [ @regions ], | |
| 466 | cities => [ @cities ], | |
| 467 | }; | |
| 468 | } | |
| 469 | ||
| 470 | ||
| 471 | #--------------------------------------------------------------------- | |
| 472 | # State-level rollup for globe.js zoom-in state dots. | |
| 473 | # Returns: { US => { 'New York' => 25, 'Colorado' => 8, ... }, ... } | |
| 474 | #--------------------------------------------------------------------- | |
| 475 | sub state_rollup { | |
| 476 | my ($self, $db, $dbh, $DB) = @_; | |
| 477 | my $since = $self->_since; my $until = $self->_until; | |
| 478 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 479 | SELECT UPPER(country) AS code, region, | |
| 480 | COUNT(DISTINCT session_token) AS visitors | |
| 481 | FROM `${DB}`.tracking_sessions | |
| 482 | WHERE country IS NOT NULL AND CHAR_LENGTH(country)=2 | |
| 483 | AND region IS NOT NULL AND region<>'' | |
| 484 | AND last_seen_at BETWEEN $since AND $until | |
| 485 | GROUP BY country, region | |
| 486 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 487 | my %out; | |
| 488 | foreach my $r (@rows) { | |
| 489 | $out{ $r->{code} } ||= {}; | |
| 490 | $out{ $r->{code} }{ $r->{region} } += ($r->{visitors} || 0); | |
| 491 | } | |
| 492 | return \%out; | |
| 493 | } | |
| 494 | ||
| 495 | #--------------------------------------------------------------------- | |
| 496 | # Per-country dimension breakdowns (browser, OS, device, resolution, | |
| 497 | # viewport, language, timezone). One query per dimension. | |
| 498 | # Returns: { US => { browsers => {Chrome=>200, ...}, os=>{...}, ... }, ... } | |
| 499 | #--------------------------------------------------------------------- | |
| 500 | sub country_dimensions_rollup { | |
| 501 | my ($self, $db, $dbh, $DB) = @_; | |
| 502 | my $since = $self->_since; my $until = $self->_until; | |
| 503 | my @dims = ( | |
| 504 | { key => 'browsers', col => "COALESCE(NULLIF(browser_name,''),'Unknown')" }, | |
| 505 | { key => 'os', col => "COALESCE(NULLIF(os_name,''),'Unknown')" }, | |
| 506 | { key => 'devices', col => "COALESCE(device_type,'unknown')" }, | |
| 507 | { key => 'resolutions', col => "CONCAT(COALESCE(screen_width,'?'),' x ',COALESCE(screen_height,'?'))" }, | |
| 508 | { key => 'viewports', col => "CONCAT(COALESCE(viewport_width,'?'),' x ',COALESCE(viewport_height,'?'))" }, | |
| 509 | { key => 'languages', col => "COALESCE(NULLIF(language,''),'Unknown')" }, | |
| 510 | { key => 'timezones', col => "COALESCE(NULLIF(timezone,''),'Unknown')" }, | |
| 511 | ); | |
| 512 | my %out; | |
| 513 | foreach my $d (@dims) { | |
| 514 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 515 | SELECT UPPER(country) AS code, $d->{col} AS v, COUNT(*) AS n | |
| 516 | FROM `${DB}`.tracking_sessions | |
| 517 | WHERE country IS NOT NULL AND CHAR_LENGTH(country)=2 | |
| 518 | AND last_seen_at BETWEEN $since AND $until | |
| 519 | GROUP BY country, $d->{col} | |
| 520 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 521 | foreach my $r (@rows) { | |
| 522 | my $v = defined($r->{v}) ? $r->{v} : 'Unknown'; | |
| 523 | next if $v eq '? x ?'; | |
| 524 | $out{ $r->{code} } ||= { browsers => {}, os => {}, devices => {}, resolutions => {}, viewports => {}, languages => {}, timezones => {} }; | |
| 525 | $out{ $r->{code} }{ $d->{key} }{ $v } += ($r->{n} || 0); | |
| 526 | } | |
| 527 | } | |
| 528 | return \%out; | |
| 529 | } | |
| 530 | ||
| 531 | #--------------------------------------------------------------------- | |
| 532 | # Per-state dimension breakdowns. | |
| 533 | # Returns: { US => { 'New York' => { browsers => {...}, os => {...}, ... } } } | |
| 534 | #--------------------------------------------------------------------- | |
| 535 | sub state_dimensions_rollup { | |
| 536 | my ($self, $db, $dbh, $DB) = @_; | |
| 537 | my $since = $self->_since; my $until = $self->_until; | |
| 538 | my @dims = ( | |
| 539 | { key => 'browsers', col => "COALESCE(NULLIF(browser_name,''),'Unknown')" }, | |
| 540 | { key => 'os', col => "COALESCE(NULLIF(os_name,''),'Unknown')" }, | |
| 541 | { key => 'devices', col => "COALESCE(device_type,'unknown')" }, | |
| 542 | { key => 'resolutions', col => "CONCAT(COALESCE(screen_width,'?'),' x ',COALESCE(screen_height,'?'))" }, | |
| 543 | { key => 'viewports', col => "CONCAT(COALESCE(viewport_width,'?'),' x ',COALESCE(viewport_height,'?'))" }, | |
| 544 | { key => 'languages', col => "COALESCE(NULLIF(language,''),'Unknown')" }, | |
| 545 | { key => 'timezones', col => "COALESCE(NULLIF(timezone,''),'Unknown')" }, | |
| 546 | ); | |
| 547 | my %out; | |
| 548 | foreach my $d (@dims) { | |
| 549 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 550 | SELECT UPPER(country) AS code, region, $d->{col} AS v, COUNT(*) AS n | |
| 551 | FROM `${DB}`.tracking_sessions | |
| 552 | WHERE country IS NOT NULL AND CHAR_LENGTH(country)=2 | |
| 553 | AND region IS NOT NULL AND region<>'' | |
| 554 | AND last_seen_at BETWEEN $since AND $until | |
| 555 | GROUP BY country, region, $d->{col} | |
| 556 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 557 | foreach my $r (@rows) { | |
| 558 | my $v = defined($r->{v}) ? $r->{v} : 'Unknown'; | |
| 559 | next if $v eq '? x ?'; | |
| 560 | $out{ $r->{code} } ||= {}; | |
| 561 | $out{ $r->{code} }{ $r->{region} } ||= { browsers => {}, os => {}, devices => {}, resolutions => {}, viewports => {}, languages => {}, timezones => {} }; | |
| 562 | $out{ $r->{code} }{ $r->{region} }{ $d->{key} }{ $v } += ($r->{n} || 0); | |
| 563 | } | |
| 564 | } | |
| 565 | return \%out; | |
| 566 | } | |
| 567 | ||
| 568 | #--------------------------------------------------------------------- | |
| 569 | # Full country -> state -> city tree for the accordion drill. | |
| 570 | #--------------------------------------------------------------------- | |
| 571 | sub full_drill_tree { | |
| 572 | my ($self, $db, $dbh, $DB) = @_; | |
| 573 | my $since = $self->_since; my $until = $self->_until; | |
| 574 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 575 | SELECT UPPER(country) AS code, | |
| 576 | COALESCE(NULLIF(region,''),'(unknown)') AS region, | |
| 577 | COALESCE(NULLIF(city,''),'(unknown)') AS city, | |
| 578 | COUNT(DISTINCT session_token) AS visitors, | |
| 579 | COUNT(*) AS sessions | |
| 580 | FROM `${DB}`.tracking_sessions | |
| 581 | WHERE country IS NOT NULL AND CHAR_LENGTH(country)=2 | |
| 582 | AND last_seen_at BETWEEN $since AND $until | |
| 583 | GROUP BY country, region, city | |
| 584 | ORDER BY visitors DESC | |
| 585 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 586 | my (%by_code, %tot); | |
| 587 | foreach my $r (@rows) { | |
| 588 | my $code = $r->{code}; | |
| 589 | my $reg = $r->{region}; | |
| 590 | my $cty = $r->{city}; | |
| 591 | my $v = ($r->{visitors} || 0) + 0; | |
| 592 | my $s = ($r->{sessions} || 0) + 0; | |
| 593 | $by_code{$code} ||= { visitors => 0, sessions => 0, states => {} }; | |
| 594 | $by_code{$code}{visitors} += $v; | |
| 595 | $by_code{$code}{sessions} += $s; | |
| 596 | my $st = $by_code{$code}{states}{$reg} ||= { visitors => 0, sessions => 0, cities => [] }; | |
| 597 | $st->{visitors} += $v; | |
| 598 | $st->{sessions} += $s; | |
| 599 | push @{ $st->{cities} }, { city => $cty, visitors => $v, sessions => $s }; | |
| 600 | $tot{v} += $v; $tot{s} += $s; | |
| 601 | } | |
| 602 | my @countries; | |
| 603 | foreach my $code (sort { $by_code{$b}{visitors} <=> $by_code{$a}{visitors} } keys %by_code) { | |
| 604 | my $centroid = $self->country_centroid($code); | |
| 605 | my $name = $centroid ? $centroid->[2] : $code; | |
| 606 | my $cd = $by_code{$code}; | |
| 607 | my @states; | |
| 608 | foreach my $rn (sort { $cd->{states}{$b}{visitors} <=> $cd->{states}{$a}{visitors} } keys %{$cd->{states}}) { | |
| 609 | my $st = $cd->{states}{$rn}; | |
| 610 | my @cities = sort { $b->{visitors} <=> $a->{visitors} } @{ $st->{cities} }; | |
| 611 | push @states, { | |
| 612 | region => $rn, | |
| 613 | visitors => $st->{visitors}, | |
| 614 | sessions => $st->{sessions}, | |
| 615 | cities => \@cities, | |
| 616 | }; | |
| 617 | } | |
| 618 | push @countries, { | |
| 619 | code => $code, | |
| 620 | name => $name, | |
| 621 | visitors => $cd->{visitors}, | |
| 622 | sessions => $cd->{sessions}, | |
| 623 | states => \@states, | |
| 624 | }; | |
| 625 | } | |
| 626 | return { | |
| 627 | total_visitors => $tot{v} || 0, | |
| 628 | total_sessions => $tot{s} || 0, | |
| 629 | countries => \@countries, | |
| 630 | }; | |
| 631 | } | |
| 632 | ||
| 633 | 1; |