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