added on WebSTLs (webstls.com) at 2026-07-01 22:26:33
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs - Run your 3D creator business like an operator | |
| 4 | # Page body lives in TEMPLATES/webstls_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 | # Also consolidates the simple marketing pages via SCRIPT_NAME | |
| 12 | # dispatch (about, contact, faq, features, help, privacy, terms, | |
| 13 | # why). Each of those .cgi files is a 3-line wrapper that `do`s this | |
| 14 | # file; we look at SCRIPT_NAME and hand off to _mkt_render_page. | |
| 15 | #====================================================================== | |
| 16 | use strict; | |
| 17 | use warnings; | |
| 18 | ||
| 19 | use lib '/var/www/vhosts/webstls.com/httpdocs'; | |
| 20 | use CGI; | |
| 21 | use MODS::Template; | |
| 22 | use MODS::DBConnect; | |
| 23 | use MODS::Login; | |
| 24 | use MODS::WebSTLs::Config; | |
| 25 | use MODS::WebSTLs::Wrapper; | |
| 26 | use MODS::WebSTLs::Billing; | |
| 27 | use MODS::WebSTLs::Promotions; | |
| 28 | ||
| 29 | my $q = CGI->new; | |
| 30 | my $form = $q->Vars; | |
| 31 | my $auth = MODS::Login->new; | |
| 32 | my $wrap = MODS::WebSTLs::Wrapper->new; | |
| 33 | my $tfile = MODS::Template->new; | |
| 34 | my $db = MODS::DBConnect->new; | |
| 35 | my $cfg = MODS::WebSTLs::Config->new; | |
| 36 | my $bill = MODS::WebSTLs::Billing->new; | |
| 37 | my $DB = $cfg->settings('database_name'); | |
| 38 | ||
| 39 | $|=1; | |
| 40 | my $userinfo = $auth->login_verify(); # may be undef on marketing pages | |
| 41 | ||
| 42 | #---------------------------------------------------------------------- | |
| 43 | # SCRIPT_NAME dispatch for consolidated marketing pages. | |
| 44 | #---------------------------------------------------------------------- | |
| 45 | my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'index'; | |
| 46 | ||
| 47 | my %MKT_PAGES = ( | |
| 48 | about => { tmpl => 'webstls_about.html', title => 'About' }, | |
| 49 | contact => { tmpl => 'webstls_contact.html', title => 'Contact' }, | |
| 50 | faq => { tmpl => 'webstls_faq.html', title => 'FAQ' }, | |
| 51 | features => { tmpl => 'webstls_features.html', title => 'Features' }, | |
| 52 | help => { tmpl => 'webstls_help.html', title => 'Help', require_login => 1, page_key => '' }, | |
| 53 | privacy => { tmpl => 'webstls_privacy.html', title => 'Privacy Policy' }, | |
| 54 | terms => { tmpl => 'webstls_terms.html', title => 'Terms of Service' }, | |
| 55 | why => { tmpl => 'webstls_why.html', title => 'Why WebSTLs' }, | |
| 56 | ); | |
| 57 | ||
| 58 | if ($MKT_PAGES{$entry}) { | |
| 59 | _mkt_render_page($MKT_PAGES{$entry}); | |
| 60 | exit; | |
| 61 | } | |
| 62 | ||
| 63 | my $dbh = $db->db_connect(); | |
| 64 | my @plans = _build_landing_plan_cards($db, $dbh, $DB, $bill); | |
| 65 | ||
| 66 | # Active plan promo for the marketing banner above the pricing block. | |
| 67 | my $promo_obj = MODS::WebSTLs::Promotions->new; | |
| 68 | my $active_promo = $promo_obj->active_plan_promo($db, $dbh, $DB); | |
| 69 | my $promo_code = ($active_promo && $active_promo->{code}) ? $active_promo->{code} : ''; | |
| 70 | my $promo_label = $active_promo ? $promo_obj->marketing_label($active_promo) : ''; | |
| 71 | ||
| 72 | # Per-card eligibility badge (same logic as /pricing.cgi). Cards the | |
| 73 | # active promo doesn't cover (free + plans outside the eligibility | |
| 74 | # set) simply don't render the promo line. | |
| 75 | if ($active_promo) { | |
| 76 | my @eligible = $promo_obj->eligible_plan_ids($db, $dbh, $DB, $active_promo->{id}); | |
| 77 | my %eligible_set = map { $_ => 1 } @eligible; | |
| 78 | my $all_paid = !scalar(@eligible); | |
| 79 | foreach my $c (@plans) { | |
| 80 | next if ($c->{price_display} || '$0') eq '$0'; | |
| 81 | next unless $all_paid || $eligible_set{ $c->{id} || 0 }; | |
| 82 | $c->{promo_active} = 1; | |
| 83 | $c->{promo_code} = $promo_code; | |
| 84 | $c->{promo_label} = $promo_label; | |
| 85 | $c->{promo_card_line} = $promo_label . ' with code <strong>' . $promo_code . '</strong>'; | |
| 86 | } | |
| 87 | } | |
| 88 | ||
| 89 | $db->db_disconnect($dbh); | |
| 90 | ||
| 91 | 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"; | |
| 92 | ||
| 93 | my $tvars = { | |
| 94 | user_id => $userinfo ? $userinfo->{user_id} : '', | |
| 95 | plans => \@plans, | |
| 96 | has_plans => scalar(@plans) ? 1 : 0, | |
| 97 | has_promo => $active_promo ? 1 : 0, | |
| 98 | promo_code => $promo_code, | |
| 99 | promo_label => $promo_label, | |
| 100 | }; | |
| 101 | ||
| 102 | my $body = join('', $tfile->template('webstls_index.html', $tvars, $userinfo)); | |
| 103 | ||
| 104 | $wrap->render({ | |
| 105 | userinfo => $userinfo, | |
| 106 | title => 'Run your 3D creator business like an operator', | |
| 107 | body => $body, | |
| 108 | }); | |
| 109 | ||
| 110 | #---------------------------------------------------------------------- | |
| 111 | # Compact card shape used by the landing pricing grid (4 cards, one | |
| 112 | # per tier, monthly price). Bullets are pre-rendered to side-step the | |
| 113 | # template engine's nested-loop quirks. | |
| 114 | sub _build_landing_plan_cards { | |
| 115 | my ($db, $dbh, $DB, $bill) = @_; | |
| 116 | return _landing_fallback_plans() unless $bill->schema_ready($db, $dbh, $DB); | |
| 117 | ||
| 118 | my @rows = $bill->list_plans($db, $dbh, $DB); | |
| 119 | return _landing_fallback_plans() unless scalar @rows; | |
| 120 | ||
| 121 | my $entitle_ready = $bill->plan_features_ready($db, $dbh, $DB); | |
| 122 | my @catalog = $bill->feature_catalog; | |
| 123 | ||
| 124 | my %by_tier; | |
| 125 | foreach my $r (@rows) { push @{ $by_tier{ $r->{tier} } }, $r; } | |
| 126 | ||
| 127 | my @tiers_seen; | |
| 128 | foreach my $r (@rows) { | |
| 129 | next if grep { $_ eq $r->{tier} } @tiers_seen; | |
| 130 | push @tiers_seen, $r->{tier}; | |
| 131 | } | |
| 132 | ||
| 133 | my @out; | |
| 134 | foreach my $tier (@tiers_seen) { | |
| 135 | my $monthly = (grep { ($_->{cadence}||'') eq 'monthly' } @{ $by_tier{$tier} })[0] | |
| 136 | || $by_tier{$tier}->[0]; | |
| 137 | next unless $monthly; | |
| 138 | ||
| 139 | # Build a short bullet list. Prefer the marketing copy supplied | |
| 140 | # by the admin; otherwise synthesise from entitlements so the | |
| 141 | # card never renders empty on a fresh install. | |
| 142 | my @bullets = _parse_features_for_landing($monthly->{features}); | |
| 143 | if (!scalar @bullets && $entitle_ready) { | |
| 144 | my $set = $bill->plan_feature_set($db, $dbh, $DB, $monthly->{id}); | |
| 145 | foreach my $f (@catalog) { | |
| 146 | next unless $set->{ $f->{key} }; | |
| 147 | push @bullets, $f->{name} . ' — ' . $f->{blurb}; | |
| 148 | } | |
| 149 | } | |
| 150 | # Cap to 5 bullets to match the original card visual density. | |
| 151 | @bullets = @bullets[0 .. ( $#bullets > 4 ? 4 : $#bullets )]; | |
| 152 | my $bullets_html = ''; | |
| 153 | foreach my $b (@bullets) { | |
| 154 | $bullets_html .= '<li><svg viewBox="0 0 24 24" fill="none" stroke="currentColor" stroke-width="3">' | |
| 155 | . '<polyline points="20 6 9 17 4 12"/></svg> ' . $b . '</li>'; | |
| 156 | } | |
| 157 | ||
| 158 | my $tier_slug = lc($monthly->{tier} || ''); $tier_slug =~ s/[^a-z0-9_\-]//g; | |
| 159 | ||
| 160 | push @out, { | |
| 161 | id => $monthly->{id}, | |
| 162 | tier => $monthly->{tier}, | |
| 163 | display_name => $monthly->{display_name} || ucfirst($monthly->{tier} || ''), | |
| 164 | price_display => _fmt_price_short($monthly->{price_cents}), | |
| 165 | is_featured => $monthly->{is_featured} ? 1 : 0, | |
| 166 | not_featured => $monthly->{is_featured} ? 0 : 1, | |
| 167 | tagline => $monthly->{tagline} || '', | |
| 168 | has_tagline => $monthly->{tagline} ? 1 : 0, | |
| 169 | cta_label => $monthly->{cta_label} || ($monthly->{price_cents} ? 'Start trial' : 'Start free'), | |
| 170 | cta_href => $monthly->{price_cents} ? ('signup.cgi?plan=' . $tier_slug) : 'signup.cgi', | |
| 171 | bullets_html => $bullets_html, | |
| 172 | }; | |
| 173 | } | |
| 174 | return @out; | |
| 175 | } | |
| 176 | ||
| 177 | sub _fmt_price_short { | |
| 178 | my ($cents) = @_; | |
| 179 | $cents = 0 unless defined $cents; | |
| 180 | if ($cents % 100 == 0) { | |
| 181 | return '$' . int($cents / 100); | |
| 182 | } | |
| 183 | return '$' . sprintf('%.2f', $cents / 100); | |
| 184 | } | |
| 185 | ||
| 186 | sub _parse_features_for_landing { | |
| 187 | my ($raw) = @_; | |
| 188 | return () unless defined $raw && $raw =~ /\S/; | |
| 189 | my @out; | |
| 190 | while ($raw =~ m/\{\s*"name"\s*:\s*"((?:\\.|[^"\\])*)"\s*,\s*"included"\s*:\s*(true|false|0|1)\s*\}/gi) { | |
| 191 | my $name = $1; my $inc = lc $2; | |
| 192 | $name =~ s/\\"/"/g; $name =~ s/\\\\/\\/g; | |
| 193 | # Landing block only shows the positive bullets. | |
| 194 | push @out, $name if $inc eq 'true' || $inc eq '1'; | |
| 195 | } | |
| 196 | return @out; | |
| 197 | } | |
| 198 | ||
| 199 | sub _landing_fallback_plans { | |
| 200 | my $li = sub { | |
| 201 | my @items = @_; | |
| 202 | my $h = ''; | |
| 203 | foreach my $t (@items) { | |
| 204 | $h .= '<li><svg viewBox="0 0 24 24" fill="none" stroke="currentColor" stroke-width="3">' | |
| 205 | . '<polyline points="20 6 9 17 4 12"/></svg> ' . $t . '</li>'; | |
| 206 | } | |
| 207 | return $h; | |
| 208 | }; | |
| 209 | return ( | |
| 210 | { tier=>'free', display_name=>'Free', price_display=>'$0', | |
| 211 | is_featured=>0, not_featured=>1, | |
| 212 | tagline=>'Solo creators just publishing to one or two marketplaces.', | |
| 213 | has_tagline=>1, cta_label=>'Start free', cta_href=>'signup.cgi', | |
| 214 | bullets_html => $li->('Up to 10 models', '2 platform connections', 'Cross-platform analytics') }, | |
| 215 | { tier=>'starter', display_name=>'Starter', price_display=>'$9', | |
| 216 | is_featured=>0, not_featured=>1, | |
| 217 | tagline=>'Active creators publishing to several marketplaces.', | |
| 218 | has_tagline=>1, cta_label=>'Start trial', cta_href=>'signup.cgi?plan=starter', | |
| 219 | bullets_html => $li->('Unlimited models', 'All platform connections', 'Per-platform overrides', 'Priority publishing queue') }, | |
| 220 | { tier=>'pro', display_name=>'Pro', price_display=>'$29', | |
| 221 | is_featured=>1, not_featured=>0, | |
| 222 | tagline=>'Storefront + optimization for creators going independent.', | |
| 223 | has_tagline=>1, cta_label=>'Start trial', cta_href=>'signup.cgi?plan=pro', | |
| 224 | bullets_html => $li->('Everything in Starter', 'Branded storefront + custom domain', 'A/B + MVT testing', 'Price discovery tools', 'Stripe Connect direct payouts') }, | |
| 225 | { tier=>'studio', display_name=>'Studio', price_display=>'$99', | |
| 226 | is_featured=>0, not_featured=>1, | |
| 227 | tagline=>'Teams. Multiple storefronts. Pooled-data recommendations.', | |
| 228 | has_tagline=>1, cta_label=>'Start trial', cta_href=>'signup.cgi?plan=studio', | |
| 229 | bullets_html => $li->('Everything in Pro', 'Up to 10 team members + roles', 'Multiple storefronts', 'Pooled-data recommendations', '2FA mandatory + audit log access') }, | |
| 230 | ); | |
| 231 | } | |
| 232 | ||
| 233 | #---------------------------------------------------------------------- | |
| 234 | # Marketing page renderer. Each page is a simple template render with | |
| 235 | # the shared wrapper; help.cgi is the only one that requires an | |
| 236 | # authenticated session (kept identical to the old standalone file). | |
| 237 | #---------------------------------------------------------------------- | |
| 238 | sub _mkt_render_page { | |
| 239 | my ($spec) = @_; | |
| 240 | if ($spec->{require_login} && !$userinfo) { | |
| 241 | print "Status: 302 Found\nLocation: /login.cgi\n\n"; | |
| 242 | return; | |
| 243 | } | |
| 244 | 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"; | |
| 245 | my $body = join('', $tfile->template($spec->{tmpl}, {}, $userinfo)); | |
| 246 | my %args = ( | |
| 247 | userinfo => $userinfo, | |
| 248 | title => $spec->{title}, | |
| 249 | body => $body, | |
| 250 | ); | |
| 251 | $args{page_key} = $spec->{page_key} if exists $spec->{page_key}; | |
| 252 | $wrap->render(\%args); | |
| 253 | } |