added on WebSTLs (webstls.com) at 2026-07-01 22:26:18
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs - Admin Packages (plans + pricing + entitlements) | |
| 4 | # | |
| 5 | # Company-staff-only console for editing the catalogue of billing plans. | |
| 6 | # Every change here flows out to pricing.cgi, the index.cgi pricing | |
| 7 | # block, and the per-feature gate on preferences.cgi via plan_features. | |
| 8 | # | |
| 9 | # Views: | |
| 10 | # list = catalogue grid + create form (?new=1 opens the create form) | |
| 11 | # edit = full edit form for a single plan (?edit_id=N) | |
| 12 | # | |
| 13 | # Saves are POSTed to /admin_packages_action.cgi which redirects back | |
| 14 | # here on success. | |
| 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::Admin; | |
| 27 | use MODS::WebSTLs::Billing; | |
| 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 $admin = MODS::WebSTLs::Admin->new; | |
| 37 | my $bill = MODS::WebSTLs::Billing->new; | |
| 38 | my $DB = $cfg->settings('database_name'); | |
| 39 | ||
| 40 | $|=1; | |
| 41 | my $userinfo = $auth->login_verify(); | |
| 42 | if (!$userinfo) { | |
| 43 | print "Status: 302 Found\nLocation: /login.cgi\n\n"; | |
| 44 | exit; | |
| 45 | } | |
| 46 | $admin->require_admin($userinfo); | |
| 47 | require MODS::WebSTLs::Permissions; | |
| 48 | # Plan pricing is global to the platform -- super-admin only. Manager | |
| 49 | # role can still issue refunds and grant credit per-user (those go | |
| 50 | # through admin_billing_action.cgi which keeps the manager-level | |
| 51 | # admin_edit_billing ptag), but nobody except the owner sets prices. | |
| 52 | MODS::WebSTLs::Permissions->new->require_super_admin($userinfo); | |
| 53 | ||
| 54 | my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'admin_packages'; | |
| 55 | ||
| 56 | if ($entry eq 'admin_packages_action') { | |
| 57 | _handle_action($q, $form, $userinfo); | |
| 58 | exit; | |
| 59 | } | |
| 60 | ||
| 61 | my $view = ($form->{new} && $form->{new} eq '1') ? 'new' | |
| 62 | : ($form->{edit_id} && $form->{edit_id} =~ /^\d+$/) ? 'edit' | |
| 63 | : 'list'; | |
| 64 | my $edit_id = $form->{edit_id} || ''; | |
| 65 | $edit_id =~ s/[^0-9]//g; | |
| 66 | ||
| 67 | my $flash_msg = ''; | |
| 68 | my $flash_kind = 'ok'; | |
| 69 | if ($form->{msg}) { | |
| 70 | my %ok = ( | |
| 71 | saved => 'Plan saved.', | |
| 72 | created => 'Plan created.', | |
| 73 | active => 'Plan reactivated.', | |
| 74 | retired => 'Plan retired -- it stays in the catalogue for historical invoices but no longer shows in pricing.', | |
| 75 | ); | |
| 76 | if ($form->{msg} =~ /^err:(.+)$/) { | |
| 77 | my $detail = $1; | |
| 78 | $detail =~ s/[^A-Za-z0-9 .,;:_\-\$()%']//g; | |
| 79 | $flash_msg = "Couldn't save: $detail"; | |
| 80 | $flash_kind = 'danger'; | |
| 81 | } elsif ($ok{ $form->{msg} }) { | |
| 82 | $flash_msg = $ok{ $form->{msg} }; | |
| 83 | } | |
| 84 | } | |
| 85 | ||
| 86 | my $dbh = $db->db_connect(); | |
| 87 | my $schema_ready = $bill->schema_ready($db, $dbh, $DB); | |
| 88 | my $columns_ready = $schema_ready ? $bill->plan_columns_ready($db, $dbh, $DB) : 0; | |
| 89 | my $entitle_ready = $schema_ready ? $bill->plan_features_ready($db, $dbh, $DB) : 0; | |
| 90 | my $migration_pending = ($schema_ready && (!$columns_ready || !$entitle_ready)) ? 1 : 0; | |
| 91 | ||
| 92 | my @catalog = $bill->feature_catalog; | |
| 93 | ||
| 94 | # ---- LIST view: every plan (active + retired) grouped by tier ---- | |
| 95 | my @plans_for_list; | |
| 96 | if ($schema_ready) { | |
| 97 | foreach my $p ($bill->list_plans($db, $dbh, $DB, 1)) { | |
| 98 | my $features_set = $entitle_ready | |
| 99 | ? $bill->plan_feature_set($db, $dbh, $DB, $p->{id}) | |
| 100 | : {}; | |
| 101 | my @fset_labels; | |
| 102 | foreach my $f (@catalog) { | |
| 103 | push @fset_labels, $f->{name} if $features_set->{ $f->{key} }; | |
| 104 | } | |
| 105 | # Compute the effective yearly price from whatever mode this | |
| 106 | # plan is using so the list view shows both monthly + yearly. | |
| 107 | my $yearly_cents = $bill->compute_yearly_price_cents($p); | |
| 108 | my $yearly_label = ''; | |
| 109 | if ($yearly_cents > 0) { | |
| 110 | $yearly_label = $bill->fmt_money($yearly_cents, $p->{currency}); | |
| 111 | } elsif (($p->{price_cents} || 0) > 0) { | |
| 112 | $yearly_label = 'No yearly'; | |
| 113 | } | |
| 114 | ||
| 115 | push @plans_for_list, { | |
| 116 | id => $p->{id}, | |
| 117 | tier => $p->{tier}, | |
| 118 | tier_label => ucfirst($p->{tier} || ''), | |
| 119 | display_name => $p->{display_name} || '', | |
| 120 | tagline => $p->{tagline} || '', | |
| 121 | cta_label => $p->{cta_label} || '', | |
| 122 | price_display => $bill->fmt_money($p->{price_cents} || 0, $p->{currency}), | |
| 123 | price_cents => $p->{price_cents} || 0, | |
| 124 | yearly_display => $yearly_label, | |
| 125 | yearly_cents => $yearly_cents, | |
| 126 | yearly_mode => $p->{yearly_mode} || 'none', | |
| 127 | has_yearly => $yearly_cents > 0 ? 1 : 0, | |
| 128 | sort_order => $p->{sort_order} || 0, | |
| 129 | is_active => $p->{is_active} ? 1 : 0, | |
| 130 | is_inactive => $p->{is_active} ? 0 : 1, | |
| 131 | is_featured => $p->{is_featured} ? 1 : 0, | |
| 132 | entitled_summary => (@fset_labels ? join(', ', @fset_labels) : 'No features assigned'), | |
| 133 | entitled_count => scalar(@fset_labels), | |
| 134 | }; | |
| 135 | } | |
| 136 | } | |
| 137 | ||
| 138 | # ---- EDIT / NEW view --------------------------------------------------- | |
| 139 | my %edit_row; | |
| 140 | my @edit_features; | |
| 141 | if ($view eq 'edit' && $edit_id) { | |
| 142 | my $p = $bill->plan_by_id($db, $dbh, $DB, $edit_id); | |
| 143 | if ($p && $p->{id}) { | |
| 144 | my $set = $entitle_ready | |
| 145 | ? $bill->plan_feature_set($db, $dbh, $DB, $p->{id}) | |
| 146 | : {}; | |
| 147 | my $ym = $p->{yearly_mode} || 'none'; | |
| 148 | %edit_row = ( | |
| 149 | id => $p->{id}, | |
| 150 | tier => $p->{tier} || '', | |
| 151 | display_name => _h_attr($p->{display_name}), | |
| 152 | tagline => _h_attr($p->{tagline}), | |
| 153 | cta_label => _h_attr($p->{cta_label}), | |
| 154 | features_raw => _h_textarea($p->{features}), | |
| 155 | price_cents => $p->{price_cents} || 0, | |
| 156 | price_dollars => sprintf('%.2f', ($p->{price_cents} || 0) / 100), | |
| 157 | currency => $p->{currency} || 'USD', | |
| 158 | sort_order => defined $p->{sort_order} ? $p->{sort_order} : 0, | |
| 159 | is_active => $p->{is_active} ? 1 : 0, | |
| 160 | is_featured => $p->{is_featured} ? 1 : 0, | |
| 161 | is_active_checked => $p->{is_active} ? 'checked' : '', | |
| 162 | is_featured_checked => $p->{is_featured} ? 'checked' : '', | |
| 163 | # Yearly-pricing inputs (single row per tier, replaces the | |
| 164 | # old monthly+annual duplicate plans). Three modes: | |
| 165 | # none - tier offers monthly only (e.g. Free) | |
| 166 | # percent_off - X% off the monthly * 12 total | |
| 167 | # dollars_off - Subtract Y dollars from monthly * 12 | |
| 168 | # explicit - Type an exact yearly price | |
| 169 | yearly_mode => $ym, | |
| 170 | yearly_mode_none_sel => ($ym eq 'none') ? ' selected' : '', | |
| 171 | yearly_mode_percent_sel => ($ym eq 'percent_off') ? ' selected' : '', | |
| 172 | yearly_mode_dollars_sel => ($ym eq 'dollars_off') ? ' selected' : '', | |
| 173 | yearly_mode_explicit_sel=> ($ym eq 'explicit') ? ' selected' : '', | |
| 174 | yearly_pct_off => int($p->{yearly_pct_off} || 0), | |
| 175 | yearly_off_dollars => sprintf('%.2f', int($p->{yearly_off_cents} || 0) / 100), | |
| 176 | yearly_price_dollars => sprintf('%.2f', int($p->{yearly_price_cents} || 0) / 100), | |
| 177 | yearly_computed => $bill->fmt_money($bill->compute_yearly_price_cents($p), $p->{currency} || 'USD'), | |
| 178 | ); | |
| 179 | foreach my $f (@catalog) { | |
| 180 | push @edit_features, { | |
| 181 | key => $f->{key}, | |
| 182 | name => $f->{name}, | |
| 183 | blurb => $f->{blurb}, | |
| 184 | checked => $set->{ $f->{key} } ? 'checked' : '', | |
| 185 | included => $set->{ $f->{key} } ? 1 : 0, | |
| 186 | }; | |
| 187 | } | |
| 188 | } else { | |
| 189 | $view = 'list'; # bad id -> fall back | |
| 190 | } | |
| 191 | } | |
| 192 | if ($view eq 'new') { | |
| 193 | %edit_row = ( | |
| 194 | id => 0, | |
| 195 | tier => '', | |
| 196 | display_name => '', | |
| 197 | tagline => '', | |
| 198 | cta_label => 'Start free trial', | |
| 199 | features_raw => '', | |
| 200 | price_cents => 0, | |
| 201 | price_dollars => '0.00', | |
| 202 | currency => 'USD', | |
| 203 | sort_order => (scalar(@plans_for_list) * 10) + 10, | |
| 204 | is_active => 1, | |
| 205 | is_featured => 0, | |
| 206 | is_active_checked => 'checked', | |
| 207 | is_featured_checked => '', | |
| 208 | yearly_mode => 'percent_off', | |
| 209 | yearly_mode_none_sel => '', | |
| 210 | yearly_mode_percent_sel => ' selected', | |
| 211 | yearly_mode_dollars_sel => '', | |
| 212 | yearly_mode_explicit_sel=> '', | |
| 213 | yearly_pct_off => 17, # ~"2 months free" default | |
| 214 | yearly_off_dollars => '0.00', | |
| 215 | yearly_price_dollars => '0.00', | |
| 216 | yearly_computed => '$0.00', | |
| 217 | ); | |
| 218 | foreach my $f (@catalog) { | |
| 219 | push @edit_features, { | |
| 220 | key => $f->{key}, | |
| 221 | name => $f->{name}, | |
| 222 | blurb => $f->{blurb}, | |
| 223 | checked => '', | |
| 224 | included => 0, | |
| 225 | }; | |
| 226 | } | |
| 227 | } | |
| 228 | ||
| 229 | # Feature catalog block shared by both list (column header hint) and | |
| 230 | # the edit form. We also pre-compute the list of plans that currently | |
| 231 | # include each feature so the click-to-detail modal can show "Included | |
| 232 | # in: Starter, Pro, Studio" without doing a second round-trip. | |
| 233 | my @feature_catalog_view; | |
| 234 | foreach my $f (@catalog) { | |
| 235 | my @plans_with; | |
| 236 | if ($entitle_ready) { | |
| 237 | foreach my $p (@plans_for_list) { | |
| 238 | my $set = $bill->plan_feature_set($db, $dbh, $DB, $p->{id}); | |
| 239 | push @plans_with, $p->{display_name} if $set->{ $f->{key} }; | |
| 240 | } | |
| 241 | } | |
| 242 | push @feature_catalog_view, { | |
| 243 | key => $f->{key}, | |
| 244 | name => $f->{name}, | |
| 245 | blurb => $f->{blurb}, | |
| 246 | details => $f->{details} || '', | |
| 247 | enforced_in => $f->{enforced_in} || '', | |
| 248 | plans_included => (@plans_with ? join(', ', @plans_with) : 'No plans currently include this feature.'), | |
| 249 | has_plans => scalar(@plans_with) ? 1 : 0, | |
| 250 | }; | |
| 251 | } | |
| 252 | ||
| 253 | $db->db_disconnect($dbh); | |
| 254 | ||
| 255 | my $tvars = { | |
| 256 | user_id => $userinfo->{user_id}, | |
| 257 | is_view_list => ($view eq 'list') ? 1 : 0, | |
| 258 | is_view_edit => ($view eq 'edit') ? 1 : 0, | |
| 259 | is_view_new => ($view eq 'new') ? 1 : 0, | |
| 260 | is_view_form => ($view ne 'list') ? 1 : 0, | |
| 261 | schema_ready => $schema_ready ? 1 : 0, | |
| 262 | schema_missing => $schema_ready ? 0 : 1, | |
| 263 | migration_pending => $migration_pending, | |
| 264 | flash_msg => $flash_msg, | |
| 265 | has_flash => $flash_msg ? 1 : 0, | |
| 266 | flash_kind => $flash_kind, | |
| 267 | plan_count => scalar(@plans_for_list), | |
| 268 | plans => \@plans_for_list, | |
| 269 | has_plans => scalar(@plans_for_list) ? 1 : 0, | |
| 270 | feature_catalog => \@feature_catalog_view, | |
| 271 | edit_features => \@edit_features, | |
| 272 | %edit_row, | |
| 273 | }; | |
| 274 | ||
| 275 | 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"; | |
| 276 | ||
| 277 | my $body = join('', $tfile->template('webstls_admin_packages.html', $tvars, $userinfo)); | |
| 278 | ||
| 279 | $wrap->render({ | |
| 280 | userinfo => $userinfo, | |
| 281 | page_key => 'admin_packages', | |
| 282 | title => 'Pricing & Promotions', | |
| 283 | body => $body, | |
| 284 | }); | |
| 285 | ||
| 286 | #---------------------------------------------------------------------- | |
| 287 | sub _h_attr { | |
| 288 | my $s = shift; $s = '' unless defined $s; | |
| 289 | $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; $s =~ s/"/"/g; | |
| 290 | return $s; | |
| 291 | } | |
| 292 | sub _h_textarea { | |
| 293 | my $s = shift; $s = '' unless defined $s; | |
| 294 | $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; | |
| 295 | return $s; | |
| 296 | } | |
| 297 | ||
| 298 | #====================================================================== | |
| 299 | # admin_packages_action entry: POST handlers (create/save/retire/restore). | |
| 300 | # Auth (require_admin + require_super_admin) applied above. | |
| 301 | #====================================================================== | |
| 302 | sub _handle_action { | |
| 303 | my ($q, $form, $userinfo) = @_; | |
| 304 | ||
| 305 | my $action = $form->{action} || ''; | |
| 306 | ||
| 307 | my $dbh = $db->db_connect(); | |
| 308 | unless ($bill->schema_ready($db, $dbh, $DB)) { | |
| 309 | $db->db_disconnect($dbh); | |
| 310 | _act_err('billing schema missing -- run the migration first'); | |
| 311 | return; | |
| 312 | } | |
| 313 | unless ($bill->plan_columns_ready($db, $dbh, $DB)) { | |
| 314 | $db->db_disconnect($dbh); | |
| 315 | _act_err('plan columns not migrated -- run the Packages migration'); | |
| 316 | return; | |
| 317 | } | |
| 318 | ||
| 319 | if ($action eq 'create') { | |
| 320 | my @included = $q->multi_param('feature_keys'); | |
| 321 | my ($new_id, $err) = $bill->create_plan($db, $dbh, $DB, _act_form_to_plan_args($form)); | |
| 322 | if (!$new_id) { | |
| 323 | $db->db_disconnect($dbh); | |
| 324 | _act_err($err || 'create failed', '/admin_packages.cgi?new=1'); | |
| 325 | return; | |
| 326 | } | |
| 327 | $bill->set_plan_features($db, $dbh, $DB, $new_id, \@included) | |
| 328 | if $bill->plan_features_ready($db, $dbh, $DB); | |
| 329 | $db->db_disconnect($dbh); | |
| 330 | _act_back('/admin_packages.cgi?msg=created'); | |
| 331 | return; | |
| 332 | } | |
| 333 | elsif ($action eq 'save') { | |
| 334 | my $plan_id = $form->{plan_id} || ''; | |
| 335 | $plan_id =~ s/[^0-9]//g; | |
| 336 | unless ($plan_id) { | |
| 337 | $db->db_disconnect($dbh); | |
| 338 | _act_err('missing plan id'); | |
| 339 | return; | |
| 340 | } | |
| 341 | my @included = $q->multi_param('feature_keys'); | |
| 342 | my ($id, $err) = $bill->update_plan($db, $dbh, $DB, $plan_id, _act_form_to_plan_args($form)); | |
| 343 | if (!$id) { | |
| 344 | $db->db_disconnect($dbh); | |
| 345 | _act_err($err || 'save failed', "/admin_packages.cgi?edit_id=$plan_id"); | |
| 346 | return; | |
| 347 | } | |
| 348 | $bill->set_plan_features($db, $dbh, $DB, $id, \@included) | |
| 349 | if $bill->plan_features_ready($db, $dbh, $DB); | |
| 350 | $db->db_disconnect($dbh); | |
| 351 | _act_back('/admin_packages.cgi?msg=saved'); | |
| 352 | return; | |
| 353 | } | |
| 354 | elsif ($action eq 'retire') { | |
| 355 | my $plan_id = $form->{plan_id} || ''; | |
| 356 | $plan_id =~ s/[^0-9]//g; | |
| 357 | if ($plan_id) { | |
| 358 | $bill->deactivate_plan($db, $dbh, $DB, $plan_id); | |
| 359 | } | |
| 360 | $db->db_disconnect($dbh); | |
| 361 | _act_back('/admin_packages.cgi?msg=retired'); | |
| 362 | return; | |
| 363 | } | |
| 364 | elsif ($action eq 'restore') { | |
| 365 | my $plan_id = $form->{plan_id} || ''; | |
| 366 | $plan_id =~ s/[^0-9]//g; | |
| 367 | if ($plan_id) { | |
| 368 | $bill->activate_plan($db, $dbh, $DB, $plan_id); | |
| 369 | } | |
| 370 | $db->db_disconnect($dbh); | |
| 371 | _act_back('/admin_packages.cgi?msg=active'); | |
| 372 | return; | |
| 373 | } | |
| 374 | else { | |
| 375 | $db->db_disconnect($dbh); | |
| 376 | _act_back('/admin_packages.cgi'); | |
| 377 | return; | |
| 378 | } | |
| 379 | } | |
| 380 | ||
| 381 | sub _act_back { | |
| 382 | my ($target) = @_; | |
| 383 | $target ||= '/admin_packages.cgi'; | |
| 384 | print "Status: 302 Found\nLocation: $target\n\n"; | |
| 385 | } | |
| 386 | sub _act_err { | |
| 387 | my ($msg, $back_to) = @_; | |
| 388 | $msg =~ s/[^A-Za-z0-9 .,;:_\-\$()%']//g; | |
| 389 | _act_back(($back_to || '/admin_packages.cgi') . '?msg=err:' . $msg); | |
| 390 | } | |
| 391 | ||
| 392 | #---------------------------------------------------------------------- | |
| 393 | # Convert form fields into the kwargs Billing->{create,update}_plan | |
| 394 | # expect. Splits price (entered in dollars) into cents. | |
| 395 | sub _act_form_to_plan_args { | |
| 396 | my ($f) = @_; | |
| 397 | my $price_dollars = defined $f->{price_dollars} ? $f->{price_dollars} : '0'; | |
| 398 | $price_dollars =~ s/[^0-9.]//g; | |
| 399 | my $price_cents = int(($price_dollars + 0) * 100 + 0.5); | |
| 400 | ||
| 401 | # Yearly pricing: three modes, only one of the three inputs is read. | |
| 402 | my %yearly_ok = map { $_ => 1 } qw(none percent_off dollars_off explicit); | |
| 403 | my $yearly_mode = $f->{yearly_mode} || 'none'; | |
| 404 | $yearly_mode = 'none' unless $yearly_ok{$yearly_mode}; | |
| 405 | ||
| 406 | my $yearly_pct_off = int($f->{yearly_pct_off} || 0); | |
| 407 | $yearly_pct_off = 0 if $yearly_pct_off < 0; | |
| 408 | $yearly_pct_off = 90 if $yearly_pct_off > 90; | |
| 409 | ||
| 410 | my $yearly_off_dollars = defined $f->{yearly_off_dollars} ? $f->{yearly_off_dollars} : '0'; | |
| 411 | $yearly_off_dollars =~ s/[^0-9.]//g; | |
| 412 | my $yearly_off_cents = int(($yearly_off_dollars + 0) * 100 + 0.5); | |
| 413 | ||
| 414 | my $yearly_price_dollars = defined $f->{yearly_price_dollars} ? $f->{yearly_price_dollars} : '0'; | |
| 415 | $yearly_price_dollars =~ s/[^0-9.]//g; | |
| 416 | my $yearly_price_cents = int(($yearly_price_dollars + 0) * 100 + 0.5); | |
| 417 | ||
| 418 | return ( | |
| 419 | tier => $f->{tier}, | |
| 420 | # cadence is always 'monthly' on the row -- the row is the | |
| 421 | # canonical tier definition; the yearly_mode fields drive | |
| 422 | # the annual price. | |
| 423 | cadence => 'monthly', | |
| 424 | display_name => $f->{display_name}, | |
| 425 | tagline => $f->{tagline}, | |
| 426 | cta_label => $f->{cta_label}, | |
| 427 | features => $f->{features_raw}, | |
| 428 | price_cents => $price_cents, | |
| 429 | currency => $f->{currency}, | |
| 430 | sort_order => $f->{sort_order}, | |
| 431 | is_featured => ($f->{is_featured} ? 1 : 0), | |
| 432 | is_active => ($f->{is_active} ? 1 : 0), | |
| 433 | yearly_mode => $yearly_mode, | |
| 434 | yearly_pct_off => $yearly_pct_off, | |
| 435 | yearly_off_cents => $yearly_off_cents, | |
| 436 | yearly_price_cents => $yearly_price_cents, | |
| 437 | ); | |
| 438 | } |