added on WebSTLs (webstls.com) at 2026-07-01 22:26:46
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs - Global search | |
| 4 | # | |
| 5 | # Single-input search across the user's models, orders, and a few | |
| 6 | # settings sections. Triggered from the topbar search box. | |
| 7 | # | |
| 8 | # Cheap LIKE query against three tables, scoped to the seller's own | |
| 9 | # data. Real full-text search is queued for when we graduate to | |
| 10 | # Meilisearch / Typesense (see specs). | |
| 11 | #====================================================================== | |
| 12 | use strict; | |
| 13 | use warnings; | |
| 14 | ||
| 15 | use lib '/var/www/vhosts/webstls.com/httpdocs'; | |
| 16 | use CGI; | |
| 17 | use MODS::Template; | |
| 18 | use MODS::DBConnect; | |
| 19 | use MODS::Login; | |
| 20 | use MODS::WebSTLs::Config; | |
| 21 | use MODS::WebSTLs::Wrapper; | |
| 22 | ||
| 23 | my $q = CGI->new; | |
| 24 | my $form = $q->Vars; | |
| 25 | my $auth = MODS::Login->new; | |
| 26 | my $wrap = MODS::WebSTLs::Wrapper->new; | |
| 27 | my $tfile = MODS::Template->new; | |
| 28 | my $db = MODS::DBConnect->new; | |
| 29 | my $cfg = MODS::WebSTLs::Config->new; | |
| 30 | my $DB = $cfg->settings('database_name'); | |
| 31 | ||
| 32 | $|=1; | |
| 33 | my $userinfo = $auth->login_verify(); | |
| 34 | if (!$userinfo) { | |
| 35 | print "Status: 302 Found\nLocation: /login.cgi\n\n"; | |
| 36 | exit; | |
| 37 | } | |
| 38 | my $uid = $userinfo->{user_id}; | |
| 39 | $uid =~ s/[^0-9]//g; | |
| 40 | ||
| 41 | my $raw_q = defined $form->{q} ? $form->{q} : ''; | |
| 42 | my $clean = $raw_q; | |
| 43 | $clean =~ s/[^A-Za-z0-9._@\s\-]//g; | |
| 44 | $clean =~ s/^\s+|\s+$//g; | |
| 45 | ||
| 46 | # Tokenize on whitespace, dashes, and underscores so "cop-tur" still | |
| 47 | # matches a model titled "Cop-Tur", "Cop Tur", "cop_tur", etc. | |
| 48 | my @terms = grep { length($_) > 0 } split(/[\s\-_]+/, $clean); | |
| 49 | ||
| 50 | # Punctuation-stripped form of the whole query. Used to match a model | |
| 51 | # titled "Cop-Tur" when the user typed "coptur" (or vice versa). Empty | |
| 52 | # when the query is empty after stripping. | |
| 53 | my $compact = lc $clean; | |
| 54 | $compact =~ s/[^a-z0-9]//g; | |
| 55 | ||
| 56 | # Per-column expression that strips dashes/underscores/spaces and | |
| 57 | # lowercases on the database side. Wrapped in a sub so we don't repeat | |
| 58 | # the REPLACE chain everywhere. | |
| 59 | sub _normalized { | |
| 60 | my ($col) = @_; | |
| 61 | return "REPLACE(REPLACE(REPLACE(LOWER($col),'-',''),'_',''),' ','')"; | |
| 62 | } | |
| 63 | ||
| 64 | # Build the WHERE clause: | |
| 65 | # - per-token AND match inside each column (handles "cop tur") | |
| 66 | # - OR a normalized whole-query match (handles "coptur" -> "Cop-Tur") | |
| 67 | sub _term_clause { | |
| 68 | my (@cols) = @_; | |
| 69 | my @groups; | |
| 70 | foreach my $col (@cols) { | |
| 71 | # AND-of-tokens match | |
| 72 | if (@terms) { | |
| 73 | my @parts; | |
| 74 | foreach my $t (@terms) { | |
| 75 | my $sql_t = $t; $sql_t =~ s/'/''/g; | |
| 76 | push @parts, "$col LIKE '%$sql_t%'"; | |
| 77 | } | |
| 78 | push @groups, '(' . join(' AND ', @parts) . ')'; | |
| 79 | } | |
| 80 | # Normalized whole-query match (only useful when the query has | |
| 81 | # at least 3 characters after stripping punctuation) | |
| 82 | if (length($compact) >= 3) { | |
| 83 | my $sql_c = $compact; $sql_c =~ s/'/''/g; | |
| 84 | push @groups, _normalized($col) . " LIKE '%$sql_c%'"; | |
| 85 | } | |
| 86 | } | |
| 87 | return @groups ? '(' . join(' OR ', @groups) . ')' : '(1=0)'; | |
| 88 | } | |
| 89 | ||
| 90 | my $dbh = $db->db_connect(); | |
| 91 | ||
| 92 | # Check whether the optional physical-product columns are in place | |
| 93 | # yet. If the new ALTER TABLE has not been run, we drop them from the | |
| 94 | # search columns so the query does not 500. Core columns always run. | |
| 95 | sub _has_column { | |
| 96 | my ($table, $col) = @_; | |
| 97 | my $r = $db->db_readwrite($dbh, qq~ | |
| 98 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 99 | WHERE table_schema='$DB' AND table_name='$table' AND column_name='$col' | |
| 100 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 101 | return ($r && $r->{n}) ? 1 : 0; | |
| 102 | } | |
| 103 | ||
| 104 | my @model_cols = qw(title slug tagline description category); | |
| 105 | push @model_cols, 'color_options' if _has_column('models', 'color_options'); | |
| 106 | push @model_cols, 'material_options' if _has_column('models', 'material_options'); | |
| 107 | ||
| 108 | # Models the seller owns. Includes draft / unlisted / published -- | |
| 109 | # anything not purged is fair game in search since the user may want | |
| 110 | # to find their own draft. | |
| 111 | my @models; | |
| 112 | if (@terms || length($compact) >= 3) { | |
| 113 | my $model_where = _term_clause(@model_cols); | |
| 114 | @models = $db->db_readwrite_multiple($dbh, qq~ | |
| 115 | SELECT id, title, status, category, hero_image_url, primary_image_id | |
| 116 | FROM `${DB}`.models | |
| 117 | WHERE user_id='$uid' | |
| 118 | AND purged_at IS NULL | |
| 119 | AND $model_where | |
| 120 | ORDER BY updated_at DESC | |
| 121 | LIMIT 25 | |
| 122 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 123 | } | |
| 124 | ||
| 125 | # Orders -- search by buyer email and (if the query looks numeric) by | |
| 126 | # order id. Tokens are applied to the email column so a "jane smith" | |
| 127 | # style search hits 'jane.smith@example.com'. | |
| 128 | my @orders; | |
| 129 | if (@terms) { | |
| 130 | my $order_where = _term_clause('o.buyer_email'); | |
| 131 | # If any token is a pure digit run, also accept it as a direct order id. | |
| 132 | my @id_tokens = grep { /^\d+$/ } @terms; | |
| 133 | my $id_clause = ''; | |
| 134 | if (@id_tokens) { | |
| 135 | my $ids = join(',', map { "'$_'" } @id_tokens); | |
| 136 | $id_clause = " OR o.id IN ($ids)"; | |
| 137 | } | |
| 138 | @orders = $db->db_readwrite_multiple($dbh, qq~ | |
| 139 | SELECT o.id, o.buyer_email, o.total_amount_cents, o.status, | |
| 140 | DATE_FORMAT(o.created_at, '%Y-%m-%d') AS placed_on | |
| 141 | FROM `${DB}`.orders o | |
| 142 | JOIN `${DB}`.storefronts s ON s.id = o.storefront_id | |
| 143 | WHERE s.user_id='$uid' | |
| 144 | AND ($order_where $id_clause) | |
| 145 | ORDER BY o.created_at DESC | |
| 146 | LIMIT 25 | |
| 147 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 148 | } | |
| 149 | ||
| 150 | # Static settings-area links that match the query loosely. | |
| 151 | my @settings_hits; | |
| 152 | if (length $clean) { | |
| 153 | my @candidates = ( | |
| 154 | { label=>'Account profile', href=>'/profile.cgi', keywords=>'account profile email name' }, | |
| 155 | { label=>'Billing & Plan', href=>'/billing.cgi', keywords=>'billing subscription invoice card payment plan' }, | |
| 156 | { label=>'Promotions', href=>'/promotions.cgi', keywords=>'promo coupon sale bundle discount' }, | |
| 157 | { label=>'Storefront SEO', href=>'/storefront_seo.cgi', keywords=>'seo meta description keywords og' }, | |
| 158 | { label=>'Marketplaces', href=>'/marketplaces.cgi', keywords=>'marketplace cults3d patreon etsy myminifactory amazon ebay' }, | |
| 159 | { label=>'Optimization (A/B)', href=>'/optimization.cgi', keywords=>'experiment ab test optimization variant winner' }, | |
| 160 | { label=>'Audience', href=>'/audience.cgi', keywords=>'buyer customer audience emails repeat' }, | |
| 161 | { label=>'Messages inbox', href=>'/messages.cgi', keywords=>'review comment inbox reply messages' }, | |
| 162 | ); | |
| 163 | my $needle = lc $clean; | |
| 164 | foreach my $c (@candidates) { | |
| 165 | my $hay = lc($c->{label} . ' ' . $c->{keywords}); | |
| 166 | if (index($hay, $needle) >= 0) { | |
| 167 | push @settings_hits, $c; | |
| 168 | } | |
| 169 | } | |
| 170 | } | |
| 171 | ||
| 172 | $db->db_disconnect($dbh); | |
| 173 | ||
| 174 | sub _h { | |
| 175 | my $s = shift; $s //= ''; | |
| 176 | $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; $s =~ s/"/"/g; | |
| 177 | return $s; | |
| 178 | } | |
| 179 | ||
| 180 | my @model_rows; | |
| 181 | foreach my $m (@models) { | |
| 182 | # Thumbnail priority: hero_image_url (creator's custom hero), then | |
| 183 | # /img.cgi?id=<primary_image_id> (uploaded model_images), then no | |
| 184 | # image (the template renders a colored placeholder tile). | |
| 185 | my $thumb = ''; | |
| 186 | if ($m->{hero_image_url} && length $m->{hero_image_url}) { | |
| 187 | $thumb = $m->{hero_image_url}; | |
| 188 | } elsif ($m->{primary_image_id} && $m->{primary_image_id} > 0) { | |
| 189 | $thumb = '/img.cgi?id=' . $m->{primary_image_id}; | |
| 190 | } | |
| 191 | # Single-letter fallback shown inside the colored placeholder tile. | |
| 192 | my $title_raw = $m->{title} || ('Model #' . $m->{id}); | |
| 193 | my $initial = uc(substr($title_raw, 0, 1)); | |
| 194 | $initial = '?' unless $initial =~ /[A-Z0-9]/; | |
| 195 | push @model_rows, { | |
| 196 | id => $m->{id}, | |
| 197 | title => _h($title_raw), | |
| 198 | status => $m->{status} || '', | |
| 199 | category => _h($m->{category} || ''), | |
| 200 | href => '/upload_model.cgi?model_id=' . $m->{id}, | |
| 201 | thumb => _h($thumb), | |
| 202 | has_thumb => length $thumb ? 1 : 0, | |
| 203 | thumb_initial => _h($initial), | |
| 204 | }; | |
| 205 | } | |
| 206 | ||
| 207 | my @order_rows; | |
| 208 | foreach my $o (@orders) { | |
| 209 | push @order_rows, { | |
| 210 | id => $o->{id}, | |
| 211 | buyer => _h($o->{buyer_email} || ''), | |
| 212 | amount => '$' . sprintf('%.2f', ($o->{total_amount_cents} || 0) / 100), | |
| 213 | status => $o->{status} || '', | |
| 214 | placed_on => $o->{placed_on} || '', | |
| 215 | }; | |
| 216 | } | |
| 217 | ||
| 218 | ||
| 219 | # Diagnostic: how many models / orders does this user have AT ALL? | |
| 220 | # Surfaces in the empty state so a zero-results page can tell the user | |
| 221 | # whether the issue is "search missed it" or "no rows in the DB". | |
| 222 | my $total_models = 0; | |
| 223 | my $total_orders = 0; | |
| 224 | { | |
| 225 | my $r = $db->db_readwrite($dbh, qq~ | |
| 226 | SELECT COUNT(*) AS n FROM `${DB}`.models | |
| 227 | WHERE user_id='$uid' AND purged_at IS NULL | |
| 228 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 229 | $total_models = ($r && $r->{n}) ? $r->{n} : 0; | |
| 230 | } | |
| 231 | { | |
| 232 | my $r = $db->db_readwrite($dbh, qq~ | |
| 233 | SELECT COUNT(*) AS n | |
| 234 | FROM `${DB}`.orders o | |
| 235 | JOIN `${DB}`.storefronts s ON s.id = o.storefront_id | |
| 236 | WHERE s.user_id='$uid' | |
| 237 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 238 | $total_orders = ($r && $r->{n}) ? $r->{n} : 0; | |
| 239 | } | |
| 240 | ||
| 241 | my $tvars = { | |
| 242 | user_id => $uid, | |
| 243 | query => _h($clean), | |
| 244 | has_query => length($clean) ? 1 : 0, | |
| 245 | models => \@model_rows, | |
| 246 | has_models => scalar(@model_rows) ? 1 : 0, | |
| 247 | orders => \@order_rows, | |
| 248 | has_orders => scalar(@order_rows) ? 1 : 0, | |
| 249 | settings_hits => \@settings_hits, | |
| 250 | has_settings_hits => scalar(@settings_hits) ? 1 : 0, | |
| 251 | has_any => (scalar(@model_rows) + scalar(@order_rows) + scalar(@settings_hits)) ? 1 : 0, | |
| 252 | ||
| 253 | # Diagnostic data shown in the empty state -- helps the user tell | |
| 254 | # "search missed it" from "this row does not exist". | |
| 255 | token_list => _h(join(', ', @terms) || '(none)'), | |
| 256 | cols_searched => _h(join(', ', @model_cols)), | |
| 257 | total_models => $total_models, | |
| 258 | has_any_models => $total_models > 0 ? 1 : 0, | |
| 259 | total_orders => $total_orders, | |
| 260 | has_any_orders => $total_orders > 0 ? 1 : 0, | |
| 261 | }; | |
| 262 | ||
| 263 | 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"; | |
| 264 | ||
| 265 | my $body = join('', $tfile->template('webstls_search.html', $tvars, $userinfo)); | |
| 266 | ||
| 267 | $wrap->render({ | |
| 268 | userinfo => $userinfo, | |
| 269 | page_key => '', | |
| 270 | title => length($clean) ? ('Search: ' . _h($clean)) : 'Search', | |
| 271 | body => $body, | |
| 272 | }); |