added on WebSTLs (webstls.com) at 2026-07-01 22:26:38
| 1 | package MODS::WebSTLs::Categories; | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs -- seller-defined categories (custom storefront taxonomy). | |
| 4 | # | |
| 5 | # Distinct from the platform-wide `category` column on models (which | |
| 6 | # carries the global taxonomy: "miniatures", "weapons", etc.). These | |
| 7 | # are per-seller collections like "Halloween 2026" / "Patreon exclusive" | |
| 8 | # that drive filter chips on the seller's storefront. | |
| 9 | # | |
| 10 | # Public surface: | |
| 11 | # my $cat = MODS::WebSTLs::Categories->new; | |
| 12 | # $cat->schema_ready($db, $dbh, $DB) -- 1 if tables exist | |
| 13 | # $cat->list_for_user($db, $dbh, $DB, $uid) -- arrayref of category rows | |
| 14 | # $cat->by_id($db, $dbh, $DB, $id, $uid) -- one row owned by $uid | |
| 15 | # $cat->create($db, $dbh, $DB, $uid, %fields) | |
| 16 | # $cat->update($db, $dbh, $DB, $id, $uid, %fields) | |
| 17 | # $cat->delete($db, $dbh, $DB, $id, $uid) | |
| 18 | # $cat->assign($db, $dbh, $DB, $model_id, \@cat_ids, $uid) | |
| 19 | # $cat->for_model($db, $dbh, $DB, $model_id) -- arrayref of categories | |
| 20 | # $cat->refresh_counts($db, $dbh, $DB, $uid) | |
| 21 | #====================================================================== | |
| 22 | use strict; | |
| 23 | use warnings; | |
| 24 | ||
| 25 | sub new { bless {}, shift } | |
| 26 | ||
| 27 | sub schema_ready { | |
| 28 | my ($self, $db, $dbh, $DB) = @_; | |
| 29 | return $self->{_ready} if exists $self->{_ready}; | |
| 30 | foreach my $t (qw(seller_categories model_seller_categories)) { | |
| 31 | my $r = $db->db_readwrite($dbh, qq~ | |
| 32 | SELECT COUNT(*) AS n FROM information_schema.tables | |
| 33 | WHERE table_schema='$DB' AND table_name='$t' | |
| 34 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 35 | unless ($r && $r->{n}) { $self->{_ready} = 0; return 0; } | |
| 36 | } | |
| 37 | $self->{_ready} = 1; | |
| 38 | return 1; | |
| 39 | } | |
| 40 | ||
| 41 | sub defaults_ready { | |
| 42 | my ($self, $db, $dbh, $DB) = @_; | |
| 43 | return $self->{_def_ready} if exists $self->{_def_ready}; | |
| 44 | my $r = $db->db_readwrite($dbh, qq~ | |
| 45 | SELECT COUNT(*) AS n FROM information_schema.tables | |
| 46 | WHERE table_schema='$DB' AND table_name='default_categories' | |
| 47 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 48 | $self->{_def_ready} = ($r && $r->{n}) ? 1 : 0; | |
| 49 | return $self->{_def_ready}; | |
| 50 | } | |
| 51 | ||
| 52 | sub _slugify { | |
| 53 | my ($s) = @_; | |
| 54 | return '' unless defined $s; | |
| 55 | $s = lc $s; | |
| 56 | $s =~ s/[^a-z0-9]+/-/g; | |
| 57 | $s =~ s/^-+|-+$//g; | |
| 58 | return substr($s, 0, 80); | |
| 59 | } | |
| 60 | ||
| 61 | sub _esc { my $s = shift // ''; $s =~ s/\\/\\\\/g; $s =~ s/'/''/g; return $s; } | |
| 62 | ||
| 63 | sub list_for_user { | |
| 64 | my ($self, $db, $dbh, $DB, $uid) = @_; | |
| 65 | return [] unless $uid && $self->schema_ready($db, $dbh, $DB); | |
| 66 | $uid =~ s/[^0-9]//g; return [] unless length $uid; | |
| 67 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 68 | SELECT id, slug, name, description, icon, color, sort_order, | |
| 69 | is_public, model_count, created_at | |
| 70 | FROM `${DB}`.seller_categories | |
| 71 | WHERE user_id='$uid' | |
| 72 | ORDER BY sort_order ASC, name ASC | |
| 73 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 74 | return \@rows; | |
| 75 | } | |
| 76 | ||
| 77 | sub by_id { | |
| 78 | my ($self, $db, $dbh, $DB, $id, $uid) = @_; | |
| 79 | return undef unless $id && $self->schema_ready($db, $dbh, $DB); | |
| 80 | $id =~ s/[^0-9]//g; return undef unless length $id; | |
| 81 | my $where = ''; | |
| 82 | if ($uid) { | |
| 83 | $uid =~ s/[^0-9]//g; | |
| 84 | $where = " AND user_id='$uid'" if length $uid; | |
| 85 | } | |
| 86 | my $r = $db->db_readwrite($dbh, qq~ | |
| 87 | SELECT * FROM `${DB}`.seller_categories | |
| 88 | WHERE id='$id' $where LIMIT 1 | |
| 89 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 90 | return ($r && $r->{id}) ? $r : undef; | |
| 91 | } | |
| 92 | ||
| 93 | # Insert. Returns the new id, or 0 on slug collision. | |
| 94 | sub create { | |
| 95 | my ($self, $db, $dbh, $DB, $uid, %f) = @_; | |
| 96 | return 0 unless $uid && $self->schema_ready($db, $dbh, $DB); | |
| 97 | $uid =~ s/[^0-9]//g; return 0 unless length $uid; | |
| 98 | my $name = substr($f{name} || '', 0, 120); | |
| 99 | return 0 unless length $name; | |
| 100 | my $slug = _slugify($f{slug} || $name); | |
| 101 | return 0 unless length $slug; | |
| 102 | my $desc = substr($f{description} || '', 0, 255); | |
| 103 | my $icon = substr($f{icon} || '', 0, 40); | |
| 104 | my $color= substr($f{color} || '', 0, 20); | |
| 105 | my $sort = int($f{sort_order} || 0); | |
| 106 | my $pub = $f{is_public} ? 1 : 0; | |
| 107 | ||
| 108 | # Slug must be unique per seller. | |
| 109 | my $check = $db->db_readwrite($dbh, qq~ | |
| 110 | SELECT id FROM `${DB}`.seller_categories | |
| 111 | WHERE user_id='$uid' AND slug='~ . _esc($slug) . qq~' LIMIT 1 | |
| 112 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 113 | return 0 if $check && $check->{id}; | |
| 114 | ||
| 115 | $db->db_readwrite($dbh, qq~ | |
| 116 | INSERT INTO `${DB}`.seller_categories SET | |
| 117 | user_id='$uid', | |
| 118 | slug='~ . _esc($slug) . qq~', | |
| 119 | name='~ . _esc($name) . qq~', | |
| 120 | description='~ . _esc($desc) . qq~', | |
| 121 | icon='~ . _esc($icon) . qq~', | |
| 122 | color='~ . _esc($color) . qq~', | |
| 123 | sort_order='$sort', | |
| 124 | is_public='$pub', | |
| 125 | created_at=NOW() | |
| 126 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 127 | my $r = $db->db_readwrite($dbh, qq~SELECT LAST_INSERT_ID() AS id~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 128 | return ($r && $r->{id}) ? $r->{id} : 0; | |
| 129 | } | |
| 130 | ||
| 131 | sub update { | |
| 132 | my ($self, $db, $dbh, $DB, $id, $uid, %f) = @_; | |
| 133 | return 0 unless $self->by_id($db, $dbh, $DB, $id, $uid); | |
| 134 | $id =~ s/[^0-9]//g; | |
| 135 | $uid =~ s/[^0-9]//g; | |
| 136 | my @sets; | |
| 137 | if (defined $f{name}) { push @sets, "name='" . _esc(substr($f{name},0,120)) . "'"; } | |
| 138 | if (defined $f{description}) { push @sets, "description='" . _esc(substr($f{description},0,255)) . "'"; } | |
| 139 | if (defined $f{icon}) { push @sets, "icon='" . _esc(substr($f{icon},0,40)) . "'"; } | |
| 140 | if (defined $f{color}) { push @sets, "color='" . _esc(substr($f{color},0,20)) . "'"; } | |
| 141 | if (defined $f{sort_order}) { push @sets, "sort_order='" . int($f{sort_order}) . "'"; } | |
| 142 | if (defined $f{is_public}) { push @sets, "is_public='" . ($f{is_public} ? 1 : 0) . "'"; } | |
| 143 | return 1 unless @sets; | |
| 144 | $db->db_readwrite($dbh, qq~ | |
| 145 | UPDATE `${DB}`.seller_categories | |
| 146 | SET ~ . join(',', @sets) . qq~ | |
| 147 | WHERE id='$id' AND user_id='$uid' LIMIT 1 | |
| 148 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 149 | return 1; | |
| 150 | } | |
| 151 | ||
| 152 | sub delete { | |
| 153 | my ($self, $db, $dbh, $DB, $id, $uid) = @_; | |
| 154 | return 0 unless $self->by_id($db, $dbh, $DB, $id, $uid); | |
| 155 | $id =~ s/[^0-9]//g; | |
| 156 | $uid =~ s/[^0-9]//g; | |
| 157 | # ON DELETE CASCADE on the join table sweeps the assignments. | |
| 158 | $db->db_readwrite($dbh, qq~ | |
| 159 | DELETE FROM `${DB}`.seller_categories | |
| 160 | WHERE id='$id' AND user_id='$uid' LIMIT 1 | |
| 161 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 162 | return 1; | |
| 163 | } | |
| 164 | ||
| 165 | # Replace the full set of categories assigned to one model. Owner- | |
| 166 | # verified at the model level (caller passes $uid). | |
| 167 | sub assign { | |
| 168 | my ($self, $db, $dbh, $DB, $model_id, $cat_ids, $uid) = @_; | |
| 169 | return 0 unless $self->schema_ready($db, $dbh, $DB); | |
| 170 | $model_id =~ s/[^0-9]//g; return 0 unless length $model_id; | |
| 171 | $uid =~ s/[^0-9]//g; return 0 unless length $uid; | |
| 172 | ||
| 173 | # Verify the model belongs to this seller. | |
| 174 | my $own = $db->db_readwrite($dbh, qq~ | |
| 175 | SELECT user_id FROM `${DB}`.models WHERE id='$model_id' LIMIT 1 | |
| 176 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 177 | return 0 unless $own && $own->{user_id} eq $uid; | |
| 178 | ||
| 179 | # Clear prior assignments then insert the new set. | |
| 180 | $db->db_readwrite($dbh, qq~ | |
| 181 | DELETE FROM `${DB}`.model_seller_categories WHERE model_id='$model_id' | |
| 182 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 183 | ||
| 184 | my $sort = 0; | |
| 185 | foreach my $cid (@{ $cat_ids || [] }) { | |
| 186 | $cid =~ s/[^0-9]//g; next unless length $cid; | |
| 187 | # Only allow categories the seller owns. | |
| 188 | my $own2 = $db->db_readwrite($dbh, qq~ | |
| 189 | SELECT id FROM `${DB}`.seller_categories | |
| 190 | WHERE id='$cid' AND user_id='$uid' LIMIT 1 | |
| 191 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 192 | next unless $own2 && $own2->{id}; | |
| 193 | $db->db_readwrite($dbh, qq~ | |
| 194 | INSERT IGNORE INTO `${DB}`.model_seller_categories | |
| 195 | SET model_id='$model_id', category_id='$cid', | |
| 196 | sort_order='$sort', added_at=NOW() | |
| 197 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 198 | $sort++; | |
| 199 | } | |
| 200 | return 1; | |
| 201 | } | |
| 202 | ||
| 203 | # Categories assigned to one model. Returns arrayref of {id,slug,name,color,icon}. | |
| 204 | sub for_model { | |
| 205 | my ($self, $db, $dbh, $DB, $model_id) = @_; | |
| 206 | return [] unless $self->schema_ready($db, $dbh, $DB); | |
| 207 | $model_id =~ s/[^0-9]//g; return [] unless length $model_id; | |
| 208 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 209 | SELECT sc.id, sc.slug, sc.name, sc.color, sc.icon | |
| 210 | FROM `${DB}`.model_seller_categories msc | |
| 211 | JOIN `${DB}`.seller_categories sc ON sc.id = msc.category_id | |
| 212 | WHERE msc.model_id='$model_id' | |
| 213 | ORDER BY msc.sort_order ASC | |
| 214 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 215 | return \@rows; | |
| 216 | } | |
| 217 | ||
| 218 | #====================================================================== | |
| 219 | # Default-category list -- admin-owned template that new sellers receive | |
| 220 | # a copy of. Edits here do NOT propagate to sellers who have already been | |
| 221 | # seeded; this is the "starter pack" only. | |
| 222 | #====================================================================== | |
| 223 | ||
| 224 | sub default_list { | |
| 225 | my ($self, $db, $dbh, $DB) = @_; | |
| 226 | return [] unless $self->defaults_ready($db, $dbh, $DB); | |
| 227 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 228 | SELECT id, slug, name, description, icon, color, sort_order, is_public | |
| 229 | FROM `${DB}`.default_categories | |
| 230 | ORDER BY sort_order ASC, name ASC | |
| 231 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 232 | return \@rows; | |
| 233 | } | |
| 234 | ||
| 235 | sub default_by_id { | |
| 236 | my ($self, $db, $dbh, $DB, $id) = @_; | |
| 237 | return undef unless $id && $self->defaults_ready($db, $dbh, $DB); | |
| 238 | $id =~ s/[^0-9]//g; return undef unless length $id; | |
| 239 | my $r = $db->db_readwrite($dbh, qq~ | |
| 240 | SELECT * FROM `${DB}`.default_categories WHERE id='$id' LIMIT 1 | |
| 241 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 242 | return ($r && $r->{id}) ? $r : undef; | |
| 243 | } | |
| 244 | ||
| 245 | # Insert a default. Returns new id or 0 on slug collision. | |
| 246 | sub default_create { | |
| 247 | my ($self, $db, $dbh, $DB, %f) = @_; | |
| 248 | return 0 unless $self->defaults_ready($db, $dbh, $DB); | |
| 249 | my $name = substr($f{name} || '', 0, 120); | |
| 250 | return 0 unless length $name; | |
| 251 | my $slug = _slugify($f{slug} || $name); | |
| 252 | return 0 unless length $slug; | |
| 253 | my $desc = substr($f{description} || '', 0, 255); | |
| 254 | my $icon = substr($f{icon} || '', 0, 40); | |
| 255 | my $color= substr($f{color} || '', 0, 20); | |
| 256 | my $sort = int($f{sort_order} || 0); | |
| 257 | my $pub = $f{is_public} ? 1 : 0; | |
| 258 | ||
| 259 | my $check = $db->db_readwrite($dbh, qq~ | |
| 260 | SELECT id FROM `${DB}`.default_categories | |
| 261 | WHERE slug='~ . _esc($slug) . qq~' LIMIT 1 | |
| 262 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 263 | return 0 if $check && $check->{id}; | |
| 264 | ||
| 265 | $db->db_readwrite($dbh, qq~ | |
| 266 | INSERT INTO `${DB}`.default_categories SET | |
| 267 | slug='~ . _esc($slug) . qq~', | |
| 268 | name='~ . _esc($name) . qq~', | |
| 269 | description='~ . _esc($desc) . qq~', | |
| 270 | icon='~ . _esc($icon) . qq~', | |
| 271 | color='~ . _esc($color) . qq~', | |
| 272 | sort_order='$sort', | |
| 273 | is_public='$pub', | |
| 274 | created_at=NOW() | |
| 275 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 276 | my $r = $db->db_readwrite($dbh, qq~SELECT LAST_INSERT_ID() AS id~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 277 | return ($r && $r->{id}) ? $r->{id} : 0; | |
| 278 | } | |
| 279 | ||
| 280 | sub default_update { | |
| 281 | my ($self, $db, $dbh, $DB, $id, %f) = @_; | |
| 282 | return 0 unless $self->default_by_id($db, $dbh, $DB, $id); | |
| 283 | $id =~ s/[^0-9]//g; | |
| 284 | my @sets; | |
| 285 | if (defined $f{name}) { push @sets, "name='" . _esc(substr($f{name},0,120)) . "'"; } | |
| 286 | if (defined $f{description}) { push @sets, "description='" . _esc(substr($f{description},0,255)) . "'"; } | |
| 287 | if (defined $f{icon}) { push @sets, "icon='" . _esc(substr($f{icon},0,40)) . "'"; } | |
| 288 | if (defined $f{color}) { push @sets, "color='" . _esc(substr($f{color},0,20)) . "'"; } | |
| 289 | if (defined $f{sort_order}) { push @sets, "sort_order='" . int($f{sort_order}) . "'"; } | |
| 290 | if (defined $f{is_public}) { push @sets, "is_public='" . ($f{is_public} ? 1 : 0) . "'"; } | |
| 291 | return 1 unless @sets; | |
| 292 | $db->db_readwrite($dbh, qq~ | |
| 293 | UPDATE `${DB}`.default_categories | |
| 294 | SET ~ . join(',', @sets) . qq~ | |
| 295 | WHERE id='$id' LIMIT 1 | |
| 296 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 297 | return 1; | |
| 298 | } | |
| 299 | ||
| 300 | sub default_delete { | |
| 301 | my ($self, $db, $dbh, $DB, $id) = @_; | |
| 302 | return 0 unless $self->default_by_id($db, $dbh, $DB, $id); | |
| 303 | $id =~ s/[^0-9]//g; | |
| 304 | $db->db_readwrite($dbh, qq~ | |
| 305 | DELETE FROM `${DB}`.default_categories WHERE id='$id' LIMIT 1 | |
| 306 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 307 | return 1; | |
| 308 | } | |
| 309 | ||
| 310 | # Lazy seed -- merges the default_categories list into a seller's | |
| 311 | # seller_categories on first touch. Additive: any defaults the seller | |
| 312 | # doesn't already have a row for (matched by slug) get inserted; any | |
| 313 | # they DO already have stay untouched. Runs once per user; the | |
| 314 | # users.categories_seeded_at sentinel prevents re-seeding even if the | |
| 315 | # user later deletes a default they didn't want. | |
| 316 | sub seed_for_user_if_unseeded { | |
| 317 | my ($self, $db, $dbh, $DB, $uid) = @_; | |
| 318 | return 0 unless $uid; | |
| 319 | $uid =~ s/[^0-9]//g; return 0 unless length $uid; | |
| 320 | return 0 unless $self->schema_ready($db, $dbh, $DB); | |
| 321 | return 0 unless $self->defaults_ready($db, $dbh, $DB); | |
| 322 | ||
| 323 | # users.categories_seeded_at is an optional column; if the migration | |
| 324 | # adding it hasn't run yet, just bail and let upload.cgi fall back to | |
| 325 | # whatever rows the seller already has. | |
| 326 | my $col = $db->db_readwrite($dbh, qq~ | |
| 327 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 328 | WHERE table_schema='$DB' AND table_name='users' | |
| 329 | AND column_name='categories_seeded_at' | |
| 330 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 331 | return 0 unless $col && $col->{n}; | |
| 332 | ||
| 333 | my $u = $db->db_readwrite($dbh, qq~ | |
| 334 | SELECT categories_seeded_at FROM `${DB}`.users | |
| 335 | WHERE id='$uid' LIMIT 1 | |
| 336 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 337 | return 0 if $u && $u->{categories_seeded_at}; | |
| 338 | ||
| 339 | # INSERT IGNORE relies on uq_sc_user_slug to skip any default whose | |
| 340 | # slug already exists for this user. Defaults that don't collide get | |
| 341 | # inserted; the seller's own rows stay put. | |
| 342 | $db->db_readwrite($dbh, qq~ | |
| 343 | INSERT IGNORE INTO `${DB}`.seller_categories | |
| 344 | (user_id, slug, name, description, icon, color, | |
| 345 | sort_order, is_public, created_at) | |
| 346 | SELECT '$uid', slug, name, description, icon, color, | |
| 347 | sort_order, is_public, NOW() | |
| 348 | FROM `${DB}`.default_categories | |
| 349 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 350 | ||
| 351 | $db->db_readwrite($dbh, qq~ | |
| 352 | UPDATE `${DB}`.users SET categories_seeded_at=NOW() | |
| 353 | WHERE id='$uid' LIMIT 1 | |
| 354 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 355 | return 1; | |
| 356 | } | |
| 357 | ||
| 358 | # Recompute model_count cache. Called after bulk assignments. | |
| 359 | sub refresh_counts { | |
| 360 | my ($self, $db, $dbh, $DB, $uid) = @_; | |
| 361 | return 0 unless $self->schema_ready($db, $dbh, $DB); | |
| 362 | $uid =~ s/[^0-9]//g; return 0 unless length $uid; | |
| 363 | $db->db_readwrite($dbh, qq~ | |
| 364 | UPDATE `${DB}`.seller_categories sc | |
| 365 | SET model_count = ( | |
| 366 | SELECT COUNT(*) FROM `${DB}`.model_seller_categories msc | |
| 367 | JOIN `${DB}`.models m ON m.id = msc.model_id | |
| 368 | WHERE msc.category_id = sc.id | |
| 369 | AND m.status = 'published' | |
| 370 | AND m.purged_at IS NULL | |
| 371 | ) | |
| 372 | WHERE user_id='$uid' | |
| 373 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 374 | return 1; | |
| 375 | } | |
| 376 | ||
| 377 | 1; |