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

O Operator
Diff

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

added on local at 2026-07-11 18:38:36

Added
+503
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to a80d8a5d3c53
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# 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::AffSoft::Admin->require_admin.
11#======================================================================
12use strict;
13use warnings;
14
15use lib '/var/www/vhosts/3dshawn.com/affiliate.3dshawn.com';
16use CGI;
17use MODS::Template;
18use MODS::DBConnect;
19use MODS::Login;
20use MODS::AffSoft::Config;
21use MODS::AffSoft::Wrapper;
22use MODS::AffSoft::Admin;
23use MODS::AffSoft::Promotions;
24use MODS::AffSoft::Billing;
25
26my $q = CGI->new;
27my $form = $q->Vars;
28my $auth = MODS::Login->new;
29my $wrap = MODS::AffSoft::Wrapper->new;
30my $tfile = MODS::Template->new;
31my $db = MODS::DBConnect->new;
32my $cfg = MODS::AffSoft::Config->new;
33my $admin = MODS::AffSoft::Admin->new;
34my $promo = MODS::AffSoft::Promotions->new;
35my $DB = $cfg->settings('database_name');
36
37$|=1;
38my $userinfo = $auth->login_verify();
39if (!$userinfo) {
40 print "Status: 302 Found\nLocation: /login.cgi\n\n";
41 exit;
42}
43$admin->require_admin($userinfo);
44require MODS::AffSoft::Permissions;
45
46my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'admin_promotions';
47
48if ($entry eq 'admin_promotion_action') {
49 MODS::AffSoft::Permissions->new->require_feature($userinfo, 'admin_edit_promotions');
50 _handle_action();
51 exit;
52}
53
54MODS::AffSoft::Permissions->new->require_feature($userinfo, 'admin_view_promotions');
55
56my $admin_id = $userinfo->{user_id};
57$admin_id =~ s/[^0-9]//g;
58
59my $tutorial_mode = ($form->{tutorial} && $form->{tutorial} eq '1') ? 1 : 0;
60
61my $view = ($form->{new} && $form->{new} eq '1') ? 'new'
62 : ($form->{edit_id} && $form->{edit_id} =~ /^\d+$/) ? 'edit'
63 : 'list';
64my $edit_id = ($form->{edit_id} || '');
65$edit_id =~ s/[^0-9]//g;
66
67my $dbh = $db->db_connect();
68my $schema_ready = $promo->schema_ready($db, $dbh, $DB);
69
70my @rows_raw = $schema_ready ? $promo->list_for_admin($db, $dbh, $DB, 200) : ();
71
72my @rows;
73my $cnt_active = 0; my $cnt_scheduled = 0; my $cnt_paused = 0; my $cnt_expired = 0;
74my $sum_redemptions = 0; my $sum_discount_cents = 0;
75foreach 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
87my %edit_row;
88if ($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.
103my @plan_options;
104{
105 my $bill = MODS::AffSoft::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
122my %flash;
123if ($form->{ok} eq 'created') { %flash = (kind=>'ok', msg=>'Platform promotion created.'); }
124elsif ($form->{ok} eq 'updated') { %flash = (kind=>'ok', msg=>'Platform promotion updated.'); }
125elsif ($form->{ok} eq 'deleted') { %flash = (kind=>'ok', msg=>'Platform promotion deleted.'); }
126elsif ($form->{ok} eq 'activated') { %flash = (kind=>'ok', msg=>'Promotion is now active across the platform.'); }
127elsif ($form->{ok} eq 'paused') { %flash = (kind=>'ok', msg=>'Promotion paused.'); }
128elsif ($form->{err} eq 'bad_input') { %flash = (kind=>'err', msg=>'Required fields missing.'); }
129elsif ($form->{err} eq 'denied') { %flash = (kind=>'err', msg=>'Action not permitted.'); }
130
131$db->db_disconnect($dbh);
132
133my $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.
167if ($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
203print "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
205my $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
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 starts_at_epoch => _apr_epoch($r->{starts_at}),
243 ends_at => $r->{ends_at} || '',
244 ends_at_epoch => _apr_epoch($r->{ends_at}),
245 has_window => (($r->{starts_at} || $r->{ends_at}) ? 1 : 0),
246 current_redemptions => $r->{current_redemptions} || 0,
247 max_redemptions => defined $r->{max_redemptions} ? $r->{max_redemptions} : 0,
248 has_cap => (defined $r->{max_redemptions} && $r->{max_redemptions} > 0) ? 1 : 0,
249 cap_label => _cap_label($r),
250 discount_given_display => '$' . sprintf('%.2f', ($promo->total_discount_given_cents($db, $dbh, $DB, $r->{id}) || 0) / 100),
251 new_customers_only => $r->{new_customers_only} ? 1 : 0,
252 edit_url => '/admin_promotions.cgi?edit_id=' . $r->{id},
253 };
254}
255
256sub _row_for_edit_form {
257 my ($r) = @_;
258 my $pct = ($r->{discount_value_bp} || 0) / 100;
259 my $amt = ($r->{discount_value_cents} || 0) / 100;
260 my $min = ($r->{minimum_order_cents} || 0) / 100;
261 my $tk = $r->{target_kind} || 'model';
262 return (
263 id => $r->{id},
264 name => _h($r->{name} || ''),
265 description => _h($r->{description} || ''),
266 kind => $r->{kind},
267 is_coupon => ($r->{kind} eq 'coupon') ? 1 : 0,
268 is_sale => ($r->{kind} eq 'sale') ? 1 : 0,
269 is_bundle => ($r->{kind} eq 'bundle') ? 1 : 0,
270 is_flash => ($r->{kind} eq 'flash_sale') ? 1 : 0,
271 target_kind => $tk,
272 is_target_model=> ($tk eq 'model') ? 1 : 0,
273 is_target_plan => ($tk eq 'plan') ? 1 : 0,
274 is_target_any => ($tk eq 'any') ? 1 : 0,
275 discount_type => $r->{discount_type},
276 is_dtype_pct => ($r->{discount_type} eq 'percent') ? 1 : 0,
277 is_dtype_amt => ($r->{discount_type} eq 'fixed_amount') ? 1 : 0,
278 is_dtype_bun => ($r->{discount_type} eq 'bundle_price') ? 1 : 0,
279 is_dtype_free => ($r->{discount_type} eq 'free') ? 1 : 0,
280 discount_value_pct => sprintf('%.0f', $pct),
281 discount_value_amt => sprintf('%.2f', $amt),
282 minimum_order => sprintf('%.2f', $min),
283 code => _h($r->{code} || ''),
284 public_slug => _h($r->{public_slug} || ''),
285 starts_at_local => _to_local_input($r->{starts_at}),
286 ends_at_local => _to_local_input($r->{ends_at}),
287 max_redemptions => defined $r->{max_redemptions} ? $r->{max_redemptions} : '',
288 max_per_user => defined $r->{max_per_user} ? $r->{max_per_user} : '',
289 new_customers_only => $r->{new_customers_only} ? 1 : 0,
290 status => $r->{status},
291 );
292}
293
294sub _to_local_input {
295 my $ts = shift;
296 return '' unless defined $ts && $ts ne '';
297 if ($ts =~ /^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2})/) {
298 return "$1T$2";
299 }
300 return '';
301}
302
303# Parse a MySQL DATETIME or DATE to epoch seconds. 0 on failure. Powers
304# the data-ts= viewer-local timestamps on the promo list.
305sub _apr_epoch {
306 my $s = shift; return 0 unless defined $s && length $s;
307 if ($s =~ /^(\d{4})-(\d{2})-(\d{2})[T ](\d{2}):(\d{2}):(\d{2})/) {
308 require Time::Local;
309 return eval { Time::Local::timelocal($6, $5, $4, $3, $2 - 1, $1 - 1900) } || 0;
310 }
311 if ($s =~ /^(\d{4})-(\d{2})-(\d{2})$/) {
312 require Time::Local;
313 return eval { Time::Local::timelocal(0, 0, 0, $3, $2 - 1, $1 - 1900) } || 0;
314 }
315 return 0;
316}
317
318sub _cap_label {
319 my ($r) = @_;
320 my $cur = $r->{current_redemptions} || 0;
321 if (defined $r->{max_redemptions} && $r->{max_redemptions} > 0) {
322 return "$cur of $r->{max_redemptions} used";
323 }
324 return "$cur used";
325}
326
327sub _h {
328 my $s = shift;
329 $s //= '';
330 $s =~ s/&/&/g;
331 $s =~ s/</&lt;/g;
332 $s =~ s/>/&gt;/g;
333 $s =~ s/"/&quot;/g;
334 return $s;
335}
336
337#======================================================================
338# admin_promotion_action entry: POST handler
339#
340# Platform-wide create/update/delete/activate/pause.
341#======================================================================
342sub _handle_action {
343 my $act = defined $form->{act} ? $form->{act} : '';
344
345 my $dbh = $db->db_connect();
346 unless ($promo->schema_ready($db, $dbh, $DB)) {
347 $db->db_disconnect($dbh);
348 _act_redirect('/admin_promotions.cgi?err=schema');
349 return;
350 }
351
352 if ($act eq 'create') {
353 my $new_id = $promo->create($db, $dbh, $DB,
354 scope => 'platform',
355 storefront_id => undef,
356 kind => $form->{kind},
357 # Platform-scope (admin-issued) promos always target our
358 # subscription plans -- never a seller's product catalog. The
359 # admin form intentionally omits the target_kind selector.
360 target_kind => 'plan',
361 name => $form->{name},
362 description => $form->{description},
363 discount_type => $form->{discount_type},
364 discount_value_bp => _percent_to_bp($form->{discount_value_pct}),
365 discount_value_cents => _dollars_to_cents($form->{discount_value_amt}),
366 minimum_order_cents => _dollars_to_cents($form->{minimum_order}),
367 code => $form->{code},
368 public_slug => $form->{public_slug},
369 starts_at => $form->{starts_at_local},
370 ends_at => $form->{ends_at_local},
371 max_redemptions => $form->{max_redemptions},
372 max_per_user => $form->{max_per_user},
373 new_customers_only => $form->{new_customers_only},
374 status => $form->{publish_now} ? 'active' : 'draft',
375 created_by_user_id => $admin_id,
376 );
377 unless ($new_id) {
378 $db->db_disconnect($dbh);
379 _act_redirect('/admin_promotions.cgi?err=bad_input');
380 return;
381 }
382 # Persist the "Applies to plans" picks. Only when the admin chose
383 # 'specific' -- 'all' leaves the join table empty, which the
384 # validate/load helpers interpret as "every paid plan".
385 if (($form->{plan_scope} || 'all') eq 'specific') {
386 my @ids = _multi_values($q, 'plan_ids');
387 $promo->set_eligible_plans($db, $dbh, $DB, $new_id, \@ids);
388 } else {
389 $promo->set_eligible_plans($db, $dbh, $DB, $new_id, []);
390 }
391 $db->db_disconnect($dbh);
392 _act_redirect('/admin_promotions.cgi?ok=created');
393 return;
394 }
395
396 if ($act eq 'update') {
397 my $id = $form->{id}; $id =~ s/[^0-9]//g;
398 my $row = $id ? $promo->get_for_admin($db, $dbh, $DB, $id) : {};
399 unless ($row && $row->{id}) {
400 $db->db_disconnect($dbh);
401 _act_redirect('/admin_promotions.cgi?err=denied');
402 return;
403 }
404 my $ok = $promo->update($db, $dbh, $DB, $id,
405 scope => 'platform',
406 storefront_id => undef,
407 kind => $form->{kind},
408 # Platform-scope (admin-issued) promos always target plans --
409 # never a seller's product catalog. See create handler.
410 target_kind => 'plan',
411 name => $form->{name},
412 description => $form->{description},
413 discount_type => $form->{discount_type},
414 discount_value_bp => _percent_to_bp($form->{discount_value_pct}),
415 discount_value_cents => _dollars_to_cents($form->{discount_value_amt}),
416 minimum_order_cents => _dollars_to_cents($form->{minimum_order}),
417 code => $form->{code},
418 public_slug => $form->{public_slug},
419 starts_at => $form->{starts_at_local},
420 ends_at => $form->{ends_at_local},
421 max_redemptions => $form->{max_redemptions},
422 max_per_user => $form->{max_per_user},
423 new_customers_only => $form->{new_customers_only},
424 );
425 unless ($ok) {
426 $db->db_disconnect($dbh);
427 _act_redirect('/admin_promotions.cgi?err=bad_input');
428 return;
429 }
430 if (($form->{plan_scope} || 'all') eq 'specific') {
431 my @ids = _multi_values($q, 'plan_ids');
432 $promo->set_eligible_plans($db, $dbh, $DB, $id, \@ids);
433 } else {
434 $promo->set_eligible_plans($db, $dbh, $DB, $id, []);
435 }
436 $db->db_disconnect($dbh);
437 _act_redirect('/admin_promotions.cgi?ok=updated');
438 return;
439 }
440
441 if ($act eq 'activate' || $act eq 'pause' || $act eq 'archive') {
442 my $id = $form->{id}; $id =~ s/[^0-9]//g;
443 my $row = $id ? $promo->get_for_admin($db, $dbh, $DB, $id) : {};
444 unless ($row && $row->{id}) {
445 $db->db_disconnect($dbh);
446 _act_redirect('/admin_promotions.cgi?err=denied');
447 return;
448 }
449 my $new_status =
450 $act eq 'activate' ? 'active' :
451 $act eq 'pause' ? 'paused' :
452 'archived';
453 $promo->set_status($db, $dbh, $DB, $id, $new_status);
454 $db->db_disconnect($dbh);
455 _act_redirect('/admin_promotions.cgi?ok=' . ($act eq 'activate' ? 'activated' : $act eq 'pause' ? 'paused' : 'updated'));
456 return;
457 }
458
459 if ($act eq 'delete') {
460 my $id = $form->{id}; $id =~ s/[^0-9]//g;
461 my $row = $id ? $promo->get_for_admin($db, $dbh, $DB, $id) : {};
462 unless ($row && $row->{id}) {
463 $db->db_disconnect($dbh);
464 _act_redirect('/admin_promotions.cgi?err=denied');
465 return;
466 }
467 $promo->delete_promo($db, $dbh, $DB, $id);
468 $db->db_disconnect($dbh);
469 _act_redirect('/admin_promotions.cgi?ok=deleted');
470 return;
471 }
472
473 $db->db_disconnect($dbh);
474 _act_redirect('/admin_promotions.cgi?err=unknown_act');
475}
476
477sub _act_redirect { my $url = shift; print "Status: 302 Found\nLocation: $url\n\n"; }
478# CGI->Vars collapses repeated form fields into a single \0-joined
479# string. For the plan_ids[] checkboxes we want them back as a list.
480sub _multi_values {
481 my ($qq, $name) = @_;
482 my @raw = $qq->multi_param($name);
483 return () unless @raw;
484 my @out;
485 foreach my $v (@raw) {
486 next unless defined $v;
487 foreach my $piece (split /\0/, $v) {
488 $piece =~ s/[^0-9]//g;
489 push @out, $piece if length $piece;
490 }
491 }
492 return @out;
493}
494sub _percent_to_bp {
495 my $v = shift; return 0 unless defined $v && $v ne '';
496 $v =~ s/[^0-9.]//g; return 0 unless length $v;
497 my $bp = int($v * 100); $bp = 0 if $bp < 0; $bp = 10000 if $bp > 10000; return $bp;
498}
499sub _dollars_to_cents {
500 my $v = shift; return 0 unless defined $v && $v ne '';
501 $v =~ s/[^0-9.]//g; return 0 unless length $v;
502 return int($v * 100 + 0.5);
503}