added on local at 2026-07-01 13:47:44
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs -- seller-side subscription plan manager. | |
| 4 | # | |
| 5 | # GET /subscription_plans.cgi -> list + new-form | |
| 6 | # GET /subscription_plans.cgi?id=N -> edit one plan | |
| 7 | # POST /subscription_plans.cgi (_act=) -> create / update / publish / | |
| 8 | # pause / archive / delete / | |
| 9 | # set_models | |
| 10 | #====================================================================== | |
| 11 | use strict; | |
| 12 | use warnings; | |
| 13 | ||
| 14 | use lib '/var/www/vhosts/3dshawn.com/affiliate.3dshawn.com'; | |
| 15 | use CGI; | |
| 16 | use MODS::Template; | |
| 17 | use MODS::DBConnect; | |
| 18 | use MODS::Login; | |
| 19 | use MODS::AffSoft::Config; | |
| 20 | use MODS::AffSoft::Wrapper; | |
| 21 | use MODS::AffSoft::Permissions; | |
| 22 | use MODS::AffSoft::Subscriptions; | |
| 23 | use MODS::AffSoft::Categories; | |
| 24 | ||
| 25 | $| = 1; | |
| 26 | ||
| 27 | my $q = CGI->new; | |
| 28 | my $form = $q->Vars; | |
| 29 | my $auth = MODS::Login->new; | |
| 30 | my $tfile = MODS::Template->new; | |
| 31 | my $db = MODS::DBConnect->new; | |
| 32 | my $cfg = MODS::AffSoft::Config->new; | |
| 33 | my $wrap = MODS::AffSoft::Wrapper->new; | |
| 34 | my $perm = MODS::AffSoft::Permissions->new; | |
| 35 | my $sub = MODS::AffSoft::Subscriptions->new; | |
| 36 | my $cat = MODS::AffSoft::Categories->new; | |
| 37 | my $DB = $cfg->settings('database_name'); | |
| 38 | ||
| 39 | my $userinfo = $auth->login_verify(); | |
| 40 | unless ($userinfo) { print "Status: 302 Found\nLocation: /login.cgi\n\n"; exit; } | |
| 41 | $perm->require_feature($userinfo, 'edit_models'); | |
| 42 | ||
| 43 | my $uid = $userinfo->{user_id}; $uid =~ s/[^0-9]//g; | |
| 44 | my $owner_uid = $userinfo->{owner_user_id} || $uid; | |
| 45 | $owner_uid =~ s/[^0-9]//g; | |
| 46 | ||
| 47 | my $dbh = $db->db_connect(); | |
| 48 | ||
| 49 | unless ($sub->schema_ready($db, $dbh, $DB)) { | |
| 50 | $db->db_disconnect($dbh); | |
| 51 | 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"; | |
| 52 | $wrap->render({ | |
| 53 | userinfo => $userinfo, page_key => 'subscriptions', title => 'Subscription Plans', | |
| 54 | body => qq~<div class="module"><div class="module-body" style="padding:40px;text-align:center"> | |
| 55 | <h1 style="font-family:var(--font-display);color:#fff">Subscriptions not installed yet</h1> | |
| 56 | <p style="color:var(--col-text-2);margin-top:12px">Run the subscriptions migration from <code>installation_instructions.html</code> § 5.15c, then refresh.</p> | |
| 57 | </div></div>~, | |
| 58 | }); | |
| 59 | exit; | |
| 60 | } | |
| 61 | ||
| 62 | # ---- POST ---------------------------------------------------------- | |
| 63 | if (($ENV{REQUEST_METHOD} || '') eq 'POST') { | |
| 64 | my $act = lc($form->{_act} || ''); $act =~ s/[^a-z_]//g; | |
| 65 | if ($act eq 'create') { | |
| 66 | my $id = $sub->create_plan($db, $dbh, $DB, $owner_uid, | |
| 67 | name => $form->{name}, | |
| 68 | tagline => $form->{tagline}, | |
| 69 | description => $form->{description}, | |
| 70 | kind => $form->{kind} || 'download_quota', | |
| 71 | price => $form->{price}, | |
| 72 | cadence_days => $form->{cadence_days} || 30, | |
| 73 | quota_per_period => $form->{quota_per_period} || 5, | |
| 74 | pool_kind => $form->{pool_kind} || 'all', | |
| 75 | pool_category_id => $form->{pool_category_id}, | |
| 76 | max_subscribers => $form->{max_subscribers} || 0, | |
| 77 | ); | |
| 78 | $db->db_disconnect($dbh); | |
| 79 | print "Status: 302 Found\nLocation: " . ($id ? "/subscription_plans.cgi?id=$id&ok=1" : "/subscription_plans.cgi?err=1") . "\n\n"; exit; | |
| 80 | } | |
| 81 | if ($act eq 'update') { | |
| 82 | my $id = $form->{id}; $id =~ s/[^0-9]//g; | |
| 83 | $sub->update_plan($db, $dbh, $DB, $id, $owner_uid, | |
| 84 | name => $form->{name}, | |
| 85 | tagline => $form->{tagline}, | |
| 86 | description => $form->{description}, | |
| 87 | kind => $form->{kind}, | |
| 88 | price => $form->{price}, | |
| 89 | cadence_days => $form->{cadence_days}, | |
| 90 | quota_per_period => $form->{quota_per_period}, | |
| 91 | pool_kind => $form->{pool_kind}, | |
| 92 | pool_category_id => $form->{pool_category_id}, | |
| 93 | max_subscribers => $form->{max_subscribers}, | |
| 94 | ); | |
| 95 | if (($form->{pool_kind} || '') eq 'specific') { | |
| 96 | my @ids = grep { length } split /[,\s]+/, ($form->{model_ids} || ''); | |
| 97 | $sub->set_plan_models($db, $dbh, $DB, $id, \@ids, $owner_uid); | |
| 98 | } | |
| 99 | $db->db_disconnect($dbh); | |
| 100 | print "Status: 302 Found\nLocation: /subscription_plans.cgi?id=$id&ok=1\n\n"; exit; | |
| 101 | } | |
| 102 | if ($act =~ /^(publish|pause|archive|unarchive)$/) { | |
| 103 | my $id = $form->{id}; $id =~ s/[^0-9]//g; | |
| 104 | my %map = (publish=>'active', pause=>'paused', archive=>'archived', unarchive=>'draft'); | |
| 105 | $sub->update_plan($db, $dbh, $DB, $id, $owner_uid, status => $map{$act}); | |
| 106 | $db->db_disconnect($dbh); | |
| 107 | print "Status: 302 Found\nLocation: /subscription_plans.cgi?id=$id&ok=1\n\n"; exit; | |
| 108 | } | |
| 109 | $db->db_disconnect($dbh); | |
| 110 | print "Status: 302 Found\nLocation: /subscription_plans.cgi\n\n"; exit; | |
| 111 | } | |
| 112 | ||
| 113 | # ---- GET ----------------------------------------------------------- | |
| 114 | my $is_new_form = (defined $form->{id} && $form->{id} eq 'new') ? 1 : 0; | |
| 115 | my $edit_id = ''; | |
| 116 | if (defined $form->{id} && !$is_new_form) { | |
| 117 | $edit_id = $form->{id}; $edit_id =~ s/[^0-9]//g; | |
| 118 | } | |
| 119 | my $editing = ($edit_id) ? $sub->plan_by_id($db, $dbh, $DB, $edit_id, $owner_uid) : undef; | |
| 120 | ||
| 121 | my $cats = $cat->list_for_user($db, $dbh, $DB, $owner_uid); | |
| 122 | my @cat_options; | |
| 123 | foreach my $c (@$cats) { | |
| 124 | push @cat_options, { | |
| 125 | id => $c->{id}, | |
| 126 | name => _h($c->{name}), | |
| 127 | sel => ($editing && ($editing->{pool_category_id} || 0) eq $c->{id}) ? 'selected' : '', | |
| 128 | }; | |
| 129 | } | |
| 130 | ||
| 131 | # Candidate models for the specific-pool picker. | |
| 132 | my @candidates; | |
| 133 | my %selected_model_ids; | |
| 134 | if ($editing && $editing->{pool_kind} eq 'specific') { | |
| 135 | foreach my $m (@{ $sub->plan_models($db, $dbh, $DB, $editing->{id}) }) { | |
| 136 | $selected_model_ids{$m->{model_id}} = 1; | |
| 137 | } | |
| 138 | } | |
| 139 | my @cand_rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 140 | SELECT id, title, base_price_cents, product_kind | |
| 141 | FROM `${DB}`.models | |
| 142 | WHERE user_id='$owner_uid' AND purged_at IS NULL | |
| 143 | AND status IN ('published','draft','unlisted') | |
| 144 | ORDER BY updated_at DESC, id DESC | |
| 145 | LIMIT 200 | |
| 146 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 147 | foreach my $m (@cand_rows) { | |
| 148 | push @candidates, { | |
| 149 | id => $m->{id}, | |
| 150 | title => _h($m->{title}), | |
| 151 | kind => $m->{product_kind} || 'digital', | |
| 152 | price => '$' . sprintf('%.2f', ($m->{base_price_cents} || 0) / 100), | |
| 153 | is_selected => $selected_model_ids{$m->{id}} ? 1 : 0, | |
| 154 | }; | |
| 155 | } | |
| 156 | ||
| 157 | my @list_rows; | |
| 158 | foreach my $p (@{ $sub->plans_for_user($db, $dbh, $DB, $owner_uid) }) { | |
| 159 | push @list_rows, { | |
| 160 | id => $p->{id}, | |
| 161 | name => _h($p->{name}), | |
| 162 | tagline => _h($p->{tagline} || ''), | |
| 163 | kind => $p->{kind}, | |
| 164 | kind_label => $p->{kind} eq 'ship_monthly' ? 'Ship monthly' : 'Download quota', | |
| 165 | status => $p->{status}, | |
| 166 | is_active => $p->{status} eq 'active' ? 1 : 0, | |
| 167 | is_draft => $p->{status} eq 'draft' ? 1 : 0, | |
| 168 | is_paused => $p->{status} eq 'paused' ? 1 : 0, | |
| 169 | is_archived => $p->{status} eq 'archived' ? 1 : 0, | |
| 170 | active_subs => $p->{active_subs} || 0, | |
| 171 | quota => $p->{quota_per_period}, | |
| 172 | cadence => $p->{cadence_days}, | |
| 173 | price_label => '$' . sprintf('%.2f', ($p->{price_cents} || 0) / 100), | |
| 174 | }; | |
| 175 | } | |
| 176 | ||
| 177 | $db->db_disconnect($dbh); | |
| 178 | ||
| 179 | my $flash_msg = ''; | |
| 180 | my $flash_kind = ''; | |
| 181 | if (defined $form->{ok}) { $flash_msg = 'Saved.'; $flash_kind = 'ok'; } | |
| 182 | if (defined $form->{err}) { $flash_msg = 'Save failed -- name and price required.'; $flash_kind = 'danger'; } | |
| 183 | ||
| 184 | my $tvars = { | |
| 185 | has_plans => scalar(@list_rows) ? 1 : 0, | |
| 186 | plans => \@list_rows, | |
| 187 | is_editing => ($editing || $is_new_form) ? 1 : 0, | |
| 188 | is_new_form => $is_new_form, | |
| 189 | cat_options => \@cat_options, | |
| 190 | has_cat_options=> scalar(@cat_options) ? 1 : 0, | |
| 191 | candidates => \@candidates, | |
| 192 | has_candidates => scalar(@candidates) ? 1 : 0, | |
| 193 | selected_model_ids => join(',', sort { $a <=> $b } keys %selected_model_ids), | |
| 194 | flash_msg => $flash_msg, flash_kind => $flash_kind, | |
| 195 | has_flash => length $flash_msg ? 1 : 0, | |
| 196 | }; | |
| 197 | ||
| 198 | my %d = ( | |
| 199 | edit_id => $editing ? $editing->{id} : '', | |
| 200 | name => $editing ? _h($editing->{name}) : '', | |
| 201 | tagline => $editing ? _h($editing->{tagline} || '') : '', | |
| 202 | description => $editing ? _h($editing->{description} || '') : '', | |
| 203 | price => $editing ? sprintf('%.2f', ($editing->{price_cents} || 0) / 100) : '', | |
| 204 | cadence_days => $editing ? $editing->{cadence_days} : 30, | |
| 205 | quota_per_period=> $editing ? $editing->{quota_per_period} : 5, | |
| 206 | max_subscribers => $editing ? $editing->{max_subscribers} : 0, | |
| 207 | kind => $editing ? $editing->{kind} : 'download_quota', | |
| 208 | pool_kind => $editing ? $editing->{pool_kind} : 'all', | |
| 209 | ); | |
| 210 | $tvars->{$_} = $d{$_} for keys %d; | |
| 211 | $tvars->{kind_dl_sel} = ($tvars->{kind} eq 'download_quota') ? 'selected' : ''; | |
| 212 | $tvars->{kind_ship_sel} = ($tvars->{kind} eq 'ship_monthly') ? 'selected' : ''; | |
| 213 | $tvars->{pool_all_sel} = ($tvars->{pool_kind} eq 'all') ? 'selected' : ''; | |
| 214 | $tvars->{pool_cat_sel} = ($tvars->{pool_kind} eq 'category') ? 'selected' : ''; | |
| 215 | $tvars->{pool_spec_sel} = ($tvars->{pool_kind} eq 'specific') ? 'selected' : ''; | |
| 216 | ||
| 217 | 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"; | |
| 218 | my $body = join('', $tfile->template('webstls_subscription_plans.html', $tvars, $userinfo)); | |
| 219 | $wrap->render({ | |
| 220 | userinfo => $userinfo, page_key => 'subscriptions', title => 'Subscription Plans', body => $body, | |
| 221 | }); | |
| 222 | exit; | |
| 223 | ||
| 224 | sub _h { | |
| 225 | my $s = shift // ''; | |
| 226 | $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; | |
| 227 | $s =~ s/"/"/g; $s =~ s/'/'/g; | |
| 228 | return $s; | |
| 229 | } |