Diff -- /var/www/vhosts/3dshawn.com/crm.3dshawn.com/_pricing_v3_smoke.pl
Diff

/var/www/vhosts/3dshawn.com/crm.3dshawn.com/_pricing_v3_smoke.pl

added on local at 2026-07-01 15:03:23

Added
+106
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to aaf1006b84bf
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# ContactForge -- pricing v3 smoke test
4# 1. Create pricetest@ai.acme.com with plan_tier=pro + 14d trial
5# 2. Verify pricing.cgi renders Pro/Business + $29/$99 + 14-day CTA
6# 3. Verify billing_plans has exactly 2 active rows
7# 4. Verify no `starter` / `studio` / `free` strings in the swept files
8# 5. Cleanup the test user
9#======================================================================
10use strict;
11use warnings;
12use lib '/var/www/vhosts/3dshawn.com/crm.3dshawn.com';
13use DBI;
14
15my $DSN = 'DBI:mysql:database=crm3dshawn;host=localhost';
16my $USER = 'crm';
17my $PASS = 'Sh@wn135';
18my $BASE = 'https://crm.3dshawn.com';
19my $EMAIL = 'pricetest@ai.acme.com';
20
21my $pass_n = 0; my $fail_n = 0;
22sub ok { my ($t, $m) = @_; if ($t) { $pass_n++; print " PASS $m\n"; } else { $fail_n++; print " FAIL $m\n"; } }
23
24my $dbh = DBI->connect($DSN, $USER, $PASS, { RaiseError => 0, PrintError => 0 })
25 or die "DBI connect failed: $DBI::errstr";
26
27# ---- 1. Create test user ---------------------------------------------
28print "\n[1] Create test user $EMAIL\n";
29$dbh->do("DELETE FROM users WHERE email=?", undef, $EMAIL);
30my $rv = $dbh->do(qq~
31 INSERT INTO users (email, password_hash, display_name, plan_tier, trial_ends_at, trial_contacts_cap)
32 VALUES (?, ?, 'PriceTest', 'pro', DATE_ADD(NOW(), INTERVAL 14 DAY), 250)
33~, undef, $EMAIL, 'x' x 60);
34ok($rv, "INSERT pricetest\@ai.acme.com");
35
36my $row = $dbh->selectrow_hashref("SELECT plan_tier, trial_ends_at, trial_contacts_cap FROM users WHERE email=?", undef, $EMAIL);
37ok($row && $row->{plan_tier} eq 'pro', "plan_tier=pro on test user");
38ok($row && $row->{trial_ends_at}, "trial_ends_at populated");
39ok($row && ($row->{trial_contacts_cap} || 0) == 250, "trial_contacts_cap=250");
40
41# ---- 2. pricing.cgi render --------------------------------------------
42print "\n[2] curl pricing.cgi\n";
43my $body = `curl -s --max-time 10 $BASE/pricing.cgi`;
44ok(length($body) > 500, "pricing.cgi returned body");
45ok($body =~ /\bPro\b/, "pricing.cgi mentions Pro");
46ok($body =~ /\bBusiness\b/, "pricing.cgi mentions Business");
47ok($body =~ /\$29\b/, "pricing.cgi mentions \$29");
48ok($body =~ /\$99\b/, "pricing.cgi mentions \$99");
49ok($body =~ /14-day free trial/i, "pricing.cgi mentions 14-day free trial");
50ok($body =~ /signup\.cgi\?plan=pro\b/, "pricing.cgi has signup.cgi?plan=pro link");
51ok($body =~ /signup\.cgi\?plan=business\b/, "pricing.cgi has signup.cgi?plan=business link");
52ok($body !~ /\bStarter\b/, "pricing.cgi has no Starter");
53ok($body !~ /\bStudio\b/, "pricing.cgi has no Studio");
54
55# ---- 3. billing_plans state -------------------------------------------
56print "\n[3] billing_plans active rows\n";
57my $active_count = $dbh->selectrow_array("SELECT COUNT(*) FROM billing_plans WHERE is_active=1");
58ok($active_count == 2, "exactly 2 active billing_plans rows (got $active_count)");
59
60my @slugs = map { $_->[0] } @{ $dbh->selectall_arrayref("SELECT slug FROM billing_plans WHERE is_active=1 ORDER BY sort_order") };
61ok(scalar(@slugs) == 2 && $slugs[0] eq 'pro' && $slugs[1] eq 'business',
62 "active slugs are (pro, business) -- got (@slugs)");
63
64my ($pro_price) = $dbh->selectrow_array("SELECT price_cents FROM billing_plans WHERE slug='pro' AND is_active=1");
65my ($biz_price) = $dbh->selectrow_array("SELECT price_cents FROM billing_plans WHERE slug='business' AND is_active=1");
66ok(($pro_price || 0) == 2900, "pro price_cents = 2900");
67ok(($biz_price || 0) == 9900, "business price_cents = 9900");
68
69# ---- 4. No legacy slugs in swept files --------------------------------
70print "\n[4] grep for legacy slugs in swept files\n";
71my $vhost = '/var/www/vhosts/3dshawn.com/crm.3dshawn.com';
72my @swept = qw(
73 pricing.cgi billing.cgi index.cgi signup.cgi admin_billing.cgi
74 MODS/ContactForge/Billing.pm MODS/ContactForge/Config.pm
75);
76foreach my $rel (@swept) {
77 my $path = "$vhost/$rel";
78 unless (-r $path) { ok(0, "$rel exists"); next; }
79 open(my $fh, '<', $path) or do { ok(0, "open $rel: $!"); next; };
80 my $found_starter = 0; my $found_studio = 0; my $found_free = 0;
81 while (my $line = <$fh>) {
82 $found_starter++ if $line =~ /\bstarter\b/i;
83 $found_studio++ if $line =~ /\bstudio\b/i;
84 $found_free++ if $line =~ /\bfree\b/i;
85 }
86 close $fh;
87 # NOTE: `free` is a common English word that appears in legit copy
88 # like "Start 14-day free trial" / "free tier is gone". We only
89 # warn (not fail) on `free` matches. starter/studio must be 0.
90 ok($found_starter == 0, "$rel has no 'starter'");
91 ok($found_studio == 0, "$rel has no 'studio'");
92 print " INFO $rel: 'free' hits=$found_free (informational; many are legit copy like 'free trial')\n";
93}
94
95# ---- 5. Cleanup ------------------------------------------------------
96print "\n[5] cleanup test user\n";
97my $del = $dbh->do("DELETE FROM users WHERE email=?", undef, $EMAIL);
98ok(($del || 0) >= 1, "test user deleted");
99
100$dbh->disconnect;
101
102# ---- Summary ----------------------------------------------------------
103print "\n=================================================\n";
104print " Smoke: $pass_n passed, $fail_n failed\n";
105print "=================================================\n";
106exit($fail_n ? 1 : 0);
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help