added on WebSTLs (webstls.com) at 2026-07-01 22:26:47
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs -- buyer-side subscribe to a plan. | |
| 4 | # | |
| 5 | # GET /subscribe.cgi?plan=<id> -> confirmation page | |
| 6 | # POST /subscribe.cgi -> create the subscription row | |
| 7 | # | |
| 8 | # v1 note: this creates the buyer_subscriptions row in 'active' state | |
| 9 | # with a 7-day no-charge introductory period. Stripe Subscription / | |
| 10 | # recurring billing wiring is queued -- the data model already carries | |
| 11 | # stripe_subscription_id + stripe_customer_id, so the upgrade is a | |
| 12 | # focused change inside this CGI + the webhook. | |
| 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::WebSTLs::Config; | |
| 22 | use MODS::WebSTLs::Themes; | |
| 23 | use MODS::WebSTLs::BuyerAuth; | |
| 24 | use MODS::WebSTLs::Subscriptions; | |
| 25 | use MODS::WebSTLs::Stripe; | |
| 26 | ||
| 27 | $| = 1; | |
| 28 | ||
| 29 | my $q = CGI->new; | |
| 30 | my $form = $q->Vars; | |
| 31 | my $tfile = MODS::Template->new; | |
| 32 | my $db = MODS::DBConnect->new; | |
| 33 | my $cfg = MODS::WebSTLs::Config->new; | |
| 34 | my $themes= MODS::WebSTLs::Themes->new; | |
| 35 | my $bauth = MODS::WebSTLs::BuyerAuth->new; | |
| 36 | my $sub = MODS::WebSTLs::Subscriptions->new; | |
| 37 | my $DB = $cfg->settings('database_name'); | |
| 38 | ||
| 39 | my $plan_id = $form->{plan} || $form->{id} || 0; | |
| 40 | $plan_id =~ s/[^0-9]//g; | |
| 41 | unless ($plan_id) { print "Status: 302 Found\nLocation: /\n\n"; exit; } | |
| 42 | ||
| 43 | my $dbh = $db->db_connect(); | |
| 44 | ||
| 45 | unless ($sub->schema_ready($db, $dbh, $DB)) { | |
| 46 | $db->db_disconnect($dbh); | |
| 47 | print "Status: 302 Found\nLocation: /\n\n"; exit; | |
| 48 | } | |
| 49 | ||
| 50 | my $plan = $sub->plan_by_id($db, $dbh, $DB, $plan_id); | |
| 51 | unless ($plan && $plan->{status} eq 'active') { | |
| 52 | $db->db_disconnect($dbh); | |
| 53 | print "Status: 404 Not Found\nContent-Type: text/html\n\nPlan not available."; exit; | |
| 54 | } | |
| 55 | ||
| 56 | # Sign-in required. | |
| 57 | my $buyer = $bauth->verify($q, $db, $dbh, $DB); | |
| 58 | unless ($buyer && $buyer->{id}) { | |
| 59 | $db->db_disconnect($dbh); | |
| 60 | print "Status: 302 Found\nLocation: /buyer_login.cgi?id=$plan->{storefront_id}&next=" . | |
| 61 | '%2Fsubscribe.cgi%3Fplan%3D' . $plan_id . "\n\n"; | |
| 62 | exit; | |
| 63 | } | |
| 64 | ||
| 65 | # POST -> create. | |
| 66 | if (($ENV{REQUEST_METHOD} || '') eq 'POST') { | |
| 67 | # Defensive: don't double-subscribe to the same plan. | |
| 68 | my $existing = $db->db_readwrite($dbh, qq~ | |
| 69 | SELECT id FROM `${DB}`.buyer_subscriptions | |
| 70 | WHERE buyer_account_id='$buyer->{id}' AND plan_id='$plan_id' | |
| 71 | AND status='active' LIMIT 1 | |
| 72 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 73 | if ($existing && $existing->{id}) { | |
| 74 | $db->db_disconnect($dbh); | |
| 75 | print "Status: 302 Found\nLocation: /my_subscription.cgi?id=$plan->{storefront_id}\n\n"; exit; | |
| 76 | } | |
| 77 | ||
| 78 | # Create a pending buyer_subscriptions row -- captures the buyer's | |
| 79 | # ship address (for ship_monthly) BEFORE we hand off to Stripe. | |
| 80 | # The Stripe webhook activates it on checkout.session.completed. | |
| 81 | my $sub_id = $sub->start_subscription($db, $dbh, $DB, | |
| 82 | buyer_account_id => $buyer->{id}, | |
| 83 | plan_id => $plan_id, | |
| 84 | ship_name => $form->{ship_name}, | |
| 85 | ship_addr1 => $form->{ship_addr1}, | |
| 86 | ship_city => $form->{ship_city}, | |
| 87 | ship_postal => $form->{ship_postal}, | |
| 88 | ship_country => $form->{ship_country}, | |
| 89 | ); | |
| 90 | unless ($sub_id) { | |
| 91 | $db->db_disconnect($dbh); | |
| 92 | print "Status: 302 Found\nLocation: /subscribe.cgi?plan=$plan_id&err=1\n\n"; exit; | |
| 93 | } | |
| 94 | ||
| 95 | # If Stripe is configured, open a Checkout Session in subscription | |
| 96 | # mode and redirect. Stripe handles customer + card + recurring. | |
| 97 | # Otherwise fall back to the "instant active" v1 flow (the row is | |
| 98 | # already set to active by start_subscription) so the user can | |
| 99 | # exercise the data-model end-to-end without keys. | |
| 100 | my $stripe = MODS::WebSTLs::Stripe->new; | |
| 101 | if ($stripe->is_configured) { | |
| 102 | # 1. Ensure Stripe Product + Price for this plan. | |
| 103 | my $sp = $sub->ensure_stripe_price($db, $dbh, $DB, $plan_id, $stripe); | |
| 104 | if ($sp->{error}) { | |
| 105 | # Couldn't reach Stripe -- leave the row pending so the | |
| 106 | # buyer can retry. Show a friendly error. | |
| 107 | $db->db_disconnect($dbh); | |
| 108 | print "Status: 302 Found\nLocation: /subscribe.cgi?plan=$plan_id&stripe_err=" . | |
| 109 | _urlencode($sp->{error}) . "\n\n"; | |
| 110 | exit; | |
| 111 | } | |
| 112 | # 2. Open Checkout Session. | |
| 113 | my $base = 'https://' . ($ENV{HTTP_HOST} || 'webstls.com'); | |
| 114 | my $success = "$base/my_subscription.cgi?id=$plan->{storefront_id}&ok=$sub_id&session={CHECKOUT_SESSION_ID}"; | |
| 115 | my $cancel = "$base/subscribe.cgi?plan=$plan_id&canceled=1"; | |
| 116 | my $session = $stripe->create_checkout_session_subscription( | |
| 117 | price => $sp->{price}, | |
| 118 | success_url => $success, | |
| 119 | cancel_url => $cancel, | |
| 120 | customer_email => $buyer->{email}, | |
| 121 | metadata => { | |
| 122 | buyer_account_id => $buyer->{id}, | |
| 123 | buyer_subscription_id => $sub_id, | |
| 124 | plan_id => $plan_id, | |
| 125 | storefront_id => $plan->{storefront_id}, | |
| 126 | }, | |
| 127 | idempotency_key => "sub_session_${sub_id}", | |
| 128 | ); | |
| 129 | if ($session->{error} || !$session->{url}) { | |
| 130 | $db->db_disconnect($dbh); | |
| 131 | print "Status: 302 Found\nLocation: /subscribe.cgi?plan=$plan_id&stripe_err=" . | |
| 132 | _urlencode($session->{error} || 'no session url') . "\n\n"; | |
| 133 | exit; | |
| 134 | } | |
| 135 | # 3. Mark the buyer_subscriptions row as pending payment until | |
| 136 | # the webhook activates it. Update status='past_due' as a | |
| 137 | # signal that we're awaiting the first charge. | |
| 138 | $db->db_readwrite($dbh, qq~ | |
| 139 | UPDATE `${DB}`.buyer_subscriptions | |
| 140 | SET status='past_due', | |
| 141 | stripe_customer_id=NULL | |
| 142 | WHERE id='$sub_id' LIMIT 1 | |
| 143 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 144 | $db->db_disconnect($dbh); | |
| 145 | print "Status: 302 Found\nLocation: $session->{url}\n\n"; exit; | |
| 146 | } | |
| 147 | ||
| 148 | $db->db_disconnect($dbh); | |
| 149 | print "Status: 302 Found\nLocation: /my_subscription.cgi?id=$plan->{storefront_id}&ok=$sub_id\n\n"; exit; | |
| 150 | } | |
| 151 | ||
| 152 | sub _urlencode { | |
| 153 | my $s = shift // ''; | |
| 154 | $s =~ s/([^A-Za-z0-9\-._~])/sprintf('%%%02X', ord($1))/ge; | |
| 155 | return $s; | |
| 156 | } | |
| 157 | ||
| 158 | # GET -> confirm. | |
| 159 | my $store = $db->db_readwrite($dbh, qq~ | |
| 160 | SELECT id, name, subdomain, theme_id FROM `${DB}`.storefronts | |
| 161 | WHERE id='$plan->{storefront_id}' LIMIT 1 | |
| 162 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 163 | my $theme = $themes->by_id($store->{theme_id}); | |
| 164 | my $css = $themes->css_vars($theme); | |
| 165 | ||
| 166 | $db->db_disconnect($dbh); | |
| 167 | ||
| 168 | my $tvars = { | |
| 169 | theme_css_vars => $css, | |
| 170 | plan_id => $plan->{id}, | |
| 171 | plan_name => _h($plan->{name}), | |
| 172 | plan_tagline => _h($plan->{tagline} || ''), | |
| 173 | plan_desc => _h($plan->{description} || ''), | |
| 174 | price_label => '$' . sprintf('%.2f', ($plan->{price_cents} || 0) / 100), | |
| 175 | cadence => $plan->{cadence_days}, | |
| 176 | quota => $plan->{quota_per_period}, | |
| 177 | kind => $plan->{kind}, | |
| 178 | is_ship_kind => $plan->{kind} eq 'ship_monthly' ? 1 : 0, | |
| 179 | is_dl_kind => $plan->{kind} eq 'download_quota' ? 1 : 0, | |
| 180 | store_id => $store->{id}, | |
| 181 | store_name => _h($store->{name} || $store->{subdomain}), | |
| 182 | buyer_email => _h($buyer->{email}), | |
| 183 | }; | |
| 184 | ||
| 185 | 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"; | |
| 186 | print join('', $tfile->template('webstls_subscribe.html', $tvars, undef)); | |
| 187 | exit; | |
| 188 | ||
| 189 | sub _h { | |
| 190 | my $s = shift // ''; | |
| 191 | $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; | |
| 192 | $s =~ s/"/"/g; $s =~ s/'/'/g; | |
| 193 | return $s; | |
| 194 | } |