added on local at 2026-07-01 22:09:34
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # ShopCart - Run your 3D creator business like an operator | |
| 4 | # Page body lives in TEMPLATES/shopcart_index.html | |
| 5 | # | |
| 6 | # Pricing block on this page pulls from billing_plans so it stays in | |
| 7 | # lockstep with /pricing.cgi and the admin Packages console. Falls | |
| 8 | # back to a built-in 4-tier list if the billing schema hasn't been | |
| 9 | # migrated yet. | |
| 10 | # | |
| 11 | # Consolidates the 8 small marketing-page CGIs via SCRIPT_NAME dispatch: | |
| 12 | # about.cgi contact.cgi faq.cgi features.cgi help.cgi privacy.cgi | |
| 13 | # terms.cgi why.cgi | |
| 14 | # Each of those becomes a wrapper that `do`'s this file. This file also | |
| 15 | # still serves /index.cgi (the landing page) with its dashboard redirect | |
| 16 | # for logged-in users. | |
| 17 | #====================================================================== | |
| 18 | use strict; | |
| 19 | use warnings; | |
| 20 | ||
| 21 | use lib '/var/www/vhosts/3dshawn.com/shop.3dshawn.com'; | |
| 22 | use CGI; | |
| 23 | use MODS::Template; | |
| 24 | use MODS::DBConnect; | |
| 25 | use MODS::Login; | |
| 26 | use MODS::ShopCart::Config; | |
| 27 | use MODS::ShopCart::Wrapper; | |
| 28 | use MODS::ShopCart::Billing; | |
| 29 | use MODS::ShopCart::Promotions; | |
| 30 | ||
| 31 | my $q = CGI->new; | |
| 32 | my $form = $q->Vars; | |
| 33 | my $auth = MODS::Login->new; | |
| 34 | my $wrap = MODS::ShopCart::Wrapper->new; | |
| 35 | my $tfile = MODS::Template->new; | |
| 36 | my $db = MODS::DBConnect->new; | |
| 37 | my $cfg = MODS::ShopCart::Config->new; | |
| 38 | my $bill = MODS::ShopCart::Billing->new; | |
| 39 | my $DB = $cfg->settings('database_name'); | |
| 40 | ||
| 41 | $|=1; | |
| 42 | my $userinfo = $auth->login_verify(); # may be undef on marketing pages | |
| 43 | ||
| 44 | my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'index'; | |
| 45 | ||
| 46 | # ---- Marketing-page dispatch (all use the small template pattern) ---- | |
| 47 | # Each entry maps to { template, title, requires_login }. | |
| 48 | my %MKT = ( | |
| 49 | about => { template => 'shopcart_about.html', title => 'About', login => 0 }, | |
| 50 | contact => { template => 'shopcart_contact.html', title => 'Contact', login => 0 }, | |
| 51 | faq => { template => 'shopcart_faq.html', title => 'FAQ', login => 0 }, | |
| 52 | features => { template => 'shopcart_features.html', title => 'Features', login => 0 }, | |
| 53 | help => { template => 'shopcart_help.html', title => 'Help', login => 1 }, | |
| 54 | privacy => { template => 'shopcart_privacy.html', title => 'Privacy Policy', login => 0 }, | |
| 55 | terms => { template => 'shopcart_terms.html', title => 'Terms of Service', login => 0 }, | |
| 56 | why => { template => 'shopcart_why.html', title => 'Why ShopCart', login => 0 }, | |
| 57 | ); | |
| 58 | ||
| 59 | if (my $mkt = $MKT{$entry}) { | |
| 60 | _mkt_render($mkt); | |
| 61 | exit; | |
| 62 | } | |
| 63 | ||
| 64 | # ---- index.cgi (default) -------------------------------------------- | |
| 65 | # Signed-in users always land on the in-app dashboard, never the | |
| 66 | # marketing index. | |
| 67 | if ($userinfo && $userinfo->{user_id}) { | |
| 68 | print "Status: 302 Found\nLocation: /dashboard.cgi\n\n"; | |
| 69 | exit; | |
| 70 | } | |
| 71 | ||
| 72 | my $dbh = $db->db_connect(); | |
| 73 | my @plans = _mkt_build_landing_plan_cards($db, $dbh, $DB, $bill); | |
| 74 | ||
| 75 | # Active plan promo for the marketing banner above the pricing block. | |
| 76 | my $promo_obj = MODS::ShopCart::Promotions->new; | |
| 77 | my $active_promo = $promo_obj->active_plan_promo($db, $dbh, $DB); | |
| 78 | my $promo_code = ($active_promo && $active_promo->{code}) ? $active_promo->{code} : ''; | |
| 79 | my $promo_label = $active_promo ? $promo_obj->marketing_label($active_promo) : ''; | |
| 80 | ||
| 81 | # Per-card eligibility badge (same logic as /pricing.cgi). Cards the | |
| 82 | # active promo doesn't cover (free + plans outside the eligibility | |
| 83 | # set) simply don't render the promo line. | |
| 84 | if ($active_promo) { | |
| 85 | my @eligible = $promo_obj->eligible_plan_ids($db, $dbh, $DB, $active_promo->{id}); | |
| 86 | my %eligible_set = map { $_ => 1 } @eligible; | |
| 87 | my $all_paid = !scalar(@eligible); | |
| 88 | foreach my $c (@plans) { | |
| 89 | next if ($c->{price_display} || '$0') eq '$0'; | |
| 90 | next unless $all_paid || $eligible_set{ $c->{id} || 0 }; | |
| 91 | $c->{promo_active} = 1; | |
| 92 | $c->{promo_code} = $promo_code; | |
| 93 | $c->{promo_label} = $promo_label; | |
| 94 | $c->{promo_card_line} = $promo_label . ' with code <strong>' . $promo_code . '</strong>'; | |
| 95 | } | |
| 96 | } | |
| 97 | ||
| 98 | $db->db_disconnect($dbh); | |
| 99 | ||
| 100 | 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"; | |
| 101 | ||
| 102 | my $tvars = { | |
| 103 | user_id => $userinfo ? $userinfo->{user_id} : '', | |
| 104 | plans => \@plans, | |
| 105 | has_plans => scalar(@plans) ? 1 : 0, | |
| 106 | has_promo => $active_promo ? 1 : 0, | |
| 107 | promo_code => $promo_code, | |
| 108 | promo_label => $promo_label, | |
| 109 | }; | |
| 110 | ||
| 111 | my $body = join('', $tfile->template('shopcart_index.html', $tvars, $userinfo)); | |
| 112 | ||
| 113 | $wrap->render({ | |
| 114 | userinfo => $userinfo, | |
| 115 | title => 'Sell physical products without juggling 5 apps', | |
| 116 | body => $body, | |
| 117 | }); | |
| 118 | ||
| 119 | #---------------------------------------------------------------------- | |
| 120 | # Render a small marketing page (about/contact/faq/features/help/privacy/ | |
| 121 | # terms/why). All follow the same template pattern; help.cgi requires | |
| 122 | # a valid session so we bounce anonymous visitors to /login.cgi. | |
| 123 | sub _mkt_render { | |
| 124 | my ($mkt) = @_; | |
| 125 | if ($mkt->{login} && !$userinfo) { | |
| 126 | print "Status: 302 Found\nLocation: /login.cgi\n\n"; | |
| 127 | return; | |
| 128 | } | |
| 129 | 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"; | |
| 130 | my $body = join('', $tfile->template($mkt->{template}, {}, $userinfo)); | |
| 131 | $wrap->render({ | |
| 132 | userinfo => $userinfo, | |
| 133 | page_key => '', | |
| 134 | title => $mkt->{title}, | |
| 135 | body => $body, | |
| 136 | }); | |
| 137 | return; | |
| 138 | } | |
| 139 | ||
| 140 | #---------------------------------------------------------------------- | |
| 141 | # Compact card shape used by the landing pricing grid (4 cards, one | |
| 142 | # per tier, monthly price). Bullets are pre-rendered to side-step the | |
| 143 | # template engine's nested-loop quirks. | |
| 144 | sub _mkt_build_landing_plan_cards { | |
| 145 | my ($db, $dbh, $DB, $bill) = @_; | |
| 146 | return _mkt_landing_fallback_plans() unless $bill->schema_ready($db, $dbh, $DB); | |
| 147 | ||
| 148 | my @rows = $bill->list_plans($db, $dbh, $DB); | |
| 149 | return _mkt_landing_fallback_plans() unless scalar @rows; | |
| 150 | ||
| 151 | my $entitle_ready = $bill->plan_features_ready($db, $dbh, $DB); | |
| 152 | my @catalog = $bill->feature_catalog; | |
| 153 | ||
| 154 | my %by_tier; | |
| 155 | foreach my $r (@rows) { push @{ $by_tier{ $r->{tier} } }, $r; } | |
| 156 | ||
| 157 | my @tiers_seen; | |
| 158 | foreach my $r (@rows) { | |
| 159 | next if grep { $_ eq $r->{tier} } @tiers_seen; | |
| 160 | push @tiers_seen, $r->{tier}; | |
| 161 | } | |
| 162 | ||
| 163 | my @out; | |
| 164 | foreach my $tier (@tiers_seen) { | |
| 165 | my $monthly = (grep { ($_->{cadence}||'') eq 'monthly' } @{ $by_tier{$tier} })[0] | |
| 166 | || $by_tier{$tier}->[0]; | |
| 167 | next unless $monthly; | |
| 168 | ||
| 169 | # Build a short bullet list. Prefer the marketing copy supplied | |
| 170 | # by the admin; otherwise synthesise from entitlements so the | |
| 171 | # card never renders empty on a fresh install. | |
| 172 | my @bullets = _mkt_parse_features_for_landing($monthly->{features}); | |
| 173 | if (!scalar @bullets && $entitle_ready) { | |
| 174 | my $set = $bill->plan_feature_set($db, $dbh, $DB, $monthly->{id}); | |
| 175 | foreach my $f (@catalog) { | |
| 176 | next unless $set->{ $f->{key} }; | |
| 177 | push @bullets, $f->{name} . ' — ' . $f->{blurb}; | |
| 178 | } | |
| 179 | } | |
| 180 | # Cap to 5 bullets to match the original card visual density. | |
| 181 | @bullets = @bullets[0 .. ( $#bullets > 4 ? 4 : $#bullets )]; | |
| 182 | my $bullets_html = ''; | |
| 183 | foreach my $b (@bullets) { | |
| 184 | $bullets_html .= '<li><svg viewBox="0 0 24 24" fill="none" stroke="currentColor" stroke-width="3">' | |
| 185 | . '<polyline points="20 6 9 17 4 12"/></svg> ' . $b . '</li>'; | |
| 186 | } | |
| 187 | ||
| 188 | my $tier_slug = lc($monthly->{tier} || ''); $tier_slug =~ s/[^a-z0-9_\-]//g; | |
| 189 | ||
| 190 | push @out, { | |
| 191 | id => $monthly->{id}, | |
| 192 | tier => $monthly->{tier}, | |
| 193 | display_name => $monthly->{display_name} || ucfirst($monthly->{tier} || ''), | |
| 194 | price_display => _mkt_fmt_price_short($monthly->{price_cents}), | |
| 195 | is_featured => $monthly->{is_featured} ? 1 : 0, | |
| 196 | not_featured => $monthly->{is_featured} ? 0 : 1, | |
| 197 | tagline => $monthly->{tagline} || '', | |
| 198 | has_tagline => $monthly->{tagline} ? 1 : 0, | |
| 199 | cta_label => $monthly->{cta_label} || ($monthly->{price_cents} ? 'Start trial' : 'Start free'), | |
| 200 | cta_href => $monthly->{price_cents} ? ('signup.cgi?plan=' . $tier_slug) : 'signup.cgi', | |
| 201 | bullets_html => $bullets_html, | |
| 202 | }; | |
| 203 | } | |
| 204 | return @out; | |
| 205 | } | |
| 206 | ||
| 207 | sub _mkt_fmt_price_short { | |
| 208 | my ($cents) = @_; | |
| 209 | $cents = 0 unless defined $cents; | |
| 210 | if ($cents % 100 == 0) { | |
| 211 | return '$' . int($cents / 100); | |
| 212 | } | |
| 213 | return '$' . sprintf('%.2f', $cents / 100); | |
| 214 | } | |
| 215 | ||
| 216 | sub _mkt_parse_features_for_landing { | |
| 217 | my ($raw) = @_; | |
| 218 | return () unless defined $raw && $raw =~ /\S/; | |
| 219 | my @out; | |
| 220 | while ($raw =~ m/\{\s*"name"\s*:\s*"((?:\\.|[^"\\])*)"\s*,\s*"included"\s*:\s*(true|false|0|1)\s*\}/gi) { | |
| 221 | my $name = $1; my $inc = lc $2; | |
| 222 | $name =~ s/\\"/"/g; $name =~ s/\\\\/\\/g; | |
| 223 | # Landing block only shows the positive bullets. | |
| 224 | push @out, $name if $inc eq 'true' || $inc eq '1'; | |
| 225 | } | |
| 226 | return @out; | |
| 227 | } | |
| 228 | ||
| 229 | sub _mkt_landing_fallback_plans { | |
| 230 | my $li = sub { | |
| 231 | my @items = @_; | |
| 232 | my $h = ''; | |
| 233 | foreach my $t (@items) { | |
| 234 | $h .= '<li><svg viewBox="0 0 24 24" fill="none" stroke="currentColor" stroke-width="3">' | |
| 235 | . '<polyline points="20 6 9 17 4 12"/></svg> ' . $t . '</li>'; | |
| 236 | } | |
| 237 | return $h; | |
| 238 | }; | |
| 239 | return ( | |
| 240 | { tier=>'free', display_name=>'Free', price_display=>'$0', | |
| 241 | is_featured=>0, not_featured=>1, | |
| 242 | tagline=>'Stand up your store and start selling.', | |
| 243 | has_tagline=>1, cta_label=>'Start free', cta_href=>'signup.cgi', | |
| 244 | bullets_html => $li->('Up to 50 products', 'Per-file upload up to 25 MB', '1 team seat', '1 active A/B test', '0% platform fee') }, | |
| 245 | { tier=>'pro', display_name=>'Pro', price_display=>'$29', | |
| 246 | is_featured=>1, not_featured=>0, | |
| 247 | tagline=>'Run real experiments on your store.', | |
| 248 | has_tagline=>1, cta_label=>'Start trial', cta_href=>'signup.cgi?plan=pro', | |
| 249 | bullets_html => $li->('Unlimited products', 'Per-file upload up to 500 MB', '5 team seats', '10 A/B + 3 MVT block tests', 'Custom domain') }, | |
| 250 | { tier=>'business',display_name=>'Business',price_display=>'$79', | |
| 251 | is_featured=>0, not_featured=>1, | |
| 252 | tagline=>'Scale without limits.', | |
| 253 | has_tagline=>1, cta_label=>'Start trial', cta_href=>'signup.cgi?plan=business', | |
| 254 | bullets_html => $li->('Everything in Pro', 'Per-file upload up to 5 GB', 'Unlimited team seats', 'Unlimited A/B + MVT', 'White-label checkout') }, | |
| 255 | ); | |
| 256 | } |