Diff -- /var/www/vhosts/3dshawn.com/shop.3dshawn.com/orders.cgi
Diff

/var/www/vhosts/3dshawn.com/shop.3dshawn.com/orders.cgi

added on local at 2026-07-01 22:09:42

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