added on local at 2026-07-01 16:00:54
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # ABForge - Admin Heatmap | |
| 4 | # | |
| 5 | # Admin-only. Two modes: | |
| 6 | # 1. List mode (default): top pages ranked by click activity. Each | |
| 7 | # row links into detail mode. | |
| 8 | # 2. Detail mode (?page=/some/path): renders the page in an iframe | |
| 9 | # with click positions overlaid as glowing dots, plus a scroll- | |
| 10 | # depth histogram showing how far visitors typically read. | |
| 11 | # | |
| 12 | # Data comes from tracking_events: 'click'/'heatmap' rows carry | |
| 13 | # x_pct/y_pct of the cursor at click time, 'scroll' rows carry the | |
| 14 | # max scroll_pct per visit. | |
| 15 | #====================================================================== | |
| 16 | use strict; | |
| 17 | use warnings; | |
| 18 | ||
| 19 | use lib '/var/www/vhosts/abforge.com/httpdocs'; | |
| 20 | use CGI; | |
| 21 | use MODS::Template; | |
| 22 | use MODS::DBConnect; | |
| 23 | use MODS::Login; | |
| 24 | use MODS::ABForge::Config; | |
| 25 | use MODS::ABForge::Wrapper; | |
| 26 | use MODS::ABForge::Admin; | |
| 27 | use MODS::ABForge::Tracking; | |
| 28 | ||
| 29 | my $q = CGI->new; | |
| 30 | my $form = $q->Vars; | |
| 31 | my $auth = MODS::Login->new; | |
| 32 | my $wrap = MODS::ABForge::Wrapper->new; | |
| 33 | my $tfile = MODS::Template->new; | |
| 34 | my $db = MODS::DBConnect->new; | |
| 35 | my $cfg = MODS::ABForge::Config->new; | |
| 36 | my $admin = MODS::ABForge::Admin->new; | |
| 37 | my $tr = MODS::ABForge::Tracking->new; | |
| 38 | my $DB = $cfg->settings('database_name'); | |
| 39 | ||
| 40 | $|=1; | |
| 41 | my $userinfo = $auth->login_verify(); | |
| 42 | if (!$userinfo) { | |
| 43 | print "Status: 302 Found\nLocation: /login.cgi\n\n"; | |
| 44 | exit; | |
| 45 | } | |
| 46 | $admin->require_admin($userinfo); | |
| 47 | require MODS::ABForge::Permissions; | |
| 48 | MODS::ABForge::Permissions->new->require_feature($userinfo, 'admin_view_traffic'); | |
| 49 | ||
| 50 | my $dbh = $db->db_connect(); | |
| 51 | my $schema_ready = $tr->schema_ready($db, $dbh, $DB); | |
| 52 | ||
| 53 | sub _h { my $s = shift; $s = '' unless defined $s; $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; $s =~ s/"/"/g; return $s; } | |
| 54 | sub _u { | |
| 55 | my $s = shift; $s = '' unless defined $s; | |
| 56 | $s =~ s/([^A-Za-z0-9\-_.~\/?=&])/sprintf('%%%02X', ord($1))/eg; | |
| 57 | return $s; | |
| 58 | } | |
| 59 | ||
| 60 | # ---- Destructive: PLATFORM-WIDE wipe of heatmap data ---------------- | |
| 61 | # Triggered by the type-to-confirm modal in the template. Requires | |
| 62 | # POST + action=wipe_heatmap + confirm=WIPE (verbatim). Drops every | |
| 63 | # click / heatmap / scroll row across every storefront -- way more | |
| 64 | # severe than the seller's per-storefront wipe, which is why the | |
| 65 | # admin modal demands a different phrase (WIPE PLATFORM). | |
| 66 | if (($ENV{REQUEST_METHOD} || '') eq 'POST' | |
| 67 | && ($form->{action} || '') eq 'wipe_heatmap' | |
| 68 | && uc($form->{confirm} || '') eq 'WIPE PLATFORM' | |
| 69 | && $schema_ready) { | |
| 70 | my $c = $db->db_readwrite($dbh, qq~ | |
| 71 | SELECT COUNT(*) AS n FROM `${DB}`.tracking_events | |
| 72 | WHERE event_type IN ('click','heatmap','scroll') | |
| 73 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 74 | my $deleted = ($c && $c->{n}) ? $c->{n} : 0; | |
| 75 | ||
| 76 | $db->db_readwrite($dbh, qq~ | |
| 77 | DELETE FROM `${DB}`.tracking_events | |
| 78 | WHERE event_type IN ('click','heatmap','scroll') | |
| 79 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 80 | ||
| 81 | $db->db_disconnect($dbh); | |
| 82 | print "Status: 302 Found\nLocation: /admin_heatmap.cgi?wiped=$deleted\n\n"; | |
| 83 | exit; | |
| 84 | } | |
| 85 | ||
| 86 | # ---- Detail vs list mode -------------------------------------------- | |
| 87 | my $page_path = defined $form->{page} ? $form->{page} : ''; | |
| 88 | $page_path =~ s/[\r\n]//g; | |
| 89 | $page_path = substr($page_path, 0, 500); | |
| 90 | my $is_detail = (length $page_path) ? 1 : 0; | |
| 91 | ||
| 92 | my (@top_pages, $summary, @dots, @scroll_hist); | |
| 93 | my $scroll_max_count = 0; | |
| 94 | ||
| 95 | if ($schema_ready && !$is_detail) { | |
| 96 | @top_pages = $tr->heatmap_top_pages($db, $dbh, $DB, 30, 50); | |
| 97 | } | |
| 98 | my $typical_vh = 900; | |
| 99 | if ($schema_ready && $is_detail) { | |
| 100 | $summary = $tr->heatmap_page_summary($db, $dbh, $DB, $page_path, 30); | |
| 101 | @dots = $tr->heatmap_dots($db, $dbh, $DB, $page_path, 800); | |
| 102 | @scroll_hist = $tr->scroll_depth_distribution($db, $dbh, $DB, $page_path, 30); | |
| 103 | foreach my $b (@scroll_hist) { | |
| 104 | $scroll_max_count = $b->{count} if $b->{count} > $scroll_max_count; | |
| 105 | } | |
| 106 | # Median visitor viewport for this page (platform-wide) -- used by | |
| 107 | # the scroll-depth pin overlay to position lines at "where they | |
| 108 | # actually saw" rather than just where they scrolled. | |
| 109 | $typical_vh = $tr->typical_viewport_height($db, $dbh, $DB, undef, $page_path); | |
| 110 | } | |
| 111 | ||
| 112 | $db->db_disconnect($dbh); | |
| 113 | ||
| 114 | # ---- Build template vars -------------------------------------------- | |
| 115 | my @top_rows; | |
| 116 | foreach my $r (@top_pages) { | |
| 117 | my $path = _h($r->{page_path} || '/'); | |
| 118 | push @top_rows, { | |
| 119 | path => $path, | |
| 120 | path_raw => $r->{page_path} || '/', | |
| 121 | clicks => $r->{clicks} || 0, | |
| 122 | sessions => $r->{sessions} || 0, | |
| 123 | view_href => '/admin_heatmap.cgi?page=' . _u($r->{page_path} || '/'), | |
| 124 | }; | |
| 125 | } | |
| 126 | ||
| 127 | # Pack dots for the JS overlay. Each row carries: | |
| 128 | # x, y -- viewport-relative percent (last-resort fallback) | |
| 129 | # sel -- CSS path/selector for the clicked element | |
| 130 | # ox, oy -- element-relative offset 0..1 (defaults to 0.5/0.5 == element center) | |
| 131 | # The renderer prefers (sel + ox/oy) so the dot stays glued to the DOM | |
| 132 | # element through any reflow. When offsets are absent but a selector | |
| 133 | # exists, we still anchor to the element -- centered -- which is far | |
| 134 | # better than viewport-relative drift. Final fallback to (x, y) only | |
| 135 | # kicks in when the selector can't be resolved (page edited, etc.). | |
| 136 | my @dot_rows; | |
| 137 | my $rows_with_selector = 0; | |
| 138 | my $rows_with_offsets = 0; | |
| 139 | foreach my $d (@dots) { | |
| 140 | next unless defined $d->{x_pct} && defined $d->{y_pct}; | |
| 141 | my $sel = defined $d->{element_selector} ? $d->{element_selector} : ''; | |
| 142 | my $has_off = (defined $d->{offset_x_pct} && defined $d->{offset_y_pct}) ? 1 : 0; | |
| 143 | $rows_with_selector++ if length $sel; | |
| 144 | $rows_with_offsets++ if length $sel && $has_off; | |
| 145 | push @dot_rows, { | |
| 146 | x_pct => sprintf('%.2f', $d->{x_pct}), | |
| 147 | y_pct => sprintf('%.2f', $d->{y_pct}), | |
| 148 | sel => $sel, | |
| 149 | ox => $has_off ? sprintf('%.4f', $d->{offset_x_pct}) : '', | |
| 150 | oy => $has_off ? sprintf('%.4f', $d->{offset_y_pct}) : '', | |
| 151 | }; | |
| 152 | } | |
| 153 | ||
| 154 | # Tiny JSON-string escaper for embedding the selector path. Selectors | |
| 155 | # contain '>' and ':' but no quotes -- still, belt-and-suspenders. | |
| 156 | sub _js_str { | |
| 157 | my $s = shift; $s = '' unless defined $s; | |
| 158 | $s =~ s/\\/\\\\/g; | |
| 159 | $s =~ s/"/\\"/g; | |
| 160 | $s =~ s/[\r\n\t]/ /g; | |
| 161 | return $s; | |
| 162 | } | |
| 163 | ||
| 164 | my @hist_rows; | |
| 165 | foreach my $b (@scroll_hist) { | |
| 166 | my $pct = $scroll_max_count ? sprintf('%.1f', ($b->{count} / $scroll_max_count) * 100) : '0.0'; | |
| 167 | push @hist_rows, { | |
| 168 | range => $b->{range}, | |
| 169 | lo => $b->{lo}, | |
| 170 | hi => $b->{hi}, | |
| 171 | count => $b->{count}, | |
| 172 | pct => $pct, | |
| 173 | }; | |
| 174 | } | |
| 175 | ||
| 176 | # Encode dot data as compact JSON for the JS overlay. sel/ox/oy are | |
| 177 | # omitted when missing to keep the payload small for popular pages. | |
| 178 | my $dots_json = '[' . join(',', map { | |
| 179 | my $r = $_; | |
| 180 | my @kv = ('"x":' . $r->{x_pct}, '"y":' . $r->{y_pct}); | |
| 181 | if (length $r->{sel} && length $r->{ox} && length $r->{oy}) { | |
| 182 | push @kv, '"s":"' . _js_str($r->{sel}) . '"'; | |
| 183 | push @kv, '"ox":' . $r->{ox}; | |
| 184 | push @kv, '"oy":' . $r->{oy}; | |
| 185 | } | |
| 186 | '{' . join(',', @kv) . '}' | |
| 187 | } @dot_rows) . ']'; | |
| 188 | ||
| 189 | # Heuristic: iframe gets the page path including any querystring, | |
| 190 | # parented to the host's root. We strip anything that doesn't look | |
| 191 | # like a safe URL fragment. | |
| 192 | my $iframe_src = $page_path; | |
| 193 | $iframe_src =~ s/['"<>]//g; | |
| 194 | $iframe_src = '/' . $iframe_src if $iframe_src !~ m{^/}; | |
| 195 | ||
| 196 | # Append heatmap_view=1 so the wrapper renders the PUBLIC marketing | |
| 197 | # template instead of wrapping the page in the admin sidebar. Critical | |
| 198 | # for selector resolution -- the stored selectors are paths against | |
| 199 | # the public DOM; if the iframe rendered with the admin shell, every | |
| 200 | # `body > section:nth-of-type(1)` etc. would resolve to a different | |
| 201 | # element and the heatmap would be totally wrong. | |
| 202 | $iframe_src .= ($iframe_src =~ /\?/) ? '&heatmap_view=1' : '?heatmap_view=1'; | |
| 203 | ||
| 204 | # Success banner after a successful wipe-redirect (?wiped=N). | |
| 205 | my $wiped_count = 0; | |
| 206 | if (defined $form->{wiped}) { | |
| 207 | my $w = $form->{wiped}; $w =~ s/[^0-9]//g; | |
| 208 | $wiped_count = $w if length $w; | |
| 209 | } | |
| 210 | ||
| 211 | my $tvars = { | |
| 212 | user_id => $userinfo->{user_id}, | |
| 213 | schema_ready => $schema_ready ? 1 : 0, | |
| 214 | schema_missing => $schema_ready ? 0 : 1, | |
| 215 | ||
| 216 | just_wiped => $wiped_count > 0 ? 1 : 0, | |
| 217 | wiped_count => $wiped_count, | |
| 218 | ||
| 219 | typical_viewport_h => $typical_vh, | |
| 220 | ||
| 221 | is_list_view => $is_detail ? 0 : 1, | |
| 222 | is_detail_view => $is_detail ? 1 : 0, | |
| 223 | ||
| 224 | top_pages => \@top_rows, | |
| 225 | has_top_pages => scalar(@top_rows) ? 1 : 0, | |
| 226 | top_page_count => scalar(@top_rows), | |
| 227 | ||
| 228 | detail_path => _h($page_path), | |
| 229 | detail_path_raw => $page_path, | |
| 230 | iframe_src => _h($iframe_src), | |
| 231 | dots_json => $dots_json, | |
| 232 | dot_count => scalar(@dot_rows), | |
| 233 | dots_with_selector => $rows_with_selector, | |
| 234 | dots_with_offsets => $rows_with_offsets, | |
| 235 | dots_legacy => scalar(@dot_rows) - $rows_with_selector, | |
| 236 | anchor_pct => scalar(@dot_rows) ? int(($rows_with_offsets / scalar(@dot_rows)) * 100) : 0, | |
| 237 | has_any_anchored => $rows_with_offsets ? 1 : 0, | |
| 238 | all_legacy => (scalar(@dot_rows) && $rows_with_selector == 0) ? 1 : 0, | |
| 239 | summary_clicks => ($summary && $summary->{clicks}) || 0, | |
| 240 | summary_sessions => ($summary && $summary->{sessions}) || 0, | |
| 241 | summary_page_views => ($summary && $summary->{page_views}) || 0, | |
| 242 | summary_avg_scroll => ($summary && $summary->{avg_scroll}) || 0, | |
| 243 | summary_max_scroll => ($summary && $summary->{max_scroll}) || 0, | |
| 244 | ||
| 245 | scroll_hist => \@hist_rows, | |
| 246 | has_scroll_hist => (scalar(@hist_rows) && $scroll_max_count > 0) ? 1 : 0, | |
| 247 | }; | |
| 248 | ||
| 249 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n"; | |
| 250 | ||
| 251 | my $body = join('', $tfile->template('abforge_admin_heatmap.html', $tvars, $userinfo)); | |
| 252 | ||
| 253 | $wrap->render({ | |
| 254 | userinfo => $userinfo, | |
| 255 | page_key => 'admin_visitors', # Heatmaps lives under Traffic Statistics sidebar entry | |
| 256 | title => 'Admin · Heatmaps', | |
| 257 | body => $body, | |
| 258 | }); |