added on local at 2026-07-06 01:29:48
| 1 | package MODS::ABForge::Stats; | |
| 2 | #====================================================================== | |
| 3 | # ABForge -- traffic analytics rollups for /admin_traffic.cgi. | |
| 4 | # Generated from the canonical PTMatrix-shape Stats.pm template. | |
| 5 | # Queries `mkt_tracking_sessions` + `mkt_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 | # Per-site scope. Set on the customer-facing analytics.cgi (which loads | |
| 36 | # a specific site's data via public_token); left unset for admin_traffic | |
| 37 | # which shows portfolio-wide traffic. When set, canonical methods append | |
| 38 | # " AND site_id='X' " to their WHERE clauses (via _site_and) so the same | |
| 39 | # code path serves both call sites. | |
| 40 | sub set_site { | |
| 41 | my ($self, $id) = @_; | |
| 42 | if (defined $id && $id =~ /^\d+$/ && int($id) > 0) { | |
| 43 | $self->{_site_id} = int($id); | |
| 44 | } else { | |
| 45 | delete $self->{_site_id}; | |
| 46 | } | |
| 47 | return $self; | |
| 48 | } | |
| 49 | sub _site_and { | |
| 50 | my ($self) = @_; | |
| 51 | return $self->{_site_id} ? " AND site_id='$self->{_site_id}' " : ''; | |
| 52 | } | |
| 53 | ||
| 54 | # Source classification for the referrer string. Identical to CF. | |
| 55 | sub _classify_source { | |
| 56 | my ($ref_host, $utm_medium) = @_; | |
| 57 | $utm_medium = lc($utm_medium || ''); | |
| 58 | $ref_host = lc($ref_host || ''); | |
| 59 | return 'paid' if $utm_medium =~ /^(cpc|ppc|paid|paidsearch|paid-social|ads?|display)$/; | |
| 60 | return 'email' if $utm_medium eq 'email'; | |
| 61 | return 'email' if $ref_host =~ /(^|\.)mail\./; | |
| 62 | 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); | |
| 63 | 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); | |
| 64 | return 'search' if $ref_host && $search{$ref_host}; | |
| 65 | return 'social' if $ref_host && $social{$ref_host}; | |
| 66 | return 'referral' if $ref_host; | |
| 67 | return 'direct'; | |
| 68 | } | |
| 69 | ||
| 70 | # ---- KPIs ------------------------------------------------------------ | |
| 71 | sub kpis { | |
| 72 | my ($self, $db, $dbh, $DB) = @_; | |
| 73 | my $since = $self->_since; my $until = $self->_until; | |
| 74 | my $kpi = {}; | |
| 75 | my $r = $db->db_readwrite($dbh, qq~ | |
| 76 | SELECT COUNT(*) AS pageviews | |
| 77 | FROM `${DB}`.mkt_tracking_events | |
| 78 | WHERE event_type='page_view' AND occurred_at BETWEEN $since AND $until | |
| 79 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 80 | $kpi->{pageviews} = ($r && $r->{pageviews}) ? $r->{pageviews} : 0; | |
| 81 | ||
| 82 | $r = $db->db_readwrite($dbh, qq~ | |
| 83 | SELECT COUNT(DISTINCT session_token) AS visitors | |
| 84 | FROM `${DB}`.mkt_tracking_sessions | |
| 85 | WHERE last_seen_at BETWEEN $since AND $until | |
| 86 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 87 | $kpi->{visitors} = ($r && $r->{visitors}) ? $r->{visitors} : 0; | |
| 88 | ||
| 89 | # sessions + avg_duration + pv-per-session via derived counts. | |
| 90 | # Bounce: sessions whose pv-count is <= 1. | |
| 91 | $r = $db->db_readwrite($dbh, qq~ | |
| 92 | SELECT COUNT(*) AS sessions, | |
| 93 | AVG(TIMESTAMPDIFF(SECOND, first_seen_at, last_seen_at)) AS avg_seconds | |
| 94 | FROM `${DB}`.mkt_tracking_sessions | |
| 95 | WHERE last_seen_at BETWEEN $since AND $until | |
| 96 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 97 | $kpi->{sessions} = ($r && $r->{sessions}) ? $r->{sessions} : 0; | |
| 98 | $kpi->{avg_seconds} = sprintf('%.0f', ($r && $r->{avg_seconds}) || 0); | |
| 99 | ||
| 100 | my $sessions = $kpi->{sessions} || 1; | |
| 101 | $kpi->{pv_per_session} = sprintf('%.2f', $kpi->{pageviews} / $sessions); | |
| 102 | ||
| 103 | my $b = $db->db_readwrite($dbh, qq~ | |
| 104 | SELECT SUM(IF(pv_n<=1,1,0)) AS bounces, COUNT(*) AS total | |
| 105 | FROM ( | |
| 106 | SELECT s.id, (SELECT COUNT(*) FROM `${DB}`.mkt_tracking_events e WHERE e.session_id=s.id AND e.event_type='page_view') AS pv_n | |
| 107 | FROM `${DB}`.mkt_tracking_sessions s | |
| 108 | WHERE s.last_seen_at BETWEEN $since AND $until | |
| 109 | ) X | |
| 110 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 111 | my $bs = ($b && $b->{bounces}) || 0; | |
| 112 | my $bt = ($b && $b->{total}) || 1; | |
| 113 | $kpi->{bounce_rate} = sprintf('%.1f', 100 * $bs / $bt); | |
| 114 | return $kpi; | |
| 115 | } | |
| 116 | ||
| 117 | # Daily pageviews + visitors series | |
| 118 | sub daily_series { | |
| 119 | my ($self, $db, $dbh, $DB, $days) = @_; | |
| 120 | my $since = $self->_since; my $until = $self->_until; | |
| 121 | $days = int($days || 30); | |
| 122 | my @pv = $db->db_readwrite_multiple($dbh, qq~ | |
| 123 | SELECT DATE(occurred_at) AS d, COUNT(*) AS n | |
| 124 | FROM `${DB}`.mkt_tracking_events | |
| 125 | WHERE event_type='page_view' AND occurred_at BETWEEN $since AND $until | |
| 126 | GROUP BY DATE(occurred_at) | |
| 127 | ORDER BY d | |
| 128 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 129 | my @vs = $db->db_readwrite_multiple($dbh, qq~ | |
| 130 | SELECT DATE(last_seen_at) AS d, COUNT(DISTINCT session_token) AS n | |
| 131 | FROM `${DB}`.mkt_tracking_sessions | |
| 132 | WHERE last_seen_at BETWEEN $since AND $until | |
| 133 | GROUP BY DATE(last_seen_at) | |
| 134 | ORDER BY d | |
| 135 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 136 | my %pv_by = map { $_->{d} => $_->{n} } @pv; | |
| 137 | my %vs_by = map { $_->{d} => $_->{n} } @vs; | |
| 138 | my (@labels, @pvv, @vsv); | |
| 139 | for (my $i = $days - 1; $i >= 0; $i--) { | |
| 140 | my @t = localtime(time - $i * 86400); | |
| 141 | my $d = sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]); | |
| 142 | push @labels, $d; | |
| 143 | push @pvv, ($pv_by{$d} || 0) + 0; | |
| 144 | push @vsv, ($vs_by{$d} || 0) + 0; | |
| 145 | } | |
| 146 | return { labels => \@labels, pageviews => \@pvv, visitors => \@vsv }; | |
| 147 | } | |
| 148 | ||
| 149 | # Breakdowns -- one per facet | |
| 150 | sub _br { | |
| 151 | my ($self, $db, $dbh, $DB, $col, $lbl, $limit) = @_; | |
| 152 | my $since = $self->_since; my $until = $self->_until; | |
| 153 | $limit = int($limit || 15); | |
| 154 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 155 | SELECT COALESCE(NULLIF($col,''),'Unknown') AS $lbl, | |
| 156 | COUNT(*) AS sessions | |
| 157 | FROM `${DB}`.mkt_tracking_sessions | |
| 158 | WHERE last_seen_at BETWEEN $since AND $until | |
| 159 | GROUP BY $col | |
| 160 | ORDER BY sessions DESC LIMIT $limit | |
| 161 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 162 | } | |
| 163 | sub by_browser { | |
| 164 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 165 | return $self->_br($db, $dbh, $DB, 'browser_name', 'browser', $limit); | |
| 166 | } | |
| 167 | sub by_os { | |
| 168 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 169 | return $self->_br($db, $dbh, $DB, 'os_name', 'os', $limit); | |
| 170 | } | |
| 171 | ||
| 172 | sub by_device { | |
| 173 | my ($self, $db, $dbh, $DB) = @_; | |
| 174 | my $since = $self->_since; my $until = $self->_until; | |
| 175 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 176 | SELECT COALESCE(device_type,'unknown') AS device_type, COUNT(*) AS sessions | |
| 177 | FROM `${DB}`.mkt_tracking_sessions | |
| 178 | WHERE last_seen_at BETWEEN $since AND $until | |
| 179 | GROUP BY device_type ORDER BY sessions DESC | |
| 180 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 181 | } | |
| 182 | ||
| 183 | sub by_resolution { | |
| 184 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 185 | my $since = $self->_since; my $until = $self->_until; | |
| 186 | $limit = int($limit || 12); | |
| 187 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 188 | SELECT CONCAT(COALESCE(screen_width,'?'),' x ',COALESCE(screen_height,'?')) AS resolution, | |
| 189 | COUNT(*) AS sessions | |
| 190 | FROM `${DB}`.mkt_tracking_sessions | |
| 191 | WHERE last_seen_at BETWEEN $since AND $until | |
| 192 | GROUP BY screen_width, screen_height | |
| 193 | ORDER BY sessions DESC LIMIT $limit | |
| 194 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 195 | } | |
| 196 | ||
| 197 | sub by_viewport { | |
| 198 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 199 | my $since = $self->_since; my $until = $self->_until; | |
| 200 | $limit = int($limit || 12); | |
| 201 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 202 | SELECT CONCAT(COALESCE(viewport_width,'?'),' x ',COALESCE(viewport_height,'?')) AS viewport, | |
| 203 | COUNT(*) AS sessions | |
| 204 | FROM `${DB}`.mkt_tracking_sessions | |
| 205 | WHERE last_seen_at BETWEEN $since AND $until | |
| 206 | AND viewport_width IS NOT NULL AND viewport_height IS NOT NULL | |
| 207 | GROUP BY viewport_width, viewport_height | |
| 208 | ORDER BY sessions DESC LIMIT $limit | |
| 209 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 210 | } | |
| 211 | ||
| 212 | sub by_touch_capable { | |
| 213 | my ($self, $db, $dbh, $DB) = @_; | |
| 214 | my $since = $self->_since; my $until = $self->_until; | |
| 215 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 216 | SELECT IF(touch_capable=1,'Touch','No touch') AS touch, COUNT(*) AS sessions | |
| 217 | FROM `${DB}`.mkt_tracking_sessions | |
| 218 | WHERE last_seen_at BETWEEN $since AND $until | |
| 219 | GROUP BY touch_capable | |
| 220 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 221 | } | |
| 222 | ||
| 223 | sub by_pixel_ratio { | |
| 224 | my ($self, $db, $dbh, $DB) = @_; | |
| 225 | my $since = $self->_since; my $until = $self->_until; | |
| 226 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 227 | SELECT CAST(pixel_ratio AS CHAR(8)) AS pixel_ratio, COUNT(*) AS sessions | |
| 228 | FROM `${DB}`.mkt_tracking_sessions | |
| 229 | WHERE last_seen_at BETWEEN $since AND $until AND pixel_ratio IS NOT NULL | |
| 230 | GROUP BY pixel_ratio ORDER BY sessions DESC | |
| 231 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 232 | } | |
| 233 | ||
| 234 | sub by_color_depth { | |
| 235 | my ($self, $db, $dbh, $DB) = @_; | |
| 236 | my $since = $self->_since; my $until = $self->_until; | |
| 237 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 238 | SELECT CONCAT(color_depth,'-bit') AS color_depth, COUNT(*) AS sessions | |
| 239 | FROM `${DB}`.mkt_tracking_sessions | |
| 240 | WHERE last_seen_at BETWEEN $since AND $until AND color_depth IS NOT NULL | |
| 241 | GROUP BY color_depth ORDER BY sessions DESC | |
| 242 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 243 | } | |
| 244 | ||
| 245 | sub by_timezone { | |
| 246 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 247 | my $since = $self->_since; my $until = $self->_until; | |
| 248 | $limit = int($limit || 15); | |
| 249 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 250 | SELECT COALESCE(NULLIF(timezone,''),'(unknown)') AS timezone, COUNT(*) AS sessions | |
| 251 | FROM `${DB}`.mkt_tracking_sessions | |
| 252 | WHERE last_seen_at BETWEEN $since AND $until | |
| 253 | GROUP BY timezone ORDER BY sessions DESC LIMIT $limit | |
| 254 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 255 | } | |
| 256 | ||
| 257 | # Country breakdowns | |
| 258 | sub by_country { | |
| 259 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 260 | my $since = $self->_since; my $until = $self->_until; | |
| 261 | $limit = int($limit || 50); | |
| 262 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 263 | SELECT COALESCE(country,'') AS country, | |
| 264 | COUNT(DISTINCT session_token) AS visitors, | |
| 265 | COUNT(*) AS sessions | |
| 266 | FROM `${DB}`.mkt_tracking_sessions | |
| 267 | WHERE last_seen_at BETWEEN $since AND $until | |
| 268 | GROUP BY country | |
| 269 | ORDER BY visitors DESC LIMIT $limit | |
| 270 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 271 | } | |
| 272 | ||
| 273 | sub by_country_enriched { | |
| 274 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 275 | my $since = $self->_since; my $until = $self->_until; | |
| 276 | $limit = int($limit || 30); | |
| 277 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 278 | SELECT COALESCE(NULLIF(country,''),'(unknown)') AS country, | |
| 279 | COUNT(DISTINCT session_token) AS visitors, | |
| 280 | COUNT(*) AS sessions, | |
| 281 | AVG(TIMESTAMPDIFF(SECOND, first_seen_at, last_seen_at)) AS avg_duration_seconds, | |
| 282 | 0.0 AS bounce_rate, | |
| 283 | 0.0 AS pv_per_session | |
| 284 | FROM `${DB}`.mkt_tracking_sessions | |
| 285 | WHERE last_seen_at BETWEEN $since AND $until | |
| 286 | GROUP BY country | |
| 287 | ORDER BY visitors DESC LIMIT $limit | |
| 288 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 289 | } | |
| 290 | ||
| 291 | # Pages | |
| 292 | sub by_page { | |
| 293 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 294 | my $since = $self->_since; my $until = $self->_until; | |
| 295 | $limit = int($limit || 25); | |
| 296 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 297 | SELECT page_path, | |
| 298 | COUNT(*) AS pageviews, | |
| 299 | COUNT(DISTINCT session_id) AS sessions | |
| 300 | FROM `${DB}`.mkt_tracking_events | |
| 301 | WHERE event_type='page_view' AND occurred_at BETWEEN $since AND $until | |
| 302 | GROUP BY page_path | |
| 303 | ORDER BY pageviews DESC LIMIT $limit | |
| 304 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 305 | } | |
| 306 | ||
| 307 | sub by_landing_page { | |
| 308 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 309 | my $since = $self->_since; my $until = $self->_until; | |
| 310 | $limit = int($limit || 15); | |
| 311 | # First page-view per session | |
| 312 | return $db->db_readwrite_multiple($dbh, qq~ | |
| 313 | SELECT page_path AS entry_page, | |
| 314 | COUNT(DISTINCT session_id) AS sessions, | |
| 315 | 0 AS bounce_rate | |
| 316 | FROM `${DB}`.mkt_tracking_events e1 | |
| 317 | WHERE e1.event_type='page_view' | |
| 318 | AND e1.occurred_at BETWEEN $since AND $until | |
| 319 | AND e1.id = (SELECT MIN(e2.id) FROM `${DB}`.mkt_tracking_events e2 | |
| 320 | WHERE e2.session_id=e1.session_id AND e2.event_type='page_view') | |
| 321 | GROUP BY page_path | |
| 322 | ORDER BY sessions DESC LIMIT $limit | |
| 323 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 324 | } | |
| 325 | ||
| 326 | # Sources (referrer based) | |
| 327 | sub by_source { | |
| 328 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 329 | my $since = $self->_since; my $until = $self->_until; | |
| 330 | $limit = int($limit || 12); | |
| 331 | # Derive source_kind in Perl since the PT-shape doesn't store it. | |
| 332 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 333 | SELECT referrer, COUNT(*) AS sessions | |
| 334 | FROM `${DB}`.mkt_tracking_sessions | |
| 335 | WHERE last_seen_at BETWEEN $since AND $until | |
| 336 | GROUP BY referrer | |
| 337 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 338 | my %sum; | |
| 339 | foreach my $r (@rows) { | |
| 340 | my $host = ''; | |
| 341 | if ($r->{referrer} && $r->{referrer} =~ m{^https?://([^/]+)}i) { | |
| 342 | $host = lc $1; $host =~ s/^www\.//; | |
| 343 | } | |
| 344 | my $kind = _classify_source($host, ''); | |
| 345 | $sum{$kind} += $r->{sessions}; | |
| 346 | } | |
| 347 | my @out; | |
| 348 | foreach my $k (sort { $sum{$b} <=> $sum{$a} } keys %sum) { | |
| 349 | push @out, { source_kind => $k, sessions => $sum{$k} }; | |
| 350 | last if @out >= $limit; | |
| 351 | } | |
| 352 | return @out; | |
| 353 | } | |
| 354 | ||
| 355 | sub by_referrer_host { | |
| 356 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 357 | my $since = $self->_since; my $until = $self->_until; | |
| 358 | $limit = int($limit || 20); | |
| 359 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 360 | SELECT referrer, COUNT(*) AS sessions | |
| 361 | FROM `${DB}`.mkt_tracking_sessions | |
| 362 | WHERE last_seen_at BETWEEN $since AND $until | |
| 363 | AND referrer IS NOT NULL AND referrer<>'' | |
| 364 | GROUP BY referrer | |
| 365 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 366 | my %sum; | |
| 367 | foreach my $r (@rows) { | |
| 368 | my $host = '(direct)'; | |
| 369 | if ($r->{referrer} && $r->{referrer} =~ m{^https?://([^/]+)}i) { | |
| 370 | $host = lc $1; $host =~ s/^www\.//; | |
| 371 | } | |
| 372 | $sum{$host} += $r->{sessions}; | |
| 373 | } | |
| 374 | my @out; | |
| 375 | foreach my $k (sort { $sum{$b} <=> $sum{$a} } keys %sum) { | |
| 376 | push @out, { host => $k, sessions => $sum{$k} }; | |
| 377 | last if @out >= $limit; | |
| 378 | } | |
| 379 | return @out; | |
| 380 | } | |
| 381 | ||
| 382 | # UTM data isn't stored in PT-shape -- placeholder empty list keeps the | |
| 383 | # template happy. | |
| 384 | sub by_utm_campaign { return (); } | |
| 385 | ||
| 386 | # Country centroid lookup for the globe | |
| 387 | my %COUNTRY_CENTROIDS = ( | |
| 388 | US=>[39.5,-98.5,'United States'], CA=>[56.1,-106.3,'Canada'], MX=>[23.6,-102.5,'Mexico'], | |
| 389 | GT=>[15.8,-90.2,'Guatemala'], CR=>[9.7,-83.7,'Costa Rica'], PA=>[8.5,-80.7,'Panama'], | |
| 390 | CU=>[21.5,-77.7,'Cuba'], DO=>[18.7,-70.1,'Dominican Republic'], BR=>[-14.2,-51.9,'Brazil'], | |
| 391 | AR=>[-38.4,-63.6,'Argentina'], CL=>[-35.6,-71.5,'Chile'], CO=>[4.6,-74.0,'Colombia'], | |
| 392 | PE=>[-9.2,-75.0,'Peru'], VE=>[6.4,-66.6,'Venezuela'], EC=>[-1.8,-78.2,'Ecuador'], | |
| 393 | UY=>[-32.5,-55.8,'Uruguay'], GB=>[55.4,-3.4,'United Kingdom'], IE=>[53.4,-8.2,'Ireland'], | |
| 394 | FR=>[46.2,2.2,'France'], DE=>[51.2,10.4,'Germany'], NL=>[52.1,5.3,'Netherlands'], | |
| 395 | BE=>[50.5,4.5,'Belgium'], LU=>[49.8,6.1,'Luxembourg'], CH=>[46.8,8.2,'Switzerland'], | |
| 396 | AT=>[47.5,14.6,'Austria'], IT=>[41.9,12.6,'Italy'], ES=>[40.5,-3.7,'Spain'], | |
| 397 | PT=>[39.4,-8.2,'Portugal'], DK=>[56.3,9.5,'Denmark'], NO=>[60.5,8.5,'Norway'], | |
| 398 | SE=>[60.1,18.6,'Sweden'], FI=>[61.9,25.7,'Finland'], PL=>[51.9,19.1,'Poland'], | |
| 399 | CZ=>[49.8,15.5,'Czechia'], SK=>[48.7,19.7,'Slovakia'], HU=>[47.2,19.5,'Hungary'], | |
| 400 | RO=>[45.9,25.0,'Romania'], BG=>[42.7,25.5,'Bulgaria'], GR=>[39.1,21.8,'Greece'], | |
| 401 | UA=>[48.4,31.2,'Ukraine'], RU=>[61.5,105.3,'Russia'], TR=>[38.9,35.2,'Turkey'], | |
| 402 | IL=>[31.0,34.9,'Israel'], SA=>[23.9,45.1,'Saudi Arabia'], AE=>[23.4,53.8,'United Arab Emirates'], | |
| 403 | IR=>[32.4,53.7,'Iran'], PK=>[30.4,69.3,'Pakistan'], IN=>[20.6,78.9,'India'], | |
| 404 | BD=>[23.7,90.4,'Bangladesh'], LK=>[7.9,80.8,'Sri Lanka'], NP=>[28.4,84.1,'Nepal'], | |
| 405 | CN=>[35.9,104.2,'China'], JP=>[36.2,138.3,'Japan'], KR=>[35.9,127.8,'South Korea'], | |
| 406 | TW=>[23.7,121.0,'Taiwan'], HK=>[22.4,114.1,'Hong Kong'], SG=>[1.4,103.8,'Singapore'], | |
| 407 | MY=>[4.2,101.9,'Malaysia'], TH=>[15.9,100.9,'Thailand'], VN=>[14.1,108.3,'Vietnam'], | |
| 408 | PH=>[12.9,121.8,'Philippines'], ID=>[-0.8,113.9,'Indonesia'], AU=>[-25.3,133.8,'Australia'], | |
| 409 | NZ=>[-40.9,174.9,'New Zealand'], ZA=>[-30.6,22.9,'South Africa'], NG=>[9.1,8.7,'Nigeria'], | |
| 410 | EG=>[26.8,30.8,'Egypt'], MA=>[31.8,-7.1,'Morocco'], KE=>[-0.0,37.9,'Kenya'], | |
| 411 | ET=>[9.1,40.5,'Ethiopia'], GH=>[7.9,-1.0,'Ghana'], DZ=>[28.0,1.7,'Algeria'], | |
| 412 | TN=>[33.9,9.5,'Tunisia'], | |
| 413 | ); | |
| 414 | sub country_centroid { | |
| 415 | my ($self, $code) = @_; | |
| 416 | return undef unless defined $code; | |
| 417 | $code = uc $code; $code =~ s/[^A-Z]//g; | |
| 418 | return undef unless length($code) == 2; | |
| 419 | return $COUNTRY_CENTROIDS{$code}; | |
| 420 | } | |
| 421 | ||
| 422 | # Globe dots: country (CHAR(2)) + centroid lookup | |
| 423 | sub by_country_geo { | |
| 424 | my ($self, $db, $dbh, $DB, $limit) = @_; | |
| 425 | my $since = $self->_since; my $until = $self->_until; | |
| 426 | my $site_and = $self->_site_and; | |
| 427 | $limit = int($limit || 80); | |
| 428 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 429 | SELECT UPPER(country) AS code, | |
| 430 | COUNT(DISTINCT session_token) AS visitors, | |
| 431 | COUNT(*) AS sessions | |
| 432 | FROM `${DB}`.mkt_tracking_sessions | |
| 433 | WHERE country IS NOT NULL AND CHAR_LENGTH(country)=2 | |
| 434 | AND last_seen_at BETWEEN $since AND $until | |
| 435 | $site_and | |
| 436 | GROUP BY country | |
| 437 | ORDER BY visitors DESC LIMIT $limit | |
| 438 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 439 | my @out; | |
| 440 | foreach my $r (@rows) { | |
| 441 | my $c = $self->country_centroid($r->{code}); | |
| 442 | next unless $c; | |
| 443 | push @out, { | |
| 444 | code => $r->{code}, name => $c->[2], | |
| 445 | lat => $c->[0], lng => $c->[1], | |
| 446 | visitors => ($r->{visitors} || 0) + 0, | |
| 447 | sessions => ($r->{sessions} || 0) + 0, | |
| 448 | }; | |
| 449 | } | |
| 450 | return @out; | |
| 451 | } | |
| 452 | ||
| 453 | sub country_drill { | |
| 454 | my ($self, $db, $dbh, $DB, $iso) = @_; | |
| 455 | my $since = $self->_since; my $until = $self->_until; | |
| 456 | $iso =~ s/[^A-Za-z]//g if defined $iso; | |
| 457 | return {} unless defined($iso) && length($iso) == 2; | |
| 458 | $iso = uc $iso; | |
| 459 | my @regions = $db->db_readwrite_multiple($dbh, qq~ | |
| 460 | SELECT COALESCE(NULLIF(region,''),'(unknown)') AS region, | |
| 461 | COUNT(DISTINCT session_token) AS visitors, COUNT(*) AS sessions | |
| 462 | FROM `${DB}`.mkt_tracking_sessions | |
| 463 | WHERE UPPER(country)='$iso' | |
| 464 | AND last_seen_at BETWEEN $since AND $until | |
| 465 | GROUP BY region ORDER BY visitors DESC LIMIT 25 | |
| 466 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 467 | my @cities = $db->db_readwrite_multiple($dbh, qq~ | |
| 468 | SELECT COALESCE(NULLIF(city,''),'(unknown)') AS city, | |
| 469 | COALESCE(NULLIF(region,''),'') AS region, | |
| 470 | COUNT(DISTINCT session_token) AS visitors, COUNT(*) AS sessions | |
| 471 | FROM `${DB}`.mkt_tracking_sessions | |
| 472 | WHERE UPPER(country)='$iso' | |
| 473 | AND last_seen_at BETWEEN $since AND $until | |
| 474 | GROUP BY city, region ORDER BY visitors DESC LIMIT 25 | |
| 475 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 476 | my $tot = $db->db_readwrite($dbh, qq~ | |
| 477 | SELECT COUNT(DISTINCT session_token) AS visitors, COUNT(*) AS sessions | |
| 478 | FROM `${DB}`.mkt_tracking_sessions | |
| 479 | WHERE UPPER(country)='$iso' AND last_seen_at BETWEEN $since AND $until | |
| 480 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 481 | return { | |
| 482 | iso => $iso, | |
| 483 | name => ($self->country_centroid($iso) || [0,0,$iso])->[2], | |
| 484 | visitors => ($tot && $tot->{visitors}) ? $tot->{visitors}+0 : 0, | |
| 485 | sessions => ($tot && $tot->{sessions}) ? $tot->{sessions}+0 : 0, | |
| 486 | regions => [ @regions ], | |
| 487 | cities => [ @cities ], | |
| 488 | }; | |
| 489 | } | |
| 490 | ||
| 491 | ||
| 492 | #--------------------------------------------------------------------- | |
| 493 | # State-level rollup for globe.js zoom-in state dots. | |
| 494 | # Returns: { US => { 'New York' => 25, 'Colorado' => 8, ... }, ... } | |
| 495 | #--------------------------------------------------------------------- | |
| 496 | sub state_rollup { | |
| 497 | my ($self, $db, $dbh, $DB) = @_; | |
| 498 | my $since = $self->_since; my $until = $self->_until; | |
| 499 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 500 | SELECT UPPER(country) AS code, region, | |
| 501 | COUNT(DISTINCT session_token) AS visitors | |
| 502 | FROM `${DB}`.mkt_tracking_sessions | |
| 503 | WHERE country IS NOT NULL AND CHAR_LENGTH(country)=2 | |
| 504 | AND region IS NOT NULL AND region<>'' | |
| 505 | AND last_seen_at BETWEEN $since AND $until | |
| 506 | GROUP BY country, region | |
| 507 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 508 | my %out; | |
| 509 | foreach my $r (@rows) { | |
| 510 | $out{ $r->{code} } ||= {}; | |
| 511 | $out{ $r->{code} }{ $r->{region} } += ($r->{visitors} || 0); | |
| 512 | } | |
| 513 | return \%out; | |
| 514 | } | |
| 515 | ||
| 516 | #--------------------------------------------------------------------- | |
| 517 | # Per-country dimension breakdowns (browser, OS, device, resolution, | |
| 518 | # viewport, language, timezone). One query per dimension. | |
| 519 | # Returns: { US => { browsers => {Chrome=>200, ...}, os=>{...}, ... }, ... } | |
| 520 | #--------------------------------------------------------------------- | |
| 521 | sub country_dimensions_rollup { | |
| 522 | my ($self, $db, $dbh, $DB) = @_; | |
| 523 | my $since = $self->_since; my $until = $self->_until; | |
| 524 | my @dims = ( | |
| 525 | { key => 'browsers', col => "COALESCE(NULLIF(browser_name,''),'Unknown')" }, | |
| 526 | { key => 'os', col => "COALESCE(NULLIF(os_name,''),'Unknown')" }, | |
| 527 | { key => 'devices', col => "COALESCE(device_type,'unknown')" }, | |
| 528 | { key => 'resolutions', col => "CONCAT(COALESCE(screen_width,'?'),' x ',COALESCE(screen_height,'?'))" }, | |
| 529 | { key => 'viewports', col => "CONCAT(COALESCE(viewport_width,'?'),' x ',COALESCE(viewport_height,'?'))" }, | |
| 530 | { key => 'languages', col => "COALESCE(NULLIF(language,''),'Unknown')" }, | |
| 531 | { key => 'timezones', col => "COALESCE(NULLIF(timezone,''),'Unknown')" }, | |
| 532 | ); | |
| 533 | my %out; | |
| 534 | foreach my $d (@dims) { | |
| 535 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 536 | SELECT UPPER(country) AS code, $d->{col} AS v, COUNT(*) AS n | |
| 537 | FROM `${DB}`.mkt_tracking_sessions | |
| 538 | WHERE country IS NOT NULL AND CHAR_LENGTH(country)=2 | |
| 539 | AND last_seen_at BETWEEN $since AND $until | |
| 540 | GROUP BY country, $d->{col} | |
| 541 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 542 | foreach my $r (@rows) { | |
| 543 | my $v = defined($r->{v}) ? $r->{v} : 'Unknown'; | |
| 544 | next if $v eq '? x ?'; | |
| 545 | $out{ $r->{code} } ||= { browsers => {}, os => {}, devices => {}, resolutions => {}, viewports => {}, languages => {}, timezones => {} }; | |
| 546 | $out{ $r->{code} }{ $d->{key} }{ $v } += ($r->{n} || 0); | |
| 547 | } | |
| 548 | } | |
| 549 | return \%out; | |
| 550 | } | |
| 551 | ||
| 552 | #--------------------------------------------------------------------- | |
| 553 | # Per-state dimension breakdowns. | |
| 554 | # Returns: { US => { 'New York' => { browsers => {...}, os => {...}, ... } } } | |
| 555 | #--------------------------------------------------------------------- | |
| 556 | sub state_dimensions_rollup { | |
| 557 | my ($self, $db, $dbh, $DB) = @_; | |
| 558 | my $since = $self->_since; my $until = $self->_until; | |
| 559 | my @dims = ( | |
| 560 | { key => 'browsers', col => "COALESCE(NULLIF(browser_name,''),'Unknown')" }, | |
| 561 | { key => 'os', col => "COALESCE(NULLIF(os_name,''),'Unknown')" }, | |
| 562 | { key => 'devices', col => "COALESCE(device_type,'unknown')" }, | |
| 563 | { key => 'resolutions', col => "CONCAT(COALESCE(screen_width,'?'),' x ',COALESCE(screen_height,'?'))" }, | |
| 564 | { key => 'viewports', col => "CONCAT(COALESCE(viewport_width,'?'),' x ',COALESCE(viewport_height,'?'))" }, | |
| 565 | { key => 'languages', col => "COALESCE(NULLIF(language,''),'Unknown')" }, | |
| 566 | { key => 'timezones', col => "COALESCE(NULLIF(timezone,''),'Unknown')" }, | |
| 567 | ); | |
| 568 | my %out; | |
| 569 | foreach my $d (@dims) { | |
| 570 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 571 | SELECT UPPER(country) AS code, region, $d->{col} AS v, COUNT(*) AS n | |
| 572 | FROM `${DB}`.mkt_tracking_sessions | |
| 573 | WHERE country IS NOT NULL AND CHAR_LENGTH(country)=2 | |
| 574 | AND region IS NOT NULL AND region<>'' | |
| 575 | AND last_seen_at BETWEEN $since AND $until | |
| 576 | GROUP BY country, region, $d->{col} | |
| 577 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 578 | foreach my $r (@rows) { | |
| 579 | my $v = defined($r->{v}) ? $r->{v} : 'Unknown'; | |
| 580 | next if $v eq '? x ?'; | |
| 581 | $out{ $r->{code} } ||= {}; | |
| 582 | $out{ $r->{code} }{ $r->{region} } ||= { browsers => {}, os => {}, devices => {}, resolutions => {}, viewports => {}, languages => {}, timezones => {} }; | |
| 583 | $out{ $r->{code} }{ $r->{region} }{ $d->{key} }{ $v } += ($r->{n} || 0); | |
| 584 | } | |
| 585 | } | |
| 586 | return \%out; | |
| 587 | } | |
| 588 | ||
| 589 | #--------------------------------------------------------------------- | |
| 590 | # Full country -> state -> city tree for the accordion drill. | |
| 591 | #--------------------------------------------------------------------- | |
| 592 | sub full_drill_tree { | |
| 593 | my ($self, $db, $dbh, $DB) = @_; | |
| 594 | my $since = $self->_since; my $until = $self->_until; | |
| 595 | my $site_and = $self->_site_and; | |
| 596 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 597 | SELECT UPPER(country) AS code, | |
| 598 | COALESCE(NULLIF(region,''),'(unknown)') AS region, | |
| 599 | COALESCE(NULLIF(city,''),'(unknown)') AS city, | |
| 600 | COUNT(DISTINCT session_token) AS visitors, | |
| 601 | COUNT(*) AS sessions | |
| 602 | FROM `${DB}`.mkt_tracking_sessions | |
| 603 | WHERE country IS NOT NULL AND CHAR_LENGTH(country)=2 | |
| 604 | AND last_seen_at BETWEEN $since AND $until | |
| 605 | $site_and | |
| 606 | GROUP BY country, region, city | |
| 607 | ORDER BY visitors DESC | |
| 608 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 609 | my (%by_code, %tot); | |
| 610 | foreach my $r (@rows) { | |
| 611 | my $code = $r->{code}; | |
| 612 | my $reg = $r->{region}; | |
| 613 | my $cty = $r->{city}; | |
| 614 | my $v = ($r->{visitors} || 0) + 0; | |
| 615 | my $s = ($r->{sessions} || 0) + 0; | |
| 616 | $by_code{$code} ||= { visitors => 0, sessions => 0, states => {} }; | |
| 617 | $by_code{$code}{visitors} += $v; | |
| 618 | $by_code{$code}{sessions} += $s; | |
| 619 | my $st = $by_code{$code}{states}{$reg} ||= { visitors => 0, sessions => 0, cities => [] }; | |
| 620 | $st->{visitors} += $v; | |
| 621 | $st->{sessions} += $s; | |
| 622 | push @{ $st->{cities} }, { city => $cty, visitors => $v, sessions => $s }; | |
| 623 | $tot{v} += $v; $tot{s} += $s; | |
| 624 | } | |
| 625 | my @countries; | |
| 626 | foreach my $code (sort { $by_code{$b}{visitors} <=> $by_code{$a}{visitors} } keys %by_code) { | |
| 627 | my $centroid = $self->country_centroid($code); | |
| 628 | my $name = $centroid ? $centroid->[2] : $code; | |
| 629 | my $cd = $by_code{$code}; | |
| 630 | my @states; | |
| 631 | foreach my $rn (sort { $cd->{states}{$b}{visitors} <=> $cd->{states}{$a}{visitors} } keys %{$cd->{states}}) { | |
| 632 | my $st = $cd->{states}{$rn}; | |
| 633 | my @cities = sort { $b->{visitors} <=> $a->{visitors} } @{ $st->{cities} }; | |
| 634 | push @states, { | |
| 635 | region => $rn, | |
| 636 | visitors => $st->{visitors}, | |
| 637 | sessions => $st->{sessions}, | |
| 638 | cities => \@cities, | |
| 639 | }; | |
| 640 | } | |
| 641 | push @countries, { | |
| 642 | code => $code, | |
| 643 | name => $name, | |
| 644 | visitors => $cd->{visitors}, | |
| 645 | sessions => $cd->{sessions}, | |
| 646 | states => \@states, | |
| 647 | }; | |
| 648 | } | |
| 649 | return { | |
| 650 | total_visitors => $tot{v} || 0, | |
| 651 | total_sessions => $tot{s} || 0, | |
| 652 | countries => \@countries, | |
| 653 | }; | |
| 654 | } | |
| 655 | ||
| 656 | ||
| 657 | #====================================================================== | |
| 658 | # ABForge legacy shim. Reinstates the per-storefront Stats methods that | |
| 659 | # /dashboard.cgi (and other ABForge CGIs) call with the older signature: | |
| 660 | # $stats->kpis ($dbh, $DB, $site_id, $days) | |
| 661 | # $stats->daily_series($dbh, $DB, $site_id, $days) | |
| 662 | # $stats->by_country($dbh, $DB, $site_id, $days, $limit) | |
| 663 | # $stats->by_device ($dbh, $DB, $site_id, $days) | |
| 664 | # $stats->by_source ($dbh, $DB, $site_id, $days, $limit) | |
| 665 | # $stats->by_page ($dbh, $DB, $site_id, $days, $limit) | |
| 666 | # $stats->live_visitors($dbh, $DB, $site_id) | |
| 667 | # | |
| 668 | # Dispatch is by arg count: the canonical Meta-Admin-shape methods take | |
| 669 | # ($db, $dbh, $DB) and have arity 3 after $self; the legacy calls have | |
| 670 | # arity 4-5. We override each public method to dispatch. | |
| 671 | #====================================================================== | |
| 672 | { | |
| 673 | no warnings 'redefine'; | |
| 674 | ||
| 675 | my $_orig_kpis = \&kpis; | |
| 676 | my $_orig_daily_series = \&daily_series; | |
| 677 | my $_orig_by_browser = \&by_browser; | |
| 678 | my $_orig_by_source = \&by_source; | |
| 679 | my $_orig_by_page = \&by_page; | |
| 680 | my $_orig_by_country = \&by_country; | |
| 681 | my $_orig_by_device = \&by_device; | |
| 682 | my $_orig_by_landing_page = \&by_landing_page; | |
| 683 | my $_orig_by_referrer_host= \&by_referrer_host; | |
| 684 | my $_orig_by_utm_campaign = \&by_utm_campaign; | |
| 685 | my $_orig_by_os = defined &by_os ? \&by_os : sub { return (); }; | |
| 686 | my $_orig_by_resolution = defined &by_resolution ? \&by_resolution : sub { return (); }; | |
| 687 | ||
| 688 | # Discriminator: the canonical methods take MODS::DBConnect as the first | |
| 689 | # positional arg. The legacy ABForge methods take a raw DBI handle. So | |
| 690 | # we look at ref($_[0]) -- DBConnect routes to canonical, anything else | |
| 691 | # (DBI::db or HASH-tied DBI) routes to the legacy per-storefront query. | |
| 692 | my $_is_legacy = sub { ref($_[0]) ne 'MODS::DBConnect' }; | |
| 693 | ||
| 694 | *kpis = sub { my $s = shift; $_is_legacy->(@_) ? _abf_kpis($s, @_) : $_orig_kpis->($s, @_); }; | |
| 695 | *daily_series = sub { my $s = shift; $_is_legacy->(@_) ? _abf_daily_series($s, @_) : $_orig_daily_series->($s, @_); }; | |
| 696 | *by_browser = sub { my $s = shift; $_is_legacy->(@_) ? _abf_by_browser($s, @_) : $_orig_by_browser->($s, @_); }; | |
| 697 | *by_source = sub { my $s = shift; $_is_legacy->(@_) ? _abf_by_source($s, @_) : $_orig_by_source->($s, @_); }; | |
| 698 | *by_page = sub { my $s = shift; $_is_legacy->(@_) ? _abf_by_page($s, @_) : $_orig_by_page->($s, @_); }; | |
| 699 | *by_country = sub { my $s = shift; $_is_legacy->(@_) ? _abf_by_country($s, @_) : $_orig_by_country->($s, @_); }; | |
| 700 | *by_device = sub { my $s = shift; $_is_legacy->(@_) ? _abf_by_device($s, @_) : $_orig_by_device->($s, @_); }; | |
| 701 | *by_landing_page = sub { my $s = shift; $_is_legacy->(@_) ? _abf_by_landing_page($s, @_) : $_orig_by_landing_page->($s, @_); }; | |
| 702 | *by_referrer_host= sub { my $s = shift; $_is_legacy->(@_) ? _abf_by_referrer_host($s, @_): $_orig_by_referrer_host->($s, @_); }; | |
| 703 | *by_utm_campaign = sub { my $s = shift; $_is_legacy->(@_) ? _abf_by_utm_campaign($s, @_) : $_orig_by_utm_campaign->($s, @_); }; | |
| 704 | *by_os = sub { my $s = shift; $_is_legacy->(@_) ? _abf_by_os($s, @_) : $_orig_by_os->($s, @_); }; | |
| 705 | *by_resolution = sub { my $s = shift; $_is_legacy->(@_) ? _abf_by_resolution($s, @_) : $_orig_by_resolution->($s, @_); }; | |
| 706 | } | |
| 707 | ||
| 708 | # live_visitors has no canonical counterpart; it's legacy-only. | |
| 709 | sub live_visitors { | |
| 710 | my $self = shift; | |
| 711 | return _abf_live_visitors($self, @_) if @_ >= 3; | |
| 712 | return 0; | |
| 713 | } | |
| 714 | ||
| 715 | # hourly_heat: 7-day x 24-hour pageview intensity for the customer's | |
| 716 | # analytics.cgi heat-strip. Legacy-only, per-storefront. | |
| 717 | sub hourly_heat { | |
| 718 | my $self = shift; | |
| 719 | return _abf_hourly_heat($self, @_) if @_ >= 3; | |
| 720 | return { days => [], grid => [] }; | |
| 721 | } | |
| 722 | ||
| 723 | #---- helpers --------------------------------------------------------- | |
| 724 | sub _abf_window_clause { | |
| 725 | my ($days, $col) = @_; | |
| 726 | $days = int($days || 30); | |
| 727 | $days = 1 if $days < 1; | |
| 728 | $days = 730 if $days > 730; | |
| 729 | return "$col >= DATE_SUB(NOW(), INTERVAL $days DAY)"; | |
| 730 | } | |
| 731 | ||
| 732 | #---- legacy implementations ------------------------------------------ | |
| 733 | sub _abf_kpis { | |
| 734 | my ($self, $dbh, $DB, $site_id, $days) = @_; | |
| 735 | $site_id = int($site_id || 0); | |
| 736 | my $win_s = _abf_window_clause($days, 'last_seen_at'); | |
| 737 | my $win_e = _abf_window_clause($days, 'occurred_at'); | |
| 738 | my $kpi = {}; | |
| 739 | ||
| 740 | # Events don't carry site_id directly; join sessions (which do) to | |
| 741 | # scope pageviews to this customer's site. | |
| 742 | my ($pv) = $dbh->selectrow_array(qq~ | |
| 743 | SELECT COUNT(*) FROM `${DB}`.mkt_tracking_events e | |
| 744 | INNER JOIN `${DB}`.mkt_tracking_sessions s ON s.id = e.session_id | |
| 745 | WHERE e.event_type='page_view' | |
| 746 | AND s.site_id=$site_id | |
| 747 | AND e.$win_e | |
| 748 | ~); | |
| 749 | $kpi->{pageviews} = $pv || 0; | |
| 750 | ||
| 751 | my ($vs) = $dbh->selectrow_array(qq~ | |
| 752 | SELECT COUNT(DISTINCT session_token) FROM `${DB}`.mkt_tracking_sessions | |
| 753 | WHERE site_id=$site_id AND $win_s | |
| 754 | ~); | |
| 755 | $kpi->{visitors} = $vs || 0; | |
| 756 | ||
| 757 | my ($ss, $avg) = $dbh->selectrow_array(qq~ | |
| 758 | SELECT COUNT(*), AVG(TIMESTAMPDIFF(SECOND, first_seen_at, last_seen_at)) | |
| 759 | FROM `${DB}`.mkt_tracking_sessions | |
| 760 | WHERE site_id=$site_id AND $win_s | |
| 761 | ~); | |
| 762 | $kpi->{sessions} = $ss || 0; | |
| 763 | $kpi->{avg_seconds} = sprintf('%.0f', $avg || 0); | |
| 764 | my $denom = $kpi->{sessions} || 1; | |
| 765 | $kpi->{pv_per_session} = sprintf('%.2f', $kpi->{pageviews} / $denom); | |
| 766 | ||
| 767 | my ($bn, $bt) = $dbh->selectrow_array(qq~ | |
| 768 | SELECT SUM(IF(pv_n<=1,1,0)), COUNT(*) FROM ( | |
| 769 | SELECT s.id, (SELECT COUNT(*) FROM `${DB}`.mkt_tracking_events e | |
| 770 | WHERE e.session_id=s.id AND e.event_type='page_view') AS pv_n | |
| 771 | FROM `${DB}`.mkt_tracking_sessions s | |
| 772 | WHERE s.site_id=$site_id AND s.$win_s | |
| 773 | ) X | |
| 774 | ~); | |
| 775 | my $bt_d = $bt || 1; | |
| 776 | $kpi->{bounce_rate} = sprintf('%.1f', 100 * (($bn || 0) / $bt_d)); | |
| 777 | return $kpi; | |
| 778 | } | |
| 779 | ||
| 780 | sub _abf_daily_series { | |
| 781 | my ($self, $dbh, $DB, $site_id, $days) = @_; | |
| 782 | $site_id = int($site_id || 0); | |
| 783 | $days = int($days || 30); | |
| 784 | $days = 1 if $days < 1; | |
| 785 | $days = 730 if $days > 730; | |
| 786 | ||
| 787 | my %pv_by; my %vs_by; | |
| 788 | my $sth = $dbh->prepare(qq~ | |
| 789 | SELECT DATE(e.occurred_at) d, COUNT(*) n | |
| 790 | FROM `${DB}`.mkt_tracking_events e | |
| 791 | INNER JOIN `${DB}`.mkt_tracking_sessions s ON s.id = e.session_id | |
| 792 | WHERE e.event_type='page_view' | |
| 793 | AND s.site_id=$site_id | |
| 794 | AND e.occurred_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 795 | GROUP BY DATE(e.occurred_at) | |
| 796 | ~); | |
| 797 | $sth->execute; | |
| 798 | while (my $r = $sth->fetchrow_hashref) { $pv_by{$r->{d}} = $r->{n}; } | |
| 799 | ||
| 800 | my $sth2 = $dbh->prepare(qq~ | |
| 801 | SELECT DATE(last_seen_at) d, COUNT(DISTINCT session_token) n | |
| 802 | FROM `${DB}`.mkt_tracking_sessions | |
| 803 | WHERE site_id=$site_id | |
| 804 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 805 | GROUP BY DATE(last_seen_at) | |
| 806 | ~); | |
| 807 | $sth2->execute; | |
| 808 | while (my $r = $sth2->fetchrow_hashref) { $vs_by{$r->{d}} = $r->{n}; } | |
| 809 | ||
| 810 | my (@labels, @pv, @vs); | |
| 811 | for (my $i = $days - 1; $i >= 0; $i--) { | |
| 812 | my @t = localtime(time - $i * 86400); | |
| 813 | my $d = sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]); | |
| 814 | push @labels, $d; | |
| 815 | push @pv, ($pv_by{$d} || 0) + 0; | |
| 816 | push @vs, ($vs_by{$d} || 0) + 0; | |
| 817 | } | |
| 818 | return { labels => \@labels, pageviews => \@pv, visitors => \@vs }; | |
| 819 | } | |
| 820 | ||
| 821 | sub _abf_by_country { | |
| 822 | my ($self, $dbh, $DB, $site_id, $days, $limit) = @_; | |
| 823 | $site_id = int($site_id || 0); | |
| 824 | $limit = int($limit || 8); | |
| 825 | my $win = _abf_window_clause($days, 'last_seen_at'); | |
| 826 | my $sth = $dbh->prepare(qq~ | |
| 827 | SELECT UPPER(country) AS country, COUNT(DISTINCT session_token) AS visitors, | |
| 828 | COUNT(*) AS sessions | |
| 829 | FROM `${DB}`.mkt_tracking_sessions | |
| 830 | WHERE site_id=$site_id AND country IS NOT NULL AND $win | |
| 831 | GROUP BY UPPER(country) | |
| 832 | ORDER BY visitors DESC LIMIT $limit | |
| 833 | ~); | |
| 834 | $sth->execute; | |
| 835 | my @out; | |
| 836 | while (my $r = $sth->fetchrow_hashref) { push @out, $r; } | |
| 837 | return @out; | |
| 838 | } | |
| 839 | ||
| 840 | sub _abf_by_device { | |
| 841 | my ($self, $dbh, $DB, $site_id, $days) = @_; | |
| 842 | $site_id = int($site_id || 0); | |
| 843 | my $win = _abf_window_clause($days, 'last_seen_at'); | |
| 844 | my $sth = $dbh->prepare(qq~ | |
| 845 | SELECT device_type, | |
| 846 | COUNT(*) AS sessions, | |
| 847 | COUNT(DISTINCT session_token) AS visitors | |
| 848 | FROM `${DB}`.mkt_tracking_sessions | |
| 849 | WHERE site_id=$site_id AND $win | |
| 850 | GROUP BY device_type | |
| 851 | ORDER BY sessions DESC | |
| 852 | ~); | |
| 853 | $sth->execute; | |
| 854 | my @out; | |
| 855 | while (my $r = $sth->fetchrow_hashref) { | |
| 856 | $r->{device_type} = '(unknown)' unless $r->{device_type}; | |
| 857 | push @out, $r; | |
| 858 | } | |
| 859 | return @out; | |
| 860 | } | |
| 861 | ||
| 862 | sub _abf_by_source { | |
| 863 | my ($self, $dbh, $DB, $site_id, $days, $limit) = @_; | |
| 864 | $site_id = int($site_id || 0); | |
| 865 | $limit = int($limit || 8); | |
| 866 | my $win = _abf_window_clause($days, 'last_seen_at'); | |
| 867 | my @rows; | |
| 868 | my $sth = $dbh->prepare(qq~ | |
| 869 | SELECT referrer, COUNT(*) AS sessions | |
| 870 | FROM `${DB}`.mkt_tracking_sessions | |
| 871 | WHERE site_id=$site_id AND $win | |
| 872 | GROUP BY referrer | |
| 873 | ~); | |
| 874 | $sth->execute; | |
| 875 | while (my $r = $sth->fetchrow_hashref) { push @rows, $r; } | |
| 876 | my %sum; | |
| 877 | foreach my $r (@rows) { | |
| 878 | my $host = ''; | |
| 879 | if ($r->{referrer} && $r->{referrer} =~ m{^https?://([^/]+)}i) { | |
| 880 | $host = lc $1; $host =~ s/^www\.//; | |
| 881 | } | |
| 882 | my $kind = _classify_source($host, ''); | |
| 883 | $sum{$kind} += $r->{sessions}; | |
| 884 | } | |
| 885 | my @out; | |
| 886 | foreach my $k (sort { $sum{$b} <=> $sum{$a} } keys %sum) { | |
| 887 | push @out, { referrer_kind => $k, sessions => $sum{$k} }; | |
| 888 | last if @out >= $limit; | |
| 889 | } | |
| 890 | return @out; | |
| 891 | } | |
| 892 | ||
| 893 | sub _abf_by_page { | |
| 894 | my ($self, $dbh, $DB, $site_id, $days, $limit) = @_; | |
| 895 | $site_id = int($site_id || 0); | |
| 896 | $limit = int($limit || 10); | |
| 897 | my $win = _abf_window_clause($days, 'e.occurred_at'); | |
| 898 | my $sth = $dbh->prepare(qq~ | |
| 899 | SELECT e.page_path, COUNT(*) AS pageviews, | |
| 900 | COUNT(DISTINCT e.session_id) AS sessions, | |
| 901 | 0 AS avg_time, 0 AS avg_scroll | |
| 902 | FROM `${DB}`.mkt_tracking_events e | |
| 903 | INNER JOIN `${DB}`.mkt_tracking_sessions s ON s.id = e.session_id | |
| 904 | WHERE e.event_type='page_view' AND s.site_id=$site_id AND $win | |
| 905 | GROUP BY e.page_path | |
| 906 | ORDER BY pageviews DESC LIMIT $limit | |
| 907 | ~); | |
| 908 | $sth->execute; | |
| 909 | my @out; | |
| 910 | while (my $r = $sth->fetchrow_hashref) { push @out, $r; } | |
| 911 | return @out; | |
| 912 | } | |
| 913 | ||
| 914 | sub _abf_by_landing_page { | |
| 915 | my ($self, $dbh, $DB, $site_id, $days, $limit) = @_; | |
| 916 | $site_id = int($site_id || 0); | |
| 917 | $limit = int($limit || 15); | |
| 918 | my $win = _abf_window_clause($days, 'e1.occurred_at'); | |
| 919 | # Take the first pageview per session as the "landing" page. | |
| 920 | my $sth = $dbh->prepare(qq~ | |
| 921 | SELECT e1.page_path AS entry_page, | |
| 922 | COUNT(DISTINCT e1.session_id) AS sessions, | |
| 923 | 0 AS bounce_rate | |
| 924 | FROM `${DB}`.mkt_tracking_events e1 | |
| 925 | INNER JOIN `${DB}`.mkt_tracking_sessions s ON s.id = e1.session_id | |
| 926 | WHERE e1.event_type='page_view' AND s.site_id=$site_id AND $win | |
| 927 | AND e1.id = (SELECT MIN(e2.id) FROM `${DB}`.mkt_tracking_events e2 | |
| 928 | WHERE e2.session_id=e1.session_id AND e2.event_type='page_view') | |
| 929 | GROUP BY e1.page_path | |
| 930 | ORDER BY sessions DESC LIMIT $limit | |
| 931 | ~); | |
| 932 | $sth->execute; | |
| 933 | my @out; | |
| 934 | while (my $r = $sth->fetchrow_hashref) { push @out, $r; } | |
| 935 | return @out; | |
| 936 | } | |
| 937 | ||
| 938 | sub _abf_by_referrer_host { | |
| 939 | my ($self, $dbh, $DB, $site_id, $days, $limit) = @_; | |
| 940 | $site_id = int($site_id || 0); | |
| 941 | $limit = int($limit || 20); | |
| 942 | my $win = _abf_window_clause($days, 'last_seen_at'); | |
| 943 | my $sth = $dbh->prepare(qq~ | |
| 944 | SELECT referrer, COUNT(*) AS sessions | |
| 945 | FROM `${DB}`.mkt_tracking_sessions | |
| 946 | WHERE site_id=$site_id AND $win | |
| 947 | AND referrer IS NOT NULL AND referrer<>'' | |
| 948 | GROUP BY referrer | |
| 949 | ~); | |
| 950 | $sth->execute; | |
| 951 | my %sum; | |
| 952 | while (my $r = $sth->fetchrow_hashref) { | |
| 953 | my $host = '(direct)'; | |
| 954 | if ($r->{referrer} && $r->{referrer} =~ m{^https?://([^/]+)}i) { | |
| 955 | $host = lc $1; $host =~ s/^www\.//; | |
| 956 | } | |
| 957 | $sum{$host} += $r->{sessions}; | |
| 958 | } | |
| 959 | my @out; | |
| 960 | foreach my $k (sort { $sum{$b} <=> $sum{$a} } keys %sum) { | |
| 961 | push @out, { host => $k, sessions => $sum{$k} }; | |
| 962 | last if @out >= $limit; | |
| 963 | } | |
| 964 | return @out; | |
| 965 | } | |
| 966 | ||
| 967 | sub _abf_by_utm_campaign { | |
| 968 | my ($self, $dbh, $DB, $site_id, $days, $limit) = @_; | |
| 969 | $site_id = int($site_id || 0); | |
| 970 | $limit = int($limit || 20); | |
| 971 | my $win = _abf_window_clause($days, 'last_seen_at'); | |
| 972 | # UTM columns may or may not exist depending on tracker version — try | |
| 973 | # them, fall back to empty on schema mismatch. | |
| 974 | my $rows = eval { | |
| 975 | my $sth = $dbh->prepare(qq~ | |
| 976 | SELECT utm_campaign AS campaign, | |
| 977 | utm_source AS source, | |
| 978 | utm_medium AS medium, | |
| 979 | COUNT(*) AS sessions | |
| 980 | FROM `${DB}`.mkt_tracking_sessions | |
| 981 | WHERE site_id=$site_id AND $win | |
| 982 | AND utm_campaign IS NOT NULL AND utm_campaign<>'' | |
| 983 | GROUP BY utm_campaign, utm_source, utm_medium | |
| 984 | ORDER BY sessions DESC LIMIT $limit | |
| 985 | ~); | |
| 986 | $sth->execute; | |
| 987 | my @o; while (my $r = $sth->fetchrow_hashref) { push @o, $r; } | |
| 988 | \@o; | |
| 989 | }; | |
| 990 | return $rows ? @$rows : (); | |
| 991 | } | |
| 992 | ||
| 993 | sub _abf_by_browser { | |
| 994 | my ($self, $dbh, $DB, $site_id, $days) = @_; | |
| 995 | $site_id = int($site_id || 0); | |
| 996 | my $win = _abf_window_clause($days, 'last_seen_at'); | |
| 997 | my $sth = $dbh->prepare(qq~ | |
| 998 | SELECT browser_name AS browser, COUNT(*) AS sessions | |
| 999 | FROM `${DB}`.mkt_tracking_sessions | |
| 1000 | WHERE site_id=$site_id AND $win | |
| 1001 | GROUP BY browser_name | |
| 1002 | ORDER BY sessions DESC LIMIT 20 | |
| 1003 | ~); | |
| 1004 | $sth->execute; | |
| 1005 | my @out; | |
| 1006 | while (my $r = $sth->fetchrow_hashref) { | |
| 1007 | $r->{browser} = '(unknown)' unless $r->{browser}; | |
| 1008 | push @out, $r; | |
| 1009 | } | |
| 1010 | return @out; | |
| 1011 | } | |
| 1012 | ||
| 1013 | sub _abf_by_os { | |
| 1014 | my ($self, $dbh, $DB, $site_id, $days) = @_; | |
| 1015 | $site_id = int($site_id || 0); | |
| 1016 | my $win = _abf_window_clause($days, 'last_seen_at'); | |
| 1017 | my $sth = $dbh->prepare(qq~ | |
| 1018 | SELECT os_name AS os, COUNT(*) AS sessions | |
| 1019 | FROM `${DB}`.mkt_tracking_sessions | |
| 1020 | WHERE site_id=$site_id AND $win | |
| 1021 | GROUP BY os_name | |
| 1022 | ORDER BY sessions DESC LIMIT 20 | |
| 1023 | ~); | |
| 1024 | $sth->execute; | |
| 1025 | my @out; | |
| 1026 | while (my $r = $sth->fetchrow_hashref) { | |
| 1027 | $r->{os} = '(unknown)' unless $r->{os}; | |
| 1028 | push @out, $r; | |
| 1029 | } | |
| 1030 | return @out; | |
| 1031 | } | |
| 1032 | ||
| 1033 | sub _abf_by_resolution { | |
| 1034 | my ($self, $dbh, $DB, $site_id, $days) = @_; | |
| 1035 | $site_id = int($site_id || 0); | |
| 1036 | my $win = _abf_window_clause($days, 'last_seen_at'); | |
| 1037 | # Screen resolution stored as screen_w/screen_h ints in PT-shape. | |
| 1038 | my $sth = $dbh->prepare(qq~ | |
| 1039 | SELECT CONCAT(screen_w, 'x', screen_h) AS resolution, COUNT(*) AS sessions | |
| 1040 | FROM `${DB}`.mkt_tracking_sessions | |
| 1041 | WHERE site_id=$site_id AND $win | |
| 1042 | AND screen_w IS NOT NULL AND screen_h IS NOT NULL | |
| 1043 | GROUP BY screen_w, screen_h | |
| 1044 | ORDER BY sessions DESC LIMIT 20 | |
| 1045 | ~); | |
| 1046 | $sth->execute; | |
| 1047 | my @out; | |
| 1048 | while (my $r = $sth->fetchrow_hashref) { push @out, $r; } | |
| 1049 | return @out; | |
| 1050 | } | |
| 1051 | ||
| 1052 | sub _abf_hourly_heat { | |
| 1053 | my ($self, $dbh, $DB, $site_id) = @_; | |
| 1054 | $site_id = int($site_id || 0); | |
| 1055 | ||
| 1056 | # Build the day labels for the last 7 calendar days (oldest first). | |
| 1057 | my @days; | |
| 1058 | for (my $i = 6; $i >= 0; $i--) { | |
| 1059 | my @t = localtime(time - $i * 86400); | |
| 1060 | push @days, sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]); | |
| 1061 | } | |
| 1062 | ||
| 1063 | # 7x24 grid, initialized to 0. | |
| 1064 | my %day_ix = map { $days[$_] => $_ } 0..$#days; | |
| 1065 | my @grid = map { [ (0) x 24 ] } @days; | |
| 1066 | ||
| 1067 | my $rows = $dbh->selectall_arrayref(qq~ | |
| 1068 | SELECT DATE(e.occurred_at) AS d, HOUR(e.occurred_at) AS h, COUNT(*) AS n | |
| 1069 | FROM `${DB}`.mkt_tracking_events e | |
| 1070 | INNER JOIN `${DB}`.mkt_tracking_sessions s ON s.id = e.session_id | |
| 1071 | WHERE s.site_id=$site_id | |
| 1072 | AND e.event_type='page_view' | |
| 1073 | AND e.occurred_at >= DATE_SUB(CURDATE(), INTERVAL 6 DAY) | |
| 1074 | GROUP BY DATE(e.occurred_at), HOUR(e.occurred_at) | |
| 1075 | ~, { Slice => {} }); | |
| 1076 | ||
| 1077 | if ($rows) { | |
| 1078 | for my $r (@$rows) { | |
| 1079 | my $i = $day_ix{ $r->{d} }; | |
| 1080 | next unless defined $i; | |
| 1081 | my $h = int($r->{h} || 0); | |
| 1082 | $grid[$i][$h] = int($r->{n} || 0); | |
| 1083 | } | |
| 1084 | } | |
| 1085 | ||
| 1086 | return { days => \@days, grid => \@grid }; | |
| 1087 | } | |
| 1088 | ||
| 1089 | sub _abf_live_visitors { | |
| 1090 | my ($self, $dbh, $DB, $site_id) = @_; | |
| 1091 | $site_id = int($site_id || 0); | |
| 1092 | my ($n) = $dbh->selectrow_array(qq~ | |
| 1093 | SELECT COUNT(DISTINCT session_token) | |
| 1094 | FROM `${DB}`.mkt_tracking_sessions | |
| 1095 | WHERE site_id=$site_id AND is_online=1 | |
| 1096 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL 5 MINUTE) | |
| 1097 | ~); | |
| 1098 | return $n || 0; | |
| 1099 | } | |
| 1100 | ||
| 1101 | # Return recent live-ish sessions for the given site. Called by realtime.cgi | |
| 1102 | # with ($dbh, $DB, $site_id, $limit=30). Fields consumed by the template: | |
| 1103 | # visitor_id, city, country, device_type, browser_name, os_name, referrer_host, | |
| 1104 | # current_page, pageviews. `id` is used by the CGI to fetch idle_sec. | |
| 1105 | sub live_sessions { | |
| 1106 | my ($self, $dbh, $DB, $site_id, $limit) = @_; | |
| 1107 | $site_id = int($site_id || 0); | |
| 1108 | $limit = int($limit || 30); | |
| 1109 | $limit = 200 if $limit > 200; | |
| 1110 | my $rows = $dbh->selectall_arrayref(qq~ | |
| 1111 | SELECT id, visitor_id, city, country, | |
| 1112 | device_type, browser_name, os_name, | |
| 1113 | referrer_host, current_page, pageviews | |
| 1114 | FROM `${DB}`.mkt_tracking_sessions | |
| 1115 | WHERE site_id=$site_id AND is_online=1 | |
| 1116 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL 30 MINUTE) | |
| 1117 | ORDER BY last_seen_at DESC | |
| 1118 | LIMIT $limit | |
| 1119 | ~, { Slice => {} }); | |
| 1120 | return $rows ? @$rows : (); | |
| 1121 | } | |
| 1122 | ||
| 1123 | 1; |