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

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

added on WebSTLs (webstls.com) at 2026-07-01 22:27:10

Added
+1233
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 46b76fdc1e56
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 -- Upload & publish model.
4#
5# GET /upload_model.cgi -- renders the upload form (webstls_upload_model.html).
6# POST /upload_model.cgi -- accepts multipart/form-data:
7# - model_files[] 3D files (STL/OBJ/STEP/3MF/ZIP)
8# - model_images[] gallery images
9# - title, tagline, description, category, tags
10# - price_mode (free|paid), price
11# - visibility (public|unlisted|private)
12# - license_type
13# - schedule_mode (now|scheduled|patreon_first)
14# - scheduled_at (datetime-local string)
15# - opt_*, compat_*, mat_*, spec_*, ps_*
16# - highlights_json, included_json, videos_json
17# - publish_to[] marketplace slugs (limit 2 on free)
18# ...and inserts:
19# - one models row
20# - model_files rows (with files saved to disk)
21# - model_images rows (with files saved to disk)
22# - model_tags rows (split from comma list)
23# - one marketplace_pushes row per selected slug
24# ...then redirects to /models.cgi?published=N
25#======================================================================
26use strict;
27use warnings;
28
29use lib '/var/www/vhosts/webstls.com/httpdocs';
30use CGI;
31use MODS::Template;
32use MODS::DBConnect;
33use MODS::Login;
34use MODS::WebSTLs::Config;
35use MODS::WebSTLs::Wrapper;
36use MODS::WebSTLs::Marketplaces;
37use MODS::WebSTLs::Categories;
38use MODS::WebSTLs::Storage;
39use MODS::WebSTLs::Compress;
40
41my $q = CGI->new;
42my $form = $q->Vars;
43my $tfile = MODS::Template->new;
44my $db = MODS::DBConnect->new;
45my $auth = MODS::Login->new;
46my $config = MODS::WebSTLs::Config->new;
47my $wrap = MODS::WebSTLs::Wrapper->new;
48my $mp = MODS::WebSTLs::Marketplaces->new;
49my $catmod = MODS::WebSTLs::Categories->new;
50my $DB = $config->settings('database_name');
51
52$| = 1;
53
54my $userinfo = $auth->login_verify();
55if (!$userinfo) {
56 print "Status: 302 Found\nLocation: /login.cgi\n\n";
57 exit;
58}
59require MODS::WebSTLs::Permissions;
60MODS::WebSTLs::Permissions->new->require_feature($userinfo, 'edit_models');
61
62my $uid = $userinfo->{user_id};
63$uid =~ s/[^0-9]//g;
64
65# Free plan = demo mode (max 2 marketplace pushes).
66my $plan_tier = lc($userinfo->{plan_tier} || 'free');
67my $is_demo = ($plan_tier eq 'free') ? 1 : 0;
68my $demo_max = 2;
69
70#======================================================================
71# POST -- save the model OR handle an AJAX remove action
72#======================================================================
73if (($ENV{REQUEST_METHOD} || '') eq 'POST') {
74 # AJAX removal of an existing image or file from a model.
75 my $ajax = lc($form->{_ajax} || '');
76 $ajax =~ s/[^a-z_]//g;
77 if ($ajax eq 'remove_image' || $ajax eq 'remove_file') {
78 handle_ajax_remove($ajax);
79 exit;
80 }
81 handle_post();
82 exit;
83}
84
85sub handle_ajax_remove {
86 my ($kind) = @_;
87 print "Content-Type: application/json\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n";
88 my $row_id = $form->{row_id} || 0;
89 $row_id =~ s/[^0-9]//g;
90 unless ($row_id) {
91 print qq~{"success":0,"error":"missing row_id"}~;
92 return;
93 }
94 my $dbh = $db->db_connect();
95 my $table = ($kind eq 'remove_image') ? 'model_images' : 'model_files';
96 # Pull the size cols too so we can decrement storage_used_bytes on
97 # removal of a model_files row.
98 my $select_cols = ($table eq 'model_files')
99 ? 'm.user_id, t.storage_key, t.original_size_bytes, t.file_size_bytes'
100 : 'm.user_id, t.storage_key';
101 # Verify the row belongs to a model the user owns.
102 my $owner = $db->db_readwrite($dbh, qq~
103 SELECT $select_cols
104 FROM `${DB}`.$table t
105 JOIN `${DB}`.models m ON m.id = t.model_id
106 WHERE t.id = '$row_id' LIMIT 1
107 ~, $ENV{SCRIPT_NAME}, __LINE__);
108 unless ($owner && $owner->{user_id} && $owner->{user_id} eq $uid) {
109 $db->db_disconnect($dbh);
110 print qq~{"success":0,"error":"row not yours"}~;
111 return;
112 }
113 # Delete the row.
114 $db->db_readwrite($dbh,
115 qq~DELETE FROM `${DB}`.$table WHERE id='$row_id' LIMIT 1~,
116 $ENV{SCRIPT_NAME}, __LINE__);
117
118 # Refund this user's storage usage by the original (pre-compression)
119 # size. We charge by what they uploaded, so we refund by the same.
120 if ($table eq 'model_files') {
121 my $refund = $owner->{original_size_bytes} || $owner->{file_size_bytes} || 0;
122 if ($refund > 0) {
123 MODS::WebSTLs::Storage->new
124 ->bump_usage($db, $dbh, $DB, $uid, -$refund);
125 }
126 }
127 $db->db_disconnect($dbh);
128
129 # Best-effort on-disk cleanup. Guard against traversal in either
130 # storage root. Model files live under private_files_dir; images
131 # under httpdocs/uploads (storage_key still has the "uploads/"
132 # prefix on image rows for backwards-compat with img.cgi).
133 my $key = $owner->{storage_key} || '';
134 if ($key && $key !~ /\.\./) {
135 my $path;
136 if ($table eq 'model_files') {
137 my $root = $config->settings('private_files_dir')
138 || '/var/www/vhosts/webstls.com/private/files';
139 $path = "$root/$key";
140 } elsif ($key =~ m{^uploads/}) {
141 $path = "/var/www/vhosts/webstls.com/httpdocs/$key";
142 }
143 unlink $path if $path && -f $path;
144 }
145
146 print qq~{"success":1,"row_id":"$row_id"}~;
147}
148
149#======================================================================
150# GET -- render the form
151#
152# Two modes:
153# /upload_model.cgi -> blank form, creates a new model
154# /upload_model.cgi?model_id=N -> pre-filled form, edits the existing
155# model. Verifies ownership before
156# exposing any data.
157#======================================================================
158my $edit_id = ($form->{model_id} || $form->{id} || 0);
159$edit_id =~ s/[^0-9]//g;
160
161# Seller's categories. Two surfaces:
162# 1. The primary Category <select> -- single value stored in models.category
163# as the seller_category slug.
164# 2. The "Your collections" multi-tag chip picker (existing) -- multi-value
165# stored in model_seller_categories.
166# On first visit we lazy-seed from default_categories so the seller has
167# the platform default list to pick from without doing anything.
168my @seller_cats; # for chip picker
169my @category_picklist; # for primary <select>
170{
171 my $dbh = $db->db_connect();
172 $catmod->seed_for_user_if_unseeded($db, $dbh, $DB, $uid);
173 my $cats = $catmod->list_for_user($db, $dbh, $DB, $uid);
174 my %selected;
175 if ($edit_id) {
176 my $on = $catmod->for_model($db, $dbh, $DB, $edit_id);
177 %selected = map { $_->{id} => 1 } @$on;
178 }
179 foreach my $c (@$cats) {
180 push @seller_cats, {
181 id => $c->{id},
182 name => _ha($c->{name}),
183 color => _ha($c->{color} || '#a78bfa'),
184 icon => _ha($c->{icon} || ''),
185 checked => $selected{$c->{id}} ? 'checked' : '',
186 };
187 push @category_picklist, [ $c->{slug}, _ha($c->{name}) ];
188 }
189 $db->db_disconnect($dbh);
190}
191
192my @marketplaces;
193foreach my $p (@{ $mp->all }) {
194 push @marketplaces, {
195 slug => $p->{slug},
196 name => $p->{name},
197 icon => $p->{icon},
198 fees => $p->{fees},
199 sells_digital => $p->{sells_digital} ? 1 : 0,
200 sells_physical => $p->{sells_physical} ? 1 : 0,
201 };
202}
203
204my $tvars = {
205 user_id => $uid,
206 is_demo => $is_demo,
207 demo_max => $demo_max,
208 marketplaces => \@marketplaces,
209 seller_categories => \@seller_cats,
210 has_seller_categories => scalar(@seller_cats) ? 1 : 0,
211 is_edit => 0,
212 edit_id => '',
213 page_title => 'Upload model',
214 page_sub => 'One upload, every channel. Publish to your storefront and push out to the marketplaces you pick.',
215 submit_label => 'Publish',
216 just_saved => $form->{saved} ? 1 : 0,
217};
218
219# Defaults for every field so the template can reference them
220# uniformly whether we're in create or edit mode.
221my %FIELD_DEFAULTS = (
222 title => '',
223 tagline => '',
224 description => '',
225 category => '',
226 license_type => 'personal',
227 tags => '',
228 price => '',
229 price_mode => 'free',
230 visibility => 'public',
231 schedule_mode => 'now',
232 scheduled_at => '',
233 spec_parts => '',
234 spec_weight => '',
235 spec_time => '',
236 spec_difficulty => '',
237 spec_supports => '',
238 spec_formats => '',
239 ps_layer => '',
240 ps_infill => '',
241 ps_nozzle => '',
242 ps_bed => '',
243 ps_speed => '',
244 ps_walls => '',
245 ps_bed_min => '',
246 ps_resin => '',
247 tested_printers => '',
248 highlights_lines => '',
249 included_lines => '',
250 videos_lines => '',
251 # Physical product fields (kind=physical|both)
252 product_kind => 'digital',
253 physical_price => '',
254 inventory_qty_input => '', # blank = print-to-order (-1)
255 weight_grams => '',
256 dim_length_mm => '',
257 dim_width_mm => '',
258 dim_height_mm => '',
259 production_time_days=> '',
260 ship_from_country => '',
261 ship_from_postal => '',
262 shipping_options => '', # textarea: zone=cents per line
263 color_options => '',
264 material_options => '',
265);
266for my $k (keys %FIELD_DEFAULTS) {
267 $tvars->{$k} = $FIELD_DEFAULTS{$k};
268}
269# Pre-compute "checked" / "selected" stubs -- the template just drops
270# them into attribute positions ($chk_compat_fdm, $sel_cat_miniatures).
271my @COMPAT_FLAGS = qw(fdm resin sla sls mmu large);
272my @MAT_FLAGS = qw(pla petg abs tpu resin_std resin_abs nylon cf);
273my @OPT_FLAGS = qw(pre_supported support_free slicer_profiles assembly_guide);
274$tvars->{"chk_compat_$_"} = '' for @COMPAT_FLAGS;
275$tvars->{"chk_mat_$_"} = '' for @MAT_FLAGS;
276$tvars->{"chk_opt_$_"} = '' for @OPT_FLAGS;
277$tvars->{"sel_vis_$_"} = '' for qw(public unlisted private);
278$tvars->{"sel_vis_public"} = 'checked'; # default
279$tvars->{"sel_sched_$_"} = '' for qw(now scheduled patreon_first);
280$tvars->{"sel_sched_now"} = 'checked'; # default
281$tvars->{price_free_active} = 'is-active';
282$tvars->{price_paid_active} = '';
283$tvars->{price_wrap_style} = 'display:none';
284# Product-kind tabs (digital | physical | both). is-active class swaps
285# per the saved kind; physical_panel_style hides the physical fields
286# block on a pure-digital listing so the form doesn't bloat with
287# unused inputs.
288$tvars->{kind_digital_active} = 'is-active';
289$tvars->{kind_physical_active} = '';
290$tvars->{kind_both_active} = '';
291$tvars->{physical_panel_style} = 'display:none';
292$tvars->{digital_files_required} = 1; # required attribute on file input
293$tvars->{has_existing_images} = 0;
294$tvars->{existing_images} = [];
295$tvars->{has_existing_files} = 0;
296$tvars->{existing_files} = [];
297$tvars->{has_highlights} = 0;
298$tvars->{has_included} = 0;
299$tvars->{has_videos} = 0;
300$tvars->{highlights_arr} = [];
301$tvars->{included_arr} = [];
302$tvars->{videos_arr} = [];
303
304# License options -- same idea.
305my @LICENSES = (
306 [personal => 'Personal use only'],
307 [personal_attrib => 'Personal + attribution required'],
308 [commercial => 'Commercial use allowed'],
309 [cc_by => 'Creative Commons CC-BY'],
310 [cc_by_nc => 'Creative Commons CC-BY-NC'],
311 [cc_by_sa => 'Creative Commons CC-BY-SA'],
312 [cc0 => 'CC0 (Public Domain)'],
313);
314
315sub _build_options {
316 my ($items, $cur) = @_;
317 $cur = '' unless defined $cur;
318 my $html = '';
319 foreach my $row (@$items) {
320 my $sel = ($row->[0] eq $cur) ? ' selected' : '';
321 $html .= qq~<option value="$row->[0]"$sel>$row->[1]</option>~;
322 }
323 return $html;
324}
325
326my @DIFFICULTIES = (
327 [Beginner => 'Beginner'],
328 [Intermediate => 'Intermediate'],
329 [Advanced => 'Advanced'],
330 [Expert => 'Expert'],
331);
332my @SUPPORT_TYPES = (
333 ['Pre-supported' => 'Pre-supported'],
334 ['Manual supports needed' => 'Manual supports needed'],
335 ['Support-free design' => 'Support-free design'],
336);
337
338# Default options HTML (will be replaced in edit mode below).
339$tvars->{category_options_html} = _build_options(\@category_picklist, '');
340$tvars->{license_options_html} = _build_options(\@LICENSES, 'personal');
341$tvars->{difficulty_options_html} = _build_options(\@DIFFICULTIES, '');
342$tvars->{supports_options_html} = _build_options(\@SUPPORT_TYPES, '');
343
344if ($edit_id) {
345 my $dbh = $db->db_connect();
346 my $m = $db->db_readwrite($dbh,
347 qq~SELECT * FROM `${DB}`.models
348 WHERE id='$edit_id' AND user_id='$uid' AND purged_at IS NULL LIMIT 1~,
349 $ENV{SCRIPT_NAME}, __LINE__);
350 if ($m && $m->{id}) {
351 $tvars->{is_edit} = 1;
352 $tvars->{edit_id} = $m->{id};
353 $tvars->{page_title} = 'Edit model';
354 $tvars->{page_sub} = 'Update your listing. Changes save to this model and propagate everywhere it appears.';
355 $tvars->{submit_label} = 'Save changes';
356
357 $tvars->{title} = _ha($m->{title});
358 $tvars->{tagline} = _ha($m->{tagline});
359 $tvars->{description} = _h_text($m->{description});
360 $tvars->{category} = $m->{category} || '';
361 $tvars->{license_type} = $m->{license_type} || 'personal';
362 $tvars->{tested_printers} = _ha($m->{tested_printers});
363 $tvars->{category_options_html} = _build_options(\@category_picklist, $tvars->{category});
364 $tvars->{license_options_html} = _build_options(\@LICENSES, $tvars->{license_type});
365 # specs_json key/value parsing happens further down; the
366 # difficulty/supports dropdowns are rebuilt there.
367
368 my $cents = $m->{base_price_cents} || 0;
369 if ($cents > 0) {
370 $tvars->{price_mode} = 'paid';
371 $tvars->{price} = sprintf('%.2f', $cents / 100);
372 $tvars->{price_free_active} = '';
373 $tvars->{price_paid_active} = 'is-active';
374 $tvars->{price_wrap_style} = 'display:block';
375 }
376
377 my $vis = $m->{visibility} || 'public';
378 $tvars->{"sel_vis_$_"} = '' for qw(public unlisted private);
379 $tvars->{"sel_vis_$vis"} = 'checked';
380
381 if ($m->{scheduled_publish_at}) {
382 $tvars->{"sel_sched_$_"} = '' for qw(now scheduled patreon_first);
383 $tvars->{sel_sched_scheduled} = 'checked';
384 my $when = $m->{scheduled_publish_at};
385 $when =~ s/ /T/;
386 $tvars->{scheduled_at} = $when;
387 }
388
389 # Newline-joined text -> matches what handle_post wrote.
390 $tvars->{highlights_lines} = _h_text($m->{highlights});
391 $tvars->{included_lines} = _h_text($m->{included_items});
392 $tvars->{videos_lines} = _h_text($m->{video_links});
393
394 # Build per-line arrays for [loop:] rendering in the template.
395 my $split_lines = sub {
396 my ($raw) = @_;
397 return [] unless defined $raw && length $raw;
398 my @items;
399 foreach my $line (split /\n/, $raw) {
400 $line =~ s/^\s+//; $line =~ s/\s+$//;
401 push @items, { text => _ha($line) } if length $line;
402 }
403 return \@items;
404 };
405 $tvars->{highlights_arr} = $split_lines->($m->{highlights});
406 $tvars->{included_arr} = $split_lines->($m->{included_items});
407 $tvars->{videos_arr} = $split_lines->($m->{video_links});
408 $tvars->{has_highlights} = scalar(@{$tvars->{highlights_arr}}) ? 1 : 0;
409 $tvars->{has_included} = scalar(@{$tvars->{included_arr}}) ? 1 : 0;
410 $tvars->{has_videos} = scalar(@{$tvars->{videos_arr}}) ? 1 : 0;
411
412 # Parse specs / print_settings key=val lines back into form fields.
413 my %specs = _parse_kv_lines($m->{specs_json});
414 $tvars->{spec_parts} = _ha($specs{parts});
415 $tvars->{spec_weight} = _ha($specs{weight});
416 $tvars->{spec_time} = _ha($specs{time});
417 $tvars->{spec_difficulty} = _ha($specs{difficulty});
418 $tvars->{spec_supports} = _ha($specs{supports});
419 $tvars->{spec_formats} = _ha($specs{formats});
420 # Rebuild difficulty/supports dropdowns with the saved selection.
421 $tvars->{difficulty_options_html} = _build_options(\@DIFFICULTIES, $specs{difficulty} || '');
422 $tvars->{supports_options_html} = _build_options(\@SUPPORT_TYPES, $specs{supports} || '');
423 my %ps = _parse_kv_lines($m->{print_settings_json});
424 $tvars->{ps_layer} = _ha($ps{layer});
425 $tvars->{ps_infill} = _ha($ps{infill});
426 $tvars->{ps_nozzle} = _ha($ps{nozzle});
427 $tvars->{ps_bed} = _ha($ps{bed});
428 $tvars->{ps_speed} = _ha($ps{speed});
429 $tvars->{ps_walls} = _ha($ps{walls});
430 $tvars->{ps_bed_min} = _ha($ps{bed_min});
431 $tvars->{ps_resin} = _ha($ps{resin});
432
433 # Physical product fields. Schema columns are NULL/0 for
434 # digital-only listings so existing rows pre-fill blanks.
435 my $saved_kind = $m->{product_kind} || 'digital';
436 $tvars->{product_kind} = $saved_kind;
437 $tvars->{kind_digital_active} = ($saved_kind eq 'digital') ? 'is-active' : '';
438 $tvars->{kind_physical_active} = ($saved_kind eq 'physical') ? 'is-active' : '';
439 $tvars->{kind_both_active} = ($saved_kind eq 'both') ? 'is-active' : '';
440 $tvars->{physical_panel_style} = ($saved_kind eq 'digital') ? 'display:none' : '';
441 $tvars->{digital_files_required} = ($saved_kind eq 'physical') ? 0 : 1;
442 my $phys_cents = $m->{physical_price_cents} || 0;
443 $tvars->{physical_price} = $phys_cents > 0
444 ? sprintf('%.2f', $phys_cents / 100) : '';
445 # inventory_qty: -1 = print-to-order. Surface that as blank
446 # in the form (sentinel "unlimited") so the seller doesn't
447 # see a confusing negative number; >=0 stays literal.
448 my $inv = defined $m->{inventory_qty} ? $m->{inventory_qty} : -1;
449 $tvars->{inventory_qty_input} = ($inv < 0) ? '' : $inv;
450 $tvars->{weight_grams} = $m->{weight_grams} || '';
451 $tvars->{dim_length_mm} = $m->{dim_length_mm} || '';
452 $tvars->{dim_width_mm} = $m->{dim_width_mm} || '';
453 $tvars->{dim_height_mm} = $m->{dim_height_mm} || '';
454 $tvars->{production_time_days} = $m->{production_time_days} || '';
455 $tvars->{ship_from_country} = _ha($m->{ship_from_country} || '');
456 $tvars->{ship_from_postal} = _ha($m->{ship_from_postal_code} || '');
457 $tvars->{shipping_options} = _h_text($m->{shipping_options_json} || '');
458 $tvars->{color_options} = _ha($m->{color_options} || '');
459 $tvars->{material_options} = _ha($m->{material_options} || '');
460
461 # Compat / materials / file options -- comma-separated slugs.
462 my %compat = map { $_ => 1 } split /,/, ($m->{printer_compat} || '');
463 my %mats = map { $_ => 1 } split /,/, ($m->{materials} || '');
464 my %opts = map { $_ => 1 } split /,/, ($m->{file_options} || '');
465 for my $k (@COMPAT_FLAGS) { $tvars->{"chk_compat_$k"} = $compat{"compat_$k"} ? 'checked' : ''; }
466 for my $k (@MAT_FLAGS) { $tvars->{"chk_mat_$k"} = $mats{"mat_$k"} ? 'checked' : ''; }
467 for my $k (@OPT_FLAGS) { $tvars->{"chk_opt_$k"} = $opts{"opt_$k"} ? 'checked' : ''; }
468
469 # Tags (joined back to comma list for the input).
470 my @tag_rows = $db->db_readwrite_multiple($dbh,
471 qq~SELECT tag FROM `${DB}`.model_tags WHERE model_id='$edit_id' ORDER BY tag~,
472 $ENV{SCRIPT_NAME}, __LINE__);
473 $tvars->{tags} = _ha(join(', ', map { $_->{tag} } @tag_rows));
474
475 # Existing gallery images (model_images) -- shown with X to remove.
476 my @img_rows = $db->db_readwrite_multiple($dbh,
477 qq~SELECT id, image_type, storage_key, sort_order, is_primary
478 FROM `${DB}`.model_images
479 WHERE model_id='$edit_id'
480 ORDER BY is_primary DESC, sort_order ASC, id ASC~,
481 $ENV{SCRIPT_NAME}, __LINE__);
482 my @existing_imgs;
483 foreach my $r (@img_rows) {
484 push @existing_imgs, {
485 id => $r->{id},
486 url => "/img.cgi?m=" . $r->{id},
487 is_primary => $r->{is_primary} ? 1 : 0,
488 };
489 }
490 $tvars->{existing_images} = \@existing_imgs;
491 $tvars->{has_existing_images} = scalar(@existing_imgs) ? 1 : 0;
492
493 # Existing 3D files.
494 my @file_rows = $db->db_readwrite_multiple($dbh,
495 qq~SELECT id, filename, file_type, file_size_bytes
496 FROM `${DB}`.model_files
497 WHERE model_id='$edit_id'
498 ORDER BY id ASC~,
499 $ENV{SCRIPT_NAME}, __LINE__);
500 my @existing_files;
501 foreach my $r (@file_rows) {
502 push @existing_files, {
503 id => $r->{id},
504 name => _ha($r->{filename}),
505 ext => uc($r->{file_type} || ''),
506 size_kb => sprintf('%.1f', ($r->{file_size_bytes} || 0) / 1024),
507 };
508 }
509 $tvars->{existing_files} = \@existing_files;
510 $tvars->{has_existing_files} = scalar(@existing_files) ? 1 : 0;
511 } else {
512 # Owner mismatch or missing -- bounce to fresh upload.
513 $db->db_disconnect($dbh);
514 print "Status: 302 Found\nLocation: /upload_model.cgi\n\n";
515 exit;
516 }
517 $db->db_disconnect($dbh);
518}
519
520print "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";
521
522my $body = join('', $tfile->template('webstls_upload_model.html', $tvars, $userinfo));
523
524$wrap->render({
525 userinfo => $userinfo,
526 page_key => 'upload',
527 title => ($edit_id ? 'Edit model' : 'Upload Model'),
528 body => $body,
529});
530exit;
531
532
533# Helpers for tvar building. _ha escapes for HTML attribute context;
534# _h_text escapes for HTML text content. Both safe for textareas.
535sub _ha {
536 my ($s) = @_;
537 $s = '' unless defined $s;
538 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
539 $s =~ s/"/&quot;/g; $s =~ s/'/&#39;/g;
540 return $s;
541}
542sub _h_text {
543 my ($s) = @_;
544 $s = '' unless defined $s;
545 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
546 return $s;
547}
548sub _parse_kv_lines {
549 my ($raw) = @_;
550 my %out;
551 return %out unless defined $raw && length $raw;
552 foreach my $line (split /\n/, $raw) {
553 next unless $line =~ /^([^=]+)=(.*)$/;
554 my ($k, $v) = ($1, $2);
555 $k =~ s/^\s+//; $k =~ s/\s+$//;
556 $v =~ s/^\s+//; $v =~ s/\s+$//;
557 $out{$k} = $v;
558 }
559 return %out;
560}
561
562
563#======================================================================
564# Handlers
565#======================================================================
566sub handle_post {
567 # CGI->Vars joins multi-value form fields with \0. If a stray
568 # hidden _action ever sneaks back into the template alongside the
569 # draft/publish buttons, the value would be e.g. "publish\0draft"
570 # and a naive eq comparison would silently choose the wrong branch.
571 # Trim to the LAST value -- whichever submit button was clicked
572 # wins, since CGI appends button values after hidden inputs.
573 my $action = $form->{_action} || 'publish';
574 $action =~ s/.*\0//;
575 $action = lc($action); $action =~ s/[^a-z]//g;
576 my $is_draft = ($action eq 'draft') ? 1 : 0;
577
578 my $dbh = $db->db_connect();
579 unless ($dbh) { fail_redirect('database error'); }
580
581 # ---- Find or require the user's storefront ----
582 my $store = $db->db_readwrite($dbh,
583 qq~SELECT id FROM `${DB}`.storefronts WHERE user_id='$uid' ORDER BY id LIMIT 1~,
584 $ENV{SCRIPT_NAME}, __LINE__);
585 unless ($store && $store->{id}) {
586 $db->db_disconnect($dbh);
587 fail_redirect('no storefront found');
588 }
589 my $sid = $store->{id};
590
591 # ---- Validate + normalize fields ----
592 my $title = substr(trim($form->{title} || ''), 0, 200);
593 my $desc = $form->{description} || '';
594 if (!$is_draft && (!$title || !$desc)) {
595 $db->db_disconnect($dbh);
596 fail_redirect('title and description required');
597 }
598 $title ||= 'Untitled model';
599
600 my $tagline = substr(trim($form->{tagline} || ''), 0, 160);
601 my $category = substr(trim($form->{category} || ''), 0, 80);
602 my $license = substr(trim($form->{license_type} || 'personal'), 0, 80);
603
604 my $vis = lc($form->{visibility} || 'public');
605 $vis = 'public' unless $vis =~ /^(public|unlisted|private)$/;
606
607 my $price_mode = lc($form->{price_mode} || 'free');
608 my $price_cents = 0;
609 if ($price_mode eq 'paid') {
610 my $p = $form->{price} || 0;
611 $p =~ s/[^0-9\.]//g;
612 $price_cents = int(($p || 0) * 100);
613 }
614
615 my $slug = make_slug($title) || ('model-' . time());
616
617 # Status: draft / published / unlisted (private maps to unlisted with no public URL)
618 my $status;
619 if ($is_draft) {
620 $status = 'draft';
621 } elsif ($vis eq 'private') {
622 $status = 'unlisted';
623 } elsif ($vis eq 'unlisted') {
624 $status = 'unlisted';
625 } else {
626 $status = 'published';
627 }
628
629 # Schedule -- if scheduled, force status='draft' until the worker promotes it.
630 my $sched_mode = lc($form->{schedule_mode} || 'now');
631 my $sched_at_sql = 'NULL';
632 if ($sched_mode eq 'scheduled') {
633 my $when = $form->{scheduled_at} || '';
634 $when =~ s/T/ /; # HTML5 datetime-local => MySQL DATETIME
635 $when =~ s/[^0-9 :-]//g;
636 if ($when && length($when) >= 16) {
637 $sched_at_sql = "'$when'";
638 $status = 'draft'; # held until worker fires
639 }
640 } elsif ($sched_mode eq 'patreon_first') {
641 # Treat like 'now' here -- worker handles the 24h delay for other platforms.
642 $status = 'published' unless $is_draft;
643 }
644
645 # ---- JSON-like text columns (newline-joined for MariaDB 5.5 friendliness) ----
646 my $highlights = join_json_array($form->{highlights_json});
647 my $included = join_json_array($form->{included_json});
648 my $videos = join_json_array($form->{videos_json});
649
650 # Specs + print settings: store as key=val\n lines (simpler than JSON parse)
651 my $specs = lines_kv({
652 parts => $form->{spec_parts},
653 weight => $form->{spec_weight},
654 time => $form->{spec_time},
655 difficulty => $form->{spec_difficulty},
656 supports => $form->{spec_supports},
657 formats => $form->{spec_formats},
658 });
659 my $print_settings = lines_kv({
660 layer => $form->{ps_layer},
661 infill => $form->{ps_infill},
662 nozzle => $form->{ps_nozzle},
663 bed => $form->{ps_bed},
664 speed => $form->{ps_speed},
665 walls => $form->{ps_walls},
666 bed_min => $form->{ps_bed_min},
667 resin => $form->{ps_resin},
668 });
669
670 # Compat + materials: comma-joined slugs
671 my $compat = join_checked($form, qw(compat_fdm compat_resin compat_sla compat_sls compat_mmu compat_large));
672 my $mats = join_checked($form, qw(mat_pla mat_petg mat_abs mat_tpu mat_resin_std mat_resin_abs mat_nylon mat_cf));
673 my $opts = join_checked($form, qw(opt_pre_supported opt_support_free opt_slicer_profiles opt_assembly_guide));
674
675 my $tested_printers = substr(trim($form->{tested_printers} || ''), 0, 240);
676
677 # ---- Physical product fields ----
678 # product_kind: digital (file download only) / physical (print-and-
679 # ship only) / both (file + printed version with independent prices).
680 my $kind = lc($form->{product_kind} || 'digital');
681 $kind = 'digital' unless $kind =~ /^(digital|physical|both)$/;
682
683 my $phys_cents = 0;
684 if ($kind ne 'digital') {
685 my $p = $form->{physical_price} || 0;
686 $p =~ s/[^0-9\.]//g;
687 $phys_cents = int(($p || 0) * 100);
688 }
689
690 # inventory_qty: blank input => -1 (print-to-order). Numeric input
691 # is stored verbatim. Schema column is signed INT so -1 is valid.
692 my $inv_raw = defined($form->{inventory_qty_input})
693 ? trim($form->{inventory_qty_input}) : '';
694 my $inv_qty = -1;
695 if (length $inv_raw && $inv_raw =~ /^\d+$/) {
696 $inv_qty = int($inv_raw);
697 $inv_qty = 0 if $inv_qty < 0;
698 }
699
700 # Numeric physical fields: empty string => NULL in SQL so the
701 # column-NULL "unspecified" state is distinguishable from "0".
702 my $weight = trim($form->{weight_grams} || '');
703 my $dimL = trim($form->{dim_length_mm} || '');
704 my $dimW = trim($form->{dim_width_mm} || '');
705 my $dimH = trim($form->{dim_height_mm} || '');
706 my $prod = trim($form->{production_time_days}|| '');
707 for my $r (\$weight, \$dimL, \$dimW, \$dimH, \$prod) {
708 ${$r} =~ s/[^0-9]//g;
709 }
710 my $sql_int = sub {
711 my $v = shift;
712 return (length $v && $v =~ /^\d+$/) ? "'$v'" : 'NULL';
713 };
714
715 my $ship_country = uc(trim($form->{ship_from_country} || ''));
716 $ship_country =~ s/[^A-Z]//g;
717 $ship_country = substr($ship_country, 0, 2);
718 my $ship_postal = substr(trim($form->{ship_from_postal} || ''), 0, 20);
719
720 # shipping_options_json: textarea with zone=cents per line. Keep
721 # only valid `slug=integer` lines so a typo in one row doesn't
722 # corrupt the whole field.
723 my $ship_opts = '';
724 {
725 my $raw = $form->{shipping_options} || '';
726 my @clean;
727 foreach my $line (split /\r?\n/, $raw) {
728 $line =~ s/^\s+//; $line =~ s/\s+$//;
729 next unless $line =~ /^([A-Za-z0-9_\-]{1,40})\s*=\s*(\d+)$/;
730 push @clean, "$1=$2";
731 }
732 $ship_opts = join("\n", @clean);
733 }
734
735 my $colors = substr(trim($form->{color_options} || ''), 0, 255);
736 my $materials_phys = substr(trim($form->{material_options} || ''), 0, 255);
737
738 # ---- Edit-mode detection -----------------------------------
739 # When ?model_id=N (or hidden model_id) is set, this is an EDIT
740 # not a fresh upload. Verify ownership before letting any UPDATE
741 # touch the row.
742 my $edit_id = $form->{model_id} || 0;
743 $edit_id =~ s/[^0-9]//g;
744 my $model_id = 0;
745 if ($edit_id) {
746 my $owner = $db->db_readwrite($dbh,
747 qq~SELECT user_id, purged_at FROM `${DB}`.models WHERE id='$edit_id' LIMIT 1~,
748 $ENV{SCRIPT_NAME}, __LINE__);
749 unless ($owner && $owner->{user_id} && $owner->{user_id} eq $uid) {
750 $db->db_disconnect($dbh);
751 fail_redirect('model not yours');
752 }
753 if ($owner->{purged_at}) {
754 $db->db_disconnect($dbh);
755 fail_redirect('model has been permanently deleted');
756 }
757 $model_id = $edit_id;
758 }
759
760 # ---- Escape everything ----
761 my @to_escape = (\$title, \$slug, \$desc, \$tagline, \$category, \$license, \$vis,
762 \$highlights, \$included, \$videos, \$specs, \$print_settings,
763 \$compat, \$mats, \$opts, \$tested_printers, \$status,
764 \$kind, \$ship_country, \$ship_postal, \$ship_opts,
765 \$colors, \$materials_phys);
766 for my $r (@to_escape) { ${$r} =~ s/[\\']/\\$&/g; }
767
768 # NULL-or-quoted helpers for the physical-product columns. Required
769 # because empty numeric fields must reach the DB as NULL, not '0'.
770 my $weight_sql = $sql_int->($weight);
771 my $dimL_sql = $sql_int->($dimL);
772 my $dimW_sql = $sql_int->($dimW);
773 my $dimH_sql = $sql_int->($dimH);
774 my $prod_sql = $sql_int->($prod);
775 my $country_sql = length $ship_country == 2 ? "'$ship_country'" : 'NULL';
776 my $postal_sql = length $ship_postal ? "'$ship_postal'" : 'NULL';
777
778 if ($model_id) {
779 # ---- UPDATE existing model row ----
780 # slug stays unchanged on edits -- changing it would break any
781 # external links pointing at the old slug. created_at is also
782 # preserved.
783 $db->db_readwrite($dbh, qq~
784 UPDATE `${DB}`.models SET
785 title = '$title',
786 description = '$desc',
787 tagline = '$tagline',
788 base_price_cents = '$price_cents',
789 category = '$category',
790 license_type = '$license',
791 status = '$status',
792 visibility = '$vis',
793 highlights = '$highlights',
794 included_items = '$included',
795 video_links = '$videos',
796 specs_json = '$specs',
797 print_settings_json = '$print_settings',
798 printer_compat = '$compat',
799 materials = '$mats',
800 file_options = '$opts',
801 tested_printers = '$tested_printers',
802 product_kind = '$kind',
803 physical_price_cents = '$phys_cents',
804 inventory_qty = '$inv_qty',
805 weight_grams = $weight_sql,
806 dim_length_mm = $dimL_sql,
807 dim_width_mm = $dimW_sql,
808 dim_height_mm = $dimH_sql,
809 production_time_days = $prod_sql,
810 ship_from_country = $country_sql,
811 ship_from_postal_code= $postal_sql,
812 shipping_options_json= '$ship_opts',
813 color_options = '$colors',
814 material_options = '$materials_phys',
815 scheduled_publish_at = $sched_at_sql,
816 updated_at = NOW()
817 WHERE id = '$model_id' AND user_id = '$uid' LIMIT 1
818 ~, $ENV{SCRIPT_NAME}, __LINE__);
819
820 # Tag replacement: drop existing tags, insert the new set.
821 # That way removing a tag in the form actually removes it.
822 $db->db_readwrite($dbh,
823 qq~DELETE FROM `${DB}`.model_tags WHERE model_id='$model_id'~,
824 $ENV{SCRIPT_NAME}, __LINE__);
825 } else {
826 # ---- INSERT a fresh model row ----
827 $db->db_readwrite($dbh, qq~
828 INSERT INTO `${DB}`.models SET
829 user_id = '$uid',
830 title = '$title',
831 slug = '$slug',
832 description = '$desc',
833 tagline = '$tagline',
834 base_price_cents = '$price_cents',
835 currency = 'USD',
836 category = '$category',
837 license_type = '$license',
838 status = '$status',
839 visibility = '$vis',
840 highlights = '$highlights',
841 included_items = '$included',
842 video_links = '$videos',
843 specs_json = '$specs',
844 print_settings_json = '$print_settings',
845 printer_compat = '$compat',
846 materials = '$mats',
847 file_options = '$opts',
848 tested_printers = '$tested_printers',
849 product_kind = '$kind',
850 physical_price_cents = '$phys_cents',
851 inventory_qty = '$inv_qty',
852 weight_grams = $weight_sql,
853 dim_length_mm = $dimL_sql,
854 dim_width_mm = $dimW_sql,
855 dim_height_mm = $dimH_sql,
856 production_time_days = $prod_sql,
857 ship_from_country = $country_sql,
858 ship_from_postal_code= $postal_sql,
859 shipping_options_json= '$ship_opts',
860 color_options = '$colors',
861 material_options = '$materials_phys',
862 scheduled_publish_at = $sched_at_sql,
863 created_at = NOW(),
864 updated_at = NOW()
865 ~, $ENV{SCRIPT_NAME}, __LINE__);
866
867 my $row = $db->db_readwrite($dbh,
868 qq~SELECT id FROM `${DB}`.models WHERE user_id='$uid' AND slug='$slug' ORDER BY id DESC LIMIT 1~,
869 $ENV{SCRIPT_NAME}, __LINE__);
870 $model_id = $row && $row->{id} ? $row->{id} : 0;
871 unless ($model_id) {
872 $db->db_disconnect($dbh);
873 fail_redirect('insert failed');
874 }
875 }
876
877 # ---- Seller-defined categories ----
878 # `seller_cat_ids` arrives as a multi-value form field (CGI->Vars
879 # joins with \0). Whatever the seller checked replaces the prior
880 # set; unchecked means "no longer in this category".
881 if ($catmod->schema_ready($db, $dbh, $DB)) {
882 my $raw = $form->{seller_cat_ids};
883 my @ids;
884 if (ref $raw eq 'ARRAY') { @ids = @$raw; }
885 else { @ids = grep { length } split /\0/, ($raw // ''); }
886 $catmod->assign($db, $dbh, $DB, $model_id, \@ids, $uid);
887 }
888
889 # ---- Tags (re-insert for both create and edit) ----
890 my $raw_tags = $form->{tags} || '';
891 foreach my $tag (split /,/, $raw_tags) {
892 $tag = trim($tag);
893 $tag =~ s/'/\\'/g;
894 next if !$tag || length($tag) > 64;
895 $db->db_readwrite($dbh,
896 qq~INSERT IGNORE INTO `${DB}`.model_tags SET model_id='$model_id', tag='$tag'~,
897 $ENV{SCRIPT_NAME}, __LINE__);
898 }
899
900 # ---- Auto-list on the creator's storefront (idempotent) ----
901 # On creation, push the model to the top of the storefront so it
902 # becomes the spotlight feature. On edit, only ensure a listing
903 # row exists when the model just went published; do not re-promote
904 # an already-listed model -- that would clobber the user's manual
905 # sort_order.
906 if (!$is_draft && $status eq 'published') {
907 my $top_sort = 0;
908 my $r = $db->db_readwrite($dbh,
909 qq~SELECT COALESCE(MIN(sort_order), 0) - 1 AS new_top
910 FROM `${DB}`.storefront_listings
911 WHERE storefront_id='$sid'~,
912 $ENV{SCRIPT_NAME}, __LINE__);
913 $top_sort = $r->{new_top} if $r && defined $r->{new_top};
914 $db->db_readwrite($dbh, qq~
915 INSERT IGNORE INTO `${DB}`.storefront_listings SET
916 storefront_id = '$sid',
917 model_id = '$model_id',
918 visible = 1,
919 override_price_cents = NULL,
920 sort_order = '$top_sort',
921 added_at = NOW()
922 ~, $ENV{SCRIPT_NAME}, __LINE__);
923 }
924
925 # ---- Save uploaded model files ----
926 save_uploaded_files($dbh, $sid, $model_id, 'model_files', 'model_files', qr/\.(stl|obj|step|stp|3mf|zip|rar)$/i);
927 save_uploaded_files($dbh, $sid, $model_id, 'model_images', 'model_images', qr/\.(jpg|jpeg|png|gif|webp)$/i);
928
929 # ---- Queue marketplace pushes ----
930 # DBConnect's error() helper calls exit() on any SQL failure (eval
931 # can't catch exit), so we have to verify the table exists before
932 # inserting. Until the 5.6 migration is run on a given server,
933 # marketplace_pushes won't exist and we silently skip the queue --
934 # the model itself still publishes fine.
935 my $have_pushes_table = 0;
936 {
937 # information_schema instead of SHOW TABLES LIKE: the latter
938 # plus DBConnect autoviv produces a truthy hashref even when
939 # the table is absent, which would let an INSERT fall through
940 # to a "Table doesn't exist" 500.
941 my $row = $db->db_readwrite($dbh, qq~
942 SELECT COUNT(*) AS n FROM information_schema.tables
943 WHERE table_schema='$DB' AND table_name='marketplace_pushes'
944 ~, $ENV{SCRIPT_NAME}, __LINE__);
945 $have_pushes_table = 1 if $row && $row->{n};
946 }
947
948 my @selected;
949 if (ref $form->{'publish_to'} eq 'ARRAY') {
950 @selected = @{ $form->{'publish_to'} };
951 } else {
952 # CGI->Vars joins multi-values with "\0" — split here just in case.
953 my $raw = $form->{'publish_to'} || '';
954 @selected = grep { length } split /\0/, $raw;
955 }
956 if ($is_demo && scalar(@selected) > $demo_max) {
957 @selected = @selected[0 .. $demo_max - 1];
958 }
959 # Only queue marketplace pushes on first upload -- editing an
960 # existing model shouldn't re-queue identical push jobs. The
961 # adapter/worker will pull updated fields from the model row at
962 # send time. Physical-only listings have no STL files to push,
963 # so skip them entirely; 'both' listings still push the digital
964 # half (the printed copy is a webstls.com-only offering).
965 if ($have_pushes_table && !$edit_id && $kind ne 'physical') {
966 foreach my $slug (@selected) {
967 $slug = lc($slug); $slug =~ s/[^a-z0-9]//g;
968 next unless $slug;
969 my $platform_exists = $mp->by_slug($slug);
970 next unless $platform_exists;
971 $db->db_readwrite($dbh, qq~
972 INSERT INTO `${DB}`.marketplace_pushes SET
973 user_id = '$uid',
974 model_id = '$model_id',
975 platform = '$slug',
976 status = 'queued',
977 created_at = NOW()
978 ~, $ENV{SCRIPT_NAME}, __LINE__);
979 }
980 }
981
982 $db->db_disconnect($dbh);
983
984 # ---- Redirect ----
985 # On EDIT, return to the edit page so the user sees their changes
986 # reflected and can continue tweaking. On CREATE, go to the Models
987 # list so they see the new card alongside any existing ones.
988 if ($edit_id) {
989 print "Status: 302 Found\nLocation: /upload_model.cgi?model_id=$model_id&saved=1\n\n";
990 } else {
991 my $kind = $is_draft ? 'draft_saved' : 'published';
992 print "Status: 302 Found\nLocation: /models.cgi?$kind=$model_id\n\n";
993 }
994 return;
995}
996
997#======================================================================
998# Helpers
999#======================================================================
1000sub trim {
1001 my ($s) = @_;
1002 return '' unless defined $s;
1003 $s =~ s/^\s+//; $s =~ s/\s+$//;
1004 return $s;
1005}
1006
1007sub make_slug {
1008 my ($s) = @_;
1009 return '' unless defined $s;
1010 $s = lc($s);
1011 $s =~ s/[^a-z0-9]+/-/g;
1012 $s =~ s/^-+|-+$//g;
1013 return substr($s, 0, 120);
1014}
1015
1016# Pull a JSON-array hidden field and convert to newline-joined string.
1017sub join_json_array {
1018 my ($raw) = @_;
1019 return '' unless defined $raw && length $raw;
1020 # very small JSON parser -- handles `["a","b"]` only.
1021 return '' unless $raw =~ /^\s*\[(.*)\]\s*$/s;
1022 my $inner = $1;
1023 my @items;
1024 while ($inner =~ /"((?:\\.|[^"\\])*)"/g) {
1025 my $v = $1;
1026 $v =~ s/\\"/"/g;
1027 $v =~ s/\\\\/\\/g;
1028 push @items, $v if length $v;
1029 }
1030 return join("\n", @items);
1031}
1032
1033sub lines_kv {
1034 my ($h) = @_;
1035 my @out;
1036 foreach my $k (sort keys %$h) {
1037 my $v = $h->{$k};
1038 next unless defined $v && length $v;
1039 $v =~ s/[\r\n]/ /g;
1040 push @out, "$k=$v";
1041 }
1042 return join("\n", @out);
1043}
1044
1045sub join_checked {
1046 my ($form, @keys) = @_;
1047 my @on;
1048 foreach my $k (@keys) {
1049 push @on, $k if $form->{$k};
1050 }
1051 return join(',', @on);
1052}
1053
1054sub save_uploaded_files {
1055 my ($dbh, $sid, $model_id, $field, $table, $ext_re) = @_;
1056
1057 # CGI.pm keys uploads by the LITERAL form-field name. If the
1058 # template ever sends `name="model_images[]"` (PHP-style) the
1059 # files land under the key "model_images[]", not "model_images".
1060 # Try both so the upload pipeline never silently drops files.
1061 my @uploads = $q->upload($field);
1062 @uploads = $q->upload($field . '[]') unless @uploads;
1063 return unless @uploads;
1064
1065 # Paid model files live OUTSIDE httpdocs at config->private_files_dir.
1066 # Images keep going to httpdocs/uploads -- they're served via img.cgi
1067 # but it's OK for them to be cacheable on the public side too.
1068 my $private_root = $config->settings('private_files_dir')
1069 || '/var/www/vhosts/webstls.com/private/files';
1070 my $public_root = '/var/www/vhosts/webstls.com/httpdocs/uploads';
1071 my $base_dir = ($table eq 'model_files') ? $private_root : $public_root;
1072 my $models_dir = "$base_dir/models";
1073 my $store_dir = "$models_dir/$sid";
1074 my $dest_dir = "$store_dir/$model_id";
1075 foreach my $d ($base_dir, $models_dir, $store_dir, $dest_dir) {
1076 unless (-d $d) { mkdir $d, 0750 or return; }
1077 }
1078
1079 my $storage = MODS::WebSTLs::Storage->new;
1080 my $compress = MODS::WebSTLs::Compress->new;
1081
1082 my $order = 0;
1083 foreach my $u (@uploads) {
1084 next unless $u;
1085 my $orig = "$u";
1086 my $tmp = $q->tmpFileName($u);
1087 next unless $tmp && -f $tmp;
1088 my $size = -s $tmp;
1089 next unless $size && $size > 0;
1090 $orig =~ s/.*[\\\/]//; # strip path components
1091 $orig =~ s/[^A-Za-z0-9._-]/_/g; # safe filename
1092 next unless $orig =~ $ext_re;
1093 my $ext = lc($1);
1094
1095 # Storage cap + extension gate (model_files only -- images go
1096 # through their own path that doesn't count against per-user
1097 # storage caps for now).
1098 if ($table eq 'model_files') {
1099 my ($cap_ok, $cap_err) = $storage->check_upload_allowed(
1100 $db, $dbh, $DB, $sid, $size, $ext);
1101 unless ($cap_ok) {
1102 warn "[upload_model] sid=$sid skipped $orig: $cap_err\n";
1103 next;
1104 }
1105 }
1106
1107 my $id = random_id(16);
1108 my $base_dest_name = "$id.$ext";
1109 my $base_dest_path = "$dest_dir/$base_dest_name";
1110
1111 my $is_compressed = 0;
1112 my $algo_used = 'none';
1113 my $on_disk_size = $size;
1114 my $dest_name = $base_dest_name;
1115 my $dest_path = $base_dest_path;
1116
1117 # Try on-store compression for model files. Skip for images +
1118 # already-packed formats (3MF/GLB/etc -- Compress detects via
1119 # extension + magic bytes).
1120 if ($table eq 'model_files'
1121 && !MODS::WebSTLs::Compress::is_already_compressed($orig)) {
1122 my $algo_pref = $compress->resolved_algo;
1123 if ($algo_pref ne 'none') {
1124 my $algo_ext = ($algo_pref eq 'zstd') ? '.zst' : '.gz';
1125 my $try_path = $base_dest_path . $algo_ext;
1126 my ($cok, $algo_actual, $wrote, $cerr) =
1127 $compress->compress_file($tmp, $try_path);
1128 if ($cok && $algo_actual ne 'none' && $wrote && $wrote < $size) {
1129 $is_compressed = 1;
1130 $algo_used = $algo_actual;
1131 $on_disk_size = $wrote;
1132 $dest_name = $base_dest_name . $algo_ext;
1133 $dest_path = $try_path;
1134 } else {
1135 unlink $try_path if -e $try_path;
1136 }
1137 }
1138 }
1139
1140 # Raw copy when compression skipped or didn't shrink the file.
1141 unless ($is_compressed) {
1142 open(my $in, '<', $tmp) or next;
1143 open(my $out, '>', $dest_path) or do { close $in; next; };
1144 binmode $in; binmode $out;
1145 while (read($in, my $buf, 65536)) { print $out $buf; }
1146 close $in; close $out;
1147 $on_disk_size = -s $dest_path;
1148 }
1149
1150 # storage_key is RELATIVE to the storage root for this table.
1151 # model_files -> relative to private_files_dir; model_images ->
1152 # relative to httpdocs/uploads. Keeping the "uploads/" prefix on
1153 # image keys preserves backwards compatibility with existing img.cgi
1154 # path resolution.
1155 my $rel_key = ($table eq 'model_files')
1156 ? "models/$sid/$model_id/$dest_name"
1157 : "uploads/models/$sid/$model_id/$dest_name";
1158
1159 if ($table eq 'model_files') {
1160 my $safe_orig = $orig; $safe_orig =~ s/[\\']/\\$&/g;
1161 my $checksum = '0' x 64; # real checksum is a worker job
1162 $db->db_readwrite($dbh, qq~
1163 INSERT INTO `${DB}`.model_files SET
1164 model_id = '$model_id',
1165 filename = '$safe_orig',
1166 file_type = '$ext',
1167 file_size_bytes = '$on_disk_size',
1168 original_size_bytes = '$size',
1169 is_compressed = '$is_compressed',
1170 compression_algo = '$algo_used',
1171 storage_provider = 'local',
1172 storage_key = '$rel_key',
1173 checksum_sha256 = '$checksum',
1174 scan_status = 'pending',
1175 uploaded_at = NOW()
1176 ~, $ENV{SCRIPT_NAME}, __LINE__);
1177 # Bump per-user storage usage by the ORIGINAL (pre-compress)
1178 # size so caps math = what the user uploaded, not what we
1179 # store. Compression is OUR cost-saving, not theirs.
1180 $storage->bump_usage($db, $dbh, $DB, $sid, $size);
1181 } else {
1182 my $is_primary = ($order == 0) ? 1 : 0;
1183 my $type = ($order == 0) ? 'hero' : 'gallery';
1184 $db->db_readwrite($dbh, qq~
1185 INSERT INTO `${DB}`.model_images SET
1186 model_id = '$model_id',
1187 image_type = '$type',
1188 storage_key = '$rel_key',
1189 sort_order = '$order',
1190 is_primary = '$is_primary',
1191 created_at = NOW()
1192 ~, $ENV{SCRIPT_NAME}, __LINE__);
1193
1194 # First gallery image becomes the model's hero so the
1195 # storefront + models page render it instead of falling
1196 # back to the stock placeholder. The image is served via
1197 # /img.cgi?m=<model_images.id>.
1198 if ($order == 0) {
1199 my $r = $db->db_readwrite($dbh, qq~
1200 SELECT id FROM `${DB}`.model_images
1201 WHERE model_id='$model_id' AND storage_key='$rel_key'
1202 ORDER BY id DESC LIMIT 1
1203 ~, $ENV{SCRIPT_NAME}, __LINE__);
1204 if ($r && $r->{id}) {
1205 my $url = "/img.cgi?m=" . $r->{id};
1206 $db->db_readwrite($dbh, qq~
1207 UPDATE `${DB}`.models
1208 SET hero_image_url = '$url'
1209 WHERE id = '$model_id' LIMIT 1
1210 ~, $ENV{SCRIPT_NAME}, __LINE__);
1211 }
1212 }
1213 }
1214 $order++;
1215 }
1216}
1217
1218sub random_id {
1219 my ($len) = @_;
1220 my @hex = ('0'..'9', 'a'..'f');
1221 my $id = '';
1222 $id .= $hex[int(rand(@hex))] for 1..$len;
1223 return $id;
1224}
1225
1226sub fail_redirect {
1227 my ($msg) = @_;
1228 $msg ||= 'unknown error';
1229 $msg =~ s/[^A-Za-z0-9 _.-]/ /g;
1230 $msg =~ s/ /+/g;
1231 print "Status: 302 Found\nLocation: /upload_model.cgi?error=$msg\n\n";
1232 exit;
1233}
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help