added on WebSTLs (webstls.com) at 2026-07-01 22:26:43
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs -- buyer order history. | |
| 4 | # | |
| 5 | # Shows the logged-in buyer's order list at this storefront. Requires | |
| 6 | # a valid buyer session cookie; unauthenticated visitors are bounced | |
| 7 | # to /buyer_login.cgi. | |
| 8 | #====================================================================== | |
| 9 | use strict; | |
| 10 | use warnings; | |
| 11 | ||
| 12 | use lib '/var/www/vhosts/webstls.com/httpdocs'; | |
| 13 | use CGI; | |
| 14 | use MODS::Template; | |
| 15 | use MODS::DBConnect; | |
| 16 | use MODS::WebSTLs::Config; | |
| 17 | use MODS::WebSTLs::BuyerAuth; | |
| 18 | use MODS::WebSTLs::Themes; | |
| 19 | use MODS::WebSTLs::BuyerCredits; | |
| 20 | ||
| 21 | my $q = CGI->new; | |
| 22 | my $form = $q->Vars; | |
| 23 | my $tfile = MODS::Template->new; | |
| 24 | my $db = MODS::DBConnect->new; | |
| 25 | my $cfg = MODS::WebSTLs::Config->new; | |
| 26 | my $auth = MODS::WebSTLs::BuyerAuth->new; | |
| 27 | my $themes = MODS::WebSTLs::Themes->new; | |
| 28 | my $DB = $cfg->settings('database_name'); | |
| 29 | ||
| 30 | $| = 1; | |
| 31 | ||
| 32 | my $sid = $form->{id} || $form->{storefront_id} || 0; | |
| 33 | $sid =~ s/[^0-9]//g; | |
| 34 | ||
| 35 | my $dbh = $db->db_connect(); | |
| 36 | ||
| 37 | my $buyer = $auth->verify($q, $db, $dbh, $DB); | |
| 38 | unless ($buyer && $buyer->{id}) { | |
| 39 | $db->db_disconnect($dbh); | |
| 40 | my $target = $sid ? "/buyer_login.cgi?id=$sid" : '/'; | |
| 41 | print "Status: 302 Found\nLocation: $target\n\n"; | |
| 42 | exit; | |
| 43 | } | |
| 44 | ||
| 45 | # Resolve storefront -- use the buyer's scoped storefront if no id | |
| 46 | # was passed. | |
| 47 | $sid ||= $buyer->{storefront_id}; | |
| 48 | my $store = $db->db_readwrite($dbh, | |
| 49 | qq~SELECT id, name, subdomain, theme_id FROM `${DB}`.storefronts WHERE id='$sid' LIMIT 1~, | |
| 50 | $ENV{SCRIPT_NAME}, __LINE__); | |
| 51 | ||
| 52 | unless ($store && $store->{id}) { | |
| 53 | $db->db_disconnect($dbh); | |
| 54 | print "Status: 302 Found\nLocation: /\n\n"; | |
| 55 | exit; | |
| 56 | } | |
| 57 | ||
| 58 | # Pull orders for this buyer at this storefront. We join by buyer | |
| 59 | # email rather than buyer_account_id so guest checkouts placed with | |
| 60 | # the same email still surface for the now-registered buyer. | |
| 61 | my $email = $buyer->{email} || ''; | |
| 62 | my $safe_email = $email; | |
| 63 | $safe_email =~ s/[\\']/\\$&/g; | |
| 64 | ||
| 65 | my @orders = $db->db_readwrite_multiple($dbh, qq~ | |
| 66 | SELECT id, status, total_amount_cents, currency, created_at, paid_at, | |
| 67 | stripe_payment_intent_id | |
| 68 | FROM `${DB}`.orders | |
| 69 | WHERE storefront_id='$store->{id}' | |
| 70 | AND (buyer_email='$safe_email' OR buyer_account_id='$buyer->{id}') | |
| 71 | ORDER BY created_at DESC | |
| 72 | LIMIT 100 | |
| 73 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 74 | ||
| 75 | # Probe for the new per-line fulfillment columns -- legacy installs | |
| 76 | # may not have them yet. Use a conditional SELECT. | |
| 77 | my $have_oi_variant_cols = 0; | |
| 78 | { | |
| 79 | my $r = $db->db_readwrite($dbh, qq~ | |
| 80 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 81 | WHERE table_schema='$DB' AND table_name='order_items' | |
| 82 | AND column_name='purchase_kind' | |
| 83 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 84 | $have_oi_variant_cols = 1 if $r && $r->{n}; | |
| 85 | } | |
| 86 | my $variant_select = $have_oi_variant_cols | |
| 87 | ? q~oi.purchase_kind, oi.selected_color, oi.selected_material, | |
| 88 | oi.fulfillment_status, oi.tracking_carrier, oi.tracking_number, | |
| 89 | oi.shipped_at,~ | |
| 90 | : ''; | |
| 91 | my $have_oi_bundle = 0; | |
| 92 | { | |
| 93 | my $r = $db->db_readwrite($dbh, qq~ | |
| 94 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 95 | WHERE table_schema='$DB' AND table_name='order_items' | |
| 96 | AND column_name='bundle_id' | |
| 97 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 98 | $have_oi_bundle = 1 if $r && $r->{n}; | |
| 99 | } | |
| 100 | my $bundle_select = $have_oi_bundle | |
| 101 | ? q~oi.bundle_id, b.title AS bundle_title, b.product_kind AS bundle_kind,~ | |
| 102 | : q~NULL AS bundle_id, NULL AS bundle_title, NULL AS bundle_kind,~; | |
| 103 | my $bundle_join = $have_oi_bundle | |
| 104 | ? qq~LEFT JOIN \`${DB}\`.bundles b ON b.id = oi.bundle_id~ | |
| 105 | : ''; | |
| 106 | ||
| 107 | # Fetch line items per order in one batch. | |
| 108 | my %items_by_order; | |
| 109 | if (@orders) { | |
| 110 | my $order_ids = join(',', map { "'$_->{id}'" } @orders); | |
| 111 | my @items = $db->db_readwrite_multiple($dbh, qq~ | |
| 112 | SELECT oi.id, oi.order_id, oi.model_id, oi.price_paid_cents, oi.quantity, | |
| 113 | $variant_select | |
| 114 | $bundle_select | |
| 115 | m.title AS m_title, m.slug AS m_slug | |
| 116 | FROM `${DB}`.order_items oi | |
| 117 | LEFT JOIN `${DB}`.models m ON m.id = oi.model_id | |
| 118 | $bundle_join | |
| 119 | WHERE oi.order_id IN ($order_ids) | |
| 120 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 121 | foreach my $it (@items) { | |
| 122 | # Bundle rows hijack title; non-bundles use m_title. | |
| 123 | $it->{title} = $it->{bundle_id} | |
| 124 | ? ($it->{bundle_title} || 'Bundle') | |
| 125 | : ($it->{m_title} || ('Model #' . ($it->{model_id} || '?'))); | |
| 126 | $it->{is_bundle} = $it->{bundle_id} ? 1 : 0; | |
| 127 | } | |
| 128 | foreach my $it (@items) { | |
| 129 | push @{ $items_by_order{ $it->{order_id} } }, $it; | |
| 130 | } | |
| 131 | } | |
| 132 | ||
| 133 | my %BUYER_FUL_LABEL = ( | |
| 134 | not_required => '', | |
| 135 | pending => 'Awaiting print', | |
| 136 | printing => 'Printing', | |
| 137 | shipped => 'Shipped', | |
| 138 | delivered => 'Delivered', | |
| 139 | canceled => 'Canceled', | |
| 140 | ); | |
| 141 | ||
| 142 | # Decorate for the template. | |
| 143 | my $lifetime_cents = 0; | |
| 144 | foreach my $o (@orders) { | |
| 145 | my $items = $items_by_order{ $o->{id} } || []; | |
| 146 | my $can_download = (($o->{status} || '') eq 'paid') ? 1 : 0; | |
| 147 | foreach my $it (@$items) { | |
| 148 | my $kind = $it->{purchase_kind} || 'digital'; | |
| 149 | my $fs = $it->{fulfillment_status} || 'not_required'; | |
| 150 | $it->{price_display} = '$' . sprintf('%.2f', ($it->{price_paid_cents} || 0) / 100); | |
| 151 | $it->{title} = _h($it->{title} || 'Item'); | |
| 152 | # Digital lines get a download link; physical ones don't. | |
| 153 | my $is_physical = ($kind eq 'physical') ? 1 : 0; | |
| 154 | $it->{is_physical} = $is_physical; | |
| 155 | # Bundle digital lines need to expand into N component | |
| 156 | # download links rather than a single per-item link. | |
| 157 | if ($it->{is_bundle} && !$is_physical && $can_download) { | |
| 158 | my @comp = $db->db_readwrite_multiple($dbh, qq~ | |
| 159 | SELECT bi.model_id, m.title | |
| 160 | FROM `${DB}`.bundle_items bi | |
| 161 | JOIN `${DB}`.models m ON m.id = bi.model_id | |
| 162 | WHERE bi.bundle_id='$it->{bundle_id}' AND m.purged_at IS NULL | |
| 163 | ORDER BY bi.sort_order ASC | |
| 164 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 165 | my @links; | |
| 166 | foreach my $c (@comp) { | |
| 167 | push @links, { | |
| 168 | title => _h($c->{title}), | |
| 169 | href => "/download.cgi?order=$o->{id}&item=$it->{id}&bundle_model=$c->{model_id}", | |
| 170 | }; | |
| 171 | } | |
| 172 | $it->{bundle_components} = \@links; | |
| 173 | $it->{has_bundle_components} = scalar(@links) ? 1 : 0; | |
| 174 | } | |
| 175 | $it->{download_url} = ($can_download && !$is_physical && !$it->{is_bundle}) | |
| 176 | ? "/download.cgi?order=$o->{id}&item=$it->{id}" | |
| 177 | : ''; | |
| 178 | $it->{can_download} = ($can_download && !$is_physical && !$it->{is_bundle}) ? 1 : 0; | |
| 179 | my @bits; | |
| 180 | push @bits, _h($it->{selected_color}) if $it->{selected_color}; | |
| 181 | push @bits, _h($it->{selected_material}) if $it->{selected_material}; | |
| 182 | $it->{variant_pill} = $is_physical | |
| 183 | ? join(' · ', '3D Print', @bits) | |
| 184 | : ''; | |
| 185 | $it->{fulfillment_label} = $BUYER_FUL_LABEL{$fs} || ''; | |
| 186 | $it->{is_shipped} = ($fs eq 'shipped' || $fs eq 'delivered') ? 1 : 0; | |
| 187 | $it->{tracking_carrier} = _h($it->{tracking_carrier} || ''); | |
| 188 | $it->{tracking_number} = _h($it->{tracking_number} || ''); | |
| 189 | } | |
| 190 | $o->{items} = $items; | |
| 191 | $o->{item_count} = scalar(@$items); | |
| 192 | $o->{total} = '$' . sprintf('%.2f', ($o->{total_amount_cents} || 0) / 100); | |
| 193 | $o->{is_paid} = ($o->{status} || '') eq 'paid' ? 1 : 0; | |
| 194 | $o->{is_pending} = ($o->{status} || '') eq 'pending' ? 1 : 0; | |
| 195 | $o->{is_refund} = ($o->{status} || '') eq 'refunded' ? 1 : 0; | |
| 196 | $o->{is_partial} = ($o->{status} || '') eq 'partially_refunded' ? 1 : 0; | |
| 197 | $o->{is_failed} = ($o->{status} || '') eq 'failed' ? 1 : 0; | |
| 198 | $o->{is_cancel} = ($o->{status} || '') eq 'canceled' ? 1 : 0; | |
| 199 | $lifetime_cents += $o->{total_amount_cents} || 0 if $o->{is_paid}; | |
| 200 | } | |
| 201 | ||
| 202 | my $theme = $themes->by_id($store->{theme_id}); | |
| 203 | my $css_vars = $themes->css_vars($theme); | |
| 204 | ||
| 205 | # Store credit balance for this buyer at this storefront. Helper | |
| 206 | # self-guards against the buyer_credit_ledger table being absent. | |
| 207 | my $bc = MODS::WebSTLs::BuyerCredits->new; | |
| 208 | my $credit_cents = $bc->balance_cents($db, $dbh, $DB, $store->{id}, | |
| 209 | { buyer_account_id => $buyer->{id} }); | |
| 210 | ||
| 211 | $db->db_disconnect($dbh); | |
| 212 | ||
| 213 | require MODS::WebSTLs::StoreChrome; | |
| 214 | my $chrome_dbh = $db->db_connect(); | |
| 215 | my $chrome_html = MODS::WebSTLs::StoreChrome->header_html({ | |
| 216 | store_id => $store->{id}, | |
| 217 | store_name => $store->{name} || $store->{subdomain}, | |
| 218 | is_buyer_in => 1, # my_orders is gated behind buyer login | |
| 219 | cart_count => 0, # cart count not pre-computed here; show no badge | |
| 220 | db => $db, | |
| 221 | dbh => $chrome_dbh, | |
| 222 | DB => $DB, | |
| 223 | }); | |
| 224 | $db->db_disconnect($chrome_dbh); | |
| 225 | ||
| 226 | my $tvars = { | |
| 227 | theme_css_vars => $css_vars, | |
| 228 | store_id => $store->{id}, | |
| 229 | store_name => _h($store->{name} || $store->{subdomain}), | |
| 230 | store_chrome_html => $chrome_html, | |
| 231 | buyer_email => _h($buyer->{email}), | |
| 232 | buyer_name => _h($buyer->{display_name} || $buyer->{email}), | |
| 233 | orders => \@orders, | |
| 234 | has_orders => scalar(@orders) ? 1 : 0, | |
| 235 | order_count => scalar(@orders), | |
| 236 | lifetime_total => '$' . sprintf('%.2f', $lifetime_cents / 100), | |
| 237 | credit_dollars => '$' . sprintf('%.2f', $credit_cents / 100), | |
| 238 | credit_cents => $credit_cents, | |
| 239 | has_credit => $credit_cents > 0 ? 1 : 0, | |
| 240 | credit_history_href => "/my_credit.cgi?id=$store->{id}", | |
| 241 | logout_href => "/buyer_logout.cgi?id=$store->{id}", | |
| 242 | back_href => "/store.cgi?id=$store->{id}", | |
| 243 | }; | |
| 244 | ||
| 245 | 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"; | |
| 246 | print join('', $tfile->template('webstls_my_orders.html', $tvars, undef)); | |
| 247 | ||
| 248 | sub _h { | |
| 249 | my $s = shift; | |
| 250 | $s //= ''; | |
| 251 | $s =~ s/&/&/g; | |
| 252 | $s =~ s/</</g; | |
| 253 | $s =~ s/>/>/g; | |
| 254 | $s =~ s/"/"/g; | |
| 255 | return $s; | |
| 256 | } |