Diff -- /var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/MetaAdmin/Visitors.pm
Diff
/var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/MetaAdmin/Visitors.pm
added on local at 2026-06-25 01:50:29
Added
+661
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 29228eeddc3c
to 29228eeddc3c
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.| 1 | package MODS::MetaAdmin::Visitors; | |
| 2 | #====================================================================== | |
| 3 | # Meta-Admin -- portfolio-wide visitor rollup. | |
| 4 | # | |
| 5 | # Read-only aggregator that queries each sister site's tracking_sessions | |
| 6 | # table via SiteConn and merges results into a single dashboard view. | |
| 7 | # | |
| 8 | # Each site has its own schema flavor: | |
| 9 | # * 5 PT-shape sites (WebSTLs, PTMatrix, AffSoft, ShopCart, RePricer) | |
| 10 | # use `tracking_sessions` + `tracking_events` with country CHAR(2). | |
| 11 | # * ABForge uses `mkt_tracking_*` (marketing site tables, NOT the | |
| 12 | # product's heatmap tables). | |
| 13 | # * ContactForge uses a CRM-flavored split: `tracking_sessions` keys | |
| 14 | # by visitor_id rather than session_token; country lives in | |
| 15 | # `country_iso CHAR(2)`. | |
| 16 | # | |
| 17 | # Per-site SQL templates handle the differences. | |
| 18 | #====================================================================== | |
| 19 | use strict; | |
| 20 | use warnings; | |
| 21 | ||
| 22 | use MODS::MetaAdmin::SiteConn; | |
| 23 | ||
| 24 | sub new { | |
| 25 | my $class = shift; | |
| 26 | return bless({ sc => MODS::MetaAdmin::SiteConn->new }, $class); | |
| 27 | } | |
| 28 | ||
| 29 | # Per-slug schema template | |
| 30 | my %TPL = ( | |
| 31 | contactforge => { | |
| 32 | sessions => 'tracking_sessions', | |
| 33 | events => 'pageviews', | |
| 34 | sess_id => 'visitor_id', | |
| 35 | country => 'country_iso', | |
| 36 | page_filter => '', | |
| 37 | screen_w_col => 'screen_w', | |
| 38 | screen_h_col => 'screen_h', | |
| 39 | }, | |
| 40 | abforge => { | |
| 41 | sessions => 'mkt_tracking_sessions', | |
| 42 | events => 'mkt_tracking_events', | |
| 43 | sess_id => 'session_token', | |
| 44 | country => 'country', | |
| 45 | page_filter => "AND event_type='page_view'", | |
| 46 | screen_w_col => 'screen_width', | |
| 47 | screen_h_col => 'screen_height', | |
| 48 | }, | |
| 49 | ); | |
| 50 | # Other 5 sites default to PT-shape | |
| 51 | my %DEFAULT_TPL = ( | |
| 52 | sessions => 'tracking_sessions', | |
| 53 | events => 'tracking_events', | |
| 54 | sess_id => 'session_token', | |
| 55 | country => 'country', | |
| 56 | page_filter => "AND event_type='page_view'", | |
| 57 | screen_w_col => 'screen_width', | |
| 58 | screen_h_col => 'screen_height', | |
| 59 | ); | |
| 60 | ||
| 61 | sub _tpl { | |
| 62 | my ($slug) = @_; | |
| 63 | return $TPL{$slug} || \%DEFAULT_TPL; | |
| 64 | } | |
| 65 | ||
| 66 | # Country centroid table for the rollup globe | |
| 67 | my %COUNTRY_CENTROIDS = ( | |
| 68 | US=>[39.5,-98.5,'United States'], CA=>[56.1,-106.3,'Canada'], MX=>[23.6,-102.5,'Mexico'], | |
| 69 | GT=>[15.8,-90.2,'Guatemala'], CR=>[9.7,-83.7,'Costa Rica'], PA=>[8.5,-80.7,'Panama'], | |
| 70 | CU=>[21.5,-77.7,'Cuba'], DO=>[18.7,-70.1,'Dominican Republic'], BR=>[-14.2,-51.9,'Brazil'], | |
| 71 | AR=>[-38.4,-63.6,'Argentina'], CL=>[-35.6,-71.5,'Chile'], CO=>[4.6,-74.0,'Colombia'], | |
| 72 | PE=>[-9.2,-75.0,'Peru'], VE=>[6.4,-66.6,'Venezuela'], EC=>[-1.8,-78.2,'Ecuador'], | |
| 73 | UY=>[-32.5,-55.8,'Uruguay'], GB=>[55.4,-3.4,'United Kingdom'], IE=>[53.4,-8.2,'Ireland'], | |
| 74 | FR=>[46.2,2.2,'France'], DE=>[51.2,10.4,'Germany'], NL=>[52.1,5.3,'Netherlands'], | |
| 75 | BE=>[50.5,4.5,'Belgium'], LU=>[49.8,6.1,'Luxembourg'], CH=>[46.8,8.2,'Switzerland'], | |
| 76 | AT=>[47.5,14.6,'Austria'], IT=>[41.9,12.6,'Italy'], ES=>[40.5,-3.7,'Spain'], | |
| 77 | PT=>[39.4,-8.2,'Portugal'], DK=>[56.3,9.5,'Denmark'], NO=>[60.5,8.5,'Norway'], | |
| 78 | SE=>[60.1,18.6,'Sweden'], FI=>[61.9,25.7,'Finland'], PL=>[51.9,19.1,'Poland'], | |
| 79 | CZ=>[49.8,15.5,'Czechia'], SK=>[48.7,19.7,'Slovakia'], HU=>[47.2,19.5,'Hungary'], | |
| 80 | RO=>[45.9,25.0,'Romania'], BG=>[42.7,25.5,'Bulgaria'], GR=>[39.1,21.8,'Greece'], | |
| 81 | UA=>[48.4,31.2,'Ukraine'], RU=>[61.5,105.3,'Russia'], TR=>[38.9,35.2,'Turkey'], | |
| 82 | IL=>[31.0,34.9,'Israel'], SA=>[23.9,45.1,'Saudi Arabia'], AE=>[23.4,53.8,'United Arab Emirates'], | |
| 83 | IR=>[32.4,53.7,'Iran'], PK=>[30.4,69.3,'Pakistan'], IN=>[20.6,78.9,'India'], | |
| 84 | BD=>[23.7,90.4,'Bangladesh'], LK=>[7.9,80.8,'Sri Lanka'], NP=>[28.4,84.1,'Nepal'], | |
| 85 | CN=>[35.9,104.2,'China'], JP=>[36.2,138.3,'Japan'], KR=>[35.9,127.8,'South Korea'], | |
| 86 | TW=>[23.7,121.0,'Taiwan'], HK=>[22.4,114.1,'Hong Kong'], SG=>[1.4,103.8,'Singapore'], | |
| 87 | MY=>[4.2,101.9,'Malaysia'], TH=>[15.9,100.9,'Thailand'], VN=>[14.1,108.3,'Vietnam'], | |
| 88 | PH=>[12.9,121.8,'Philippines'], ID=>[-0.8,113.9,'Indonesia'], AU=>[-25.3,133.8,'Australia'], | |
| 89 | NZ=>[-40.9,174.9,'New Zealand'], ZA=>[-30.6,22.9,'South Africa'], NG=>[9.1,8.7,'Nigeria'], | |
| 90 | EG=>[26.8,30.8,'Egypt'], MA=>[31.8,-7.1,'Morocco'], KE=>[-0.0,37.9,'Kenya'], | |
| 91 | ET=>[9.1,40.5,'Ethiopia'], GH=>[7.9,-1.0,'Ghana'], DZ=>[28.0,1.7,'Algeria'], | |
| 92 | TN=>[33.9,9.5,'Tunisia'], | |
| 93 | ); | |
| 94 | sub country_centroid { | |
| 95 | my ($self, $code) = @_; | |
| 96 | return undef unless defined $code; | |
| 97 | $code = uc $code; $code =~ s/[^A-Z]//g; | |
| 98 | return undef unless length($code) == 2; | |
| 99 | return $COUNTRY_CENTROIDS{$code}; | |
| 100 | } | |
| 101 | ||
| 102 | #--------------------------------------------------------------------- | |
| 103 | # Roll up portfolio-wide KPIs over the last $days rolling window. | |
| 104 | # Returns: { total_pageviews, total_visitors, total_sessions, days, | |
| 105 | # per_site => [ { slug, name, color, pageviews, visitors, sessions, err } ] } | |
| 106 | #--------------------------------------------------------------------- | |
| 107 | sub kpi_rollup { | |
| 108 | my ($self, $days) = @_; | |
| 109 | $days = int($days || 30); $days = 1 if $days < 1; $days = 730 if $days > 730; | |
| 110 | my $sites = $self->{sc}->list_sites(active => 1); | |
| 111 | my %out = (total_pageviews => 0, total_visitors => 0, total_sessions => 0, days => $days, per_site => []); | |
| 112 | foreach my $row (@$sites) { | |
| 113 | my $slug = $row->{slug}; | |
| 114 | my $tpl = _tpl($slug); | |
| 115 | my $entry = { | |
| 116 | slug => $slug, | |
| 117 | display_name => $row->{display_name}, | |
| 118 | color => $row->{brand_color} || '#807aa8', | |
| 119 | pageviews => undef, | |
| 120 | visitors => undef, | |
| 121 | sessions => undef, | |
| 122 | err => '', | |
| 123 | }; | |
| 124 | ||
| 125 | # pageviews from the events table | |
| 126 | my $pv_sql = qq~ | |
| 127 | SELECT COUNT(*) AS n FROM $tpl->{events} | |
| 128 | WHERE occurred_at >= DATE_SUB(NOW(), INTERVAL $days DAY) $tpl->{page_filter} | |
| 129 | ~; | |
| 130 | my $r = eval { $self->{sc}->query_one($slug, $pv_sql) }; | |
| 131 | if ($r) { $entry->{pageviews} = ($r->{n} || 0) + 0; $out{total_pageviews} += $entry->{pageviews}; } | |
| 132 | else { $entry->{err} = $self->{sc}->last_error || ''; } | |
| 133 | ||
| 134 | # visitors + sessions from sessions table | |
| 135 | my $vs_sql = qq~ | |
| 136 | SELECT COUNT(DISTINCT $tpl->{sess_id}) AS visitors, | |
| 137 | COUNT(*) AS sessions | |
| 138 | FROM $tpl->{sessions} | |
| 139 | WHERE last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 140 | ~; | |
| 141 | $r = eval { $self->{sc}->query_one($slug, $vs_sql) }; | |
| 142 | if ($r) { | |
| 143 | $entry->{visitors} = ($r->{visitors} || 0) + 0; | |
| 144 | $entry->{sessions} = ($r->{sessions} || 0) + 0; | |
| 145 | $out{total_visitors} += $entry->{visitors}; | |
| 146 | $out{total_sessions} += $entry->{sessions}; | |
| 147 | } else { | |
| 148 | $entry->{err} ||= $self->{sc}->last_error || ''; | |
| 149 | } | |
| 150 | push @{ $out{per_site} }, $entry; | |
| 151 | } | |
| 152 | return \%out; | |
| 153 | } | |
| 154 | ||
| 155 | #--------------------------------------------------------------------- | |
| 156 | # Roll up portfolio-wide country counts for the globe. | |
| 157 | # Returns flat list of { code, name, lat, lng, count } merged across all sites. | |
| 158 | #--------------------------------------------------------------------- | |
| 159 | sub geo_rollup { | |
| 160 | my ($self, $days) = @_; | |
| 161 | $days = int($days || 30); $days = 1 if $days < 1; $days = 730 if $days > 730; | |
| 162 | my $sites = $self->{sc}->list_sites(active => 1); | |
| 163 | my %by_code; # ISO -> total count | |
| 164 | foreach my $row (@$sites) { | |
| 165 | my $slug = $row->{slug}; | |
| 166 | my $tpl = _tpl($slug); | |
| 167 | my $col = $tpl->{country}; | |
| 168 | my $sql = qq~ | |
| 169 | SELECT UPPER($col) AS code, COUNT(*) AS n | |
| 170 | FROM $tpl->{sessions} | |
| 171 | WHERE $col IS NOT NULL AND CHAR_LENGTH($col)=2 | |
| 172 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 173 | GROUP BY $col | |
| 174 | ~; | |
| 175 | my $rows = eval { $self->{sc}->query_many($slug, $sql) }; | |
| 176 | next unless ref($rows) eq 'ARRAY'; | |
| 177 | foreach my $r (@$rows) { | |
| 178 | next unless ref($r) eq 'HASH'; | |
| 179 | $by_code{ $r->{code} } += ($r->{n} || 0); | |
| 180 | } | |
| 181 | } | |
| 182 | my @out; | |
| 183 | foreach my $code (sort { $by_code{$b} <=> $by_code{$a} } keys %by_code) { | |
| 184 | my $c = $self->country_centroid($code); | |
| 185 | next unless $c; | |
| 186 | push @out, { | |
| 187 | code => $code, name => $c->[2], | |
| 188 | lat => $c->[0], lng => $c->[1], | |
| 189 | count => $by_code{$code}, | |
| 190 | }; | |
| 191 | } | |
| 192 | return @out; | |
| 193 | } | |
| 194 | ||
| 195 | #--------------------------------------------------------------------- | |
| 196 | # Per-site drill: ONE site's traffic broken down by country + region. | |
| 197 | # Returns: { slug, display_name, color, total_visitors, total_sessions, | |
| 198 | # countries => [ {code, name, visitors, sessions}, ... ], | |
| 199 | # regions => [ {country, region, visitors, sessions}, ... ] } | |
| 200 | # Returns undef if the slug isn't a known active site. | |
| 201 | #--------------------------------------------------------------------- | |
| 202 | sub site_drill { | |
| 203 | my ($self, $slug, $days, $country, $region) = @_; | |
| 204 | $days = int($days || 30); $days = 1 if $days < 1; $days = 730 if $days > 730; | |
| 205 | return undef unless defined($slug) && length($slug); | |
| 206 | ||
| 207 | my $sites = $self->{sc}->list_sites(active => 1); | |
| 208 | my $row; | |
| 209 | foreach my $s (@$sites) { $row = $s if $s->{slug} eq $slug; } | |
| 210 | return undef unless $row; | |
| 211 | ||
| 212 | # Normalize optional drill keys | |
| 213 | $country =~ s/[^A-Za-z]//g if defined $country; | |
| 214 | $country = uc(substr($country || '', 0, 2)); | |
| 215 | $country = '' unless length($country) == 2; | |
| 216 | $region //= ''; | |
| 217 | # Region is a free-form display string -- only used as a literal in | |
| 218 | # the GROUP BY filter. Strip dangerous chars before interpolating. | |
| 219 | $region =~ s/[\\']//g; | |
| 220 | $region = substr($region, 0, 120); | |
| 221 | ||
| 222 | my $tpl = _tpl($slug); | |
| 223 | ||
| 224 | # Total visitors + sessions for the active filter scope | |
| 225 | my $where = "last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY)"; | |
| 226 | $where .= " AND UPPER($tpl->{country})='$country'" if length($country); | |
| 227 | $where .= " AND region='$region'" if length($region); | |
| 228 | my $tot = eval { $self->{sc}->query_one($slug, qq~ | |
| 229 | SELECT COUNT(DISTINCT $tpl->{sess_id}) AS visitors, | |
| 230 | COUNT(*) AS sessions | |
| 231 | FROM $tpl->{sessions} | |
| 232 | WHERE $where | |
| 233 | ~) }; | |
| 234 | my $tv = (ref($tot) eq 'HASH' && $tot->{visitors}) ? $tot->{visitors} + 0 : 0; | |
| 235 | my $ts = (ref($tot) eq 'HASH' && $tot->{sessions}) ? $tot->{sessions} + 0 : 0; | |
| 236 | ||
| 237 | my %out = ( | |
| 238 | slug => $slug, | |
| 239 | display_name => $row->{display_name}, | |
| 240 | color => $row->{brand_color} || '#807aa8', | |
| 241 | total_visitors => $tv, | |
| 242 | total_sessions => $ts, | |
| 243 | level => length($region) ? 'cities' : length($country) ? 'states' : 'countries', | |
| 244 | country_code => $country, | |
| 245 | country_name => length($country) ? (($self->country_centroid($country) || [0,0,$country])->[2]) : '', | |
| 246 | region_name => $region, | |
| 247 | countries => [], | |
| 248 | states => [], | |
| 249 | cities => [], | |
| 250 | ); | |
| 251 | ||
| 252 | if (!length($country)) { | |
| 253 | # Level 1 -- countries with traffic | |
| 254 | my $sql = qq~ | |
| 255 | SELECT UPPER($tpl->{country}) AS code, | |
| 256 | COUNT(DISTINCT $tpl->{sess_id}) AS visitors, | |
| 257 | COUNT(*) AS sessions | |
| 258 | FROM $tpl->{sessions} | |
| 259 | WHERE $tpl->{country} IS NOT NULL AND CHAR_LENGTH($tpl->{country})=2 | |
| 260 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 261 | GROUP BY $tpl->{country} | |
| 262 | ORDER BY visitors DESC | |
| 263 | LIMIT 60 | |
| 264 | ~; | |
| 265 | my $rows = eval { $self->{sc}->query_many($slug, $sql) }; | |
| 266 | if (ref($rows) eq 'ARRAY') { | |
| 267 | foreach my $r (@$rows) { | |
| 268 | next unless ref($r) eq 'HASH'; | |
| 269 | my $c = $self->country_centroid($r->{code}); | |
| 270 | push @{ $out{countries} }, { | |
| 271 | code => $r->{code}, | |
| 272 | name => $c ? $c->[2] : $r->{code}, | |
| 273 | visitors => ($r->{visitors} || 0) + 0, | |
| 274 | sessions => ($r->{sessions} || 0) + 0, | |
| 275 | }; | |
| 276 | } | |
| 277 | } | |
| 278 | } | |
| 279 | elsif (!length($region)) { | |
| 280 | # Level 2 -- states (regions) within the selected country | |
| 281 | my $sql = qq~ | |
| 282 | SELECT COALESCE(NULLIF(region,''),'(unknown)') AS region, | |
| 283 | COUNT(DISTINCT $tpl->{sess_id}) AS visitors, | |
| 284 | COUNT(*) AS sessions | |
| 285 | FROM $tpl->{sessions} | |
| 286 | WHERE UPPER($tpl->{country})='$country' | |
| 287 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 288 | GROUP BY region | |
| 289 | ORDER BY visitors DESC | |
| 290 | LIMIT 50 | |
| 291 | ~; | |
| 292 | my $rows = eval { $self->{sc}->query_many($slug, $sql) }; | |
| 293 | if (ref($rows) eq 'ARRAY') { | |
| 294 | foreach my $r (@$rows) { | |
| 295 | next unless ref($r) eq 'HASH'; | |
| 296 | push @{ $out{states} }, { | |
| 297 | region => $r->{region}, | |
| 298 | visitors => ($r->{visitors} || 0) + 0, | |
| 299 | sessions => ($r->{sessions} || 0) + 0, | |
| 300 | }; | |
| 301 | } | |
| 302 | } | |
| 303 | } | |
| 304 | else { | |
| 305 | # Level 3 -- cities within the selected state of the selected country | |
| 306 | my $sql = qq~ | |
| 307 | SELECT COALESCE(NULLIF(city,''),'(unknown)') AS city, | |
| 308 | COUNT(DISTINCT $tpl->{sess_id}) AS visitors, | |
| 309 | COUNT(*) AS sessions | |
| 310 | FROM $tpl->{sessions} | |
| 311 | WHERE UPPER($tpl->{country})='$country' | |
| 312 | AND region='$region' | |
| 313 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 314 | GROUP BY city | |
| 315 | ORDER BY visitors DESC | |
| 316 | LIMIT 50 | |
| 317 | ~; | |
| 318 | my $rows = eval { $self->{sc}->query_many($slug, $sql) }; | |
| 319 | if (ref($rows) eq 'ARRAY') { | |
| 320 | foreach my $r (@$rows) { | |
| 321 | next unless ref($r) eq 'HASH'; | |
| 322 | push @{ $out{cities} }, { | |
| 323 | city => $r->{city}, | |
| 324 | visitors => ($r->{visitors} || 0) + 0, | |
| 325 | sessions => ($r->{sessions} || 0) + 0, | |
| 326 | }; | |
| 327 | } | |
| 328 | } | |
| 329 | } | |
| 330 | return \%out; | |
| 331 | } | |
| 332 | ||
| 333 | #--------------------------------------------------------------------- | |
| 334 | # State-level rollup for the globe's state-zoom dots. Returns: | |
| 335 | # { US => { 'New York' => 25, 'Colorado' => 8, ... }, GB => {...}, ... } | |
| 336 | # Aggregates region counts across every active site in the portfolio. | |
| 337 | #--------------------------------------------------------------------- | |
| 338 | sub state_rollup { | |
| 339 | my ($self, $days) = @_; | |
| 340 | $days = int($days || 30); $days = 1 if $days < 1; $days = 730 if $days > 730; | |
| 341 | my $sites = $self->{sc}->list_sites(active => 1); | |
| 342 | my %out; | |
| 343 | foreach my $row (@$sites) { | |
| 344 | my $slug = $row->{slug}; | |
| 345 | my $tpl = _tpl($slug); | |
| 346 | my $sql = qq~ | |
| 347 | SELECT UPPER($tpl->{country}) AS code, | |
| 348 | region, | |
| 349 | COUNT(DISTINCT $tpl->{sess_id}) AS visitors | |
| 350 | FROM $tpl->{sessions} | |
| 351 | WHERE $tpl->{country} IS NOT NULL AND CHAR_LENGTH($tpl->{country})=2 | |
| 352 | AND region IS NOT NULL AND region<>'' | |
| 353 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 354 | GROUP BY $tpl->{country}, region | |
| 355 | ~; | |
| 356 | my $rows = eval { $self->{sc}->query_many($slug, $sql) }; | |
| 357 | next unless ref($rows) eq 'ARRAY'; | |
| 358 | foreach my $r (@$rows) { | |
| 359 | next unless ref($r) eq 'HASH'; | |
| 360 | $out{ $r->{code} } ||= {}; | |
| 361 | $out{ $r->{code} }{ $r->{region} } += ($r->{visitors} || 0); | |
| 362 | } | |
| 363 | } | |
| 364 | return \%out; | |
| 365 | } | |
| 366 | ||
| 367 | #--------------------------------------------------------------------- | |
| 368 | # Full country -> state -> city tree for accordion drill rendering. | |
| 369 | # One SQL per site (or zero if slug not active). Returns: | |
| 370 | # { slug, display_name, color, total_visitors, total_sessions, | |
| 371 | # countries => [ | |
| 372 | # { code, name, visitors, sessions, | |
| 373 | # states => [ | |
| 374 | # { region, visitors, sessions, | |
| 375 | # cities => [ { city, visitors, sessions }, ... ] | |
| 376 | # } | |
| 377 | # ] | |
| 378 | # } | |
| 379 | # ] | |
| 380 | # } | |
| 381 | #--------------------------------------------------------------------- | |
| 382 | sub full_drill_tree { | |
| 383 | my ($self, $slug, $days) = @_; | |
| 384 | $days = int($days || 30); $days = 1 if $days < 1; $days = 730 if $days > 730; | |
| 385 | return undef unless defined($slug) && length($slug); | |
| 386 | ||
| 387 | my $sites = $self->{sc}->list_sites(active => 1); | |
| 388 | my $row; | |
| 389 | foreach my $s (@$sites) { $row = $s if $s->{slug} eq $slug; } | |
| 390 | return undef unless $row; | |
| 391 | ||
| 392 | my $tpl = _tpl($slug); | |
| 393 | my %out = ( | |
| 394 | slug => $slug, | |
| 395 | display_name => $row->{display_name}, | |
| 396 | color => $row->{brand_color} || '#807aa8', | |
| 397 | total_visitors => 0, | |
| 398 | total_sessions => 0, | |
| 399 | countries => [], | |
| 400 | ); | |
| 401 | ||
| 402 | # One SQL pulls every (country, region, city) tuple with counts. | |
| 403 | my $sql = qq~ | |
| 404 | SELECT UPPER($tpl->{country}) AS code, | |
| 405 | COALESCE(NULLIF(region,''),'(unknown)') AS region, | |
| 406 | COALESCE(NULLIF(city,''),'(unknown)') AS city, | |
| 407 | COUNT(DISTINCT $tpl->{sess_id}) AS visitors, | |
| 408 | COUNT(*) AS sessions | |
| 409 | FROM $tpl->{sessions} | |
| 410 | WHERE $tpl->{country} IS NOT NULL AND CHAR_LENGTH($tpl->{country})=2 | |
| 411 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 412 | GROUP BY $tpl->{country}, region, city | |
| 413 | ORDER BY visitors DESC | |
| 414 | ~; | |
| 415 | my $rows = eval { $self->{sc}->query_many($slug, $sql) }; | |
| 416 | return \%out unless ref($rows) eq 'ARRAY'; | |
| 417 | ||
| 418 | # Aggregate rows into a nested tree. | |
| 419 | my %by_code; # code -> { name, visitors, sessions, states_by_name => { ... } } | |
| 420 | foreach my $r (@$rows) { | |
| 421 | next unless ref($r) eq 'HASH'; | |
| 422 | my $code = $r->{code}; | |
| 423 | my $region = $r->{region}; | |
| 424 | my $city = $r->{city}; | |
| 425 | my $v = ($r->{visitors} || 0) + 0; | |
| 426 | my $s = ($r->{sessions} || 0) + 0; | |
| 427 | ||
| 428 | $by_code{$code} ||= { name => undef, visitors => 0, sessions => 0, states => {} }; | |
| 429 | $by_code{$code}{visitors} += $v; | |
| 430 | $by_code{$code}{sessions} += $s; | |
| 431 | $out{total_visitors} += $v; | |
| 432 | $out{total_sessions} += $s; | |
| 433 | ||
| 434 | my $state = $by_code{$code}{states}{$region} | |
| 435 | ||= { visitors => 0, sessions => 0, cities => [] }; | |
| 436 | $state->{visitors} += $v; | |
| 437 | $state->{sessions} += $s; | |
| 438 | push @{ $state->{cities} }, { city => $city, visitors => $v, sessions => $s }; | |
| 439 | } | |
| 440 | ||
| 441 | # Resolve country display names + sort country/state lists desc by visitors. | |
| 442 | foreach my $code (sort { $by_code{$b}{visitors} <=> $by_code{$a}{visitors} } keys %by_code) { | |
| 443 | my $centroid = $self->country_centroid($code); | |
| 444 | my $cname = $centroid ? $centroid->[2] : $code; | |
| 445 | my $cdata = $by_code{$code}; | |
| 446 | my @states; | |
| 447 | foreach my $rname (sort { $cdata->{states}{$b}{visitors} <=> $cdata->{states}{$a}{visitors} } keys %{$cdata->{states}}) { | |
| 448 | my $st = $cdata->{states}{$rname}; | |
| 449 | my @cities = sort { $b->{visitors} <=> $a->{visitors} } @{ $st->{cities} }; | |
| 450 | push @states, { | |
| 451 | region => $rname, | |
| 452 | visitors => $st->{visitors}, | |
| 453 | sessions => $st->{sessions}, | |
| 454 | cities => \@cities, | |
| 455 | }; | |
| 456 | } | |
| 457 | push @{ $out{countries} }, { | |
| 458 | code => $code, | |
| 459 | name => $cname, | |
| 460 | visitors => $cdata->{visitors}, | |
| 461 | sessions => $cdata->{sessions}, | |
| 462 | states => \@states, | |
| 463 | }; | |
| 464 | } | |
| 465 | return \%out; | |
| 466 | } | |
| 467 | ||
| 468 | #--------------------------------------------------------------------- | |
| 469 | # Cross-portfolio per-country dimension breakdowns for the modal. | |
| 470 | # Returns: { US => { | |
| 471 | # browsers: { 'Chrome'=>200, 'Safari'=>50, ... }, | |
| 472 | # os: { 'Windows'=>150, 'macOS'=>100, ... }, | |
| 473 | # devices: { 'desktop'=>300, 'mobile'=>80, ... }, | |
| 474 | # resolutions: { '1920 x 1080'=>100, ... }, | |
| 475 | # viewports: { ... }, | |
| 476 | # languages: { 'en-US'=>200, ... }, | |
| 477 | # timezones: { 'America/New_York'=>80, ... } | |
| 478 | # }, ... } | |
| 479 | # Aggregates across every active site. Each dimension is one SQL per site. | |
| 480 | #--------------------------------------------------------------------- | |
| 481 | sub country_dimensions_rollup { | |
| 482 | my ($self, $days) = @_; | |
| 483 | $days = int($days || 30); $days = 1 if $days < 1; $days = 730 if $days > 730; | |
| 484 | my $sites = $self->{sc}->list_sites(active => 1); | |
| 485 | my %out; | |
| 486 | foreach my $row (@$sites) { | |
| 487 | my $slug = $row->{slug}; | |
| 488 | my $tpl = _tpl($slug); | |
| 489 | my $sw = $tpl->{screen_w_col} || 'screen_width'; | |
| 490 | my $sh = $tpl->{screen_h_col} || 'screen_height'; | |
| 491 | my @dims = ( | |
| 492 | { key => 'browsers', col => "COALESCE(NULLIF(browser_name,''),'Unknown')" }, | |
| 493 | { key => 'os', col => "COALESCE(NULLIF(os_name,''),'Unknown')" }, | |
| 494 | { key => 'devices', col => "COALESCE(device_type,'unknown')" }, | |
| 495 | { key => 'resolutions', col => "CONCAT(COALESCE($sw,'?'),' x ',COALESCE($sh,'?'))" }, | |
| 496 | { key => 'viewports', col => "CONCAT(COALESCE(viewport_width,'?'),' x ',COALESCE(viewport_height,'?'))" }, | |
| 497 | { key => 'languages', col => "COALESCE(NULLIF(language,''),'Unknown')" }, | |
| 498 | { key => 'timezones', col => "COALESCE(NULLIF(timezone,''),'Unknown')" }, | |
| 499 | ); | |
| 500 | foreach my $d (@dims) { | |
| 501 | my $sql = qq~ | |
| 502 | SELECT UPPER($tpl->{country}) AS code, $d->{col} AS v, COUNT(*) AS n | |
| 503 | FROM $tpl->{sessions} | |
| 504 | WHERE $tpl->{country} IS NOT NULL AND CHAR_LENGTH($tpl->{country})=2 | |
| 505 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 506 | GROUP BY $tpl->{country}, $d->{col} | |
| 507 | ~; | |
| 508 | my $rows = eval { $self->{sc}->query_many($slug, $sql) }; | |
| 509 | next unless ref($rows) eq 'ARRAY'; | |
| 510 | foreach my $r (@$rows) { | |
| 511 | next unless ref($r) eq 'HASH'; | |
| 512 | $out{ $r->{code} } ||= { browsers => {}, os => {}, devices => {}, resolutions => {}, viewports => {}, languages => {}, timezones => {} }; | |
| 513 | my $v = defined($r->{v}) ? $r->{v} : 'Unknown'; | |
| 514 | next if $v eq '? x ?'; # drop totally-empty resolution buckets | |
| 515 | $out{ $r->{code} }{ $d->{key} }{ $v } += ($r->{n} || 0); | |
| 516 | } | |
| 517 | } | |
| 518 | } | |
| 519 | return \%out; | |
| 520 | } | |
| 521 | ||
| 522 | #--------------------------------------------------------------------- | |
| 523 | # Per-state dimension breakdowns (browser/OS/device/etc) for the | |
| 524 | # state-level modal. Returns: | |
| 525 | # { US => { 'New York' => { browsers => {...}, os => {...}, ... } } } | |
| 526 | # Same dimension set as country_dimensions_rollup, just additionally | |
| 527 | # grouped by region. | |
| 528 | #--------------------------------------------------------------------- | |
| 529 | sub state_dimensions_rollup { | |
| 530 | my ($self, $days) = @_; | |
| 531 | $days = int($days || 30); $days = 1 if $days < 1; $days = 730 if $days > 730; | |
| 532 | my $sites = $self->{sc}->list_sites(active => 1); | |
| 533 | my %out; | |
| 534 | foreach my $row (@$sites) { | |
| 535 | my $slug = $row->{slug}; | |
| 536 | my $tpl = _tpl($slug); | |
| 537 | my $sw = $tpl->{screen_w_col} || 'screen_width'; | |
| 538 | my $sh = $tpl->{screen_h_col} || 'screen_height'; | |
| 539 | my @dims = ( | |
| 540 | { key => 'browsers', col => "COALESCE(NULLIF(browser_name,''),'Unknown')" }, | |
| 541 | { key => 'os', col => "COALESCE(NULLIF(os_name,''),'Unknown')" }, | |
| 542 | { key => 'devices', col => "COALESCE(device_type,'unknown')" }, | |
| 543 | { key => 'resolutions', col => "CONCAT(COALESCE($sw,'?'),' x ',COALESCE($sh,'?'))" }, | |
| 544 | { key => 'viewports', col => "CONCAT(COALESCE(viewport_width,'?'),' x ',COALESCE(viewport_height,'?'))" }, | |
| 545 | { key => 'languages', col => "COALESCE(NULLIF(language,''),'Unknown')" }, | |
| 546 | { key => 'timezones', col => "COALESCE(NULLIF(timezone,''),'Unknown')" }, | |
| 547 | ); | |
| 548 | foreach my $d (@dims) { | |
| 549 | my $sql = qq~ | |
| 550 | SELECT UPPER($tpl->{country}) AS code, region, $d->{col} AS v, COUNT(*) AS n | |
| 551 | FROM $tpl->{sessions} | |
| 552 | WHERE $tpl->{country} IS NOT NULL AND CHAR_LENGTH($tpl->{country})=2 | |
| 553 | AND region IS NOT NULL AND region<>'' | |
| 554 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 555 | GROUP BY $tpl->{country}, region, $d->{col} | |
| 556 | ~; | |
| 557 | my $rows = eval { $self->{sc}->query_many($slug, $sql) }; | |
| 558 | next unless ref($rows) eq 'ARRAY'; | |
| 559 | foreach my $r (@$rows) { | |
| 560 | next unless ref($r) eq 'HASH'; | |
| 561 | my $v = defined($r->{v}) ? $r->{v} : 'Unknown'; | |
| 562 | next if $v eq '? x ?'; | |
| 563 | $out{ $r->{code} } ||= {}; | |
| 564 | $out{ $r->{code} }{ $r->{region} } ||= { browsers => {}, os => {}, devices => {}, resolutions => {}, viewports => {}, languages => {}, timezones => {} }; | |
| 565 | $out{ $r->{code} }{ $r->{region} }{ $d->{key} }{ $v } += ($r->{n} || 0); | |
| 566 | } | |
| 567 | } | |
| 568 | } | |
| 569 | return \%out; | |
| 570 | } | |
| 571 | ||
| 572 | #--------------------------------------------------------------------- | |
| 573 | # Per-country -> per-state -> per-site breakdown for the state modal. | |
| 574 | # Returns: { US => { 'New York' => [ {slug,name,color,visitors,sessions}, ... ] } } | |
| 575 | #--------------------------------------------------------------------- | |
| 576 | sub state_per_site_rollup { | |
| 577 | my ($self, $days) = @_; | |
| 578 | $days = int($days || 30); $days = 1 if $days < 1; $days = 730 if $days > 730; | |
| 579 | my $sites = $self->{sc}->list_sites(active => 1); | |
| 580 | my %out; | |
| 581 | foreach my $row (@$sites) { | |
| 582 | my $slug = $row->{slug}; | |
| 583 | my $tpl = _tpl($slug); | |
| 584 | my $sql = qq~ | |
| 585 | SELECT UPPER($tpl->{country}) AS code, | |
| 586 | region, | |
| 587 | COUNT(DISTINCT $tpl->{sess_id}) AS visitors, | |
| 588 | COUNT(*) AS sessions | |
| 589 | FROM $tpl->{sessions} | |
| 590 | WHERE $tpl->{country} IS NOT NULL AND CHAR_LENGTH($tpl->{country})=2 | |
| 591 | AND region IS NOT NULL AND region<>'' | |
| 592 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 593 | GROUP BY $tpl->{country}, region | |
| 594 | ~; | |
| 595 | my $rows = eval { $self->{sc}->query_many($slug, $sql) }; | |
| 596 | next unless ref($rows) eq 'ARRAY'; | |
| 597 | foreach my $r (@$rows) { | |
| 598 | next unless ref($r) eq 'HASH'; | |
| 599 | $out{ $r->{code} } ||= {}; | |
| 600 | $out{ $r->{code} }{ $r->{region} } ||= []; | |
| 601 | push @{ $out{ $r->{code} }{ $r->{region} } }, { | |
| 602 | slug => $slug, | |
| 603 | name => $row->{display_name}, | |
| 604 | color => $row->{brand_color} || '#807aa8', | |
| 605 | visitors => ($r->{visitors} || 0) + 0, | |
| 606 | sessions => ($r->{sessions} || 0) + 0, | |
| 607 | }; | |
| 608 | } | |
| 609 | } | |
| 610 | foreach my $code (keys %out) { | |
| 611 | foreach my $region (keys %{ $out{$code} }) { | |
| 612 | $out{$code}{$region} = [ sort { $b->{visitors} <=> $a->{visitors} } @{ $out{$code}{$region} } ]; | |
| 613 | } | |
| 614 | } | |
| 615 | return \%out; | |
| 616 | } | |
| 617 | ||
| 618 | #--------------------------------------------------------------------- | |
| 619 | # Per-country -> per-site breakdown for the globe popover. | |
| 620 | # Returns a hashref keyed by ISO code: | |
| 621 | # { US => [ {slug, name, color, visitors, sessions}, ... ], ... } | |
| 622 | # Only countries with at least one site contribution are included. | |
| 623 | #--------------------------------------------------------------------- | |
| 624 | sub country_per_site_rollup { | |
| 625 | my ($self, $days) = @_; | |
| 626 | $days = int($days || 30); $days = 1 if $days < 1; $days = 730 if $days > 730; | |
| 627 | my $sites = $self->{sc}->list_sites(active => 1); | |
| 628 | my %out; | |
| 629 | foreach my $row (@$sites) { | |
| 630 | my $slug = $row->{slug}; | |
| 631 | my $tpl = _tpl($slug); | |
| 632 | my $sql = qq~ | |
| 633 | SELECT UPPER($tpl->{country}) AS code, | |
| 634 | COUNT(DISTINCT $tpl->{sess_id}) AS visitors, | |
| 635 | COUNT(*) AS sessions | |
| 636 | FROM $tpl->{sessions} | |
| 637 | WHERE $tpl->{country} IS NOT NULL AND CHAR_LENGTH($tpl->{country})=2 | |
| 638 | AND last_seen_at >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 639 | GROUP BY $tpl->{country} | |
| 640 | ~; | |
| 641 | my $rows = eval { $self->{sc}->query_many($slug, $sql) }; | |
| 642 | next unless ref($rows) eq 'ARRAY'; | |
| 643 | foreach my $r (@$rows) { | |
| 644 | next unless ref($r) eq 'HASH'; | |
| 645 | $out{ $r->{code} } ||= []; | |
| 646 | push @{ $out{ $r->{code} } }, { | |
| 647 | slug => $slug, | |
| 648 | name => $row->{display_name}, | |
| 649 | color => $row->{brand_color} || '#807aa8', | |
| 650 | visitors => ($r->{visitors} || 0) + 0, | |
| 651 | sessions => ($r->{sessions} || 0) + 0, | |
| 652 | }; | |
| 653 | } | |
| 654 | } | |
| 655 | foreach my $code (keys %out) { | |
| 656 | $out{$code} = [ sort { $b->{visitors} <=> $a->{visitors} } @{ $out{$code} } ]; | |
| 657 | } | |
| 658 | return \%out; | |
| 659 | } | |
| 660 | ||
| 661 | 1; |