Diff -- /var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com/billing.cgi
Diff

/var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com/billing.cgi

added on local at 2026-07-01 12:34:07

Added
+281
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 83d4b419b0e8
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1#!/usr/bin/perl
2
3##################################################################################################################################
4# ______ ____ ____ ______ ______ ____ ___ __ ___ ______ _ __ ____ ____ __ __ _ __ _____ ____
5# / ____// __ \ / __ \ / ____/ / ____// __ \ / | / |/ // ____/| | / // __ \ / __ \ / //_/ | | / /|__ / / __ \
6# / / / / / // / / // __/ / /_ / /_/ // /| | / /|_/ // __/ | | /| / // / / // /_/ // ,< | | / / /_ < / / / /
7# / /___ / /_/ // /_/ // /___ / __/ / _, _// ___ | / / / // /___ | |/ |/ // /_/ // _, _// /| | | |/ / ___/ /_ / /_/ /
8# \____/ \____//_____//_____/ /_/ /_/ |_|/_/ |_|/_/ /_//_____/ |__/|__/ \____//_/ |_|/_/ |_| |___/ /____/(_)\____/
9#
10# - Written by: Shawn Pickering
11# - shawn@shawnpickering.com
12##################################################################################################################################
13use strict;
14use lib '/var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com';
15
16
17#############################################################
18## Variables
19#############################################################
20
21
22
23############################################################
24# Modules
25############################################################
26use CGI; my $query = new CGI; my $form = $query->Vars;
27use MODS::Login; my $login = new MODS::Login;
28use MODS::PTMatrix::Urls; my $getlist = new MODS::PTMatrix::Urls; my $url = $getlist->urls();
29use MODS::Template; my $tfile = new MODS::Template;
30use MODS::PTMatrix::Wrapper; my $load = new MODS::PTMatrix::Wrapper;
31use MODS::DBConnect; my $db = new MODS::DBConnect;
32use MODS::PTMatrix::Config; my $config = new MODS::PTMatrix::Config; my $database_name = $config->settings('database_name');
33use MODS::PTMatrix::PM;
34use MODS::PTMatrix::Stripe;
35
36
37
38#############################################################
39## Get form data
40#############################################################
41foreach my $line(keys %$form){
42 $form->{$line} =~ s/[^!-~\s]//g;
43 $form->{$line} = quotemeta("$form->{$line}");
44}
45
46
47
48############################################################
49# Program Controls
50############################################################
51$|=1;
52my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'billing';
53my $userinfo = $login->login_verify();
54
55if($entry eq 'billing_checkout'){
56 if(!$userinfo){print qq~Status: 302 Found\nLocation: $url->{login}\n\n~; exit;}
57 if(!MODS::PTMatrix::PM::get_company_id($userinfo) || !MODS::PTMatrix::PM::is_company_admin($userinfo)){print qq~Status: 302 Found\nLocation: $url->{billing}&err=perm\n\n~; exit;}
58 &start_checkout;
59 exit;
60}
61
62print qq~Content-type:text/html; Cache-Control:no-cache;\n\n~;
63if(!$userinfo){print qq~<script>window.location="$url->{login}";</script>~;}
64elsif(!MODS::PTMatrix::PM::is_company_admin($userinfo)){print qq~<script>window.location="$url->{dashboard}";</script>~;}
65elsif(!MODS::PTMatrix::PM::get_company_id($userinfo)){print qq~<script>window.location="$url->{admin_companies}";</script>~;}
66elsif(($ENV{REQUEST_METHOD}||'') eq 'POST' && ($form->{act}||'') eq 'request_plan'){&request_plan_change;}
67else{&billing_panel;}
68
69
70############################################################
71# Subroutines
72############################################################
73sub request_plan_change{
74 my $cid = MODS::PTMatrix::PM::get_company_id($userinfo);
75 my $uid = MODS::PTMatrix::PM::get_user_id($userinfo);
76
77 my $tier = $form->{tier};
78 if($tier !~ /^(free|starter|pro|business|enterprise)$/){
79 &billing_panel;
80 return;
81 }
82
83 my $dbh = $db->db_connect();
84 my $sq_tier = MODS::PTMatrix::PM::sql_quote($tier);
85
86 #Queue the request in company_settings - the actual Stripe checkout flow lives elsewhere
87 my $sql = qq~INSERT INTO `${database_name}`.company_settings (company_id, setting_key, setting_value) VALUES ('$cid', 'pending_plan_change', '$sq_tier') ON DUPLICATE KEY UPDATE setting_value=VALUES(setting_value)~;
88 $db->db_readwrite($dbh, $sql, $ENV{SCRIPT_NAME}, __LINE__);
89 $db->db_disconnect($dbh);
90
91 MODS::PTMatrix::PM::audit($cid, $uid, 'billing.request_plan_change', 'company', $cid, $tier);
92
93 &billing_panel("Plan change to <strong>$tier</strong> queued. We'll process it within one business day (Stripe checkout coming soon).");
94}
95
96sub billing_panel{
97 my($flash) = @_;
98 $flash ||= '';
99
100 my $cid = MODS::PTMatrix::PM::get_company_id($userinfo);
101 my $dbh = $db->db_connect();
102
103 #------------------------------------------------------------------------------------------------------
104 #The company row
105 my $c = $db->db_readwrite($dbh, qq~SELECT * FROM `${database_name}`.companies WHERE id='$cid'~, $ENV{SCRIPT_NAME}, __LINE__);
106 #------------------------------------------------------------------------------------------------------
107
108 #------------------------------------------------------------------------------------------------------
109 #All active billing plans for the picker
110 my $sql_p = qq~SELECT id, tier, display_name, tagline, cta_label, price_cents_per_seat, yearly_price_cents_per_seat, features, is_featured FROM `${database_name}`.billing_plans WHERE is_active=1 ORDER BY sort_order~;
111 my @plans = $db->db_readwrite_multiple($dbh, $sql_p, $ENV{SCRIPT_NAME}, __LINE__);
112 foreach my $p(@plans){
113 $p->{price_dollars} = int(($p->{price_cents_per_seat} || 0) / 100);
114 $p->{yearly_dollars} = int(($p->{yearly_price_cents_per_seat} || 0) / 100);
115 $p->{is_current} = ($c->{plan_tier} eq $p->{tier}) ? 1 : 0;
116
117 #Minimal "features":[...] JSON parser - keep parsing best-effort
118 my @f;
119 if($p->{features} && $p->{features} =~ /^\s*\[/){
120 while($p->{features} =~ /"name"\s*:\s*"((?:[^"\\]|\\.)*)"\s*,\s*"included"\s*:\s*(true|false)/g){
121 my $name = $1;
122 my $inc = ($2 eq 'true') ? 1 : 0;
123 $name =~ s/\\"/"/g;
124 push @f, { name => $name, included => $inc };
125 }
126 }
127 $p->{features_parsed} = \@f;
128 $p->{has_features} = scalar(@f) ? 1 : 0;
129 }
130 #------------------------------------------------------------------------------------------------------
131
132 #------------------------------------------------------------------------------------------------------
133 #Last 20 invoices for this company
134 my $sql_inv = qq~SELECT id, invoice_number, status, amount_due_cents, amount_paid_cents, currency, period_start, period_end, paid_at, hosted_invoice_url, created_at FROM `${database_name}`.invoices WHERE company_id='$cid' ORDER BY created_at DESC LIMIT 20~;
135 my @invoices = $db->db_readwrite_multiple($dbh, $sql_inv, $ENV{SCRIPT_NAME}, __LINE__);
136 foreach my $i(@invoices){
137 $i->{amount_label} = sprintf("\$%.2f", ($i->{amount_due_cents} || 0) / 100);
138 }
139 #------------------------------------------------------------------------------------------------------
140
141 #Pending plan-change request (queued from the form above)
142 my $pending = $db->db_readwrite($dbh, qq~SELECT setting_value FROM `${database_name}`.company_settings WHERE company_id='$cid' AND setting_key='pending_plan_change' LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__);
143 my $pending_plan = ($pending && $pending->{setting_value}) ? $pending->{setting_value} : '';
144
145 #Trial days countdown (only relevant on trial plan)
146 my $trial_days = 0;
147 if($c->{trial_ends_at} && $c->{plan_tier} eq 'trial'){
148 my $r = $db->db_readwrite($dbh, qq~SELECT DATEDIFF('$c->{trial_ends_at}', NOW()) AS d~, $ENV{SCRIPT_NAME}, __LINE__);
149 $trial_days = ($r && defined $r->{d}) ? $r->{d} : 0;
150 }
151
152 #Expired-trial banner detection (downgraded to free with trial in the past 90 days)
153 my $expired_param = (($form->{expired} || '') eq '1') ? 1 : 0;
154 my $just_lapsed = 0;
155 my $expired_at_str = '';
156 if($c->{trial_ends_at} && $c->{plan_tier} eq 'free'){
157 my $age_row = $db->db_readwrite($dbh, qq~SELECT trial_ends_at, (trial_ends_at < NOW()) AS is_past, (trial_ends_at > DATE_SUB(NOW(), INTERVAL 90 DAY)) AS recent FROM `${database_name}`.companies WHERE id='$cid' LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__);
158 if($age_row && $age_row->{is_past} && $age_row->{recent}){
159 $just_lapsed = 1;
160 $expired_at_str = $age_row->{trial_ends_at} || '';
161 }
162 }
163
164 $db->db_disconnect($dbh);
165
166 my $stripe_live = (length($config->settings('stripe_secret') || '') && $config->settings('stripe_secret') !~ /REPLACE/) ? 1 : 0;
167
168 #Surface Stripe error / success flashes from query string
169 if($form->{err}){
170 my $e = $form->{err}; $e =~ s/[<>"]//g; $e = substr($e, 0, 200);
171 if ($e eq 'nostripe'){$flash = qq~Stripe is not configured yet. <a href="$url->{admin_config}">Set publishable + secret + webhook</a>, then retry.~;}
172 elsif($e eq 'perm') {$flash = 'Only company admins can change the plan.';}
173 else {$flash = "Stripe error: $e";}
174 }
175 if(($form->{checkout} || '') eq 'ok') {$flash = 'Payment received. Your plan has been upgraded.';}
176 if(($form->{checkout} || '') eq 'cancel') {$flash = 'Checkout cancelled. No charge made.';}
177
178 #Upgrade nudge from a gated page: /billing.cgi?upgrade=sso -> "Upgrade to Business to unlock Single sign-on (SSO)."
179 if($form->{upgrade}){
180 my $f = $form->{upgrade}; $f =~ s/[^a-z0-9_]//g;
181 my $min = MODS::PTMatrix::PM::min_tier_for_feature($f);
182 my $lbl = MODS::PTMatrix::PM::feature_label($f);
183 if($min){
184 my $min_disp = ucfirst($min);
185 $flash = "Upgrade to <strong>$min_disp</strong> to unlock <strong>$lbl</strong>.";
186 }
187 }
188
189 my $show_expired_banner = ($expired_param || $just_lapsed) ? 1 : 0;
190
191 #Create all template variables
192 my $tvars;
193 $tvars->{flash} = $flash;
194 $tvars->{has_flash} = length($flash) ? 1 : 0;
195 $tvars->{stripe_live} = $stripe_live;
196 $tvars->{plan_tier} = ucfirst($c->{plan_tier});
197 $tvars->{is_trial} = ($c->{plan_tier} eq 'trial') ? 1 : 0;
198 $tvars->{trial_days} = $trial_days;
199 $tvars->{trial_ends} = $c->{trial_ends_at} || '';
200 $tvars->{seat_count} = $c->{seat_count} || 0;
201 $tvars->{plans} = \@plans;
202 $tvars->{has_plans} = scalar(@plans) ? 1 : 0;
203 $tvars->{invoices} = \@invoices;
204 $tvars->{has_invoices} = scalar(@invoices) ? 1 : 0;
205 $tvars->{pending_plan} = $pending_plan;
206 $tvars->{has_pending} = length($pending_plan) ? 1 : 0;
207 $tvars->{show_expired_banner} = $show_expired_banner;
208 $tvars->{expired_at_str} = $expired_at_str || $c->{trial_ends_at} || '';
209
210 my $body = join('', $tfile->template('tf_billing.html', $tvars, $userinfo));
211
212 $load->render({
213 userinfo => $userinfo,
214 page_key => 'billing',
215 title => 'Billing & Plan',
216 body => $body,
217 });
218}
219
220#============================================================
221# billing_checkout entry: Stripe Checkout Session bootstrap
222#============================================================
223sub start_checkout{
224 my $uid = MODS::PTMatrix::PM::get_user_id($userinfo);
225 my $cid = MODS::PTMatrix::PM::get_company_id($userinfo);
226
227 my $tier = $form->{tier} || '';
228 $tier =~ s/[^a-z]//g;
229 my $cadence = ($form->{cadence} && $form->{cadence} eq 'yearly') ? 'yearly' : 'monthly';
230
231 my $dbh = $db->db_connect();
232
233 my $sql_p = qq~SELECT id, tier, stripe_price_id, stripe_yearly_price_id, display_name FROM `${database_name}`.billing_plans WHERE tier='$tier' AND is_active=1 LIMIT 1~;
234 my $plan = $db->db_readwrite($dbh, $sql_p, $ENV{SCRIPT_NAME}, __LINE__);
235
236 my $price_id = '';
237 if($plan){
238 $price_id = $cadence eq 'yearly' ? ($plan->{stripe_yearly_price_id} || '') : ($plan->{stripe_price_id} || '');
239 }
240
241 if(!$plan || !$price_id){
242 $db->db_disconnect($dbh);
243 print qq~Status: 302 Found\nLocation: $url->{billing}&err=nostripe\n\n~;
244 return;
245 }
246
247 my $base = $config->settings('seo.canonical_base') || 'https://ptmatrix.3dshawn.com';
248 my $company = $db->db_readwrite($dbh, qq~SELECT name, seat_count, stripe_customer_id FROM `${database_name}`.companies WHERE id='$cid'~, $ENV{SCRIPT_NAME}, __LINE__);
249 $db->db_disconnect($dbh);
250
251 my $stripe = MODS::PTMatrix::Stripe->new;
252 if(!$stripe->key){
253 print qq~Status: 302 Found\nLocation: $url->{billing}&err=nostripe\n\n~;
254 return;
255 }
256
257 my $sess = $stripe->create_checkout_session({
258 price_id => $price_id,
259 quantity => ($company->{seat_count} || 1) + 0,
260 customer_email => $userinfo->{email},
261 success_url => "$base/billing.cgi?checkout=ok&session={CHECKOUT_SESSION_ID}",
262 cancel_url => "$base/billing.cgi?checkout=cancel",
263 metadata => { company_id => $cid, plan_tier => $plan->{tier} },
264 });
265
266 if($sess && $sess->{url}){
267 MODS::PTMatrix::PM::audit($cid, $uid, 'billing.checkout_started', 'company', $cid, $plan->{tier} . "/$cadence");
268 print qq~Status: 303 See Other\nLocation: $sess->{url}\n\n~;
269 return;
270 }
271
272 my $err = ($sess && $sess->{error} && ref($sess->{error}) eq 'HASH') ? ($sess->{error}->{message} || '') : ($sess->{error} || 'unknown');
273 $err =~ s/[^\x20-\x7e]//g;
274 print qq~Status: 302 Found\nLocation: $url->{billing}&err=~ . &bc_urlenc($err) . qq~\n\n~;
275}
276
277sub bc_urlenc{
278 my $s = shift // '';
279 $s =~ s/([^A-Za-z0-9_.\-~])/sprintf("%%%02X", ord $1)/ge;
280 return $s;
281}
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help