added on WebSTLs (webstls.com) at 2026-07-01 22:26:18
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs - Admin Promotions | |
| 4 | # | |
| 5 | # Platform-wide promotions (scope='platform'). These can target any | |
| 6 | # buyer on any storefront -- used for new-customer acquisition and | |
| 7 | # platform-wide marketing pushes (signup discounts, holiday sales | |
| 8 | # across every store, etc.). | |
| 9 | # | |
| 10 | # Admin-only via MODS::WebSTLs::Admin->require_admin. | |
| 11 | #====================================================================== | |
| 12 | use strict; | |
| 13 | use warnings; | |
| 14 | ||
| 15 | use lib '/var/www/vhosts/webstls.com/httpdocs'; | |
| 16 | use CGI; | |
| 17 | use MODS::Template; | |
| 18 | use MODS::DBConnect; | |
| 19 | use MODS::Login; | |
| 20 | use MODS::WebSTLs::Config; | |
| 21 | use MODS::WebSTLs::Wrapper; | |
| 22 | use MODS::WebSTLs::Admin; | |
| 23 | use MODS::WebSTLs::Promotions; | |
| 24 | use MODS::WebSTLs::Billing; | |
| 25 | ||
| 26 | my $q = CGI->new; | |
| 27 | my $form = $q->Vars; | |
| 28 | my $auth = MODS::Login->new; | |
| 29 | my $wrap = MODS::WebSTLs::Wrapper->new; | |
| 30 | my $tfile = MODS::Template->new; | |
| 31 | my $db = MODS::DBConnect->new; | |
| 32 | my $cfg = MODS::WebSTLs::Config->new; | |
| 33 | my $admin = MODS::WebSTLs::Admin->new; | |
| 34 | my $promo = MODS::WebSTLs::Promotions->new; | |
| 35 | my $DB = $cfg->settings('database_name'); | |
| 36 | ||
| 37 | $|=1; | |
| 38 | my $userinfo = $auth->login_verify(); | |
| 39 | if (!$userinfo) { | |
| 40 | print "Status: 302 Found\nLocation: /login.cgi\n\n"; | |
| 41 | exit; | |
| 42 | } | |
| 43 | $admin->require_admin($userinfo); | |
| 44 | require MODS::WebSTLs::Permissions; | |
| 45 | ||
| 46 | my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'admin_promotions'; | |
| 47 | ||
| 48 | if ($entry eq 'admin_promotion_action') { | |
| 49 | MODS::WebSTLs::Permissions->new->require_feature($userinfo, 'admin_edit_promotions'); | |
| 50 | _handle_action($q, $form, $userinfo); | |
| 51 | exit; | |
| 52 | } | |
| 53 | ||
| 54 | MODS::WebSTLs::Permissions->new->require_feature($userinfo, 'admin_view_promotions'); | |
| 55 | ||
| 56 | my $admin_id = $userinfo->{user_id}; | |
| 57 | $admin_id =~ s/[^0-9]//g; | |
| 58 | ||
| 59 | my $tutorial_mode = ($form->{tutorial} && $form->{tutorial} eq '1') ? 1 : 0; | |
| 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 $dbh = $db->db_connect(); | |
| 68 | my $schema_ready = $promo->schema_ready($db, $dbh, $DB); | |
| 69 | ||
| 70 | my @rows_raw = $schema_ready ? $promo->list_for_admin($db, $dbh, $DB, 200) : (); | |
| 71 | ||
| 72 | my @rows; | |
| 73 | my $cnt_active = 0; my $cnt_scheduled = 0; my $cnt_paused = 0; my $cnt_expired = 0; | |
| 74 | my $sum_redemptions = 0; my $sum_discount_cents = 0; | |
| 75 | foreach my $r (@rows_raw) { | |
| 76 | my $effective = $promo->effective_status($r); | |
| 77 | $cnt_active++ if $effective eq 'active'; | |
| 78 | $cnt_scheduled++ if $effective eq 'scheduled'; | |
| 79 | $cnt_paused++ if $effective eq 'paused'; | |
| 80 | $cnt_expired++ if $effective eq 'expired' || $effective eq 'exhausted'; | |
| 81 | $sum_redemptions += $r->{current_redemptions} || 0; | |
| 82 | $sum_discount_cents += $promo->total_discount_given_cents($db, $dbh, $DB, $r->{id}); | |
| 83 | ||
| 84 | push @rows, _row_for_template($r, $promo, $db, $dbh, $DB, $sum_discount_cents); | |
| 85 | } | |
| 86 | ||
| 87 | my %edit_row; | |
| 88 | if ($view eq 'edit' && $edit_id) { | |
| 89 | my $e = $promo->get_for_admin($db, $dbh, $DB, $edit_id); | |
| 90 | if ($e && $e->{id}) { | |
| 91 | %edit_row = _row_for_edit_form($e); | |
| 92 | my @eligible = $promo->eligible_plan_ids($db, $dbh, $DB, $e->{id}); | |
| 93 | $edit_row{eligible_plan_ids_csv} = join(',', @eligible); | |
| 94 | $edit_row{applies_all_plans} = scalar(@eligible) ? 0 : 1; | |
| 95 | $edit_row{applies_specific} = scalar(@eligible) ? 1 : 0; | |
| 96 | } else { | |
| 97 | $view = 'list'; | |
| 98 | } | |
| 99 | } | |
| 100 | ||
| 101 | # Paid plans list (Free excluded -- there's nothing to discount from $0) | |
| 102 | # for the "Applies to" checklist on the create/edit form. | |
| 103 | my @plan_options; | |
| 104 | { | |
| 105 | my $bill = MODS::WebSTLs::Billing->new; | |
| 106 | if ($bill->schema_ready($db, $dbh, $DB)) { | |
| 107 | foreach my $p ($bill->list_plans($db, $dbh, $DB)) { | |
| 108 | next unless ($p->{price_cents} || 0) > 0; | |
| 109 | my $set = $edit_row{eligible_plan_ids_csv} || ''; | |
| 110 | my $checked = ($view eq 'edit' && $set =~ /(^|,)$p->{id}(,|$)/) ? 'checked' : ''; | |
| 111 | push @plan_options, { | |
| 112 | id => $p->{id}, | |
| 113 | tier_label => ucfirst($p->{tier} || ''), | |
| 114 | display_name => $p->{display_name} || ucfirst($p->{tier} || ''), | |
| 115 | price_display => $bill->fmt_money($p->{price_cents} || 0, $p->{currency}), | |
| 116 | checked => $checked, | |
| 117 | }; | |
| 118 | } | |
| 119 | } | |
| 120 | } | |
| 121 | ||
| 122 | my %flash; | |
| 123 | if ($form->{ok} eq 'created') { %flash = (kind=>'ok', msg=>'Platform promotion created.'); } | |
| 124 | elsif ($form->{ok} eq 'updated') { %flash = (kind=>'ok', msg=>'Platform promotion updated.'); } | |
| 125 | elsif ($form->{ok} eq 'deleted') { %flash = (kind=>'ok', msg=>'Platform promotion deleted.'); } | |
| 126 | elsif ($form->{ok} eq 'activated') { %flash = (kind=>'ok', msg=>'Promotion is now active across the platform.'); } | |
| 127 | elsif ($form->{ok} eq 'paused') { %flash = (kind=>'ok', msg=>'Promotion paused.'); } | |
| 128 | elsif ($form->{err} eq 'bad_input') { %flash = (kind=>'err', msg=>'Required fields missing.'); } | |
| 129 | elsif ($form->{err} eq 'denied') { %flash = (kind=>'err', msg=>'Action not permitted.'); } | |
| 130 | ||
| 131 | $db->db_disconnect($dbh); | |
| 132 | ||
| 133 | my $tvars = { | |
| 134 | user_id => $admin_id, | |
| 135 | ||
| 136 | is_list => ($view eq 'list') ? 1 : 0, | |
| 137 | is_new => ($view eq 'new') ? 1 : 0, | |
| 138 | is_edit => ($view eq 'edit') ? 1 : 0, | |
| 139 | ||
| 140 | rows => \@rows, | |
| 141 | has_rows => scalar(@rows) ? 1 : 0, | |
| 142 | cnt_active => $cnt_active, | |
| 143 | cnt_scheduled => $cnt_scheduled, | |
| 144 | cnt_paused => $cnt_paused, | |
| 145 | cnt_expired => $cnt_expired, | |
| 146 | cnt_total => scalar(@rows), | |
| 147 | sum_redemptions => $sum_redemptions, | |
| 148 | sum_discount_display => '$' . sprintf('%.2f', $sum_discount_cents / 100), | |
| 149 | ||
| 150 | edit => \%edit_row, | |
| 151 | has_edit => %edit_row ? 1 : 0, | |
| 152 | plan_options => \@plan_options, | |
| 153 | has_plan_options => scalar(@plan_options) ? 1 : 0, | |
| 154 | ||
| 155 | schema_ready => $schema_ready ? 1 : 0, | |
| 156 | schema_missing => $schema_ready ? 0 : 1, | |
| 157 | ||
| 158 | flash_kind => $flash{kind} || '', | |
| 159 | flash_msg => $flash{msg} || '', | |
| 160 | has_flash => %flash ? 1 : 0, | |
| 161 | ||
| 162 | tutorial_mode => $tutorial_mode, | |
| 163 | not_tutorial_mode => $tutorial_mode ? 0 : 1, | |
| 164 | }; | |
| 165 | ||
| 166 | # Tutorial sample for the list view. | |
| 167 | if ($tutorial_mode && $view eq 'list') { | |
| 168 | $tvars->{rows} = [ | |
| 169 | { id=>1, name=>'New customer 20 percent off first order', kind_label=>'Coupon', is_coupon=>1, is_sale=>0, is_bundle=>0, is_flash=>0, | |
| 170 | discount_label=>'20% off', code=>'NEWBIE20', code_present=>1, public_slug=>'newbie20', slug_present=>1, | |
| 171 | status=>'active', status_label=>'Active', is_active=>1, is_paused=>0, is_scheduled=>0, is_expired=>0, is_draft=>0, | |
| 172 | starts_at=>'2026-01-01 00:00:00', ends_at=>'', has_window=>0, | |
| 173 | current_redemptions=>418, max_redemptions=>0, has_cap=>0, cap_label=>'418 used', | |
| 174 | discount_given_display=>'$4,180.00', new_customers_only=>1, | |
| 175 | edit_url=>'/admin_promotions.cgi?edit_id=1', tutorial_demo=>1 }, | |
| 176 | { id=>2, name=>'Summer site-wide 15 off', kind_label=>'Sale', is_coupon=>0, is_sale=>1, is_bundle=>0, is_flash=>0, | |
| 177 | discount_label=>'15% off', code=>'', code_present=>0, public_slug=>'summer-sale', slug_present=>1, | |
| 178 | status=>'scheduled', status_label=>'Scheduled', is_active=>0, is_paused=>0, is_scheduled=>1, is_expired=>0, is_draft=>0, | |
| 179 | starts_at=>'2026-06-21 00:00:00', ends_at=>'2026-07-04 23:59:00', has_window=>1, | |
| 180 | current_redemptions=>0, max_redemptions=>0, has_cap=>0, cap_label=>'0 used', | |
| 181 | discount_given_display=>'$0.00', new_customers_only=>0, | |
| 182 | edit_url=>'/admin_promotions.cgi?edit_id=2', tutorial_demo=>1 }, | |
| 183 | { id=>3, name=>'Black Friday flash 30 off', kind_label=>'Flash sale', is_coupon=>0, is_sale=>0, is_bundle=>0, is_flash=>1, | |
| 184 | discount_label=>'30% off', code=>'BLACKFRI', code_present=>1, public_slug=>'black-friday', slug_present=>1, | |
| 185 | status=>'scheduled', status_label=>'Scheduled', is_active=>0, is_paused=>0, is_scheduled=>1, is_expired=>0, is_draft=>0, | |
| 186 | starts_at=>'2026-11-27 00:00:00', ends_at=>'2026-11-29 23:59:00', has_window=>1, | |
| 187 | current_redemptions=>0, max_redemptions=>5000, has_cap=>1, cap_label=>'0 of 5000 used', | |
| 188 | discount_given_display=>'$0.00', new_customers_only=>0, | |
| 189 | edit_url=>'/admin_promotions.cgi?edit_id=3', tutorial_demo=>1 }, | |
| 190 | ]; | |
| 191 | $tvars->{has_rows} = 1; | |
| 192 | $tvars->{cnt_active} = 1; | |
| 193 | $tvars->{cnt_scheduled} = 2; | |
| 194 | $tvars->{cnt_paused} = 0; | |
| 195 | $tvars->{cnt_expired} = 0; | |
| 196 | $tvars->{cnt_total} = 3; | |
| 197 | $tvars->{sum_redemptions} = 418; | |
| 198 | $tvars->{sum_discount_display} = '$4,180.00'; | |
| 199 | $tvars->{schema_ready} = 1; | |
| 200 | $tvars->{schema_missing} = 0; | |
| 201 | } | |
| 202 | ||
| 203 | 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"; | |
| 204 | ||
| 205 | my $body = join('', $tfile->template('webstls_admin_promotions.html', $tvars, $userinfo)); | |
| 206 | ||
| 207 | $wrap->render({ | |
| 208 | userinfo => $userinfo, | |
| 209 | # Shared sidebar key with admin_packages.cgi -- the two pages live | |
| 210 | # under one "Pricing & Promotions" sidebar entry and a tab nav at | |
| 211 | # the top of each template lets the admin flip between them. | |
| 212 | page_key => 'admin_packages', | |
| 213 | title => 'Pricing & Promotions', | |
| 214 | body => $body, | |
| 215 | }); | |
| 216 | ||
| 217 | # ----------------------------------------------------------------- helpers | |
| 218 | sub _row_for_template { | |
| 219 | my ($r, $promo, $db, $dbh, $DB) = @_; | |
| 220 | my $eff = $promo->effective_status($r); | |
| 221 | return { | |
| 222 | id => $r->{id}, | |
| 223 | name => _h($r->{name} || ''), | |
| 224 | kind_label => ucfirst($r->{kind} || ''), | |
| 225 | is_coupon => ($r->{kind} eq 'coupon') ? 1 : 0, | |
| 226 | is_sale => ($r->{kind} eq 'sale') ? 1 : 0, | |
| 227 | is_bundle => ($r->{kind} eq 'bundle') ? 1 : 0, | |
| 228 | is_flash => ($r->{kind} eq 'flash_sale') ? 1 : 0, | |
| 229 | discount_label => $promo->discount_label($r), | |
| 230 | code => _h($r->{code} || ''), | |
| 231 | code_present => ($r->{code} && $r->{code} ne '') ? 1 : 0, | |
| 232 | public_slug => _h($r->{public_slug} || ''), | |
| 233 | slug_present => ($r->{public_slug} && $r->{public_slug} ne '') ? 1 : 0, | |
| 234 | status => $eff, | |
| 235 | status_label => $promo->status_label($eff), | |
| 236 | is_active => $eff eq 'active' ? 1 : 0, | |
| 237 | is_paused => $eff eq 'paused' ? 1 : 0, | |
| 238 | is_scheduled => $eff eq 'scheduled' ? 1 : 0, | |
| 239 | is_expired => ($eff eq 'expired' || $eff eq 'exhausted') ? 1 : 0, | |
| 240 | is_draft => $eff eq 'draft' ? 1 : 0, | |
| 241 | starts_at => $r->{starts_at} || '', | |
| 242 | ends_at => $r->{ends_at} || '', | |
| 243 | has_window => (($r->{starts_at} || $r->{ends_at}) ? 1 : 0), | |
| 244 | current_redemptions => $r->{current_redemptions} || 0, | |
| 245 | max_redemptions => defined $r->{max_redemptions} ? $r->{max_redemptions} : 0, | |
| 246 | has_cap => (defined $r->{max_redemptions} && $r->{max_redemptions} > 0) ? 1 : 0, | |
| 247 | cap_label => _cap_label($r), | |
| 248 | discount_given_display => '$' . sprintf('%.2f', ($promo->total_discount_given_cents($db, $dbh, $DB, $r->{id}) || 0) / 100), | |
| 249 | new_customers_only => $r->{new_customers_only} ? 1 : 0, | |
| 250 | edit_url => '/admin_promotions.cgi?edit_id=' . $r->{id}, | |
| 251 | }; | |
| 252 | } | |
| 253 | ||
| 254 | sub _row_for_edit_form { | |
| 255 | my ($r) = @_; | |
| 256 | my $pct = ($r->{discount_value_bp} || 0) / 100; | |
| 257 | my $amt = ($r->{discount_value_cents} || 0) / 100; | |
| 258 | my $min = ($r->{minimum_order_cents} || 0) / 100; | |
| 259 | my $tk = $r->{target_kind} || 'model'; | |
| 260 | return ( | |
| 261 | id => $r->{id}, | |
| 262 | name => _h($r->{name} || ''), | |
| 263 | description => _h($r->{description} || ''), | |
| 264 | kind => $r->{kind}, | |
| 265 | is_coupon => ($r->{kind} eq 'coupon') ? 1 : 0, | |
| 266 | is_sale => ($r->{kind} eq 'sale') ? 1 : 0, | |
| 267 | is_bundle => ($r->{kind} eq 'bundle') ? 1 : 0, | |
| 268 | is_flash => ($r->{kind} eq 'flash_sale') ? 1 : 0, | |
| 269 | target_kind => $tk, | |
| 270 | is_target_model=> ($tk eq 'model') ? 1 : 0, | |
| 271 | is_target_plan => ($tk eq 'plan') ? 1 : 0, | |
| 272 | is_target_any => ($tk eq 'any') ? 1 : 0, | |
| 273 | discount_type => $r->{discount_type}, | |
| 274 | is_dtype_pct => ($r->{discount_type} eq 'percent') ? 1 : 0, | |
| 275 | is_dtype_amt => ($r->{discount_type} eq 'fixed_amount') ? 1 : 0, | |
| 276 | is_dtype_bun => ($r->{discount_type} eq 'bundle_price') ? 1 : 0, | |
| 277 | is_dtype_free => ($r->{discount_type} eq 'free') ? 1 : 0, | |
| 278 | discount_value_pct => sprintf('%.0f', $pct), | |
| 279 | discount_value_amt => sprintf('%.2f', $amt), | |
| 280 | minimum_order => sprintf('%.2f', $min), | |
| 281 | code => _h($r->{code} || ''), | |
| 282 | public_slug => _h($r->{public_slug} || ''), | |
| 283 | starts_at_local => _to_local_input($r->{starts_at}), | |
| 284 | ends_at_local => _to_local_input($r->{ends_at}), | |
| 285 | max_redemptions => defined $r->{max_redemptions} ? $r->{max_redemptions} : '', | |
| 286 | max_per_user => defined $r->{max_per_user} ? $r->{max_per_user} : '', | |
| 287 | new_customers_only => $r->{new_customers_only} ? 1 : 0, | |
| 288 | status => $r->{status}, | |
| 289 | ); | |
| 290 | } | |
| 291 | ||
| 292 | sub _to_local_input { | |
| 293 | my $ts = shift; | |
| 294 | return '' unless defined $ts && $ts ne ''; | |
| 295 | if ($ts =~ /^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2})/) { | |
| 296 | return "$1T$2"; | |
| 297 | } | |
| 298 | return ''; | |
| 299 | } | |
| 300 | ||
| 301 | sub _cap_label { | |
| 302 | my ($r) = @_; | |
| 303 | my $cur = $r->{current_redemptions} || 0; | |
| 304 | if (defined $r->{max_redemptions} && $r->{max_redemptions} > 0) { | |
| 305 | return "$cur of $r->{max_redemptions} used"; | |
| 306 | } | |
| 307 | return "$cur used"; | |
| 308 | } | |
| 309 | ||
| 310 | sub _h { | |
| 311 | my $s = shift; | |
| 312 | $s //= ''; | |
| 313 | $s =~ s/&/&/g; | |
| 314 | $s =~ s/</</g; | |
| 315 | $s =~ s/>/>/g; | |
| 316 | $s =~ s/"/"/g; | |
| 317 | return $s; | |
| 318 | } | |
| 319 | ||
| 320 | #====================================================================== | |
| 321 | # admin_promotion_action entry: platform-wide create/update/delete/ | |
| 322 | # activate/pause/archive. require_feature('admin_edit_promotions') | |
| 323 | # applied at the dispatch site above. | |
| 324 | #====================================================================== | |
| 325 | sub _handle_action { | |
| 326 | my ($q, $form, $userinfo) = @_; | |
| 327 | ||
| 328 | my $admin_id = $userinfo->{user_id}; | |
| 329 | $admin_id =~ s/[^0-9]//g; | |
| 330 | ||
| 331 | my $act = defined $form->{act} ? $form->{act} : ''; | |
| 332 | ||
| 333 | my $dbh = $db->db_connect(); | |
| 334 | my $promo_h = MODS::WebSTLs::Promotions->new; | |
| 335 | unless ($promo_h->schema_ready($db, $dbh, $DB)) { | |
| 336 | $db->db_disconnect($dbh); | |
| 337 | _act_redirect('/admin_promotions.cgi?err=schema'); | |
| 338 | return; | |
| 339 | } | |
| 340 | ||
| 341 | if ($act eq 'create') { | |
| 342 | my $new_id = $promo_h->create($db, $dbh, $DB, | |
| 343 | scope => 'platform', | |
| 344 | storefront_id => undef, | |
| 345 | kind => $form->{kind}, | |
| 346 | # Platform-scope (admin-issued) promos always target our | |
| 347 | # subscription plans -- never a seller's product catalog. The | |
| 348 | # admin form intentionally omits the target_kind selector. | |
| 349 | target_kind => 'plan', | |
| 350 | name => $form->{name}, | |
| 351 | description => $form->{description}, | |
| 352 | discount_type => $form->{discount_type}, | |
| 353 | discount_value_bp => _act_percent_to_bp($form->{discount_value_pct}), | |
| 354 | discount_value_cents => _act_dollars_to_cents($form->{discount_value_amt}), | |
| 355 | minimum_order_cents => _act_dollars_to_cents($form->{minimum_order}), | |
| 356 | code => $form->{code}, | |
| 357 | public_slug => $form->{public_slug}, | |
| 358 | starts_at => $form->{starts_at_local}, | |
| 359 | ends_at => $form->{ends_at_local}, | |
| 360 | max_redemptions => $form->{max_redemptions}, | |
| 361 | max_per_user => $form->{max_per_user}, | |
| 362 | new_customers_only => $form->{new_customers_only}, | |
| 363 | status => $form->{publish_now} ? 'active' : 'draft', | |
| 364 | created_by_user_id => $admin_id, | |
| 365 | ); | |
| 366 | unless ($new_id) { | |
| 367 | $db->db_disconnect($dbh); | |
| 368 | _act_redirect('/admin_promotions.cgi?err=bad_input'); | |
| 369 | return; | |
| 370 | } | |
| 371 | # Persist the "Applies to plans" picks. Only when the admin chose | |
| 372 | # 'specific' -- 'all' leaves the join table empty, which the | |
| 373 | # validate/load helpers interpret as "every paid plan". | |
| 374 | if (($form->{plan_scope} || 'all') eq 'specific') { | |
| 375 | my @ids = _act_multi_values($q, 'plan_ids'); | |
| 376 | $promo_h->set_eligible_plans($db, $dbh, $DB, $new_id, \@ids); | |
| 377 | } else { | |
| 378 | $promo_h->set_eligible_plans($db, $dbh, $DB, $new_id, []); | |
| 379 | } | |
| 380 | $db->db_disconnect($dbh); | |
| 381 | _act_redirect('/admin_promotions.cgi?ok=created'); | |
| 382 | return; | |
| 383 | } | |
| 384 | ||
| 385 | if ($act eq 'update') { | |
| 386 | my $id = $form->{id}; $id =~ s/[^0-9]//g; | |
| 387 | my $row = $id ? $promo_h->get_for_admin($db, $dbh, $DB, $id) : {}; | |
| 388 | unless ($row && $row->{id}) { | |
| 389 | $db->db_disconnect($dbh); | |
| 390 | _act_redirect('/admin_promotions.cgi?err=denied'); | |
| 391 | return; | |
| 392 | } | |
| 393 | my $ok = $promo_h->update($db, $dbh, $DB, $id, | |
| 394 | scope => 'platform', | |
| 395 | storefront_id => undef, | |
| 396 | kind => $form->{kind}, | |
| 397 | # Platform-scope (admin-issued) promos always target plans -- | |
| 398 | # never a seller's product catalog. See create handler. | |
| 399 | target_kind => 'plan', | |
| 400 | name => $form->{name}, | |
| 401 | description => $form->{description}, | |
| 402 | discount_type => $form->{discount_type}, | |
| 403 | discount_value_bp => _act_percent_to_bp($form->{discount_value_pct}), | |
| 404 | discount_value_cents => _act_dollars_to_cents($form->{discount_value_amt}), | |
| 405 | minimum_order_cents => _act_dollars_to_cents($form->{minimum_order}), | |
| 406 | code => $form->{code}, | |
| 407 | public_slug => $form->{public_slug}, | |
| 408 | starts_at => $form->{starts_at_local}, | |
| 409 | ends_at => $form->{ends_at_local}, | |
| 410 | max_redemptions => $form->{max_redemptions}, | |
| 411 | max_per_user => $form->{max_per_user}, | |
| 412 | new_customers_only => $form->{new_customers_only}, | |
| 413 | ); | |
| 414 | unless ($ok) { | |
| 415 | $db->db_disconnect($dbh); | |
| 416 | _act_redirect('/admin_promotions.cgi?err=bad_input'); | |
| 417 | return; | |
| 418 | } | |
| 419 | if (($form->{plan_scope} || 'all') eq 'specific') { | |
| 420 | my @ids = _act_multi_values($q, 'plan_ids'); | |
| 421 | $promo_h->set_eligible_plans($db, $dbh, $DB, $id, \@ids); | |
| 422 | } else { | |
| 423 | $promo_h->set_eligible_plans($db, $dbh, $DB, $id, []); | |
| 424 | } | |
| 425 | $db->db_disconnect($dbh); | |
| 426 | _act_redirect('/admin_promotions.cgi?ok=updated'); | |
| 427 | return; | |
| 428 | } | |
| 429 | ||
| 430 | if ($act eq 'activate' || $act eq 'pause' || $act eq 'archive') { | |
| 431 | my $id = $form->{id}; $id =~ s/[^0-9]//g; | |
| 432 | my $row = $id ? $promo_h->get_for_admin($db, $dbh, $DB, $id) : {}; | |
| 433 | unless ($row && $row->{id}) { | |
| 434 | $db->db_disconnect($dbh); | |
| 435 | _act_redirect('/admin_promotions.cgi?err=denied'); | |
| 436 | return; | |
| 437 | } | |
| 438 | my $new_status = | |
| 439 | $act eq 'activate' ? 'active' : | |
| 440 | $act eq 'pause' ? 'paused' : | |
| 441 | 'archived'; | |
| 442 | $promo_h->set_status($db, $dbh, $DB, $id, $new_status); | |
| 443 | $db->db_disconnect($dbh); | |
| 444 | _act_redirect('/admin_promotions.cgi?ok=' . ($act eq 'activate' ? 'activated' : $act eq 'pause' ? 'paused' : 'updated')); | |
| 445 | return; | |
| 446 | } | |
| 447 | ||
| 448 | if ($act eq 'delete') { | |
| 449 | my $id = $form->{id}; $id =~ s/[^0-9]//g; | |
| 450 | my $row = $id ? $promo_h->get_for_admin($db, $dbh, $DB, $id) : {}; | |
| 451 | unless ($row && $row->{id}) { | |
| 452 | $db->db_disconnect($dbh); | |
| 453 | _act_redirect('/admin_promotions.cgi?err=denied'); | |
| 454 | return; | |
| 455 | } | |
| 456 | $promo_h->delete_promo($db, $dbh, $DB, $id); | |
| 457 | $db->db_disconnect($dbh); | |
| 458 | _act_redirect('/admin_promotions.cgi?ok=deleted'); | |
| 459 | return; | |
| 460 | } | |
| 461 | ||
| 462 | $db->db_disconnect($dbh); | |
| 463 | _act_redirect('/admin_promotions.cgi?err=unknown_act'); | |
| 464 | } | |
| 465 | ||
| 466 | sub _act_redirect { my $url = shift; print "Status: 302 Found\nLocation: $url\n\n"; } | |
| 467 | # CGI->Vars collapses repeated form fields into a single \0-joined | |
| 468 | # string. For the plan_ids[] checkboxes we want them back as a list. | |
| 469 | sub _act_multi_values { | |
| 470 | my ($q, $name) = @_; | |
| 471 | my @raw = $q->multi_param($name); | |
| 472 | return () unless @raw; | |
| 473 | my @out; | |
| 474 | foreach my $v (@raw) { | |
| 475 | next unless defined $v; | |
| 476 | foreach my $piece (split /\0/, $v) { | |
| 477 | $piece =~ s/[^0-9]//g; | |
| 478 | push @out, $piece if length $piece; | |
| 479 | } | |
| 480 | } | |
| 481 | return @out; | |
| 482 | } | |
| 483 | sub _act_percent_to_bp { | |
| 484 | my $v = shift; return 0 unless defined $v && $v ne ''; | |
| 485 | $v =~ s/[^0-9.]//g; return 0 unless length $v; | |
| 486 | my $bp = int($v * 100); $bp = 0 if $bp < 0; $bp = 10000 if $bp > 10000; return $bp; | |
| 487 | } | |
| 488 | sub _act_dollars_to_cents { | |
| 489 | my $v = shift; return 0 unless defined $v && $v ne ''; | |
| 490 | $v =~ s/[^0-9.]//g; return 0 unless length $v; | |
| 491 | return int($v * 100 + 0.5); | |
| 492 | } |