added on WebSTLs (webstls.com) at 2026-07-01 22:26:46
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs -- Sales Reports. | |
| 4 | # | |
| 5 | # Replaces the three old pages (dashboard.cgi + analytics.cgi + | |
| 6 | # audience.cgi) with one tabbed view. Same data, one URL. | |
| 7 | # | |
| 8 | # Tabs (via ?tab=NAME, default 'overview'): | |
| 9 | # overview -- top KPI tiles (revenue today/MTD/30d/AOV) + delta % | |
| 10 | # channels -- per-channel revenue cards (storefront + marketplaces) | |
| 11 | # buyers -- distinct buyers, top buyers by LTV, segment counts | |
| 12 | # products -- top-selling models by revenue + units | |
| 13 | #====================================================================== | |
| 14 | use strict; | |
| 15 | use warnings; | |
| 16 | ||
| 17 | use lib '/var/www/vhosts/webstls.com/httpdocs'; | |
| 18 | use CGI; | |
| 19 | use MODS::Template; | |
| 20 | use MODS::DBConnect; | |
| 21 | use MODS::Login; | |
| 22 | use MODS::WebSTLs::Config; | |
| 23 | use MODS::WebSTLs::Wrapper; | |
| 24 | use MODS::WebSTLs::Marketplaces; | |
| 25 | ||
| 26 | my $q = CGI->new; | |
| 27 | my $form = $q->Vars; | |
| 28 | my $auth = MODS::Login->new; | |
| 29 | my $wrap = MODS::WebSTLs::Wrapper->new; | |
| 30 | my $tfile = MODS::Template->new; | |
| 31 | my $db = MODS::DBConnect->new; | |
| 32 | my $cfg = MODS::WebSTLs::Config->new; | |
| 33 | my $mp = MODS::WebSTLs::Marketplaces->new; | |
| 34 | my $DB = $cfg->settings('database_name'); | |
| 35 | ||
| 36 | $|=1; | |
| 37 | my $userinfo = $auth->login_verify(); | |
| 38 | unless ($userinfo) { | |
| 39 | print "Status: 302 Found\nLocation: /login.cgi\n\n"; | |
| 40 | exit; | |
| 41 | } | |
| 42 | require MODS::WebSTLs::Permissions; | |
| 43 | MODS::WebSTLs::Permissions->new->require_feature($userinfo, 'view_reports'); | |
| 44 | my $uid = $userinfo->{user_id}; | |
| 45 | $uid =~ s/[^0-9]//g; | |
| 46 | ||
| 47 | my $tab = lc($form->{tab} || 'overview'); | |
| 48 | $tab =~ s/[^a-z]//g; | |
| 49 | $tab = 'overview' unless $tab =~ /^(overview|channels|buyers|products|tax)$/; | |
| 50 | ||
| 51 | my $dbh = $db->db_connect(); | |
| 52 | ||
| 53 | # Find this user's storefronts -- everything aggregates across them. | |
| 54 | my @sf_rows = $db->db_readwrite_multiple($dbh, | |
| 55 | qq~SELECT id, name FROM `${DB}`.storefronts WHERE user_id='$uid'~, | |
| 56 | $ENV{SCRIPT_NAME}, __LINE__); | |
| 57 | my @sids = map { $_->{id} } @sf_rows; | |
| 58 | my $sids_sql = scalar(@sids) ? join(',', map { "'$_'" } @sids) : "'0'"; | |
| 59 | my $has_storefront = scalar(@sids) ? 1 : 0; | |
| 60 | ||
| 61 | #----------------------------------------------------------------- | |
| 62 | # Small SQL helper. Returns the scalar field `n` from a one-row query | |
| 63 | # (or 0 if the table doesn't exist / no rows). Wrapped in eval so a | |
| 64 | # missing table doesn't take the whole CGI down. | |
| 65 | #----------------------------------------------------------------- | |
| 66 | sub _n { | |
| 67 | my ($sql) = @_; | |
| 68 | my $r; | |
| 69 | eval { $r = $db->db_readwrite($dbh, $sql, $ENV{SCRIPT_NAME}, __LINE__); 1 }; | |
| 70 | return ($r && defined $r->{n}) ? $r->{n} : 0; | |
| 71 | } | |
| 72 | ||
| 73 | # Pre-check optional tables so missing-migration installs don't 500. | |
| 74 | my $has_orders = _n(qq~SELECT COUNT(*) AS n FROM information_schema.tables | |
| 75 | WHERE table_schema='$DB' AND table_name='orders'~); | |
| 76 | my $has_order_items = _n(qq~SELECT COUNT(*) AS n FROM information_schema.tables | |
| 77 | WHERE table_schema='$DB' AND table_name='order_items'~); | |
| 78 | ||
| 79 | #================================================================= | |
| 80 | # OVERVIEW tab data | |
| 81 | #================================================================= | |
| 82 | my $rev_today_cents = 0; | |
| 83 | my $rev_mtd_cents = 0; | |
| 84 | my $rev_30d_cents = 0; | |
| 85 | my $rev_prev30_cents = 0; | |
| 86 | my $orders_today = 0; | |
| 87 | my $orders_mtd = 0; | |
| 88 | my $orders_30d = 0; | |
| 89 | my $aov_cents = 0; | |
| 90 | ||
| 91 | if ($tab eq 'overview' && $has_orders && $has_storefront) { | |
| 92 | $rev_today_cents = _n(qq~SELECT COALESCE(SUM(total_amount_cents),0) AS n | |
| 93 | FROM `${DB}`.orders | |
| 94 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 95 | AND DATE(paid_at) = CURDATE()~); | |
| 96 | $rev_mtd_cents = _n(qq~SELECT COALESCE(SUM(total_amount_cents),0) AS n | |
| 97 | FROM `${DB}`.orders | |
| 98 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 99 | AND paid_at >= DATE_FORMAT(CURDATE(), '%Y-%m-01')~); | |
| 100 | $rev_30d_cents = _n(qq~SELECT COALESCE(SUM(total_amount_cents),0) AS n | |
| 101 | FROM `${DB}`.orders | |
| 102 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 103 | AND paid_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)~); | |
| 104 | $rev_prev30_cents = _n(qq~SELECT COALESCE(SUM(total_amount_cents),0) AS n | |
| 105 | FROM `${DB}`.orders | |
| 106 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 107 | AND paid_at >= DATE_SUB(NOW(), INTERVAL 60 DAY) | |
| 108 | AND paid_at < DATE_SUB(NOW(), INTERVAL 30 DAY)~); | |
| 109 | $orders_today = _n(qq~SELECT COUNT(*) AS n FROM `${DB}`.orders | |
| 110 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 111 | AND DATE(paid_at) = CURDATE()~); | |
| 112 | $orders_mtd = _n(qq~SELECT COUNT(*) AS n FROM `${DB}`.orders | |
| 113 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 114 | AND paid_at >= DATE_FORMAT(CURDATE(), '%Y-%m-01')~); | |
| 115 | $orders_30d = _n(qq~SELECT COUNT(*) AS n FROM `${DB}`.orders | |
| 116 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 117 | AND paid_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)~); | |
| 118 | $aov_cents = $orders_30d ? int($rev_30d_cents / $orders_30d) : 0; | |
| 119 | } | |
| 120 | ||
| 121 | # Recent sales feed for the Overview tab. One row per paid order with | |
| 122 | # the buyer label, what they bought, and the amount. GROUP_CONCAT in | |
| 123 | # the items subquery keeps it to a single query instead of N+1. | |
| 124 | my @recent_sales; | |
| 125 | if ($tab eq 'overview' && $has_orders && $has_storefront) { | |
| 126 | my $items_join = $has_order_items | |
| 127 | ? qq~(SELECT GROUP_CONCAT(m.title ORDER BY oi.id SEPARATOR ', ') | |
| 128 | FROM `${DB}`.order_items oi | |
| 129 | JOIN `${DB}`.models m ON m.id = oi.model_id | |
| 130 | WHERE oi.order_id = o.id) AS items_titles, | |
| 131 | (SELECT SUM(oi2.quantity) FROM `${DB}`.order_items oi2 WHERE oi2.order_id = o.id) AS item_count,~ | |
| 132 | : qq~'' AS items_titles, 0 AS item_count,~; | |
| 133 | @recent_sales = $db->db_readwrite_multiple($dbh, qq~ | |
| 134 | SELECT o.id, o.buyer_email, o.total_amount_cents, o.currency, o.paid_at, | |
| 135 | b.display_name AS buyer_name, | |
| 136 | $items_join | |
| 137 | 1 AS keep | |
| 138 | FROM `${DB}`.orders o | |
| 139 | LEFT JOIN `${DB}`.buyer_accounts b ON b.id = o.buyer_account_id | |
| 140 | WHERE o.storefront_id IN ($sids_sql) AND o.status='paid' | |
| 141 | ORDER BY o.paid_at DESC | |
| 142 | LIMIT 30 | |
| 143 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 144 | } | |
| 145 | ||
| 146 | my @recent_sale_rows; | |
| 147 | foreach my $r (@recent_sales) { | |
| 148 | my $email = $r->{buyer_email} || ''; | |
| 149 | my $name = $r->{buyer_name} || ''; | |
| 150 | my $buyer = length($name) ? $name : $email; | |
| 151 | my $items = $r->{items_titles} || '(item info unavailable)'; | |
| 152 | my $count = $r->{item_count} || 0; | |
| 153 | my $items_short = $items; | |
| 154 | # Truncate long concat for the table; keep full text in a tooltip. | |
| 155 | if (length($items_short) > 80) { | |
| 156 | $items_short = substr($items_short, 0, 77) . '...'; | |
| 157 | } | |
| 158 | my $when = $r->{paid_at} || ''; | |
| 159 | $when =~ s/T/ /; $when =~ s/\.\d+$//; | |
| 160 | push @recent_sale_rows, { | |
| 161 | date => _h($when), | |
| 162 | buyer_safe => _h($buyer), | |
| 163 | buyer_email => _h($email), | |
| 164 | items_safe => _h($items_short), | |
| 165 | items_full => _h($items), | |
| 166 | item_count => $count, | |
| 167 | amount => '$' . sprintf('%.2f', ($r->{total_amount_cents} || 0) / 100), | |
| 168 | }; | |
| 169 | } | |
| 170 | ||
| 171 | my $delta_pct = 0; | |
| 172 | if ($rev_prev30_cents > 0) { | |
| 173 | $delta_pct = int((($rev_30d_cents - $rev_prev30_cents) / $rev_prev30_cents) * 100 + 0.5); | |
| 174 | } | |
| 175 | my $delta_dir_up = ($delta_pct > 0) ? 1 : 0; | |
| 176 | my $delta_dir_down = ($delta_pct < 0) ? 1 : 0; | |
| 177 | ||
| 178 | # 30-day daily series for the Overview + Channels tabs' KPI modal | |
| 179 | # mini-charts. Each point: {date, revenue_cents, revenue, orders}. | |
| 180 | my @daily_sales; | |
| 181 | if (($tab eq 'overview' || $tab eq 'channels') && $has_orders && $has_storefront) { | |
| 182 | my %by_date; | |
| 183 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 184 | SELECT DATE(paid_at) AS d, | |
| 185 | COALESCE(SUM(total_amount_cents),0) AS rev_cents, | |
| 186 | COUNT(*) AS orders | |
| 187 | FROM `${DB}`.orders | |
| 188 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 189 | AND paid_at >= DATE_SUB(CURDATE(), INTERVAL 30 DAY) | |
| 190 | GROUP BY DATE(paid_at) | |
| 191 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 192 | foreach my $r (@rows) { $by_date{$r->{d} || ''} = $r; } | |
| 193 | my $now = time; | |
| 194 | for (my $i = 29; $i >= 0; $i--) { | |
| 195 | my @t = localtime($now - $i * 86400); | |
| 196 | my $ymd = sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]); | |
| 197 | my $r = $by_date{$ymd} || {}; | |
| 198 | push @daily_sales, { | |
| 199 | date => $ymd, | |
| 200 | revenue_cents => $r->{rev_cents} || 0, | |
| 201 | revenue => int(($r->{rev_cents} || 0) / 100), | |
| 202 | orders => $r->{orders} || 0, | |
| 203 | }; | |
| 204 | } | |
| 205 | } | |
| 206 | ||
| 207 | # 30-day daily NEW-BUYER series for the Buyers tab. Each point shows how | |
| 208 | # many distinct first-time buyer_emails purchased on that date. | |
| 209 | my @daily_buyers; | |
| 210 | if ($tab eq 'buyers' && $has_orders && $has_storefront) { | |
| 211 | my %by_date; | |
| 212 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 213 | SELECT DATE(o1.paid_at) AS d, COUNT(DISTINCT o1.buyer_email) AS n | |
| 214 | FROM `${DB}`.orders o1 | |
| 215 | WHERE o1.storefront_id IN ($sids_sql) AND o1.status='paid' | |
| 216 | AND o1.paid_at >= DATE_SUB(CURDATE(), INTERVAL 30 DAY) | |
| 217 | AND NOT EXISTS ( | |
| 218 | SELECT 1 FROM `${DB}`.orders o2 | |
| 219 | WHERE o2.buyer_email = o1.buyer_email | |
| 220 | AND o2.storefront_id IN ($sids_sql) | |
| 221 | AND o2.status='paid' | |
| 222 | AND o2.paid_at < o1.paid_at | |
| 223 | ) | |
| 224 | GROUP BY DATE(o1.paid_at) | |
| 225 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 226 | foreach my $r (@rows) { $by_date{$r->{d} || ''} = $r; } | |
| 227 | my $now = time; | |
| 228 | for (my $i = 29; $i >= 0; $i--) { | |
| 229 | my @t = localtime($now - $i * 86400); | |
| 230 | my $ymd = sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]); | |
| 231 | my $r = $by_date{$ymd} || {}; | |
| 232 | push @daily_buyers, { | |
| 233 | date => $ymd, | |
| 234 | new_buyers => $r->{n} || 0, | |
| 235 | }; | |
| 236 | } | |
| 237 | } | |
| 238 | ||
| 239 | #================================================================= | |
| 240 | # CHANNELS tab data | |
| 241 | #================================================================= | |
| 242 | my @channels; | |
| 243 | if ($tab eq 'channels' && $has_storefront) { | |
| 244 | # The seller's own webstls.com storefront(s) -- direct sales. | |
| 245 | my $own_rev = 0; | |
| 246 | my $own_orders = 0; | |
| 247 | if ($has_orders) { | |
| 248 | $own_rev = _n(qq~SELECT COALESCE(SUM(total_amount_cents),0) AS n | |
| 249 | FROM `${DB}`.orders WHERE storefront_id IN ($sids_sql) | |
| 250 | AND status='paid' AND paid_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)~); | |
| 251 | $own_orders = _n(qq~SELECT COUNT(*) AS n FROM `${DB}`.orders | |
| 252 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 253 | AND paid_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)~); | |
| 254 | } | |
| 255 | push @channels, { | |
| 256 | slug => 'webstls', | |
| 257 | name => 'WebSTLs storefront', | |
| 258 | is_live => 1, | |
| 259 | is_awaiting => 0, | |
| 260 | revenue => '$' . sprintf('%.2f', $own_rev / 100), | |
| 261 | revenue_cents=> $own_rev, | |
| 262 | orders => $own_orders, | |
| 263 | fee_pct => '0%', | |
| 264 | icon => 'W', | |
| 265 | kpi_detail => _kpi_detail_json( | |
| 266 | 'WebSTLs storefront . last 30 days', | |
| 267 | 'Direct sales through your branded storefront on WebSTLs. These are the orders where the buyer found you on a webstls.com subdomain (or your custom domain) and checked out through your own storefront.', | |
| 268 | qq~<code>SUM(orders.total_amount_cents) WHERE storefront_id IN (your storefronts) AND status='paid' AND paid_at >= NOW() - INTERVAL 30 DAY</code>. Storefront orders carry a 0% platform fee -- 100% of the revenue is yours.~, | |
| 269 | 'The highest-margin channel because there is no marketplace cut. Storefront traffic also lets you A/B test prices and pages, so push your most profitable models here when you can. Use the Traffic Statistics page to see how visitors are finding your storefront.', | |
| 270 | { seriesGlobal => 'SALES_DAILY_SERIES', seriesKey => 'revenue', chartColor => '#22c55e', chartLabel => 'Revenue ($)', chartTitle => 'Daily revenue, last 30 days' }, | |
| 271 | ), | |
| 272 | }; | |
| 273 | ||
| 274 | # Connected marketplace accounts. Per-platform real revenue data | |
| 275 | # arrives once each adapter implements a sales fetcher; for now | |
| 276 | # the connection row is enough to show the channel exists. | |
| 277 | my @mp_accts; | |
| 278 | my $has_mp_tbl = _n(qq~SELECT COUNT(*) AS n FROM information_schema.tables | |
| 279 | WHERE table_schema='$DB' AND table_name='marketplace_accounts'~); | |
| 280 | if ($has_mp_tbl) { | |
| 281 | @mp_accts = $db->db_readwrite_multiple($dbh, qq~ | |
| 282 | SELECT platform, status, account_handle | |
| 283 | FROM `${DB}`.marketplace_accounts | |
| 284 | WHERE user_id='$uid' | |
| 285 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 286 | } | |
| 287 | foreach my $a (@mp_accts) { | |
| 288 | my $p = $mp->by_slug($a->{platform}); | |
| 289 | my $name = ($p && $p->{name}) || ucfirst($a->{platform} || 'Marketplace'); | |
| 290 | my $fees = ($p && $p->{fees}) || 'platform fees vary by listing type'; | |
| 291 | my $sells = ($p && $p->{sells}) || ''; | |
| 292 | push @channels, { | |
| 293 | slug => $a->{platform}, | |
| 294 | name => $name, | |
| 295 | is_live => 0, | |
| 296 | is_awaiting => 1, | |
| 297 | revenue => '$0.00', | |
| 298 | revenue_cents=> 0, | |
| 299 | orders => 0, | |
| 300 | fee_pct => ($p && $p->{fees}) || '', | |
| 301 | icon => ($p && $p->{icon}) || uc(substr($a->{platform} || 'M', 0, 1)), | |
| 302 | kpi_detail => _kpi_detail_json( | |
| 303 | $name . ' . awaiting sales adapter', | |
| 304 | 'You have connected a ' . $name . ' account, but the sales-data adapter for this marketplace is not yet pulling order history. The card appears here so you can see the connection is live; the revenue and order counts will populate once the adapter ships. ' . ($sells ? 'This platform: ' . $sells : ''), | |
| 305 | 'Connection lives in <code>marketplace_accounts WHERE platform='' . $a->{platform} . '' AND user_id=(you)</code>. Once the per-platform sales fetcher is implemented, paid orders will flow into the <code>orders</code> table tagged with this platform and start populating the revenue here.', | |
| 306 | 'Each marketplace has a different fee structure (' . $fees . '), so per-channel revenue and AOV vary. Comparing AOV across channels in this tab tells you which marketplaces drive your highest-value buyers.', | |
| 307 | ), | |
| 308 | }; | |
| 309 | } | |
| 310 | } | |
| 311 | my $channel_count = scalar @channels; | |
| 312 | ||
| 313 | #================================================================= | |
| 314 | # BUYERS tab data (lifted from old audience.cgi, lightly cleaned) | |
| 315 | #================================================================= | |
| 316 | my $total_buyers = 0; | |
| 317 | my $repeat_buyers = 0; | |
| 318 | my $new_30d_buyers = 0; | |
| 319 | my $seg_recent = 0; | |
| 320 | my $seg_lapsed = 0; | |
| 321 | my @top_buyers; | |
| 322 | if ($tab eq 'buyers' && $has_orders && $has_storefront) { | |
| 323 | $total_buyers = _n(qq~SELECT COUNT(DISTINCT buyer_email) AS n | |
| 324 | FROM `${DB}`.orders WHERE storefront_id IN ($sids_sql) AND status='paid'~); | |
| 325 | $repeat_buyers = _n(qq~SELECT COUNT(*) AS n FROM ( | |
| 326 | SELECT buyer_email FROM `${DB}`.orders | |
| 327 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 328 | GROUP BY buyer_email HAVING COUNT(*) >= 3 | |
| 329 | ) t~); | |
| 330 | $new_30d_buyers = _n(qq~SELECT COUNT(DISTINCT buyer_email) AS n | |
| 331 | FROM `${DB}`.orders o1 | |
| 332 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 333 | AND created_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 334 | AND NOT EXISTS (SELECT 1 FROM `${DB}`.orders o2 | |
| 335 | WHERE o2.buyer_email=o1.buyer_email | |
| 336 | AND o2.storefront_id IN ($sids_sql) | |
| 337 | AND o2.status='paid' | |
| 338 | AND o2.created_at < DATE_SUB(NOW(), INTERVAL 30 DAY))~); | |
| 339 | $seg_recent = _n(qq~SELECT COUNT(DISTINCT buyer_email) AS n | |
| 340 | FROM `${DB}`.orders WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 341 | AND created_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)~); | |
| 342 | $seg_lapsed = _n(qq~SELECT COUNT(*) AS n FROM ( | |
| 343 | SELECT buyer_email, MAX(created_at) AS last_seen | |
| 344 | FROM `${DB}`.orders WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 345 | GROUP BY buyer_email HAVING last_seen < DATE_SUB(NOW(), INTERVAL 90 DAY) | |
| 346 | ) t~); | |
| 347 | @top_buyers = $db->db_readwrite_multiple($dbh, qq~ | |
| 348 | SELECT buyer_email, COUNT(*) AS orders, | |
| 349 | SUM(total_amount_cents) AS ltv_cents, | |
| 350 | MAX(created_at) AS last_seen | |
| 351 | FROM `${DB}`.orders | |
| 352 | WHERE storefront_id IN ($sids_sql) AND status='paid' | |
| 353 | GROUP BY buyer_email | |
| 354 | ORDER BY ltv_cents DESC | |
| 355 | LIMIT 20 | |
| 356 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 357 | foreach my $b (@top_buyers) { | |
| 358 | my $email = $b->{buyer_email} || ''; | |
| 359 | my $local = $email; $local =~ s/\@.*$//; | |
| 360 | my @parts = split /[._\-+]/, $local; | |
| 361 | my $init = uc(substr($parts[0] || $local, 0, 1)); | |
| 362 | $init .= uc(substr($parts[1] || '', 0, 1)) if @parts > 1; | |
| 363 | $b->{initials} = $init || '?'; | |
| 364 | $b->{email_safe} = _h($email); | |
| 365 | $b->{ltv} = '$' . sprintf('%.2f', ($b->{ltv_cents} || 0) / 100); | |
| 366 | $b->{last_seen_pretty} = $b->{last_seen} || '-'; | |
| 367 | } | |
| 368 | } | |
| 369 | ||
| 370 | #================================================================= | |
| 371 | # PRODUCTS tab data (top-selling by revenue + units across orders) | |
| 372 | #================================================================= | |
| 373 | my @top_products; | |
| 374 | if ($tab eq 'products' && $has_storefront && $has_order_items) { | |
| 375 | @top_products = $db->db_readwrite_multiple($dbh, qq~ | |
| 376 | SELECT m.id, m.title, m.slug, m.hero_image_url, | |
| 377 | COUNT(DISTINCT oi.order_id) AS orders, | |
| 378 | SUM(oi.quantity) AS units, | |
| 379 | SUM(oi.price_paid_cents * oi.quantity) AS revenue_cents | |
| 380 | FROM `${DB}`.order_items oi | |
| 381 | JOIN `${DB}`.orders o ON o.id = oi.order_id | |
| 382 | JOIN `${DB}`.models m ON m.id = oi.model_id | |
| 383 | WHERE o.storefront_id IN ($sids_sql) AND o.status='paid' | |
| 384 | GROUP BY m.id, m.title, m.slug, m.hero_image_url | |
| 385 | ORDER BY revenue_cents DESC | |
| 386 | LIMIT 20 | |
| 387 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 388 | foreach my $p (@top_products) { | |
| 389 | $p->{title_safe} = _h($p->{title} || 'Untitled'); | |
| 390 | $p->{revenue} = '$' . sprintf('%.2f', ($p->{revenue_cents} || 0) / 100); | |
| 391 | $p->{hero} = $p->{hero_image_url} || '/assets/no-cover.svg'; | |
| 392 | } | |
| 393 | } | |
| 394 | ||
| 395 | # Tax tab data -- per-jurisdiction tax collected on this seller's | |
| 396 | # orders. Visible-only to the seller; the platform handles | |
| 397 | # collection + remittance under the marketplace-facilitator model. | |
| 398 | my @tax_breakdown_rows; | |
| 399 | my ($tax_total_cents, $tax_total_orders) = (0, 0); | |
| 400 | my $seller_tax_mode = 'platform_collects'; | |
| 401 | if ($has_storefront && $tab eq 'tax') { | |
| 402 | # Guarded -- order_tax_lines may not exist yet on un-migrated DBs. | |
| 403 | my $col = $db->db_readwrite($dbh, qq~ | |
| 404 | SELECT COUNT(*) AS n FROM information_schema.tables | |
| 405 | WHERE table_schema='$DB' AND table_name='order_tax_lines' | |
| 406 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 407 | if ($col && $col->{n}) { | |
| 408 | my @br = $db->db_readwrite_multiple($dbh, qq~ | |
| 409 | SELECT otl.country_iso2, otl.region_code, otl.jurisdiction_label, | |
| 410 | otl.tax_type, otl.rate_pct, | |
| 411 | COUNT(DISTINCT otl.order_id) AS n_orders, | |
| 412 | SUM(otl.taxable_amount_cents) AS taxable_cents, | |
| 413 | SUM(otl.tax_amount_cents) AS tax_cents | |
| 414 | FROM `${DB}`.order_tax_lines otl | |
| 415 | JOIN `${DB}`.orders o ON o.id = otl.order_id | |
| 416 | WHERE o.status='paid' | |
| 417 | AND o.storefront_id IN ($sids_sql) | |
| 418 | GROUP BY otl.country_iso2, otl.region_code, otl.jurisdiction_label, otl.tax_type, otl.rate_pct | |
| 419 | ORDER BY tax_cents DESC | |
| 420 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 421 | foreach my $r (@br) { | |
| 422 | $tax_total_cents += ($r->{tax_cents} || 0); | |
| 423 | $tax_total_orders += ($r->{n_orders} || 0); | |
| 424 | push @tax_breakdown_rows, { | |
| 425 | country => _h($r->{country_iso2}), | |
| 426 | region => _h($r->{region_code} || ''), | |
| 427 | label => _h($r->{jurisdiction_label}), | |
| 428 | type => _h(uc $r->{tax_type}), | |
| 429 | rate => sprintf('%.2f', $r->{rate_pct}), | |
| 430 | orders => $r->{n_orders} || 0, | |
| 431 | taxable => '$' . sprintf('%.2f', ($r->{taxable_cents} || 0) / 100), | |
| 432 | tax => '$' . sprintf('%.2f', ($r->{tax_cents} || 0) / 100), | |
| 433 | }; | |
| 434 | } | |
| 435 | } | |
| 436 | # Pull this storefront's tax_mode for the banner. | |
| 437 | my $sf_mode_row = $db->db_readwrite($dbh, qq~ | |
| 438 | SELECT tax_mode FROM `${DB}`.storefronts WHERE id='$sids[0]' LIMIT 1 | |
| 439 | ~, $ENV{SCRIPT_NAME}, __LINE__) if @sids; | |
| 440 | $seller_tax_mode = ($sf_mode_row && $sf_mode_row->{tax_mode}) || 'platform_collects'; | |
| 441 | } | |
| 442 | ||
| 443 | $db->db_disconnect($dbh); | |
| 444 | ||
| 445 | #================================================================= | |
| 446 | # Build template vars | |
| 447 | #================================================================= | |
| 448 | my $tvars = { | |
| 449 | tab_overview => ($tab eq 'overview') ? 1 : 0, | |
| 450 | tab_channels => ($tab eq 'channels') ? 1 : 0, | |
| 451 | tab_buyers => ($tab eq 'buyers') ? 1 : 0, | |
| 452 | tab_products => ($tab eq 'products') ? 1 : 0, | |
| 453 | tab_tax => ($tab eq 'tax') ? 1 : 0, | |
| 454 | ||
| 455 | has_storefront => $has_storefront, | |
| 456 | has_orders => $has_orders, | |
| 457 | ||
| 458 | # Overview | |
| 459 | recent_sales => \@recent_sale_rows, | |
| 460 | has_recent_sales => scalar(@recent_sale_rows) ? 1 : 0, | |
| 461 | rev_today => '$' . sprintf('%.2f', $rev_today_cents / 100), | |
| 462 | rev_mtd => '$' . sprintf('%.2f', $rev_mtd_cents / 100), | |
| 463 | rev_30d => '$' . sprintf('%.2f', $rev_30d_cents / 100), | |
| 464 | aov => '$' . sprintf('%.2f', $aov_cents / 100), | |
| 465 | orders_today => $orders_today, | |
| 466 | orders_mtd => $orders_mtd, | |
| 467 | orders_30d => $orders_30d, | |
| 468 | delta_pct => abs($delta_pct), | |
| 469 | delta_dir_up => $delta_dir_up, | |
| 470 | delta_dir_down => $delta_dir_down, | |
| 471 | has_delta => ($rev_prev30_cents > 0) ? 1 : 0, | |
| 472 | ||
| 473 | # Channels | |
| 474 | channels => \@channels, | |
| 475 | channel_count => $channel_count, | |
| 476 | has_channels => $channel_count ? 1 : 0, | |
| 477 | ||
| 478 | # Buyers | |
| 479 | total_buyers => $total_buyers, | |
| 480 | new_30d_buyers => $new_30d_buyers, | |
| 481 | repeat_buyers => $repeat_buyers, | |
| 482 | seg_recent => $seg_recent, | |
| 483 | seg_lapsed => $seg_lapsed, | |
| 484 | top_buyers => \@top_buyers, | |
| 485 | has_top_buyers => scalar(@top_buyers) ? 1 : 0, | |
| 486 | ||
| 487 | # Products | |
| 488 | top_products => \@top_products, | |
| 489 | has_top_products=> scalar(@top_products) ? 1 : 0, | |
| 490 | ||
| 491 | # Daily series feeding the KPI-modal area charts | |
| 492 | daily_sales_json => _to_json_array(\@daily_sales), | |
| 493 | has_daily_sales => scalar(@daily_sales) ? 1 : 0, | |
| 494 | daily_buyers_json => _to_json_array(\@daily_buyers), | |
| 495 | has_daily_buyers => scalar(@daily_buyers) ? 1 : 0, | |
| 496 | ||
| 497 | # Tax | |
| 498 | tax_rows => \@tax_breakdown_rows, | |
| 499 | has_tax_rows => scalar(@tax_breakdown_rows) ? 1 : 0, | |
| 500 | tax_total => '$' . sprintf('%.2f', $tax_total_cents / 100), | |
| 501 | tax_total_orders => $tax_total_orders, | |
| 502 | seller_tax_mode => _h($seller_tax_mode), | |
| 503 | mode_is_platform => ($seller_tax_mode eq 'platform_collects') ? 1 : 0, | |
| 504 | mode_is_self => ($seller_tax_mode eq 'seller_handles') ? 1 : 0, | |
| 505 | }; | |
| 506 | ||
| 507 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n"; | |
| 508 | ||
| 509 | my $body = join('', $tfile->template('webstls_sales_reports.html', $tvars, $userinfo)); | |
| 510 | ||
| 511 | $wrap->render({ | |
| 512 | userinfo => $userinfo, | |
| 513 | page_key => 'sales_reports', | |
| 514 | title => 'Sales reports', | |
| 515 | body => $body, | |
| 516 | extra_js => ['/assets/javascript/graphs.js'], | |
| 517 | }); | |
| 518 | exit; | |
| 519 | ||
| 520 | # Builds a JSON string for the data-kpi-detail attribute. The attribute | |
| 521 | # is single-quoted in the template, so we strip single quotes from values | |
| 522 | # and replace " with the HTML escape so it survives both JSON parsing and | |
| 523 | # attribute boundary. Used by graphs.js wireKpiCards() to open a modal. | |
| 524 | # The optional 5th arg is a hashref of chart fields (seriesGlobal, | |
| 525 | # seriesKey, chartColor, chartLabel, chartTitle) merged into the JSON. | |
| 526 | sub _kpi_detail_json { | |
| 527 | my ($eyebrow, $description, $methodology, $interpretation, $chart) = @_; | |
| 528 | my @pairs_in = ( | |
| 529 | [ 'eyebrow', $eyebrow ], | |
| 530 | [ 'description', $description ], | |
| 531 | [ 'methodology', $methodology ], | |
| 532 | [ 'interpretation', $interpretation ], | |
| 533 | ); | |
| 534 | if (ref($chart) eq 'HASH') { | |
| 535 | foreach my $k (qw(seriesGlobal seriesKey chartColor chartLabel chartTitle)) { | |
| 536 | push @pairs_in, [ $k, $chart->{$k} ] if defined $chart->{$k}; | |
| 537 | } | |
| 538 | } | |
| 539 | my @parts; | |
| 540 | foreach my $pair (@pairs_in) { | |
| 541 | my $v = defined $pair->[1] ? $pair->[1] : ''; | |
| 542 | $v =~ s/\\/\\\\/g; | |
| 543 | $v =~ s/"/"/g; # HTML-escape so it survives the attribute | |
| 544 | $v =~ s/'/'/g; | |
| 545 | $v =~ s/\r?\n/ /g; | |
| 546 | push @parts, '"' . $pair->[0] . '":"' . $v . '"'; | |
| 547 | } | |
| 548 | return '{' . join(',', @parts) . '}'; | |
| 549 | } | |
| 550 | ||
| 551 | # JSON encoder for the daily-series payloads. Matches the helper used | |
| 552 | # in admin_visitors.cgi / traffic_reports.cgi -- emits an array of flat | |
| 553 | # objects, safe for inline <script> insertion (the </ sequence is escaped). | |
| 554 | sub _to_json_array { | |
| 555 | my ($aref) = @_; | |
| 556 | $aref ||= []; | |
| 557 | my @out; | |
| 558 | foreach my $row (@$aref) { | |
| 559 | my @pairs; | |
| 560 | foreach my $k (sort keys %$row) { | |
| 561 | push @pairs, _json_str($k) . ':' . _json_value($row->{$k}); | |
| 562 | } | |
| 563 | push @out, '{' . join(',', @pairs) . '}'; | |
| 564 | } | |
| 565 | return '[' . join(',', @out) . ']'; | |
| 566 | } | |
| 567 | sub _json_value { | |
| 568 | my ($v) = @_; | |
| 569 | return 'null' unless defined $v; | |
| 570 | if (ref($v) eq '') { | |
| 571 | if ($v =~ /^-?(?:\d+\.?\d*|\.\d+)$/) { return $v + 0; } | |
| 572 | return _json_str($v); | |
| 573 | } | |
| 574 | return 'null'; | |
| 575 | } | |
| 576 | sub _json_str { | |
| 577 | my ($s) = @_; | |
| 578 | $s = '' unless defined $s; | |
| 579 | $s =~ s/\\/\\\\/g; $s =~ s/"/\\"/g; | |
| 580 | $s =~ s/\r/\\r/g; $s =~ s/\n/\\n/g; $s =~ s/\t/\\t/g; | |
| 581 | $s =~ s|</|<\\/|g; | |
| 582 | return '"' . $s . '"'; | |
| 583 | } | |
| 584 | ||
| 585 | sub _h { | |
| 586 | my $s = shift; $s = '' unless defined $s; | |
| 587 | $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; | |
| 588 | $s =~ s/"/"/g; $s =~ s/'/'/g; | |
| 589 | return $s; | |
| 590 | } |