Diff -- /var/www/vhosts/3dshawn.com/repricer.3dshawn.com/_attic/optimization.cgi
Diff

/var/www/vhosts/3dshawn.com/repricer.3dshawn.com/_attic/optimization.cgi

added on local at 2026-07-01 21:47:34

Added
+878
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 30673cf66cf6
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# RePricer - Optimization
4#
5# Page body lives in TEMPLATES/repricer_optimization.html.
6#
7# ?new=1 show the New-experiment builder form instead of dashboard
8# (no arg) show the dashboard with the user's real experiments
9#======================================================================
10use strict;
11use warnings;
12
13use lib '/var/www/vhosts/3dshawn.com/repricer.3dshawn.com';
14use CGI;
15use MODS::Template;
16use MODS::DBConnect;
17use MODS::Login;
18use MODS::RePricer::Config;
19use MODS::RePricer::Wrapper;
20use MODS::RePricer::Experiments;
21use MODS::RePricer::PricingExperiments;
22use MODS::RePricer::Layouts;
23use MODS::RePricer::Themes;
24
25my $q = CGI->new;
26my $form = $q->Vars;
27my $auth = MODS::Login->new;
28my $wrap = MODS::RePricer::Wrapper->new;
29my $tfile = MODS::Template->new;
30my $db = MODS::DBConnect->new;
31my $cfg = MODS::RePricer::Config->new;
32my $DB = $cfg->settings('database_name');
33
34$|=1;
35my $userinfo = $auth->login_verify();
36if (!$userinfo) {
37 print "Status: 302 Found\nLocation: /login.cgi\n\n";
38 exit;
39}
40require MODS::RePricer::Permissions;
41MODS::RePricer::Permissions->new->require_feature($userinfo, 'view_reports');
42my $uid = $userinfo->{user_id};
43$uid =~ s/[^0-9]//g;
44
45# Tutorial mode: when ?tutorial=1 we paint sample experiments, price
46# tests, and recommendations so a brand-new account can see what the
47# Optimization suite looks like with activity. Same pattern as the
48# dashboard / analytics tutorials.
49my $tutorial_mode = ($form->{tutorial} && $form->{tutorial} eq '1') ? 1 : 0;
50
51my $detail_id = $form->{id} || 0;
52$detail_id =~ s/[^0-9]//g;
53my $edit_id = $form->{edit} || 0;
54$edit_id =~ s/[^0-9]//g;
55
56# Mode resolution: detail > edit > new > list. Edit is treated as a
57# variation of "new" -- same builder UI, but pre-populated.
58my $mode =
59 $detail_id ? 'detail' :
60 $edit_id ? 'new' :
61 ($form->{new} && $form->{new} eq '1') ? 'new' : 'list';
62
63# ---- Pull the user's experiments (ab_tests JOIN storefronts) ---------
64# Guarded against the surface column not existing yet on a stale DB.
65my @experiments;
66my $dbh = $db->db_connect();
67
68my $has_tbl = $db->db_readwrite($dbh, qq~
69 SELECT COUNT(*) AS n FROM information_schema.tables
70 WHERE table_schema='$DB' AND table_name='ab_tests'
71~, $ENV{SCRIPT_NAME}, __LINE__);
72
73my $has_surface = 0;
74if ($has_tbl && $has_tbl->{n}) {
75 my $col = $db->db_readwrite($dbh, qq~
76 SELECT COUNT(*) AS n FROM information_schema.columns
77 WHERE table_schema='$DB' AND table_name='ab_tests' AND column_name='surface'
78 ~, $ENV{SCRIPT_NAME}, __LINE__);
79 $has_surface = ($col && $col->{n}) ? 1 : 0;
80
81 my $surface_sql = $has_surface ? 'ab.surface,' : "'' AS surface,";
82 my @rows = $db->db_readwrite_multiple($dbh, qq~
83 SELECT ab.id, ab.name, ab.test_type, $surface_sql
84 ab.status, ab.confidence_score, ab.traffic_seen,
85 ab.start_date, ab.created_at,
86 s.name AS storefront_name
87 FROM `${DB}`.ab_tests ab
88 JOIN `${DB}`.storefronts s ON s.id = ab.storefront_id
89 WHERE s.user_id = '$uid'
90 ORDER BY ab.created_at DESC
91 LIMIT 50
92 ~, $ENV{SCRIPT_NAME}, __LINE__);
93
94 # Bayesian stats: for every experiment row we recompute confidence
95 # from ab_test_events on the fly. Cheap because the visitor counts
96 # are COUNT(DISTINCT visitor_hash) on indexed columns.
97 my $exh = MODS::RePricer::Experiments->new;
98
99 foreach my $r (@rows) {
100 my $status = $r->{status} || 'draft';
101
102 my $stats = ($status eq 'running' || $status eq 'paused' || $status eq 'complete')
103 ? $exh->compute_stats($db, $dbh, $DB, $r->{id})
104 : {};
105
106 my $conf_display = '-';
107 my $lift_display = '-';
108 my $traffic = $r->{traffic_seen} || 0;
109 if ($stats && %$stats) {
110 $traffic = $stats->{traffic_seen} || 0;
111 $conf_display = sprintf('%.1f%%', ($stats->{confidence} || 0) * 100);
112 my $lift = $stats->{lift_pct} || 0;
113 $lift_display = ($lift >= 0 ? '+' : '') . sprintf('%.1f%%', $lift);
114 }
115
116 # Current leader (used in the Complete confirm dialog so the
117 # user can see which variant will get locked in). Ties go to
118 # the control, matching the rule in optimization_action.cgi.
119 my $rate_a = $stats->{rate_a} || 0;
120 my $rate_b = $stats->{rate_b} || 0;
121 my $leader_label = ($rate_b > $rate_a) ? 'B' : 'A';
122 my $leader_rate = ($rate_b > $rate_a) ? $rate_b : $rate_a;
123 my $has_any_data = (($stats->{exposures_a} || 0) + ($stats->{exposures_b} || 0)) > 0 ? 1 : 0;
124 my $leader_rate_pct = sprintf('%.2f%%', $leader_rate * 100);
125
126 # Pre-render the Complete confirm() text. Must avoid apostrophes
127 # because the string is dropped into a single-quoted JS string
128 # in an HTML onsubmit attribute. Using "is" / "no" wording
129 # instead of "is not" / "does not" keeps everything safe.
130 my $complete_confirm =
131 $has_any_data
132 ? "Mark this experiment complete? Based on current data, Variant ${leader_label} is winning at ${leader_rate_pct} conversion. Marking complete locks in Variant ${leader_label} as the winner, stops bucketing new visitors, and moves the test to the Completed section."
133 : "Mark this experiment complete? No visitors have been bucketed yet so the control (Variant A) will be locked in as the winner by default. You can Re-run the test from the Completed section once you want fresh data.";
134
135 push @experiments, {
136 id => $r->{id},
137 name => _h($r->{name}),
138 test_type => uc($r->{test_type} || 'AB'),
139 surface => $r->{surface} || '',
140 status => $status,
141 status_label => ucfirst($status),
142 is_draft => $status eq 'draft' ? 1 : 0,
143 is_running => $status eq 'running' ? 1 : 0,
144 is_paused => $status eq 'paused' ? 1 : 0,
145 is_complete => $status eq 'complete' ? 1 : 0,
146 is_aborted => $status eq 'aborted' ? 1 : 0,
147 confidence => $conf_display,
148 lift => $lift_display,
149 traffic_seen => $traffic,
150 storefront => _h($r->{storefront_name} || ''),
151 created_at => $r->{created_at} || '',
152 # Leader info for the Complete confirm dialog.
153 leader_label => $leader_label,
154 leader_rate => $leader_rate_pct,
155 has_any_data => $has_any_data,
156 complete_confirm => $complete_confirm,
157 };
158 }
159}
160
161# Get the user's primary storefront so the builder can default to it.
162my $sf = $db->db_readwrite($dbh,
163 qq~SELECT id, name FROM `${DB}`.storefronts WHERE user_id='$uid' ORDER BY id LIMIT 1~,
164 $ENV{SCRIPT_NAME}, __LINE__);
165my $store_id = ($sf && $sf->{id}) ? $sf->{id} : 0;
166my $store_name = ($sf && $sf->{name}) ? $sf->{name} : '';
167
168# Re-derive the surface-column existence flag here so it is in scope
169# for the edit/detail loaders below (the listing block defines it
170# locally; we hoist it out for re-use).
171unless (defined $has_surface) {
172 my $col2 = $db->db_readwrite($dbh, qq~
173 SELECT COUNT(*) AS n FROM information_schema.columns
174 WHERE table_schema='$DB' AND table_name='ab_tests' AND column_name='surface'
175 ~, $ENV{SCRIPT_NAME}, __LINE__);
176 $has_surface = ($col2 && $col2->{n}) ? 1 : 0;
177}
178
179# Forward-declared lookup lists used by BOTH the edit/detail block
180# (which mirrors has_custom_themes into each variant) and the builder's
181# new-experiment form. Populated once below when $mode eq 'new'; the
182# edit/detail path only needs the scalar size.
183my @user_models;
184my @layout_options;
185my @theme_options;
186my @custom_theme_options;
187
188# Load a single experiment row for edit + detail modes. Ownership is
189# enforced via the storefront JOIN; if the row does not belong to this
190# user, $edit_row stays empty and the templates fall back gracefully.
191my %edit_row;
192my %detail_row;
193my @detail_variants;
194my %detail_stats;
195if ($edit_id || $detail_id) {
196 my $target_id = $edit_id || $detail_id;
197 my $surface_sql_pick = $has_surface ? 'ab.surface' : "'' AS surface";
198 my $r = $db->db_readwrite($dbh, qq~
199 SELECT ab.id, ab.name, ab.test_type, $surface_sql_pick,
200 ab.status, ab.primary_metric, ab.variants,
201 ab.winner_variant_id, ab.confidence_score,
202 ab.start_date, ab.end_date, ab.created_at,
203 s.id AS storefront_id
204 FROM `${DB}`.ab_tests ab
205 JOIN `${DB}`.storefronts s ON s.id = ab.storefront_id
206 WHERE ab.id='$target_id' AND s.user_id='$uid'
207 LIMIT 1
208 ~, $ENV{SCRIPT_NAME}, __LINE__);
209
210 if ($r && $r->{id}) {
211 # Parse out every variant for the edit form (up to 6: A-F).
212 my @vs = _parse_variants_for_edit($r->{variants} || '');
213
214 %edit_row = (
215 id => $r->{id},
216 name => _h($r->{name}),
217 test_type => $r->{test_type} || 'ab',
218 surface => $r->{surface} || 'hero_title',
219 primary_metric => $r->{primary_metric} || 'conversion_rate',
220 target_model_id => (
221 ($vs[0] && $vs[0]->{target_model_id}) ||
222 ($vs[1] && $vs[1]->{target_model_id}) || 0
223 ),
224 edit_variant_count => scalar(@vs) || 2,
225 );
226
227 # Build the per-variant edit fields. We always render 2 rows
228 # (A control + B challenger) and additionally render C..F when
229 # the saved JSON carried them. The template iterates a single
230 # loop over edit_variants to keep the markup uniform.
231 my @LETTERS = ('A', 'B', 'C', 'D', 'E', 'F');
232 my @edit_variants;
233 my $n_render = scalar(@vs);
234 $n_render = 2 if $n_render < 2;
235 $n_render = 6 if $n_render > 6;
236 for (my $i = 0; $i < $n_render; $i++) {
237 my $v = $vs[$i] || {};
238 my $vid = $LETTERS[$i];
239 my $is_control = ($i == 0) ? 1 : 0;
240 push @edit_variants, {
241 vid => $vid,
242 vid_lc => lc($vid),
243 label => $is_control
244 ? "Variant $vid . Control"
245 : "Variant $vid . Challenger",
246 is_control => $is_control,
247 name => _h($v->{name} // ''),
248 text => _h($v->{text} // ''),
249 image_url => $v->{image_url} // '',
250 has_image => $v->{image_url} ? 1 : 0,
251 layout_id => ($v->{layout_id} || 0) + 0,
252 theme_id => ($v->{theme_id} || 0) + 0,
253 custom_theme_id => ($v->{custom_theme_id} || 0) + 0,
254 # Pre-baked form field names. The template engine's
255 # greedy \w+ parsing means $loop1.vid_text would look up
256 # key "vid_text" (not concatenate). Pre-compute the full
257 # names here so the template can just emit them.
258 name_field => "variant_${vid}_name",
259 text_field => "variant_${vid}_text",
260 image_field => "variant_${vid}_image",
261 image_existing_field => "variant_${vid}_image_existing",
262 layout_id_field => "variant_${vid}_layout_id",
263 theme_id_field => "variant_${vid}_theme_id",
264 custom_theme_id_field => "variant_${vid}_custom_theme_id",
265 # Mirror top-level tvars into each row so [if:] tests
266 # work inside the loop (engine resolves bare $foo against
267 # the current $loopN row, not the outer tvars).
268 has_custom_themes => scalar(@custom_theme_options) ? 1 : 0,
269 };
270 }
271 $edit_row{edit_variants} = \@edit_variants;
272
273 # Detail view: per-variant stats.
274 if ($detail_id) {
275 require MODS::RePricer::Experiments;
276 my $exh = MODS::RePricer::Experiments->new;
277 my $stats = $exh->compute_stats($db, $dbh, $DB, $r->{id}) || {};
278
279 %detail_row = (
280 id => $r->{id},
281 name => _h($r->{name}),
282 test_type => uc($r->{test_type} || 'AB'),
283 surface => $r->{surface} || '',
284 status => $r->{status} || 'draft',
285 primary_metric => $r->{primary_metric} || 'conversion_rate',
286 created_at => $r->{created_at} || '',
287 start_date => $r->{start_date} || '-',
288 );
289 $detail_row{is_running} = $detail_row{status} eq 'running' ? 1 : 0;
290 $detail_row{is_draft} = $detail_row{status} eq 'draft' ? 1 : 0;
291 $detail_row{is_paused} = $detail_row{status} eq 'paused' ? 1 : 0;
292 $detail_row{is_complete} = $detail_row{status} eq 'complete' ? 1 : 0;
293
294 my $exp_a = $stats->{exposures_a} || 0;
295 my $exp_b = $stats->{exposures_b} || 0;
296 my $conv_a = $stats->{conversions_a} || 0;
297 my $conv_b = $stats->{conversions_b} || 0;
298 my $rate_a = $stats->{rate_a} || 0;
299 my $rate_b = $stats->{rate_b} || 0;
300 my $lift = $stats->{lift_pct} || 0;
301 my $conf = $stats->{confidence} || 0;
302
303 $detail_row{traffic_seen} = $stats->{traffic_seen} || 0;
304 $detail_row{has_stats} = ($exp_a + $exp_b) ? 1 : 0;
305 $detail_row{conf_pct} = sprintf('%.1f%%', $conf * 100);
306 $detail_row{conf_raw} = $conf;
307 $detail_row{lift_pct} = ($lift >= 0 ? '+' : '') . sprintf('%.1f%%', $lift);
308 $detail_row{lift_raw} = $lift;
309
310 # Winner state: above threshold = call winner; ramping up
311 # otherwise; insufficient data when fewer than ~50 per arm.
312 my $threshold = 0.95;
313 $detail_row{below_min_sample} = ($exp_a < 25 || $exp_b < 25) ? 1 : 0;
314 $detail_row{winner_called} = (!$detail_row{below_min_sample} && $conf >= $threshold) ? 1 : 0;
315 $detail_row{too_early} = (!$detail_row{below_min_sample} && !$detail_row{winner_called}) ? 1 : 0;
316
317 # Why-is-it-winning narrative.
318 my $w_label = $rate_b > $rate_a ? 'B' : 'A';
319 my $w_rate = $rate_b > $rate_a ? $rate_b : $rate_a;
320 my $l_rate = $rate_b > $rate_a ? $rate_a : $rate_b;
321 my $w_pct = sprintf('%.2f%%', $w_rate * 100);
322 my $l_pct = sprintf('%.2f%%', $l_rate * 100);
323 $detail_row{leader_label} = $w_label;
324 $detail_row{leader_rate} = $w_pct;
325 $detail_row{loser_rate} = $l_pct;
326
327 # If the test has already been Completed, the winner is
328 # locked in the row's winner_variant_id. Surface it so the
329 # detail page can display the final pick prominently.
330 my $locked = $r->{winner_variant_id} || '';
331 $locked =~ s/[^A-Za-z0-9_\-]//g;
332 $detail_row{has_locked_winner} = ($locked && $detail_row{is_complete}) ? 1 : 0;
333 $detail_row{locked_winner_id} = $locked;
334 $detail_row{has_any_data} = ($exp_a + $exp_b) ? 1 : 0;
335
336 # Pre-render the Complete confirm() text for the detail
337 # action bar -- same format as the list rows.
338 my $w_lbl = $detail_row{leader_label};
339 $detail_row{complete_confirm} = ($exp_a + $exp_b)
340 ? "Mark this experiment complete? Based on current data, Variant ${w_lbl} is winning at ${w_pct} conversion. Marking complete locks in Variant ${w_lbl} as the winner, stops bucketing new visitors, and moves the test to the Completed section."
341 : "Mark this experiment complete? No visitors have been bucketed yet so the control (Variant A) will be locked in as the winner by default. You can Re-run the test from the Completed section once you want fresh data.";
342
343 # Variant cards.
344 my $primary_metric_label =
345 $detail_row{primary_metric} eq 'conversion_rate' ? 'purchases' :
346 $detail_row{primary_metric} eq 'add_to_cart' ? 'add to carts' :
347 $detail_row{primary_metric} eq 'click' ? 'clicks' :
348 $detail_row{primary_metric} eq 'signup' ? 'signups' :
349 'conversions';
350 $detail_row{metric_label} = $primary_metric_label;
351
352 # Per-variant per-event-type counts so MVT tests with 3+
353 # variants can still render their cards with real exposure
354 # + conversion numbers (the rate_a / rate_b returned by
355 # compute_stats only covers the leader pair).
356 my $conv_event_for_metric =
357 $detail_row{primary_metric} eq 'add_to_cart' ? 'add_to_cart' :
358 $detail_row{primary_metric} eq 'click' ? 'click' :
359 $detail_row{primary_metric} eq 'signup' ? 'custom' :
360 'purchase';
361 my %expo_by;
362 my %conv_by;
363 my @e_rows = $db->db_readwrite_multiple($dbh, qq~
364 SELECT variant_id, COUNT(DISTINCT visitor_hash) AS n
365 FROM `${DB}`.ab_test_events
366 WHERE ab_test_id='$r->{id}' AND event_type='exposure'
367 GROUP BY variant_id
368 ~, $ENV{SCRIPT_NAME}, __LINE__);
369 $expo_by{$_->{variant_id}} = $_->{n} for @e_rows;
370 my @c_rows = $db->db_readwrite_multiple($dbh, qq~
371 SELECT variant_id, COUNT(DISTINCT visitor_hash) AS n
372 FROM `${DB}`.ab_test_events
373 WHERE ab_test_id='$r->{id}' AND event_type='$conv_event_for_metric'
374 GROUP BY variant_id
375 ~, $ENV{SCRIPT_NAME}, __LINE__);
376 $conv_by{$_->{variant_id}} = $_->{n} for @c_rows;
377
378 # Highest conversion rate among variants -> "is_leader"
379 # styling on that card.
380 my %rate_by;
381 foreach my $v (@vs) {
382 my $vid = $v->{id} || '';
383 my $e = $expo_by{$vid} || 0;
384 my $c = $conv_by{$vid} || 0;
385 $rate_by{$vid} = $e ? ($c / $e) : 0;
386 }
387 my $leader_vid = '';
388 my $leader_r = -1;
389 foreach my $vid (keys %rate_by) {
390 if ($rate_by{$vid} > $leader_r) {
391 $leader_r = $rate_by{$vid};
392 $leader_vid = $vid;
393 }
394 }
395
396 # Helper objects so we can resolve layout / theme ids back to
397 # display names for the detail cards.
398 my $layouts_h = MODS::RePricer::Layouts->new;
399 my $themes_h = MODS::RePricer::Themes->new;
400
401 foreach my $v (@vs) {
402 my $vid = $v->{id} || '';
403 my $e = $expo_by{$vid} || 0;
404 my $c = $conv_by{$vid} || 0;
405 my $rt = $rate_by{$vid} || 0;
406 my $is_control = ($vid eq ($vs[0]->{id} || 'A')) ? 1 : 0;
407
408 my $lid = ($v->{layout_id} || 0) + 0;
409 my $tid = ($v->{theme_id} || 0) + 0;
410 my $ctid = ($v->{custom_theme_id} || 0) + 0;
411 my $layout_name = '';
412 my $theme_name = '';
413 if ($lid) {
414 my $L = $layouts_h->by_id($lid);
415 $layout_name = $L->{name} if $L && $L->{name};
416 }
417 if ($ctid) {
418 my $ct = $themes_h->custom_by_id($db, $dbh, $DB, $ctid);
419 $theme_name = ($ct && $ct->{name}) ? $ct->{name} : '';
420 } elsif ($tid) {
421 my $T = $themes_h->by_id($tid);
422 $theme_name = $T->{name} if $T && $T->{name};
423 }
424
425 # Is this experiment a design-surface test? Used so the
426 # template can render an explicit "inherits storefront's
427 # saved layout/theme" panel on the control card instead
428 # of falling through to the generic "no image" placeholder.
429 my $is_design_test =
430 ($detail_row{surface} eq 'layout'
431 || $detail_row{surface} eq 'theme'
432 || $detail_row{surface} eq 'layout_and_theme') ? 1 : 0;
433 my $show_layout_inherit =
434 $is_design_test
435 && !$lid
436 && ($detail_row{surface} eq 'layout'
437 || $detail_row{surface} eq 'layout_and_theme');
438 my $show_theme_inherit =
439 $is_design_test
440 && !$tid && !$ctid
441 && ($detail_row{surface} eq 'theme'
442 || $detail_row{surface} eq 'layout_and_theme');
443
444 push @detail_variants, {
445 id => $vid,
446 label => 'Variant ' . $vid . ' . '
447 . ($is_control ? 'Control' : 'Challenger'),
448 text => _h($v->{text} || '(unchanged)'),
449 image_url => $v->{image_url} || '',
450 has_image => $v->{image_url} ? 1 : 0,
451 layout_id => $lid,
452 theme_id => $tid,
453 custom_theme_id => $ctid,
454 layout_name => _h($layout_name),
455 theme_name => _h($theme_name),
456 has_design => ($lid || $tid || $ctid || $is_design_test) ? 1 : 0,
457 has_layout_pick => $lid ? 1 : 0,
458 has_theme_pick => ($tid || $ctid) ? 1 : 0,
459 show_layout_inherit => $show_layout_inherit ? 1 : 0,
460 show_theme_inherit => $show_theme_inherit ? 1 : 0,
461 exposures => $e,
462 conversions => $c,
463 rate => sprintf('%.2f%%', $rt * 100),
464 is_leader => ($vid eq $leader_vid && $e > 0) ? 1 : 0,
465 is_locked_winner => ($detail_row{has_locked_winner}
466 && $detail_row{locked_winner_id} eq $vid) ? 1 : 0,
467 };
468 }
469 }
470 }
471 elsif ($detail_id || $edit_id) {
472 # Row not owned / not found -- bounce back to the list.
473 $db->db_disconnect($dbh);
474 print "Status: 302 Found\nLocation: /optimization.cgi\n\n";
475 exit;
476 }
477}
478
479# Load the user's published models. Needed by:
480# - mode=new : the experiment builder's "Product to test" dropdown
481# - mode=list: the Price tests / Surveys "Pick a model" dropdowns
482# (previously gated to mode=new which left those empty)
483# Layout / theme pickers are only needed by the builder, so they stay
484# gated to mode=new.
485if ($mode eq 'new' || $mode eq 'list') {
486 @user_models = $db->db_readwrite_multiple($dbh, qq~
487 SELECT id, title
488 FROM `${DB}`.models
489 WHERE user_id='$uid'
490 AND purged_at IS NULL
491 AND status='published'
492 ORDER BY updated_at DESC
493 LIMIT 100
494 ~, $ENV{SCRIPT_NAME}, __LINE__);
495 foreach my $m (@user_models) {
496 $m->{title} = _h($m->{title} || ('Model #' . $m->{id}));
497 }
498}
499
500if ($mode eq 'new') {
501 # Layout picker options (used by surface=layout / layout_and_theme).
502 my $layouts_helper = MODS::RePricer::Layouts->new;
503 foreach my $L (@{ $layouts_helper->all }) {
504 push @layout_options, {
505 id => $L->{id},
506 name => _h($L->{name} || ('Layout ' . $L->{id})),
507 tagline => _h($L->{tagline} || ''),
508 };
509 }
510
511 # Built-in theme picker options.
512 my $themes_helper = MODS::RePricer::Themes->new;
513 foreach my $T (@{ $themes_helper->all }) {
514 push @theme_options, {
515 id => $T->{id},
516 name => _h($T->{name} || ('Theme ' . $T->{id})),
517 };
518 }
519
520 # The seller's saved custom themes for THIS user's storefronts.
521 # Joined to storefronts so we only show themes the seller actually
522 # owns. Distinct names because a theme is tied to one storefront.
523 if ($store_id) {
524 my @rows = $db->db_readwrite_multiple($dbh, qq~
525 SELECT id, name
526 FROM `${DB}`.storefront_custom_themes
527 WHERE storefront_id='$store_id'
528 ORDER BY updated_at DESC
529 LIMIT 50
530 ~, $ENV{SCRIPT_NAME}, __LINE__);
531 foreach my $ct (@rows) {
532 push @custom_theme_options, {
533 id => $ct->{id},
534 name => _h($ct->{name} || ('Custom theme #' . $ct->{id})),
535 };
536 }
537 }
538}
539
540# Price tests + Van Westendorp surveys -- the previously "coming soon"
541# section. Same render template; just extra tvars driving real rows.
542my $px = MODS::RePricer::PricingExperiments->new;
543my $px_ready = $px->schema_ready($db, $dbh, $DB);
544my @price_tests = $px_ready ? $px->list_user_price_tests($db, $dbh, $DB, $uid) : ();
545my @surveys = $px_ready ? $px->list_user_surveys($db, $dbh, $DB, $uid) : ();
546
547# Optional: when the seller navigates to ?survey_results=N we render
548# the aggregated VW intersection points for that one survey on this
549# page (no separate page). Caller-scoped via PricingExperiments which
550# does the ownership check.
551my $survey_results_id = $form->{survey_results} || 0;
552$survey_results_id =~ s/[^0-9]//g;
553my %survey_results;
554if ($survey_results_id && $px_ready) {
555 my $r = $px->survey_results($db, $dbh, $DB, $uid, $survey_results_id);
556 if ($r && $r->{ok}) { %survey_results = %$r; }
557}
558
559# Format price-test rows for the template.
560my @test_rows;
561foreach my $t (@price_tests) {
562 my $rules = $t->{test_rules} || '';
563 my ($min_c, $max_c, $step_c) = (0, 0, 100);
564 if ($rules =~ /"min":\s*(\d+)/) { $min_c = $1; }
565 if ($rules =~ /"max":\s*(\d+)/) { $max_c = $1; }
566 if ($rules =~ /"step":\s*(\d+)/) { $step_c = $1; }
567 push @test_rows, {
568 id => $t->{id},
569 model_title => _h($t->{model_title} || ('Model #' . $t->{model_id})),
570 current_display => '$' . sprintf('%.2f', ($t->{current_price_cents} || 0) / 100),
571 min_display => '$' . sprintf('%.2f', $min_c / 100),
572 max_display => '$' . sprintf('%.2f', $max_c / 100),
573 step_display => '$' . sprintf('%.2f', $step_c / 100),
574 status => $t->{status} || 'draft',
575 status_label => ucfirst($t->{status} || 'draft'),
576 is_draft => ($t->{status} || '') eq 'draft' ? 1 : 0,
577 is_running => ($t->{status} || '') eq 'running' ? 1 : 0,
578 is_paused => ($t->{status} || '') eq 'paused' ? 1 : 0,
579 is_complete => ($t->{status} || '') eq 'complete' ? 1 : 0,
580 };
581}
582
583# Format survey rows. public_url is the absolute URL the seller will
584# share with respondents.
585my @survey_rows;
586my $proto = 'https';
587$proto = 'http' unless ($ENV{HTTPS} || '') =~ /^on$/i
588 || ($ENV{HTTP_X_FORWARDED_PROTO} || '') =~ /^https$/i;
589my $host = $ENV{HTTP_HOST} || 'repricer.com';
590foreach my $s (@surveys) {
591 push @survey_rows, {
592 id => $s->{id},
593 model_title => _h($s->{model_title} || ('Model #' . $s->{model_id})),
594 title => _h($s->{title} || 'Pricing survey'),
595 public_url => "$proto://$host/price_survey.cgi?t=" . ($s->{public_token} || ''),
596 response_count => $s->{response_count} || 0,
597 status => $s->{status} || 'open',
598 is_open => ($s->{status} || '') eq 'open' ? 1 : 0,
599 is_closed => ($s->{status} || '') eq 'closed' ? 1 : 0,
600 results_href => '/optimization.cgi?survey_results=' . $s->{id} . '#survey',
601 };
602}
603
604# Aggregated Van Westendorp intersections for the requested survey,
605# if any. Money formatting happens here so the template stays dumb.
606my %vw_display;
607if (%survey_results && $survey_results{n}) {
608 %vw_display = (
609 vw_n => $survey_results{n},
610 vw_pmc => '$' . sprintf('%.2f', ($survey_results{pmc} || 0) / 100),
611 vw_pme => '$' . sprintf('%.2f', ($survey_results{pme} || 0) / 100),
612 vw_opp => '$' . sprintf('%.2f', ($survey_results{opp} || 0) / 100),
613 vw_ipp => '$' . sprintf('%.2f', ($survey_results{ipp} || 0) / 100),
614 );
615}
616
617# Flash params from optimization_action.cgi.
618my $opt_flash_msg = '';
619my $opt_flash_kind = '';
620if (defined $form->{ok}) {
621 my $k = $form->{ok}; $k =~ s/[^a-z_]//g;
622 $opt_flash_kind = 'success';
623 $opt_flash_msg = 'test_created' eq $k ? 'Price test created (status: draft). Start it when you are ready.'
624 : 'test_status' eq $k ? 'Price test status updated.'
625 : 'test_deleted' eq $k ? 'Price test deleted.'
626 : 'survey_created' eq $k ? 'Survey created. Share the URL below to start collecting responses.'
627 : 'survey_closed' eq $k ? 'Survey closed -- no new responses will be accepted.'
628 : 'survey_deleted' eq $k ? 'Survey deleted.'
629 : 'Saved.';
630}
631if (defined $form->{err}) {
632 my $e = $form->{err}; $e =~ s/[^A-Za-z0-9 ._-]//g; $e = substr($e, 0, 120);
633 $opt_flash_kind = 'danger';
634 $opt_flash_msg = $e eq 'denied' ? 'Permission denied.'
635 : $e eq 'schema' ? 'Pricing-experiment tables are not migrated yet.'
636 : 'Could not complete the action: ' . $e;
637}
638
639$db->db_disconnect($dbh);
640
641my $tvars = {
642 user_id => $uid,
643 mode_new => $mode eq 'new' ? 1 : 0,
644 mode_list => $mode eq 'list' ? 1 : 0,
645 mode_detail => $mode eq 'detail' ? 1 : 0,
646 is_edit => $edit_id ? 1 : 0,
647 edit_id => $edit_id || 0,
648 has_storefront => $store_id ? 1 : 0,
649 store_id => $store_id,
650 store_name => _h($store_name),
651 user_models => \@user_models,
652 has_user_models => scalar(@user_models) ? 1 : 0,
653 layout_options => \@layout_options,
654 has_layout_options => scalar(@layout_options) ? 1 : 0,
655 theme_options => \@theme_options,
656 has_theme_options => scalar(@theme_options) ? 1 : 0,
657 custom_theme_options => \@custom_theme_options,
658 has_custom_themes => scalar(@custom_theme_options) ? 1 : 0,
659 experiments => \@experiments,
660 has_experiments => scalar(@experiments) ? 1 : 0,
661 experiment_count => scalar(@experiments),
662 # Split into three lifecycle buckets so the list view can show them
663 # as separate sections: Active (draft/running/paused), Completed
664 # (the test was called), Archived (aborted/parked).
665 experiments_active => [ grep { $_->{is_draft} || $_->{is_running} || $_->{is_paused} } @experiments ],
666 experiments_completed => [ grep { $_->{is_complete} } @experiments ],
667 experiments_archived => [ grep { $_->{is_aborted} } @experiments ],
668 has_active_experiments => (scalar(grep { $_->{is_draft} || $_->{is_running} || $_->{is_paused} } @experiments)) ? 1 : 0,
669 has_completed_experiments => (scalar(grep { $_->{is_complete} } @experiments)) ? 1 : 0,
670 has_archived_experiments => (scalar(grep { $_->{is_aborted} } @experiments)) ? 1 : 0,
671 active_count => scalar(grep { $_->{is_draft} || $_->{is_running} || $_->{is_paused} } @experiments),
672 completed_count => scalar(grep { $_->{is_complete} } @experiments),
673 archived_count => scalar(grep { $_->{is_aborted} } @experiments),
674 saved_flash => ($form->{saved} || '') eq '1' ? 1 : 0,
675
676 # Edit-mode pre-population (empty strings when in create mode).
677 edit_name => $edit_row{name} // '',
678 edit_test_type => $edit_row{test_type} // '',
679 edit_surface => $edit_row{surface} // '',
680 edit_primary_metric => $edit_row{primary_metric} // '',
681 edit_target_model_id => $edit_row{target_model_id} // 0,
682 edit_variant_count => $edit_row{edit_variant_count} // 2,
683 edit_variants => $edit_row{edit_variants} // [
684 {
685 vid=>'A', vid_lc=>'a', label=>'Variant A . Control',
686 is_control=>1, name=>'', text=>'', image_url=>'',
687 has_image=>0, layout_id=>0, theme_id=>0, custom_theme_id=>0,
688 name_field=>'variant_A_name', text_field=>'variant_A_text',
689 image_field=>'variant_A_image', image_existing_field=>'variant_A_image_existing',
690 layout_id_field=>'variant_A_layout_id',
691 theme_id_field=>'variant_A_theme_id',
692 custom_theme_id_field=>'variant_A_custom_theme_id',
693 has_custom_themes => scalar(@custom_theme_options) ? 1 : 0,
694 },
695 {
696 vid=>'B', vid_lc=>'b', label=>'Variant B . Challenger',
697 is_control=>0, name=>'', text=>'', image_url=>'',
698 has_image=>0, layout_id=>0, theme_id=>0, custom_theme_id=>0,
699 name_field=>'variant_B_name', text_field=>'variant_B_text',
700 image_field=>'variant_B_image', image_existing_field=>'variant_B_image_existing',
701 layout_id_field=>'variant_B_layout_id',
702 theme_id_field=>'variant_B_theme_id',
703 custom_theme_id_field=>'variant_B_custom_theme_id',
704 has_custom_themes => scalar(@custom_theme_options) ? 1 : 0,
705 },
706 ],
707
708 # Detail-mode payload (empty/zero when not in detail mode).
709 detail_id => $detail_row{id} // 0,
710 detail_name => $detail_row{name} // '',
711 detail_test_type => $detail_row{test_type} // '',
712 detail_surface => $detail_row{surface} // '',
713 detail_status => $detail_row{status} // '',
714 detail_metric_label => $detail_row{metric_label} // 'conversions',
715 detail_primary_metric => $detail_row{primary_metric} // '',
716 detail_traffic => $detail_row{traffic_seen} // 0,
717 detail_conf_pct => $detail_row{conf_pct} // '0.0%',
718 detail_lift_pct => $detail_row{lift_pct} // '+0.0%',
719 detail_leader_label => $detail_row{leader_label} // 'A',
720 detail_leader_rate => $detail_row{leader_rate} // '0.00%',
721 detail_loser_rate => $detail_row{loser_rate} // '0.00%',
722 detail_created => $detail_row{created_at} // '',
723 detail_started => $detail_row{start_date} // '-',
724 detail_is_running => $detail_row{is_running} // 0,
725 detail_is_draft => $detail_row{is_draft} // 0,
726 detail_is_paused => $detail_row{is_paused} // 0,
727 detail_is_complete => $detail_row{is_complete} // 0,
728 detail_has_stats => $detail_row{has_stats} // 0,
729 detail_winner_called => $detail_row{winner_called} // 0,
730 detail_too_early => $detail_row{too_early} // 0,
731 detail_below_min => $detail_row{below_min_sample}// 0,
732 detail_has_any_data => $detail_row{has_any_data} // 0,
733 detail_has_locked => $detail_row{has_locked_winner}// 0,
734 detail_locked_winner => $detail_row{locked_winner_id} // '',
735 detail_complete_confirm => $detail_row{complete_confirm}// '',
736 detail_variants => \@detail_variants,
737
738 # Tutorial flag drives the sample-data walkthrough.
739 tutorial_mode => $tutorial_mode,
740 not_tutorial_mode => $tutorial_mode ? 0 : 1,
741
742 # Price tests + Van Westendorp surveys (previously "Coming soon")
743 px_ready => $px_ready ? 1 : 0,
744 px_not_ready => $px_ready ? 0 : 1,
745 price_tests => \@test_rows,
746 has_price_tests => scalar(@test_rows) ? 1 : 0,
747 surveys => \@survey_rows,
748 has_surveys => scalar(@survey_rows) ? 1 : 0,
749 show_vw_results => (%vw_display && $vw_display{vw_n}) ? 1 : 0,
750 vw_n => $vw_display{vw_n} // 0,
751 vw_pmc => $vw_display{vw_pmc} // '-',
752 vw_pme => $vw_display{vw_pme} // '-',
753 vw_opp => $vw_display{vw_opp} // '-',
754 vw_ipp => $vw_display{vw_ipp} // '-',
755
756 opt_flash_msg => $opt_flash_msg,
757 has_opt_flash => length $opt_flash_msg ? 1 : 0,
758 opt_flash_kind => $opt_flash_kind,
759};
760
761# Tutorial-mode overlay -- sample experiments, price tests, and ideas.
762# Painted only when ?tutorial=1; nothing here touches the DB.
763if ($tutorial_mode) {
764 # Drive the same "has experiments" / list branches as the real path
765 # by feeding the template a synthetic active+completed list.
766 my @sample_active = (
767 { id=>'demo-1', name=>'Hero variant', test_type=>'AB', surface=>'hero_title',
768 status=>'running', status_label=>'Running',
769 is_draft=>0, is_running=>1, is_paused=>0, is_complete=>0, is_aborted=>0,
770 confidence=>'96.4%', lift=>'+51.5%', traffic_seen=>2841,
771 storefront=>'demo-studio.example', created_at=>'2026-05-05',
772 leader_label=>'B', leader_rate=>'5.18%', has_any_data=>1,
773 complete_confirm=>'Mark complete?' },
774 { id=>'demo-2', name=>'Bundle CTA copy', test_type=>'AB', surface=>'cta_label',
775 status=>'running', status_label=>'Running',
776 is_draft=>0, is_running=>1, is_paused=>0, is_complete=>0, is_aborted=>0,
777 confidence=>'71.0%', lift=>'+8.4%', traffic_seen=>620,
778 storefront=>'demo-studio.example', created_at=>'2026-05-08',
779 leader_label=>'B', leader_rate=>'3.10%', has_any_data=>1,
780 complete_confirm=>'Mark complete?' },
781 );
782 my @sample_completed = (
783 { id=>'demo-3', name=>'Catalog grid layout', test_type=>'MVT', surface=>'product_tile',
784 status=>'complete', status_label=>'Complete',
785 is_draft=>0, is_running=>0, is_paused=>0, is_complete=>1, is_aborted=>0,
786 confidence=>'98.1%', lift=>'+12.0%', traffic_seen=>4120,
787 storefront=>'demo-studio.example', created_at=>'2026-04-21',
788 leader_label=>'B', leader_rate=>'4.40%', has_any_data=>1,
789 complete_confirm=>'' },
790 { id=>'demo-4', name=>'Free shipping banner', test_type=>'AB', surface=>'hero_subtitle',
791 status=>'complete', status_label=>'Complete',
792 is_draft=>0, is_running=>0, is_paused=>0, is_complete=>1, is_aborted=>0,
793 confidence=>'92.0%', lift=>'-4.2%', traffic_seen=>1820,
794 storefront=>'demo-studio.example', created_at=>'2026-04-12',
795 leader_label=>'A', leader_rate=>'2.80%', has_any_data=>1,
796 complete_confirm=>'' },
797 );
798 my @sample_archived = (
799 { id=>'demo-5', name=>'Pricing card design', test_type=>'AB', surface=>'product_tile',
800 status=>'aborted', status_label=>'Aborted',
801 is_draft=>0, is_running=>0, is_paused=>0, is_complete=>0, is_aborted=>1,
802 confidence=>'-', lift=>'-', traffic_seen=>0,
803 storefront=>'demo-studio.example', created_at=>'2026-04-01',
804 leader_label=>'A', leader_rate=>'0.00%', has_any_data=>0,
805 complete_confirm=>'' },
806 );
807 my @sample_all = (@sample_active, @sample_completed, @sample_archived);
808
809 $tvars->{experiments} = \@sample_all;
810 $tvars->{has_experiments} = 1;
811 $tvars->{experiment_count} = scalar @sample_all;
812 $tvars->{experiments_active} = \@sample_active;
813 $tvars->{experiments_completed} = \@sample_completed;
814 $tvars->{experiments_archived} = \@sample_archived;
815 $tvars->{has_active_experiments} = 1;
816 $tvars->{has_completed_experiments} = 1;
817 $tvars->{has_archived_experiments} = 1;
818 $tvars->{active_count} = scalar @sample_active;
819 $tvars->{completed_count} = scalar @sample_completed;
820 $tvars->{archived_count} = scalar @sample_archived;
821 $tvars->{has_storefront} = 1;
822}
823
824print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n";
825
826my $body = join('', $tfile->template('repricer_optimization.html', $tvars, $userinfo));
827
828$wrap->render({
829 userinfo => $userinfo,
830 page_key => 'optimize',
831 title => 'Optimization',
832 body => $body,
833 extra_js => ['/assets/javascript/graphs.js'],
834});
835
836sub _h {
837 my ($s) = @_;
838 $s //= '';
839 $s =~ s/&/&amp;/g;
840 $s =~ s/</&lt;/g;
841 $s =~ s/>/&gt;/g;
842 $s =~ s/"/&quot;/g;
843 return $s;
844}
845
846# Parse the variants JSON into a list of hashes -- used to pre-populate
847# the edit form and to break out per-variant content on the detail
848# page. Mirrors the parser in MODS::RePricer::Experiments::_parse_variants
849# but lives here too so this CGI is self-contained for the rendering
850# path (the helper module is only loaded on the storefront side).
851sub _parse_variants_for_edit {
852 my ($json) = @_;
853 return () unless defined $json && length $json;
854 my @out;
855 while ($json =~ /\{"id":"([^"]+)","name":"((?:[^"\\]|\\.)*)","traffic_pct":(\d+)(?:,"target_model_id":(\d+))?,"changes":\{"text":"((?:[^"\\]|\\.)*)","image_url":"((?:[^"\\]|\\.)*)"(?:,"layout_id":(\d+))?(?:,"theme_id":(\d+))?(?:,"custom_theme_id":(\d+))?\}\}/g) {
856 my ($id, $name, $pct, $target, $text, $img, $lid, $tid, $ctid)
857 = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
858 for ($name, $text, $img) {
859 s/\\"/"/g;
860 s/\\\\/\\/g;
861 s/\\n/\n/g;
862 s/\\r/\r/g;
863 s/\\t/\t/g;
864 }
865 push @out, {
866 id => $id,
867 name => $name,
868 traffic_pct => $pct + 0,
869 target_model_id => ($target // 0) + 0,
870 text => $text,
871 image_url => $img,
872 layout_id => ($lid // 0) + 0,
873 theme_id => ($tid // 0) + 0,
874 custom_theme_id => ($ctid // 0) + 0,
875 };
876 }
877 return @out;
878}
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help