added on local at 2026-07-01 22:09:37
| 1 | package MODS::ShopCart::Cart; | |
| 2 | #====================================================================== | |
| 3 | # ShopCart -- shopping cart helpers. | |
| 4 | # | |
| 5 | # A cart is identified by a random hex token stored in a "shopcart_cart" | |
| 6 | # cookie. Cart rows live in cart_items keyed by that token + storefront. | |
| 7 | # Storefronts are independent: a buyer who has items in two creators' | |
| 8 | # stores has two separate carts under the same cookie. | |
| 9 | # | |
| 10 | # Use: | |
| 11 | # my $cart = MODS::ShopCart::Cart->new; | |
| 12 | # my $token = $cart->read_token($q); # may be '' | |
| 13 | # my $token2 = $cart->ensure_token($q, \$cookie); # generates + Set-Cookie if missing | |
| 14 | # my $count = $cart->count($dbh, $DB, $token, $sid); | |
| 15 | # my @rows = $cart->items($dbh, $DB, $token, $sid); | |
| 16 | #====================================================================== | |
| 17 | use strict; | |
| 18 | use warnings; | |
| 19 | ||
| 20 | sub new { | |
| 21 | my ($class) = @_; | |
| 22 | return bless({}, $class); | |
| 23 | } | |
| 24 | ||
| 25 | # Has the cart_items table been created on this server? Cached per | |
| 26 | # request so we only SHOW TABLES once. Returns 0 when the migration | |
| 27 | # hasn't been run -- every Cart method then returns the safe default | |
| 28 | # (empty cart) instead of 500ing the storefront. | |
| 29 | sub _has_table { | |
| 30 | my ($self, $db, $dbh, $DB) = @_; | |
| 31 | return $self->{_has_table} if exists $self->{_has_table}; | |
| 32 | # information_schema instead of SHOW TABLES LIKE -- the latter | |
| 33 | # returns no rows when the table is missing, but DBConnect's | |
| 34 | # db_readwrite autovivifies a truthy-but-empty hashref from the | |
| 35 | # rows_affected line, so a naive `if $r` always passes. | |
| 36 | # COUNT(*) always returns one row with a definitive 0 or 1. | |
| 37 | my $r = $db->db_readwrite($dbh, qq~ | |
| 38 | SELECT COUNT(*) AS n FROM information_schema.tables | |
| 39 | WHERE table_schema='$DB' AND table_name='cart_items' | |
| 40 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 41 | $self->{_has_table} = ($r && $r->{n}) ? 1 : 0; | |
| 42 | return $self->{_has_table}; | |
| 43 | } | |
| 44 | ||
| 45 | # Read the cart token from the request cookie. Returns '' when there | |
| 46 | # isn't one yet. | |
| 47 | sub read_token { | |
| 48 | my ($self, $q) = @_; | |
| 49 | my $token = $q->cookie('shopcart_cart'); | |
| 50 | return '' unless defined $token; | |
| 51 | $token =~ s/[^a-f0-9]//g; | |
| 52 | return '' if length($token) < 16 || length($token) > 64; | |
| 53 | return $token; | |
| 54 | } | |
| 55 | ||
| 56 | # Read OR mint a token. If a new token is minted, the caller should | |
| 57 | # emit the returned Set-Cookie header line before any body content. | |
| 58 | # Usage: | |
| 59 | # my ($token, $cookie_line) = $cart->ensure_token($q); | |
| 60 | # print "Set-Cookie: $cookie_line\n" if $cookie_line; | |
| 61 | sub ensure_token { | |
| 62 | my ($self, $q) = @_; | |
| 63 | my $token = $self->read_token($q); | |
| 64 | return ($token, '') if $token; | |
| 65 | ||
| 66 | my @hex = ('0'..'9', 'a'..'f'); | |
| 67 | my $new_token = ''; | |
| 68 | $new_token .= $hex[int(rand(@hex))] for 1..32; | |
| 69 | # 30-day cookie, HttpOnly, SameSite=Lax. Path covers the entire | |
| 70 | # storefront so add-to-cart from any page lands in the same cart. | |
| 71 | my $cookie = qq~shopcart_cart=$new_token; Max-Age=2592000; Path=/; SameSite=Lax; HttpOnly~; | |
| 72 | return ($new_token, $cookie); | |
| 73 | } | |
| 74 | ||
| 75 | # Count how many rows (sum of quantity) the cart has for the given | |
| 76 | # storefront. Used for header badge. | |
| 77 | sub count { | |
| 78 | my ($self, $db, $dbh, $DB, $token, $sid) = @_; | |
| 79 | return 0 unless $token && $sid; | |
| 80 | return 0 unless $self->_has_table($db, $dbh, $DB); | |
| 81 | $token =~ s/[^a-f0-9]//g; | |
| 82 | $sid =~ s/[^0-9]//g; | |
| 83 | return 0 unless $token && $sid; | |
| 84 | my $r = $db->db_readwrite($dbh, qq~ | |
| 85 | SELECT COALESCE(SUM(quantity), 0) AS n | |
| 86 | FROM `${DB}`.cart_items | |
| 87 | WHERE cart_token='$token' AND storefront_id='$sid' | |
| 88 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 89 | return ($r && $r->{n}) ? $r->{n} : 0; | |
| 90 | } | |
| 91 | ||
| 92 | # Probe whether the variant columns (purchase_kind, selected_color, | |
| 93 | # selected_material) exist on cart_items. Cached per request. On a | |
| 94 | # legacy install we degrade items() to the digital-only column list. | |
| 95 | sub _has_variant_cols { | |
| 96 | my ($self, $db, $dbh, $DB) = @_; | |
| 97 | return $self->{_has_variant_cols} if exists $self->{_has_variant_cols}; | |
| 98 | my $r = $db->db_readwrite($dbh, qq~ | |
| 99 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 100 | WHERE table_schema='$DB' AND table_name='cart_items' | |
| 101 | AND column_name='purchase_kind' | |
| 102 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 103 | $self->{_has_variant_cols} = ($r && $r->{n}) ? 1 : 0; | |
| 104 | return $self->{_has_variant_cols}; | |
| 105 | } | |
| 106 | ||
| 107 | sub _has_bundle_cols { | |
| 108 | my ($self, $db, $dbh, $DB) = @_; | |
| 109 | return $self->{_has_bundle_cols} if exists $self->{_has_bundle_cols}; | |
| 110 | my $r = $db->db_readwrite($dbh, qq~ | |
| 111 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 112 | WHERE table_schema='$DB' AND table_name='cart_items' | |
| 113 | AND column_name='bundle_id' | |
| 114 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 115 | $self->{_has_bundle_cols} = ($r && $r->{n}) ? 1 : 0; | |
| 116 | return $self->{_has_bundle_cols}; | |
| 117 | } | |
| 118 | ||
| 119 | # List cart rows joined with model data. Each row has: cart_item_id, | |
| 120 | # model_id, title, price_cents, quantity, hero_url, slug, plus when | |
| 121 | # the variant columns are present: purchase_kind, selected_color, | |
| 122 | # selected_material, requires_shipping (1 iff purchase_kind='physical'). | |
| 123 | sub items { | |
| 124 | my ($self, $db, $dbh, $DB, $token, $sid) = @_; | |
| 125 | return () unless $token && $sid; | |
| 126 | return () unless $self->_has_table($db, $dbh, $DB); | |
| 127 | $token =~ s/[^a-f0-9]//g; | |
| 128 | $sid =~ s/[^0-9]//g; | |
| 129 | return () unless $token && $sid; | |
| 130 | my $variant_select = $self->_has_variant_cols($db, $dbh, $DB) | |
| 131 | ? q~ci.purchase_kind, ci.selected_color, ci.selected_material,~ | |
| 132 | : q~'digital' AS purchase_kind, '' AS selected_color, '' AS selected_material,~; | |
| 133 | my $has_bundle = $self->_has_bundle_cols($db, $dbh, $DB); | |
| 134 | # qq~~ (interpolating) so $DB substitutes -- the older q~~ form | |
| 135 | # left "${DB}" as a literal in the SQL, breaking bundle lookups | |
| 136 | # with a "table not found / permission denied" error at query time. | |
| 137 | my $bundle_select = $has_bundle | |
| 138 | ? qq~ci.bundle_id, | |
| 139 | b.title AS bundle_title, | |
| 140 | b.slug AS bundle_slug, | |
| 141 | b.hero_image_url AS bundle_hero_url, | |
| 142 | b.product_kind AS bundle_kind, | |
| 143 | (SELECT COUNT(*) FROM `${DB}`.bundle_items bi WHERE bi.bundle_id=ci.bundle_id) AS bundle_item_count,~ | |
| 144 | : q~NULL AS bundle_id, NULL AS bundle_title, NULL AS bundle_slug, | |
| 145 | NULL AS bundle_hero_url, NULL AS bundle_kind, 0 AS bundle_item_count,~; | |
| 146 | my $bundle_join = $has_bundle | |
| 147 | ? qq~LEFT JOIN `${DB}`.bundles b ON b.id = ci.bundle_id~ | |
| 148 | : ''; | |
| 149 | # LEFT JOIN models because a bundle row has model_id NULL. | |
| 150 | # WHERE filter: bundle row OR (model row AND not-purged). | |
| 151 | my $where_filter = $has_bundle | |
| 152 | ? "AND (ci.bundle_id IS NOT NULL OR m.purged_at IS NULL)" | |
| 153 | : 'AND m.purged_at IS NULL'; | |
| 154 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 155 | SELECT ci.id AS cart_item_id, | |
| 156 | ci.model_id, | |
| 157 | ci.quantity, | |
| 158 | ci.unit_price_cents, | |
| 159 | ci.unit_price_cents AS price_cents, | |
| 160 | $variant_select | |
| 161 | $bundle_select | |
| 162 | m.title, | |
| 163 | m.slug, | |
| 164 | m.hero_image_url, | |
| 165 | m.hero_image_pos, | |
| 166 | m.currency | |
| 167 | FROM `${DB}`.cart_items ci | |
| 168 | LEFT JOIN `${DB}`.models m ON m.id = ci.model_id | |
| 169 | $bundle_join | |
| 170 | WHERE ci.cart_token='$token' | |
| 171 | AND ci.storefront_id='$sid' | |
| 172 | $where_filter | |
| 173 | ORDER BY ci.added_at ASC, ci.id ASC | |
| 174 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 175 | foreach my $r (@rows) { | |
| 176 | # A bundle row hijacks title/hero from the bundles table. | |
| 177 | if ($r->{bundle_id}) { | |
| 178 | $r->{title} = $r->{bundle_title}; | |
| 179 | $r->{hero_image_url} = $r->{bundle_hero_url}; | |
| 180 | $r->{is_bundle} = 1; | |
| 181 | } else { | |
| 182 | $r->{is_bundle} = 0; | |
| 183 | } | |
| 184 | $r->{requires_shipping} = ($r->{purchase_kind} && $r->{purchase_kind} eq 'physical') ? 1 : 0; | |
| 185 | } | |
| 186 | return @rows; | |
| 187 | } | |
| 188 | ||
| 189 | # True iff the cart contains at least one physical-kind line. Used by | |
| 190 | # the checkout page to decide whether to render the shipping address | |
| 191 | # form + ship-rate selector. | |
| 192 | sub requires_shipping { | |
| 193 | my ($self, $db, $dbh, $DB, $token, $sid) = @_; | |
| 194 | return 0 unless $token && $sid; | |
| 195 | return 0 unless $self->_has_table($db, $dbh, $DB); | |
| 196 | return 0 unless $self->_has_variant_cols($db, $dbh, $DB); | |
| 197 | $token =~ s/[^a-f0-9]//g; | |
| 198 | $sid =~ s/[^0-9]//g; | |
| 199 | return 0 unless $token && $sid; | |
| 200 | my $r = $db->db_readwrite($dbh, qq~ | |
| 201 | SELECT COUNT(*) AS n | |
| 202 | FROM `${DB}`.cart_items | |
| 203 | WHERE cart_token='$token' | |
| 204 | AND storefront_id='$sid' | |
| 205 | AND purchase_kind='physical' | |
| 206 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 207 | return ($r && $r->{n}) ? 1 : 0; | |
| 208 | } | |
| 209 | ||
| 210 | # Total cents across all items in the cart for one storefront. | |
| 211 | sub total_cents { | |
| 212 | my ($self, $db, $dbh, $DB, $token, $sid) = @_; | |
| 213 | return 0 unless $token && $sid; | |
| 214 | return 0 unless $self->_has_table($db, $dbh, $DB); | |
| 215 | $token =~ s/[^a-f0-9]//g; | |
| 216 | $sid =~ s/[^0-9]//g; | |
| 217 | return 0 unless $token && $sid; | |
| 218 | my $r = $db->db_readwrite($dbh, qq~ | |
| 219 | SELECT COALESCE(SUM(unit_price_cents * quantity), 0) AS total | |
| 220 | FROM `${DB}`.cart_items | |
| 221 | WHERE cart_token='$token' AND storefront_id='$sid' | |
| 222 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 223 | return ($r && defined $r->{total}) ? $r->{total} : 0; | |
| 224 | } | |
| 225 | ||
| 226 | # Clear every row from the cart for one storefront (called after a | |
| 227 | # successful checkout, or manually from /cart.cgi). | |
| 228 | sub clear { | |
| 229 | my ($self, $db, $dbh, $DB, $token, $sid) = @_; | |
| 230 | return unless $token && $sid; | |
| 231 | return unless $self->_has_table($db, $dbh, $DB); | |
| 232 | $token =~ s/[^a-f0-9]//g; | |
| 233 | $sid =~ s/[^0-9]//g; | |
| 234 | return unless $token && $sid; | |
| 235 | $db->db_readwrite($dbh, qq~ | |
| 236 | DELETE FROM `${DB}`.cart_items | |
| 237 | WHERE cart_token='$token' AND storefront_id='$sid' | |
| 238 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 239 | } | |
| 240 | ||
| 241 | 1; |