Diff -- /var/www/vhosts/3dshawn.com/abforge.3dshawn.com/page.cgi

O Operator
Diff

/var/www/vhosts/3dshawn.com/abforge.3dshawn.com/page.cgi

added on local at 2026-07-01 16:01:35

Added
+316
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to fc71bdeff293
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# ABForge — single page editor
4#
5# /page.cgi?id=N → edit storefront_pages.id=N
6# /page.cgi?store=N&new=1→ create a new page on site N
7#
8# GET : render the editor (title, slug, body, status)
9# POST : update the page row, redirect back to site editor
10#======================================================================
11use strict;
12use warnings;
13
14use lib '/var/www/vhosts/3dshawn.com/abforge.3dshawn.com';
15use CGI;
16use MODS::Template;
17use MODS::DBConnect;
18use MODS::Login;
19use MODS::ABForge::Config;
20use MODS::ABForge::Wrapper;
21
22my $q = CGI->new;
23my $form = $q->Vars;
24my $tfile = MODS::Template->new;
25my $db = MODS::DBConnect->new;
26my $auth = MODS::Login->new;
27my $config = MODS::ABForge::Config->new;
28my $wrap = MODS::ABForge::Wrapper->new;
29my $DB = $config->settings('database_name');
30
31$|=1;
32
33my $userinfo = $auth->login_verify();
34if (!$userinfo) {
35 print "Status: 302 Found\nLocation: /login.cgi\n\n";
36 exit;
37}
38
39my $dbh = $db->db_connect();
40
41# ---------- Load the page (or build a new one) -------------------------
42my $page;
43my $is_new = (($form->{new} || '') eq '1');
44my $store_id = $form->{store} || 0;
45$store_id =~ s/[^0-9]//g;
46
47if (!$is_new) {
48 my $page_id = $form->{id} || 0;
49 $page_id =~ s/[^0-9]//g;
50 return _bail($dbh, '/sites.cgi') unless $page_id;
51
52 $page = $db->db_readwrite($dbh,
53 qq~SELECT p.*, s.user_id AS owner_id
54 FROM `${DB}`.storefront_pages p
55 JOIN `${DB}`.storefronts s ON s.id = p.storefront_id
56 WHERE p.id = '$page_id' LIMIT 1~,
57 $ENV{SCRIPT_NAME}, __LINE__);
58
59 return _bail($dbh, '/sites.cgi') unless $page && $page->{id};
60 return _bail($dbh, '/sites.cgi') unless $page->{owner_id} eq $userinfo->{user_id};
61
62 $store_id = $page->{storefront_id};
63} else {
64 return _bail($dbh, '/sites.cgi') unless $store_id;
65 my $own = $db->db_readwrite($dbh,
66 qq~SELECT id FROM `${DB}`.storefronts WHERE id='$store_id' AND user_id='$userinfo->{user_id}' LIMIT 1~,
67 $ENV{SCRIPT_NAME}, __LINE__);
68 return _bail($dbh, '/sites.cgi') unless $own && $own->{id};
69
70 $page = {
71 id => 0,
72 storefront_id => $store_id,
73 slug => '',
74 page_type => 'custom',
75 title => 'New page',
76 layout => '{"body":""}',
77 status => 'draft',
78 };
79}
80
81# ---------- POST: save changes ----------------------------------------
82my $save_msg = '';
83if (($ENV{REQUEST_METHOD} || '') eq 'POST' && ($form->{action} || '') eq 'save') {
84 # CGI.pm Vars() joins duplicate-name inputs with NUL. The status
85 # form sends BOTH a hidden <input name="status"> AND a <select
86 # name="status">, so we see e.g. "published\0published" here.
87 # Strip on NUL and take the first value before validating.
88 my $dedupe = sub { my $v = shift; defined $v ? (split /\0/, $v)[0] : ''; };
89 my $title = substr($dedupe->($form->{title}) || '', 0, 200);
90 $title =~ s/^\s+|\s+$//g;
91 my $slug = lc($dedupe->($form->{slug}) || '');
92 my $body = $dedupe->($form->{body}) || '';
93 my $status = $dedupe->($form->{status}) || 'draft';
94 # Optional short label for the site header nav. Falls back to
95 # the page title at render time, so leaving it blank is fine.
96 my $menu_label = substr($dedupe->($form->{menu_label}) || '', 0, 120);
97 $menu_label =~ s/^\s+|\s+$//g;
98
99 # Slug allowed chars: lowercase letters, digits, dash, underscore.
100 # Spaces collapse to underscores; everything else is stripped.
101 $slug =~ s/\s+/_/g;
102 $slug =~ s/[^a-z0-9_-]//g;
103 $slug =~ s/^[_-]+|[_-]+$//g; # trim leading/trailing separators
104 $slug = substr($slug, 0, 120);
105
106 # If the slug came back empty, generate one from the title so the
107 # NOT NULL + UNIQUE constraints can't trip us silently.
108 if (!length $slug) {
109 my $auto = lc($title);
110 $auto =~ s/\s+/_/g;
111 $auto =~ s/[^a-z0-9_-]//g;
112 $auto =~ s/^[_-]+|[_-]+$//g;
113 $auto = substr($auto, 0, 100);
114 $slug = $auto || 'page';
115 }
116
117 $status = 'draft' unless $status eq 'published' || $status eq 'archived';
118
119 # Build a tiny JSON layout (no schema validation; app just stores it)
120 my $layout = _to_json({ body => $body });
121
122 for ($title, $slug, $layout, $menu_label) { s/[\\']/\\$&/g }
123
124 if ($page->{id}) {
125 my $pub = ($status eq 'published')
126 ? qq~, published_at = COALESCE(published_at, NOW())~
127 : '';
128 $db->db_readwrite($dbh, qq~
129 UPDATE `${DB}`.storefront_pages
130 SET title='$title', slug='$slug', menu_label='$menu_label',
131 layout='$layout', status='$status' $pub
132 WHERE id='$page->{id}' LIMIT 1
133 ~, $ENV{SCRIPT_NAME}, __LINE__);
134 } else {
135 # If the chosen slug is already taken on this site, suffix
136 # it (-2, -3, ...) until we find an open one. Without this the
137 # UNIQUE (storefront_id, slug) constraint fails silently and we
138 # bounce the user back with no new page created.
139 my $base_slug = $slug;
140 my $attempt = 1;
141 while (1) {
142 my $exists = $db->db_readwrite($dbh, qq~
143 SELECT id FROM `${DB}`.storefront_pages
144 WHERE storefront_id='$store_id' AND slug='$slug' LIMIT 1
145 ~, $ENV{SCRIPT_NAME}, __LINE__);
146 last unless $exists && $exists->{id};
147 $attempt++;
148 $slug = $base_slug . '-' . $attempt;
149 $slug = substr($slug, 0, 120);
150 last if $attempt > 50; # belt-and-suspenders
151 }
152
153 my $pub = ($status eq 'published') ? 'NOW()' : 'NULL';
154 my $r = $db->db_readwrite($dbh, qq~
155 INSERT INTO `${DB}`.storefront_pages SET
156 storefront_id = '$store_id',
157 slug = '$slug',
158 page_type = 'custom',
159 title = '$title',
160 menu_label = '$menu_label',
161 layout = '$layout',
162 status = '$status',
163 published_at = $pub
164 ~, $ENV{SCRIPT_NAME}, __LINE__);
165 $page->{id} = $r->{mysql_insertid} if $r && $r->{mysql_insertid};
166 }
167
168 # Redirect to refresh state. If $page->{id} is still 0 something
169 # went wrong with the INSERT -- send back to the site page
170 # list rather than /page.cgi?id=0 which would itself bounce away.
171 $db->db_disconnect($dbh);
172 my $redir = $page->{id}
173 ? "/page.cgi?id=$page->{id}&saved=1"
174 : "/sites.cgi?err=page_save_failed";
175 print "Status: 302 Found\nLocation: $redir\n\n";
176 exit;
177}
178
179# ---------- GET: render the form --------------------------------------
180print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n";
181
182my $body_text = _extract_body_from_layout($page->{layout});
183
184# When editing the site's home page, pull the per-site hero
185# images so the left panel can offer explicit Replace buttons. The
186# floating-card hero layout can hide cards behind one another at narrow
187# iframe widths, which makes click-to-edit unreliable for cards 2 and 3
188# -- the left-panel slots give the user a guaranteed access path.
189my $is_home_page = ($page->{page_type} || '') eq 'home' ? 1 : 0;
190my %hero = (
191 h1 => '', h2 => '', h3 => '',
192 p1 => '50% 50%', p2 => '50% 50%', p3 => '50% 50%',
193);
194if ($is_home_page && $store_id) {
195 my $sf = $db->db_readwrite($dbh, qq~
196 SELECT hero_image_1, hero_image_2, hero_image_3,
197 hero_image_1_pos, hero_image_2_pos, hero_image_3_pos
198 FROM `${DB}`.storefronts
199 WHERE id='$store_id' LIMIT 1
200 ~, $ENV{SCRIPT_NAME}, __LINE__);
201 if ($sf && $sf->{hero_image_1}) {
202 $hero{h1} = $sf->{hero_image_1} || '';
203 $hero{h2} = $sf->{hero_image_2} || '';
204 $hero{h3} = $sf->{hero_image_3} || '';
205 $hero{p1} = $sf->{hero_image_1_pos} || '50% 50%';
206 $hero{p2} = $sf->{hero_image_2_pos} || '50% 50%';
207 $hero{p3} = $sf->{hero_image_3_pos} || '50% 50%';
208 }
209}
210
211my $tvars = {
212 page_id => $page->{id},
213 store_id => $store_id,
214 title => _h($page->{title}),
215 slug => _h($page->{slug}),
216 menu_label => _h($page->{menu_label} // ''),
217 is_home_page => $is_home_page,
218 hero_image_1 => _h($hero{h1}),
219 hero_image_2 => _h($hero{h2}),
220 hero_image_3 => _h($hero{h3}),
221 hero_image_1_pos => _h($hero{p1}),
222 hero_image_2_pos => _h($hero{p2}),
223 hero_image_3_pos => _h($hero{p3}),
224 has_hero_image_1 => $hero{h1} ? 1 : 0,
225 has_hero_image_2 => $hero{h2} ? 1 : 0,
226 has_hero_image_3 => $hero{h3} ? 1 : 0,
227 # body_json is the raw HTML body wrapped as a JS string literal so
228 # the editor's <script> can do `var INITIAL_BODY = $body_json;` and
229 # get a real string. Embedding HTML directly into the page would
230 # confuse Quill's init since the editor reads its initial state via
231 # JS rather than from the DOM.
232 body_json => _to_js_string($body_text),
233 page_type => $page->{page_type},
234 is_new => $is_new ? 1 : 0,
235 is_draft => ($page->{status} eq 'draft') ? 1 : 0,
236 is_published => ($page->{status} eq 'published') ? 1 : 0,
237 is_archived => ($page->{status} eq 'archived') ? 1 : 0,
238 saved_flash => (($form->{saved} || '') eq '1') ? 1 : 0,
239};
240
241my $body_html = join('', $tfile->template('abforge_page_edit.html', $tvars, $userinfo));
242
243$db->db_disconnect($dbh);
244
245$wrap->render({
246 userinfo => $userinfo,
247 page_key => 'site',
248 title => 'Edit page',
249 body => $body_html,
250});
251exit;
252
253#======================================================================
254# Helpers
255#======================================================================
256
257sub _bail {
258 my ($dbh, $loc) = @_;
259 $db->db_disconnect($dbh) if $dbh;
260 print "Status: 302 Found\nLocation: $loc\n\n";
261 exit;
262}
263
264# Pull the body string out of the JSON-shaped layout column. We don't
265# rely on a JSON parser since we may be running on systems without
266# JSON.pm; a small regex is enough for the simple shape we write.
267sub _extract_body_from_layout {
268 my ($json) = @_;
269 return '' unless defined $json && length $json;
270 if ($json =~ /"body"\s*:\s*"((?:[^"\\]|\\.)*)"/s) {
271 my $b = $1;
272 $b =~ s/\\"/"/g;
273 $b =~ s/\\\\/\\/g;
274 $b =~ s/\\n/\n/g;
275 $b =~ s/\\r/\r/g;
276 $b =~ s/\\t/\t/g;
277 return $b;
278 }
279 return '';
280}
281
282sub _to_json {
283 my ($h) = @_;
284 my $body = $h->{body} // '';
285 $body =~ s/\\/\\\\/g;
286 $body =~ s/"/\\"/g;
287 $body =~ s/\n/\\n/g;
288 $body =~ s/\r/\\r/g;
289 $body =~ s/\t/\\t/g;
290 return qq~{"body":"$body"}~;
291}
292
293sub _h {
294 my ($s) = @_;
295 $s //= '';
296 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
297 $s =~ s/"/&quot;/g; $s =~ s/'/&#39;/g;
298 return $s;
299}
300
301# Wrap a string as a JS string literal -- escaping quotes, backslashes,
302# control chars, and the </ sequence (so a closing </script> tag inside
303# the body can't break out of the surrounding <script> block).
304sub _to_js_string {
305 my ($s) = @_;
306 return '""' unless defined $s && length $s;
307 $s =~ s/\\/\\\\/g;
308 $s =~ s/"/\\"/g;
309 $s =~ s|/|\\/|g;
310 $s =~ s/\r/\\r/g;
311 $s =~ s/\n/\\n/g;
312 $s =~ s/\t/\\t/g;
313 # any remaining control chars
314 $s =~ s/([\x00-\x1F])/sprintf('\\u%04x', ord($1))/ge;
315 return qq("$s");
316}