Diff -- /var/www/vhosts/webstls.com/httpdocs/orders.cgi
Diff

/var/www/vhosts/webstls.com/httpdocs/orders.cgi

added on WebSTLs (webstls.com) at 2026-07-01 22:26:43

Added
+634
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to ae6dbb517fcf
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 - Seller-side Orders list (refundable actions).
4#
5# GET /orders.cgi
6#
7# Shows the most recent paid orders across all storefronts owned by
8# the signed-in seller. Each row exposes a Refund button (full refund
9# via Stripe) gated by the `refund_orders` ptag -- owners always pass,
10# team members need the explicit grant.
11#
12# Detailed analytics live at /sales_reports.cgi; this page is the
13# "I need to refund order #1247 right now" surface.
14#======================================================================
15use strict;
16use warnings;
17
18use lib '/var/www/vhosts/webstls.com/httpdocs';
19use CGI;
20use MODS::Template;
21use MODS::DBConnect;
22use MODS::Login;
23use MODS::WebSTLs::Config;
24use MODS::WebSTLs::Wrapper;
25use MODS::WebSTLs::Permissions;
26use MODS::WebSTLs::Stripe;
27use MODS::WebSTLs::BuyerCredits;
28
29my $q = CGI->new;
30my $form = $q->Vars;
31my $auth = MODS::Login->new;
32my $wrap = MODS::WebSTLs::Wrapper->new;
33my $tfile = MODS::Template->new;
34my $db = MODS::DBConnect->new;
35my $cfg = MODS::WebSTLs::Config->new;
36my $perm = MODS::WebSTLs::Permissions->new;
37my $stripe = MODS::WebSTLs::Stripe->new;
38my $bc = MODS::WebSTLs::BuyerCredits->new;
39my $DB = $cfg->settings('database_name');
40
41$|=1;
42my $userinfo = $auth->login_verify();
43unless ($userinfo) {
44 print "Status: 302 Found\nLocation: /login.cgi\n\n";
45 exit;
46}
47
48my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'orders';
49
50if ($entry eq 'orders_action') {
51 _handle_action($q, $form, $userinfo);
52 exit;
53}
54
55# View requires view_orders (covers owner + most preset roles); refund
56# button is shown only to those with refund_orders. Both checks are
57# owner-friendly via has_feature's owner short-circuit.
58$perm->require_feature($userinfo, 'view_orders');
59
60my $uid = $userinfo->{user_id};
61$uid =~ s/[^0-9]//g;
62my $can_refund = $perm->has_feature($userinfo, 'refund_orders') ? 1 : 0;
63
64# Resolve effective owner -- a team member sees their owner's stores.
65my $owner_uid = $userinfo->{owner_user_id} || $uid;
66$owner_uid =~ s/[^0-9]//g;
67
68my $dbh = $db->db_connect();
69
70# Flash from orders_action.cgi redirects.
71my $flash_msg = '';
72my $flash_kind = '';
73if (defined $form->{refund_ok}) {
74 my $oid = $form->{refund_ok}; $oid =~ s/[^0-9]//g;
75 $flash_kind = 'ok';
76 $flash_msg = "Refund processed for order #$oid.";
77}
78if (defined $form->{refund_err}) {
79 my $err = $form->{refund_err};
80 $err =~ s/[^A-Za-z0-9 .,;:_\-\$()%']//g;
81 $err = substr($err, 0, 200);
82 my %human = (
83 bad_act => 'Unknown action.',
84 missing_id => 'No order id supplied.',
85 not_found => 'Order not found.',
86 denied => 'You do not have permission to refund this order.',
87 not_paid => 'Only paid orders can be refunded.',
88 over_total => 'Refund amount exceeds the order total.',
89 stripe_unconfigured => 'Stripe is not configured. Add keys in Software Configuration first.',
90 );
91 $flash_kind = 'danger';
92 $flash_msg = $human{$err} || ('Refund failed: ' . $err);
93}
94if (defined $form->{credit_ok}) {
95 my $oid = $form->{credit_ok}; $oid =~ s/[^0-9]//g;
96 $flash_kind = 'ok';
97 $flash_msg = "Store credit granted for order #$oid.";
98}
99if (defined $form->{credit_err}) {
100 my $err = $form->{credit_err};
101 $err =~ s/[^A-Za-z0-9 .,;:_\-\$()%']//g;
102 $err = substr($err, 0, 200);
103 my %human = (
104 bad_input => 'Missing or invalid input.',
105 not_found => 'Order not found.',
106 denied => 'You do not have permission to credit this buyer.',
107 schema => 'The buyer credit ledger is not installed yet -- run the DB migration first.',
108 grant_failed=> 'Could not write the credit ledger row.',
109 );
110 $flash_kind = 'danger';
111 $flash_msg = $human{$err} || ('Credit failed: ' . $err);
112}
113if (defined $form->{ship_ok}) {
114 my $oid = $form->{ship_ok}; $oid =~ s/[^0-9]//g;
115 $flash_kind = 'ok';
116 $flash_msg = "Marked shipped on order #$oid.";
117}
118if (defined $form->{ship_err}) {
119 my $err = $form->{ship_err}; $err =~ s/[^A-Za-z0-9_\-]//g;
120 my %human = (
121 missing_id => 'No item id supplied.',
122 missing_tracking => 'Tracking carrier + number are required.',
123 not_found => 'Order item not found.',
124 denied => 'You do not have permission to fulfill this order.',
125 not_physical => 'That item is digital -- nothing to ship.',
126 );
127 $flash_kind = 'danger';
128 $flash_msg = $human{$err} || ('Mark-shipped failed: ' . $err);
129}
130
131# Probe whether the new shipping / per-line variant columns exist
132# on this install. Lets the page degrade to legacy display on a
133# server that hasn't run the physical-products migration yet.
134my $have_ship_cols = 0;
135{
136 my $r = $db->db_readwrite($dbh, qq~
137 SELECT COUNT(*) AS n FROM information_schema.columns
138 WHERE table_schema='$DB' AND table_name='orders'
139 AND column_name='requires_shipping'
140 ~, $ENV{SCRIPT_NAME}, __LINE__);
141 $have_ship_cols = 1 if $r && $r->{n};
142}
143my $have_oi_variant_cols = 0;
144{
145 my $r = $db->db_readwrite($dbh, qq~
146 SELECT COUNT(*) AS n FROM information_schema.columns
147 WHERE table_schema='$DB' AND table_name='order_items'
148 AND column_name='purchase_kind'
149 ~, $ENV{SCRIPT_NAME}, __LINE__);
150 $have_oi_variant_cols = 1 if $r && $r->{n};
151}
152
153# Recent orders across all storefronts this seller owns. Annual /
154# month bucketing happens on sales_reports.cgi; this page is the
155# operational list.
156my $LIMIT = 50;
157my $ship_select = $have_ship_cols ? q~
158 o.requires_shipping, o.shipping_cents, o.shipping_zone,
159 o.ship_name, o.ship_addr1, o.ship_addr2, o.ship_city,
160 o.ship_region, o.ship_postal, o.ship_country, o.ship_phone,~ : '';
161my @rows = $db->db_readwrite_multiple($dbh, qq~
162 SELECT o.id, o.status, o.total_amount_cents, o.currency,
163 o.buyer_email, o.created_at, o.paid_at,
164 o.stripe_payment_intent_id,
165 $ship_select
166 DATE_FORMAT(o.created_at, '%b %e, %Y %H:%i') AS placed_at,
167 s.name AS store_name, s.id AS store_id
168 FROM `${DB}`.orders o
169 JOIN `${DB}`.storefronts s ON s.id = o.storefront_id
170 WHERE s.user_id='$owner_uid'
171 ORDER BY o.created_at DESC
172 LIMIT $LIMIT
173~, $ENV{SCRIPT_NAME}, __LINE__);
174
175# Per-line fulfillment for the visible orders. One query, indexed
176# in Perl by order_id so the render loop is O(1) per row.
177my %lines_by_order;
178if ($have_oi_variant_cols && @rows) {
179 my @ids = map { $_->{id} } @rows;
180 my $id_in = join(',', map { "'$_'" } @ids);
181 # Probe for bundle_id column.
182 my $oi_has_bundle = 0;
183 {
184 my $pr = $db->db_readwrite($dbh, qq~
185 SELECT COUNT(*) AS n FROM information_schema.columns
186 WHERE table_schema='$DB' AND table_name='order_items'
187 AND column_name='bundle_id'
188 ~, $ENV{SCRIPT_NAME}, __LINE__);
189 $oi_has_bundle = 1 if $pr && $pr->{n};
190 }
191 my $bsel = $oi_has_bundle ? q~oi.bundle_id, b.title AS bundle_title,~ : q~NULL AS bundle_id, NULL AS bundle_title,~;
192 my $bjoin = $oi_has_bundle ? qq~LEFT JOIN \`${DB}\`.bundles b ON b.id = oi.bundle_id~ : '';
193 my @ls = $db->db_readwrite_multiple($dbh, qq~
194 SELECT oi.id, oi.order_id, oi.model_id, oi.quantity,
195 oi.purchase_kind, oi.selected_color, oi.selected_material,
196 oi.fulfillment_status, oi.tracking_carrier,
197 oi.tracking_number, oi.shipped_at,
198 $bsel
199 m.title AS m_title
200 FROM `${DB}`.order_items oi
201 LEFT JOIN `${DB}`.models m ON m.id = oi.model_id
202 $bjoin
203 WHERE oi.order_id IN ($id_in)
204 ORDER BY oi.id ASC
205 ~, $ENV{SCRIPT_NAME}, __LINE__);
206 foreach my $l (@ls) {
207 $l->{title} = $l->{bundle_id}
208 ? ($l->{bundle_title} || 'Bundle')
209 : ($l->{m_title} || ('Model #' . ($l->{model_id} || '?')));
210 }
211 foreach my $l (@ls) {
212 push @{ $lines_by_order{$l->{order_id}} }, $l;
213 }
214}
215
216$db->db_disconnect($dbh);
217
218my %FUL_LABEL = (
219 not_required => 'Digital -- no shipping',
220 pending => 'Awaiting print',
221 printing => 'Printing',
222 shipped => 'Shipped',
223 delivered => 'Delivered',
224 canceled => 'Canceled',
225);
226
227my @order_rows;
228foreach my $r (@rows) {
229 my $st = $r->{status} || 'pending';
230
231 # Per-line fulfillment data for this order.
232 my @lines;
233 foreach my $l (@{ $lines_by_order{$r->{id}} || [] }) {
234 my $kind = $l->{purchase_kind} || 'digital';
235 my $fs = $l->{fulfillment_status} || ($kind eq 'physical' ? 'pending' : 'not_required');
236 my @variant_bits;
237 push @variant_bits, _h($l->{selected_color}) if $l->{selected_color};
238 push @variant_bits, _h($l->{selected_material}) if $l->{selected_material};
239 push @lines, {
240 id => $l->{id},
241 title => _h($l->{title}),
242 quantity => $l->{quantity} || 1,
243 kind => $kind,
244 is_physical => ($kind eq 'physical') ? 1 : 0,
245 variant_pill => scalar(@variant_bits) ? join(' · ', @variant_bits) : '',
246 fulfillment => $fs,
247 fulfillment_label => $FUL_LABEL{$fs} || ucfirst($fs),
248 can_mark_shipped => ($kind eq 'physical' && $fs ne 'shipped' && $fs ne 'delivered' && $fs ne 'canceled' && $st eq 'paid') ? 1 : 0,
249 is_shipped => ($fs eq 'shipped' || $fs eq 'delivered') ? 1 : 0,
250 tracking_carrier=> _h($l->{tracking_carrier} || ''),
251 tracking_number => _h($l->{tracking_number} || ''),
252 };
253 }
254
255 # Shipping address summary -- single string + flag.
256 my $ship_addr = '';
257 if ($have_ship_cols && $r->{requires_shipping}) {
258 my @addr_lines = grep { defined && length }
259 (_h($r->{ship_name} || ''),
260 _h($r->{ship_addr1} || ''),
261 _h($r->{ship_addr2} || ''),
262 join(', ', grep { length } (_h($r->{ship_city} || ''), _h($r->{ship_region} || ''), _h($r->{ship_postal} || ''))),
263 _h($r->{ship_country} || ''));
264 $ship_addr = join('<br>', grep { length } @addr_lines);
265 }
266 my $ship_cents = $r->{shipping_cents} || 0;
267
268 push @order_rows, {
269 id => $r->{id},
270 placed_at => $r->{placed_at},
271 store_name => _h($r->{store_name}),
272 buyer_email => _h($r->{buyer_email} || '(no email)'),
273 total_amount_cents => $r->{total_amount_cents} || 0,
274 total_display => '$' . sprintf('%.2f', ($r->{total_amount_cents} || 0) / 100),
275 status => $st,
276 status_label => ucfirst($st),
277 is_paid => $st eq 'paid' ? 1 : 0,
278 is_pending => $st eq 'pending' ? 1 : 0,
279 is_failed => $st eq 'failed' ? 1 : 0,
280 is_refunded => ($st eq 'refunded' || $st eq 'partially_refunded') ? 1 : 0,
281 # Refundable = paid OR partially-refunded (further partial refund) AND has a Stripe PI
282 # AND the caller holds refund_orders. Free orders without a PI are also refundable in
283 # the orders_action.cgi flow (just marks the row); show the button if status is paid.
284 can_refund_now => ($can_refund && ($st eq 'paid' || $st eq 'partially_refunded')) ? 1 : 0,
285
286 # Physical-fulfillment surfaces.
287 requires_shipping => ($have_ship_cols && $r->{requires_shipping}) ? 1 : 0,
288 ship_address_html => $ship_addr,
289 ship_phone => _h($r->{ship_phone} || ''),
290 ship_zone => _h($r->{shipping_zone} || ''),
291 ship_cost_display => '$' . sprintf('%.2f', $ship_cents / 100),
292 lines => \@lines,
293 has_lines => scalar(@lines) ? 1 : 0,
294 };
295}
296
297my $tvars = {
298 user_id => $uid,
299 orders => \@order_rows,
300 has_orders => scalar(@order_rows) ? 1 : 0,
301 no_orders => scalar(@order_rows) ? 0 : 1,
302 can_refund => $can_refund,
303 flash_msg => $flash_msg,
304 flash_kind => $flash_kind,
305 has_flash => length $flash_msg ? 1 : 0,
306};
307
308print "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";
309
310my $body = join('', $tfile->template('webstls_orders.html', $tvars, $userinfo));
311
312$wrap->render({
313 userinfo => $userinfo,
314 page_key => 'orders',
315 title => 'Orders',
316 body => $body,
317});
318
319sub _h {
320 my $s = shift; $s = '' unless defined $s;
321 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
322 $s =~ s/"/&quot;/g; $s =~ s/'/&#39;/g;
323 return $s;
324}
325
326#======================================================================
327# orders_action entry: POST handlers (refund_order, credit_buyer,
328# mark_shipped). Auth is verified above; permission checks per-action.
329#======================================================================
330sub _handle_action {
331 my ($q, $form, $userinfo) = @_;
332
333 my $act = $form->{act} || '';
334 my $return_to = $form->{return_to} || '/sales_reports.cgi';
335 # Defang the return_to so it can't be a full-URL open redirect.
336 $return_to = '/sales_reports.cgi' unless $return_to =~ m{^/};
337
338 if ($act eq 'credit_buyer') {
339 _do_credit_buyer($form, $userinfo, $return_to);
340 return;
341 }
342
343 if ($act eq 'mark_shipped') {
344 _do_mark_shipped($form, $userinfo, $return_to);
345 return;
346 }
347
348 unless ($act eq 'refund_order') {
349 _act_back($return_to, 'refund_err=bad_act');
350 return;
351 }
352
353 my $oid = $form->{order_id} || 0;
354 $oid =~ s/[^0-9]//g;
355 unless ($oid) { _act_back($return_to, 'refund_err=missing_id'); return; }
356
357 my $amt_in = $form->{amount_cents};
358 $amt_in = '' unless defined $amt_in;
359 $amt_in =~ s/[^0-9]//g;
360 $amt_in = 0 + ($amt_in || 0);
361
362 my $reason = $form->{reason} || '';
363 $reason = '' unless $reason =~ /^(duplicate|fraudulent|requested_by_customer)$/;
364
365 my $dbh = $db->db_connect();
366
367 # Look up the order + the storefront's owner. Refund authorization
368 # needs the storefront row to know who the seller is.
369 my $order = $db->db_readwrite($dbh, qq~
370 SELECT o.id, o.storefront_id, o.status, o.total_amount_cents,
371 o.stripe_payment_intent_id, o.buyer_email,
372 o.platform_fee_cents,
373 s.user_id AS seller_user_id
374 FROM `${DB}`.orders o
375 JOIN `${DB}`.storefronts s ON s.id = o.storefront_id
376 WHERE o.id='$oid' LIMIT 1
377 ~, $ENV{SCRIPT_NAME}, __LINE__);
378
379 unless ($order && $order->{id}) {
380 $db->db_disconnect($dbh);
381 _act_back($return_to, 'refund_err=not_found');
382 return;
383 }
384
385 # ---- Authorization ----
386 my $caller_uid = $userinfo->{user_id};
387 $caller_uid =~ s/[^0-9]//g;
388 my $is_admin = $userinfo->{is_admin} ? 1 : 0;
389 my $is_seller = ($caller_uid && $caller_uid eq ($order->{seller_user_id} || '')) ? 1 : 0;
390 # A team member of the seller also counts when they hold the
391 # refund_orders ptag. Login.pm sets owner_user_id on team rows so
392 # we resolve "effective seller" through that pointer.
393 my $team_owner = $userinfo->{owner_user_id} || 0;
394 my $is_team_with_grant = 0;
395 if ($team_owner && $team_owner eq ($order->{seller_user_id} || '')
396 && $perm->has_feature($userinfo, 'refund_orders')) {
397 $is_team_with_grant = 1;
398 }
399
400 unless ($is_admin || $is_seller || $is_team_with_grant) {
401 $db->db_disconnect($dbh);
402 _act_back($return_to, 'refund_err=denied');
403 return;
404 }
405
406 # ---- Validate the order is refundable ----
407 my $status = $order->{status} || '';
408 unless ($status eq 'paid' || $status eq 'partially_refunded') {
409 $db->db_disconnect($dbh);
410 _act_back($return_to, 'refund_err=not_paid');
411 return;
412 }
413
414 unless ($order->{stripe_payment_intent_id}) {
415 # Free orders (payment_processor='free') have no PI to refund --
416 # they were never charged. Just mark the order refunded so the
417 # ledger reflects reality.
418 $db->db_readwrite($dbh, qq~
419 UPDATE `${DB}`.orders SET status='refunded' WHERE id='$oid'
420 ~, $ENV{SCRIPT_NAME}, __LINE__);
421 # Return any store credit that was consumed by this free order to
422 # the buyer's ledger. No Stripe webhook covers this path.
423 eval { $bc->reverse_for_order($db, $dbh, $DB, $oid); };
424 $db->db_disconnect($dbh);
425 _act_back($return_to, 'refund_ok=' . $oid);
426 return;
427 }
428
429 # Validate amount. Empty / 0 means full refund; otherwise must be a
430 # positive integer <= the order's total. Stripe rejects 0-cent refunds
431 # anyway but we catch obvious goofs early.
432 my $total = $order->{total_amount_cents} || 0;
433 my $amount_to_refund = $amt_in;
434 if ($amount_to_refund > 0 && $amount_to_refund > $total) {
435 $db->db_disconnect($dbh);
436 _act_back($return_to, 'refund_err=over_total');
437 return;
438 }
439
440 unless ($stripe->is_configured) {
441 $db->db_disconnect($dbh);
442 _act_back($return_to, 'refund_err=stripe_unconfigured');
443 return;
444 }
445
446 # ---- Call Stripe ----
447 my $r = $stripe->create_refund(
448 payment_intent => $order->{stripe_payment_intent_id},
449 amount_cents => ($amount_to_refund > 0 ? $amount_to_refund : 0),
450 reason => $reason,
451 is_destination_charge => 1,
452 idempotency_key => "webstls_refund_$oid" . ($amount_to_refund ? "_$amount_to_refund" : '_full'),
453 );
454
455 if ($r && $r->{error}) {
456 $db->db_disconnect($dbh);
457 my $msg = $r->{error}; $msg =~ s/[^A-Za-z0-9 .,;:_\-\$()%']//g; $msg = substr($msg, 0, 200);
458 _act_back($return_to, 'refund_err=' . _act_u($msg));
459 return;
460 }
461
462 # ---- Mark the order row ----
463 # If Stripe accepted but the webhook hasn't fired yet, mark optimistically.
464 # The webhook's charge.refunded branch will re-confirm.
465 my $new_status = ($amount_to_refund == 0 || $amount_to_refund >= $total)
466 ? 'refunded'
467 : 'partially_refunded';
468 $db->db_readwrite($dbh, qq~
469 UPDATE `${DB}`.orders SET status='$new_status'
470 WHERE id='$oid' AND status IN ('paid','partially_refunded')
471 ~, $ENV{SCRIPT_NAME}, __LINE__);
472
473 $db->db_disconnect($dbh);
474 _act_back($return_to, 'refund_ok=' . $oid);
475}
476
477sub _act_go {
478 my ($url) = @_;
479 print "Status: 302 Found\nLocation: $url\n\n";
480}
481sub _act_back {
482 my ($return_to, $qs) = @_;
483 my $sep = ($return_to =~ /\?/) ? '&' : '?';
484 _act_go($return_to . $sep . $qs);
485}
486sub _act_u {
487 my $s = shift; $s = '' unless defined $s;
488 $s =~ s/([^A-Za-z0-9\-_.~])/sprintf('%%%02X', ord($1))/eg;
489 return $s;
490}
491
492# Credit a buyer for an order without moving cash. Writes a positive
493# buyer_credit_ledger row keyed on the order's storefront + buyer.
494# The order itself stays paid; the buyer's next checkout sees the
495# credit applied automatically.
496sub _do_credit_buyer {
497 my ($form, $userinfo, $return_to) = @_;
498 my $oid = $form->{order_id} || 0;
499 $oid =~ s/[^0-9]//g;
500 unless ($oid) { _act_back($return_to, 'credit_err=bad_input'); return; }
501
502 my $amt = defined $form->{amount_cents} ? $form->{amount_cents} : '';
503 $amt =~ s/[^0-9]//g;
504 unless ($amt && $amt > 0) { _act_back($return_to, 'credit_err=bad_input'); return; }
505
506 my $note = defined $form->{note} ? $form->{note} : '';
507 $note =~ s/[\r\n]+/ /g;
508 $note = substr($note, 0, 480);
509
510 my $dbh = $db->db_connect();
511
512 my $o = $db->db_readwrite($dbh, qq~
513 SELECT o.id, o.storefront_id, o.buyer_email, o.buyer_account_id,
514 o.total_amount_cents,
515 s.user_id AS seller_user_id
516 FROM `${DB}`.orders o
517 JOIN `${DB}`.storefronts s ON s.id = o.storefront_id
518 WHERE o.id='$oid' LIMIT 1
519 ~, $ENV{SCRIPT_NAME}, __LINE__);
520 unless ($o && $o->{id}) {
521 $db->db_disconnect($dbh);
522 _act_back($return_to, 'credit_err=not_found');
523 return;
524 }
525
526 # Same authorization as refund_order.
527 my $caller_uid = $userinfo->{user_id};
528 $caller_uid =~ s/[^0-9]//g;
529 my $is_admin = $userinfo->{is_admin} ? 1 : 0;
530 my $is_seller = ($caller_uid && $caller_uid eq ($o->{seller_user_id} || '')) ? 1 : 0;
531 my $team_owner = $userinfo->{owner_user_id} || 0;
532 my $is_team_with_grant = 0;
533 if ($team_owner && $team_owner eq ($o->{seller_user_id} || '')
534 && $perm->has_feature($userinfo, 'refund_orders')) {
535 $is_team_with_grant = 1;
536 }
537 unless ($is_admin || $is_seller || $is_team_with_grant) {
538 $db->db_disconnect($dbh);
539 _act_back($return_to, 'credit_err=denied');
540 return;
541 }
542
543 unless ($bc->schema_ready($db, $dbh, $DB)) {
544 $db->db_disconnect($dbh);
545 _act_back($return_to, 'credit_err=schema');
546 return;
547 }
548
549 my $new_id = $bc->grant($db, $dbh, $DB,
550 storefront_id => $o->{storefront_id},
551 buyer_account_id => $o->{buyer_account_id} || undef,
552 buyer_email => $o->{buyer_email},
553 amount_cents => $amt,
554 reason => 'order_refund',
555 related_order_id => $oid,
556 granted_by_user_id => $caller_uid,
557 note => $note,
558 );
559
560 $db->db_disconnect($dbh);
561 _act_back($return_to, $new_id ? "credit_ok=$oid" : 'credit_err=grant_failed');
562}
563
564#======================================================================
565# mark_shipped: flip a single order_items row from pending/printing to
566# 'shipped' and capture tracking carrier + number. The seller must
567# own the storefront the order belongs to. Idempotent on duplicate
568# submits (a row already marked shipped just re-writes the same data).
569#
570# POST params:
571# order_item_id -- which row to update
572# tracking_carrier -- free text (USPS, UPS, FedEx, DHL, ...)
573# tracking_number -- free text
574# return_to -- redirect target (defaults to /orders.cgi)
575#======================================================================
576sub _do_mark_shipped {
577 my ($form, $userinfo, $return_to) = @_;
578 my $oi_id = $form->{order_item_id} || 0;
579 $oi_id =~ s/[^0-9]//g;
580 unless ($oi_id) { _act_back($return_to, 'ship_err=missing_id'); return; }
581
582 my $carrier = $form->{tracking_carrier} || '';
583 my $tracking = $form->{tracking_number} || '';
584 $carrier =~ s/^\s+|\s+$//g; $carrier = substr($carrier, 0, 40);
585 $tracking =~ s/^\s+|\s+$//g; $tracking = substr($tracking, 0, 120);
586 # Whitelist to keep printable text only -- defangs SQL + JS in
587 # one pass since these get displayed back to the buyer.
588 $carrier =~ s/[^A-Za-z0-9 _.,\-]//g;
589 $tracking =~ s/[^A-Za-z0-9 _.,\-]//g;
590 unless ($carrier && $tracking) { _act_back($return_to, 'ship_err=missing_tracking'); return; }
591
592 my $dbh = $db->db_connect();
593
594 # Verify the item belongs to an order on a storefront this seller owns.
595 my $caller_uid = $userinfo->{user_id}; $caller_uid =~ s/[^0-9]//g;
596 my $owner_uid = $userinfo->{owner_user_id} || $caller_uid;
597 $owner_uid =~ s/[^0-9]//g;
598 my $row = $db->db_readwrite($dbh, qq~
599 SELECT oi.id, oi.fulfillment_status, oi.purchase_kind,
600 o.id AS order_id, s.user_id AS seller_uid
601 FROM `${DB}`.order_items oi
602 JOIN `${DB}`.orders o ON o.id = oi.order_id
603 JOIN `${DB}`.storefronts s ON s.id = o.storefront_id
604 WHERE oi.id='$oi_id'
605 LIMIT 1
606 ~, $ENV{SCRIPT_NAME}, __LINE__);
607 unless ($row && $row->{id}) {
608 $db->db_disconnect($dbh);
609 _act_back($return_to, 'ship_err=not_found');
610 return;
611 }
612 if ($row->{seller_uid} ne $owner_uid && !($userinfo->{is_admin} || $userinfo->{is_super_admin})) {
613 $db->db_disconnect($dbh);
614 _act_back($return_to, 'ship_err=denied');
615 return;
616 }
617 if (($row->{purchase_kind} || '') ne 'physical') {
618 $db->db_disconnect($dbh);
619 _act_back($return_to, 'ship_err=not_physical');
620 return;
621 }
622
623 $db->db_readwrite($dbh, qq~
624 UPDATE `${DB}`.order_items
625 SET fulfillment_status='shipped',
626 tracking_carrier='$carrier',
627 tracking_number='$tracking',
628 shipped_at=NOW()
629 WHERE id='$oi_id' LIMIT 1
630 ~, $ENV{SCRIPT_NAME}, __LINE__);
631
632 $db->db_disconnect($dbh);
633 _act_back($return_to, "ship_ok=$row->{order_id}");
634}
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help