Diff -- /var/www/vhosts/3dshawn.com/abforge.3dshawn.com/admin_promotions.cgi
Diff

/var/www/vhosts/3dshawn.com/abforge.3dshawn.com/admin_promotions.cgi

added on local at 2026-07-01 16:00:56

Added
+482
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to ccceccd6ae07
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# ABForge - Admin Promotions
4#
5# Platform-wide promotions (scope='platform'). These can target any
6# subscriber on any plan -- used for new-customer acquisition and
7# platform-wide marketing pushes (signup discounts, holiday sales,
8# Black Friday flash sales, etc.).
9#
10# Super-admin-gated via MODS::ABForge::Permissions->require_super_admin
11# to match admin_packages.cgi -- pricing & promotions live together.
12#======================================================================
13use strict;
14use warnings;
15
16use lib '/var/www/vhosts/abforge.com/httpdocs';
17use CGI;
18use MODS::Template;
19use MODS::DBConnect;
20use MODS::Login;
21use MODS::ABForge::Config;
22use MODS::ABForge::Wrapper;
23use MODS::ABForge::Admin;
24use MODS::ABForge::Promotions;
25use MODS::ABForge::Billing;
26
27my $q = CGI->new;
28my $form = $q->Vars;
29my $auth = MODS::Login->new;
30my $wrap = MODS::ABForge::Wrapper->new;
31my $tfile = MODS::Template->new;
32my $db = MODS::DBConnect->new;
33my $cfg = MODS::ABForge::Config->new;
34my $admin = MODS::ABForge::Admin->new;
35my $promo = MODS::ABForge::Promotions->new;
36my $DB = $cfg->settings('database_name');
37
38$|=1;
39my $userinfo = $auth->login_verify();
40if (!$userinfo) {
41 print "Status: 302 Found\nLocation: /login.cgi\n\n";
42 exit;
43}
44
45my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'admin_promotions';
46
47if ($entry eq 'admin_promotion_action') {
48 $admin->require_admin($userinfo);
49 require MODS::ABForge::Permissions;
50 MODS::ABForge::Permissions->new->require_super_admin($userinfo);
51 _handle_action($q, $form);
52 exit;
53}
54
55$admin->require_admin($userinfo);
56require MODS::ABForge::Permissions;
57MODS::ABForge::Permissions->new->require_super_admin($userinfo);
58
59my $admin_id = $userinfo->{user_id};
60$admin_id =~ s/[^0-9]//g;
61
62my $tutorial_mode = ($form->{tutorial} && $form->{tutorial} eq '1') ? 1 : 0;
63
64my $view = ($form->{new} && $form->{new} eq '1') ? 'new'
65 : ($form->{edit_id} && $form->{edit_id} =~ /^\d+$/) ? 'edit'
66 : 'list';
67my $edit_id = ($form->{edit_id} || '');
68$edit_id =~ s/[^0-9]//g;
69
70my $dbh = $db->db_connect();
71my $schema_ready = $promo->schema_ready($db, $dbh, $DB);
72
73my @rows_raw = $schema_ready ? $promo->list_for_admin($db, $dbh, $DB, 200) : ();
74
75my @rows;
76my $cnt_active = 0; my $cnt_scheduled = 0; my $cnt_paused = 0; my $cnt_expired = 0;
77my $sum_redemptions = 0; my $sum_discount_cents = 0;
78foreach my $r (@rows_raw) {
79 my $effective = $promo->effective_status($r);
80 $cnt_active++ if $effective eq 'active';
81 $cnt_scheduled++ if $effective eq 'scheduled';
82 $cnt_paused++ if $effective eq 'paused';
83 $cnt_expired++ if $effective eq 'expired' || $effective eq 'exhausted';
84 $sum_redemptions += $r->{current_redemptions} || 0;
85 $sum_discount_cents += $promo->total_discount_given_cents($db, $dbh, $DB, $r->{id});
86
87 push @rows, _row_for_template($r, $promo, $db, $dbh, $DB);
88}
89
90my %edit_row;
91if ($view eq 'edit' && $edit_id) {
92 my $e = $promo->get_for_admin($db, $dbh, $DB, $edit_id);
93 if ($e && $e->{id}) {
94 %edit_row = _row_for_edit_form($e);
95 my @eligible = $promo->eligible_plan_ids($db, $dbh, $DB, $e->{id});
96 $edit_row{eligible_plan_ids_csv} = join(',', @eligible);
97 $edit_row{applies_all_plans} = scalar(@eligible) ? 0 : 1;
98 $edit_row{applies_specific} = scalar(@eligible) ? 1 : 0;
99 } else {
100 $view = 'list';
101 }
102}
103
104# Paid plans list (Free excluded -- nothing to discount from $0) for the
105# "Applies to" checklist on the create/edit form.
106my @plan_options;
107{
108 my $bill = MODS::ABForge::Billing->new;
109 if ($bill->schema_ready($db, $dbh, $DB)) {
110 foreach my $p ($bill->list_plans($db, $dbh, $DB)) {
111 next unless ($p->{price_cents} || 0) > 0;
112 my $set = $edit_row{eligible_plan_ids_csv} || '';
113 my $checked = ($view eq 'edit' && $set =~ /(^|,)$p->{id}(,|$)/) ? 'checked' : '';
114 push @plan_options, {
115 id => $p->{id},
116 tier_label => ucfirst($p->{tier} || ''),
117 display_name => $p->{display_name} || ucfirst($p->{tier} || ''),
118 price_display => $bill->fmt_money($p->{price_cents} || 0, $p->{currency}),
119 checked => $checked,
120 };
121 }
122 }
123}
124
125my %flash;
126if (($form->{ok} || '') eq 'created') { %flash = (kind=>'ok', msg=>'Platform promotion created.'); }
127elsif (($form->{ok} || '') eq 'updated') { %flash = (kind=>'ok', msg=>'Platform promotion updated.'); }
128elsif (($form->{ok} || '') eq 'deleted') { %flash = (kind=>'ok', msg=>'Platform promotion deleted.'); }
129elsif (($form->{ok} || '') eq 'activated') { %flash = (kind=>'ok', msg=>'Promotion is now active across the platform.'); }
130elsif (($form->{ok} || '') eq 'paused') { %flash = (kind=>'ok', msg=>'Promotion paused.'); }
131elsif (($form->{err} || '') eq 'bad_input') { %flash = (kind=>'err', msg=>'Required fields missing.'); }
132elsif (($form->{err} || '') eq 'denied') { %flash = (kind=>'err', msg=>'Action not permitted.'); }
133
134$db->db_disconnect($dbh);
135
136my $tvars = {
137 user_id => $admin_id,
138
139 is_list => ($view eq 'list') ? 1 : 0,
140 is_new => ($view eq 'new') ? 1 : 0,
141 is_edit => ($view eq 'edit') ? 1 : 0,
142
143 rows => \@rows,
144 has_rows => scalar(@rows) ? 1 : 0,
145 cnt_active => $cnt_active,
146 cnt_scheduled => $cnt_scheduled,
147 cnt_paused => $cnt_paused,
148 cnt_expired => $cnt_expired,
149 cnt_total => scalar(@rows),
150 sum_redemptions => $sum_redemptions,
151 sum_discount_display => '$' . sprintf('%.2f', $sum_discount_cents / 100),
152
153 edit => \%edit_row,
154 has_edit => %edit_row ? 1 : 0,
155 plan_options => \@plan_options,
156 has_plan_options => scalar(@plan_options) ? 1 : 0,
157
158 schema_ready => $schema_ready ? 1 : 0,
159 schema_missing => $schema_ready ? 0 : 1,
160
161 flash_kind => $flash{kind} || '',
162 flash_msg => $flash{msg} || '',
163 has_flash => %flash ? 1 : 0,
164
165 tutorial_mode => $tutorial_mode,
166 not_tutorial_mode => $tutorial_mode ? 0 : 1,
167};
168
169# Tutorial sample for the list view.
170if ($tutorial_mode && $view eq 'list') {
171 $tvars->{rows} = [
172 { id=>1, name=>'New customer 20 percent off first month', kind_label=>'Coupon', is_coupon=>1, is_sale=>0, is_bundle=>0, is_flash=>0,
173 discount_label=>'20% off', code=>'NEWBIE20', code_present=>1, public_slug=>'newbie20', slug_present=>1,
174 status=>'active', status_label=>'Active', is_active=>1, is_paused=>0, is_scheduled=>0, is_expired=>0, is_draft=>0,
175 starts_at=>'2026-01-01 00:00:00', ends_at=>'', has_window=>0,
176 current_redemptions=>418, max_redemptions=>0, has_cap=>0, cap_label=>'418 used',
177 discount_given_display=>'$4,180.00', new_customers_only=>1,
178 edit_url=>'/admin_promotions.cgi?edit_id=1', tutorial_demo=>1 },
179 { id=>2, name=>'Summer 15 off all plans', kind_label=>'Sale', is_coupon=>0, is_sale=>1, is_bundle=>0, is_flash=>0,
180 discount_label=>'15% off', code=>'', code_present=>0, public_slug=>'summer-sale', slug_present=>1,
181 status=>'scheduled', status_label=>'Scheduled', is_active=>0, is_paused=>0, is_scheduled=>1, is_expired=>0, is_draft=>0,
182 starts_at=>'2026-06-21 00:00:00', ends_at=>'2026-07-04 23:59:00', has_window=>1,
183 current_redemptions=>0, max_redemptions=>0, has_cap=>0, cap_label=>'0 used',
184 discount_given_display=>'$0.00', new_customers_only=>0,
185 edit_url=>'/admin_promotions.cgi?edit_id=2', tutorial_demo=>1 },
186 { id=>3, name=>'Black Friday 30 off annual', kind_label=>'Flash sale', is_coupon=>0, is_sale=>0, is_bundle=>0, is_flash=>1,
187 discount_label=>'30% off', code=>'BLACKFRI', code_present=>1, public_slug=>'black-friday', slug_present=>1,
188 status=>'scheduled', status_label=>'Scheduled', is_active=>0, is_paused=>0, is_scheduled=>1, is_expired=>0, is_draft=>0,
189 starts_at=>'2026-11-27 00:00:00', ends_at=>'2026-11-29 23:59:00', has_window=>1,
190 current_redemptions=>0, max_redemptions=>5000, has_cap=>1, cap_label=>'0 of 5000 used',
191 discount_given_display=>'$0.00', new_customers_only=>0,
192 edit_url=>'/admin_promotions.cgi?edit_id=3', tutorial_demo=>1 },
193 ];
194 $tvars->{has_rows} = 1;
195 $tvars->{cnt_active} = 1;
196 $tvars->{cnt_scheduled} = 2;
197 $tvars->{cnt_paused} = 0;
198 $tvars->{cnt_expired} = 0;
199 $tvars->{cnt_total} = 3;
200 $tvars->{sum_redemptions} = 418;
201 $tvars->{sum_discount_display} = '$4,180.00';
202 $tvars->{schema_ready} = 1;
203 $tvars->{schema_missing} = 0;
204}
205
206print "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";
207
208my $body = join('', $tfile->template('abforge_admin_promotions.html', $tvars, $userinfo));
209
210$wrap->render({
211 userinfo => $userinfo,
212 page_key => 'admin_packages',
213 title => 'Pricing & Promotions',
214 body => $body,
215});
216
217# ----------------------------------------------------------------- helpers
218sub _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
254sub _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} || 'plan';
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
292sub _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
301sub _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
310sub _h {
311 my $s = shift;
312 $s //= '';
313 $s =~ s/&/&/g;
314 $s =~ s/</&lt;/g;
315 $s =~ s/>/&gt;/g;
316 $s =~ s/"/&quot;/g;
317 return $s;
318}
319
320#======================================================================
321# admin_promotion_action entry: POST handler
322#
323# Platform-wide create / update / delete / activate / pause.
324#======================================================================
325sub _handle_action {
326 my ($q, $form) = @_;
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 unless ($promo->schema_ready($db, $dbh, $DB)) {
335 $db->db_disconnect($dbh);
336 _act_redirect('/admin_promotions.cgi?err=schema');
337 return;
338 }
339
340 if ($act eq 'create') {
341 my $new_id = $promo->create($db, $dbh, $DB,
342 scope => 'platform',
343 storefront_id => undef,
344 kind => $form->{kind},
345 target_kind => 'plan',
346 name => $form->{name},
347 description => $form->{description},
348 discount_type => $form->{discount_type},
349 discount_value_bp => _act_percent_to_bp($form->{discount_value_pct}),
350 discount_value_cents => _act_dollars_to_cents($form->{discount_value_amt}),
351 minimum_order_cents => _act_dollars_to_cents($form->{minimum_order}),
352 code => $form->{code},
353 public_slug => $form->{public_slug},
354 starts_at => $form->{starts_at_local},
355 ends_at => $form->{ends_at_local},
356 max_redemptions => $form->{max_redemptions},
357 max_per_user => $form->{max_per_user},
358 new_customers_only => $form->{new_customers_only},
359 status => $form->{publish_now} ? 'active' : 'draft',
360 created_by_user_id => $admin_id,
361 );
362 unless ($new_id) {
363 $db->db_disconnect($dbh);
364 _act_redirect('/admin_promotions.cgi?err=bad_input');
365 return;
366 }
367 if (($form->{plan_scope} || 'all') eq 'specific') {
368 my @ids = _act_multi_values($q, 'plan_ids');
369 $promo->set_eligible_plans($db, $dbh, $DB, $new_id, \@ids);
370 } else {
371 $promo->set_eligible_plans($db, $dbh, $DB, $new_id, []);
372 }
373 $db->db_disconnect($dbh);
374 _act_redirect('/admin_promotions.cgi?ok=created');
375 return;
376 }
377
378 if ($act eq 'update') {
379 my $id = $form->{id}; $id =~ s/[^0-9]//g;
380 my $row = $id ? $promo->get_for_admin($db, $dbh, $DB, $id) : {};
381 unless ($row && $row->{id}) {
382 $db->db_disconnect($dbh);
383 _act_redirect('/admin_promotions.cgi?err=denied');
384 return;
385 }
386 my $ok = $promo->update($db, $dbh, $DB, $id,
387 scope => 'platform',
388 storefront_id => undef,
389 kind => $form->{kind},
390 target_kind => 'plan',
391 name => $form->{name},
392 description => $form->{description},
393 discount_type => $form->{discount_type},
394 discount_value_bp => _act_percent_to_bp($form->{discount_value_pct}),
395 discount_value_cents => _act_dollars_to_cents($form->{discount_value_amt}),
396 minimum_order_cents => _act_dollars_to_cents($form->{minimum_order}),
397 code => $form->{code},
398 public_slug => $form->{public_slug},
399 starts_at => $form->{starts_at_local},
400 ends_at => $form->{ends_at_local},
401 max_redemptions => $form->{max_redemptions},
402 max_per_user => $form->{max_per_user},
403 new_customers_only => $form->{new_customers_only},
404 );
405 unless ($ok) {
406 $db->db_disconnect($dbh);
407 _act_redirect('/admin_promotions.cgi?err=bad_input');
408 return;
409 }
410 if (($form->{plan_scope} || 'all') eq 'specific') {
411 my @ids = _act_multi_values($q, 'plan_ids');
412 $promo->set_eligible_plans($db, $dbh, $DB, $id, \@ids);
413 } else {
414 $promo->set_eligible_plans($db, $dbh, $DB, $id, []);
415 }
416 $db->db_disconnect($dbh);
417 _act_redirect('/admin_promotions.cgi?ok=updated');
418 return;
419 }
420
421 if ($act eq 'activate' || $act eq 'pause' || $act eq 'archive') {
422 my $id = $form->{id}; $id =~ s/[^0-9]//g;
423 my $row = $id ? $promo->get_for_admin($db, $dbh, $DB, $id) : {};
424 unless ($row && $row->{id}) {
425 $db->db_disconnect($dbh);
426 _act_redirect('/admin_promotions.cgi?err=denied');
427 return;
428 }
429 my $new_status =
430 $act eq 'activate' ? 'active' :
431 $act eq 'pause' ? 'paused' :
432 'archived';
433 $promo->set_status($db, $dbh, $DB, $id, $new_status);
434 $db->db_disconnect($dbh);
435 _act_redirect('/admin_promotions.cgi?ok=' . ($act eq 'activate' ? 'activated' : $act eq 'pause' ? 'paused' : 'updated'));
436 return;
437 }
438
439 if ($act eq 'delete') {
440 my $id = $form->{id}; $id =~ s/[^0-9]//g;
441 my $row = $id ? $promo->get_for_admin($db, $dbh, $DB, $id) : {};
442 unless ($row && $row->{id}) {
443 $db->db_disconnect($dbh);
444 _act_redirect('/admin_promotions.cgi?err=denied');
445 return;
446 }
447 $promo->delete_promo($db, $dbh, $DB, $id);
448 $db->db_disconnect($dbh);
449 _act_redirect('/admin_promotions.cgi?ok=deleted');
450 return;
451 }
452
453 $db->db_disconnect($dbh);
454 _act_redirect('/admin_promotions.cgi?err=unknown_act');
455}
456
457sub _act_redirect { my $url = shift; print "Status: 302 Found\nLocation: $url\n\n"; }
458
459sub _act_multi_values {
460 my ($q, $name) = @_;
461 my @raw = $q->multi_param($name);
462 return () unless @raw;
463 my @out;
464 foreach my $v (@raw) {
465 next unless defined $v;
466 foreach my $piece (split /\0/, $v) {
467 $piece =~ s/[^0-9]//g;
468 push @out, $piece if length $piece;
469 }
470 }
471 return @out;
472}
473sub _act_percent_to_bp {
474 my $v = shift; return 0 unless defined $v && $v ne '';
475 $v =~ s/[^0-9.]//g; return 0 unless length $v;
476 my $bp = int($v * 100); $bp = 0 if $bp < 0; $bp = 10000 if $bp > 10000; return $bp;
477}
478sub _act_dollars_to_cents {
479 my $v = shift; return 0 unless defined $v && $v ne '';
480 $v =~ s/[^0-9.]//g; return 0 unless length $v;
481 return int($v * 100 + 0.5);
482}
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help