added on local at 2026-07-01 13:47:40
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # AffSoft - merchant: create program. | |
| 4 | # GET -> form. POST -> validate, insert, redirect to /program.cgi?id=N. | |
| 5 | #====================================================================== | |
| 6 | use strict; | |
| 7 | use warnings; | |
| 8 | ||
| 9 | use lib '/var/www/vhosts/3dshawn.com/affiliate.3dshawn.com'; | |
| 10 | use CGI; | |
| 11 | use MODS::DBConnect; | |
| 12 | use MODS::Login; | |
| 13 | use MODS::AffSoft::Config; | |
| 14 | use MODS::AffSoft::Wrapper; | |
| 15 | ||
| 16 | my $q = CGI->new; | |
| 17 | my $form = $q->Vars; | |
| 18 | my $auth = MODS::Login->new; | |
| 19 | my $wrap = MODS::AffSoft::Wrapper->new; | |
| 20 | my $db = MODS::DBConnect->new; | |
| 21 | my $cfg = MODS::AffSoft::Config->new; | |
| 22 | my $DB = $cfg->settings('database_name'); | |
| 23 | ||
| 24 | my $userinfo = $auth->login_verify; | |
| 25 | unless ($userinfo) { | |
| 26 | print "Status: 302 Found\r\nLocation: /login.cgi\r\n\r\n"; | |
| 27 | exit; | |
| 28 | } | |
| 29 | my $uid = $userinfo->{user_id} + 0; | |
| 30 | ||
| 31 | my $error_msg = ''; | |
| 32 | my $name_val = ''; | |
| 33 | my $dest_val = ''; | |
| 34 | my $desc_val = ''; | |
| 35 | my $ctype_val = 'percent'; | |
| 36 | my $cval_val = '15'; | |
| 37 | my $window_val = '30'; | |
| 38 | ||
| 39 | if (($ENV{REQUEST_METHOD} || '') eq 'POST') { | |
| 40 | $name_val = ($form->{name} // ''); | |
| 41 | $dest_val = ($form->{destination_url} // ''); | |
| 42 | $desc_val = ($form->{description} // ''); | |
| 43 | $ctype_val = ($form->{commission_type} // 'percent'); | |
| 44 | $cval_val = ($form->{commission_value} // '0'); | |
| 45 | $window_val = ($form->{cookie_window_days} // '30'); | |
| 46 | ||
| 47 | $ctype_val = 'percent' unless $ctype_val =~ /^(percent|flat|cpa)$/; | |
| 48 | my $window_int = int($window_val); $window_int = 30 if $window_int <= 0 || $window_int > 365; | |
| 49 | ||
| 50 | # commission_value: percent UI input is "15" meaning 15.00 percent. | |
| 51 | # Store as basis points: 15 -> 1500. flat/cpa: dollars -> cents. | |
| 52 | my $cval_num = $cval_val + 0; $cval_num = 0 if $cval_num < 0; | |
| 53 | my $cval_cents = $ctype_val eq 'percent' | |
| 54 | ? int($cval_num * 100) | |
| 55 | : int($cval_num * 100); | |
| 56 | ||
| 57 | my $name_clean = $name_val; $name_clean =~ s/^\s+|\s+$//g; | |
| 58 | my $dest_clean = $dest_val; $dest_clean =~ s/^\s+|\s+$//g; | |
| 59 | ||
| 60 | if (length($name_clean) < 2) { | |
| 61 | $error_msg = 'Give the program a name your affiliates will recognize.'; | |
| 62 | } elsif ($dest_clean !~ m{^https?://[^\s]+}i) { | |
| 63 | $error_msg = 'Destination URL must start with http:// or https://'; | |
| 64 | } else { | |
| 65 | my $slug = _slugify($name_clean) . '-' . _gen_token(6); | |
| 66 | my $name_sql = _qsql($name_clean); | |
| 67 | my $dest_sql = _qsql($dest_clean); | |
| 68 | my $desc_sql = _qsql($desc_val); | |
| 69 | my $slug_sql = _qsql($slug); | |
| 70 | my $ctype_sql = _qsql($ctype_val); | |
| 71 | ||
| 72 | my $dbh = $db->db_connect; | |
| 73 | my $sql = qq~ | |
| 74 | INSERT INTO ${DB}.affiliate_programs SET | |
| 75 | merchant_user_id = $uid, | |
| 76 | slug = $slug_sql, | |
| 77 | name = $name_sql, | |
| 78 | description = $desc_sql, | |
| 79 | destination_url = $dest_sql, | |
| 80 | commission_type = $ctype_sql, | |
| 81 | commission_value_cents = $cval_cents, | |
| 82 | cookie_window_days = $window_int, | |
| 83 | status = 'active', | |
| 84 | auto_approve_affiliates = 1, | |
| 85 | is_listed = 1, | |
| 86 | created_at = NOW() | |
| 87 | ~; | |
| 88 | $db->db_readwrite($dbh, $sql, $ENV{SCRIPT_NAME}, __LINE__); | |
| 89 | my $row = $db->db_readwrite($dbh, "SELECT LAST_INSERT_ID() AS id", $ENV{SCRIPT_NAME}, __LINE__); | |
| 90 | my $new_id = ($row && $row->{id}) ? $row->{id} : 0; | |
| 91 | ||
| 92 | # Auto-create the program's default public tier so every new affiliate | |
| 93 | # has a tier to land in. Mirrors the program's commission settings. | |
| 94 | if ($new_id) { | |
| 95 | my $tier_bps = ($ctype_val eq 'percent') ? $cval_cents : 'NULL'; | |
| 96 | $db->db_readwrite($dbh, qq~ | |
| 97 | INSERT INTO ${DB}.commission_tiers SET | |
| 98 | program_id = $new_id, | |
| 99 | name = 'Default', | |
| 100 | tier_kind = 'public', | |
| 101 | is_default = 1, | |
| 102 | sort_order = 0, | |
| 103 | commission_type = $ctype_sql, | |
| 104 | commission_value_cents = $cval_cents, | |
| 105 | commission_percent_bps = $tier_bps, | |
| 106 | cascade_to_subs = 1, | |
| 107 | created_at = NOW() | |
| 108 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 109 | } | |
| 110 | ||
| 111 | $db->db_disconnect($dbh); | |
| 112 | ||
| 113 | if ($new_id) { | |
| 114 | print "Status: 302 Found\r\nLocation: /program.cgi?id=$new_id&new=1\r\n\r\n"; | |
| 115 | exit; | |
| 116 | } | |
| 117 | $error_msg = 'Could not create the program. Try again.'; | |
| 118 | } | |
| 119 | } | |
| 120 | ||
| 121 | print "Content-Type: text/html; charset=utf-8\r\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\r\nPragma: no-cache\r\nExpires: 0\r\n\r\n"; | |
| 122 | ||
| 123 | my $err_block = $error_msg ? qq~<div style="padding:12px 14px;border:1px solid rgba(239,68,68,.4);background:rgba(239,68,68,.08);color:#fca5a5;border-radius:8px;font-size:13px;margin-bottom:18px">@{[_h($error_msg)]}</div>~ : ''; | |
| 124 | ||
| 125 | my $name_esc = _h($name_val); | |
| 126 | my $dest_esc = _h($dest_val); | |
| 127 | my $desc_esc = _h($desc_val); | |
| 128 | my $cval_esc = _h($cval_val); | |
| 129 | my $win_esc = _h($window_val); | |
| 130 | my $sel_pct = $ctype_val eq 'percent' ? ' selected' : ''; | |
| 131 | my $sel_flat = $ctype_val eq 'flat' ? ' selected' : ''; | |
| 132 | my $sel_cpa = $ctype_val eq 'cpa' ? ' selected' : ''; | |
| 133 | ||
| 134 | my $body = <<HTML; | |
| 135 | <div class="page-pad" style="padding:0"> | |
| 136 | <a href="/programs.cgi" style="color:#888;font-size:13px;text-decoration:none">← Programs</a> | |
| 137 | <h1 style="margin:8px 0 6px;font-size:28px;letter-spacing:-.01em">New program</h1> | |
| 138 | <p style="color:#888;margin:0 0 32px">Define the offer, where to send traffic, and how affiliates earn.</p> | |
| 139 | $err_block | |
| 140 | <form method="POST" action="/program_new.cgi"> | |
| 141 | <div style="margin-bottom:18px"> | |
| 142 | <label style="display:block;font-size:12px;text-transform:uppercase;letter-spacing:.05em;color:#888;margin-bottom:6px">Program name</label> | |
| 143 | <input class="input" type="text" name="name" value="$name_esc" placeholder="Spring 2026 launch" required autofocus> | |
| 144 | </div> | |
| 145 | <div style="margin-bottom:18px"> | |
| 146 | <label style="display:block;font-size:12px;text-transform:uppercase;letter-spacing:.05em;color:#888;margin-bottom:6px">Destination URL</label> | |
| 147 | <input class="input" type="url" name="destination_url" value="$dest_esc" placeholder="https://your-product.com/landing" required> | |
| 148 | <div style="font-size:12px;color:#666;margin-top:4px">Where every tracking link sends visitors. Affiliates do not see this URL until they get their link.</div> | |
| 149 | </div> | |
| 150 | <div style="margin-bottom:18px"> | |
| 151 | <label style="display:block;font-size:12px;text-transform:uppercase;letter-spacing:.05em;color:#888;margin-bottom:6px">Description <span style="color:#555">(optional)</span></label> | |
| 152 | <textarea class="input" name="description" rows="3" placeholder="One paragraph for the affiliate catalog">$desc_esc</textarea> | |
| 153 | </div> | |
| 154 | <div style="display:grid;grid-template-columns:1fr 1fr;gap:14px;margin-bottom:18px"> | |
| 155 | <div> | |
| 156 | <label style="display:block;font-size:12px;text-transform:uppercase;letter-spacing:.05em;color:#888;margin-bottom:6px">Commission type</label> | |
| 157 | <select class="input" name="commission_type"> | |
| 158 | <option value="percent"$sel_pct>Percent of order</option> | |
| 159 | <option value="flat"$sel_flat>Flat per sale (\$)</option> | |
| 160 | <option value="cpa"$sel_cpa>CPA / lead (\$)</option> | |
| 161 | </select> | |
| 162 | </div> | |
| 163 | <div> | |
| 164 | <label style="display:block;font-size:12px;text-transform:uppercase;letter-spacing:.05em;color:#888;margin-bottom:6px">Commission value</label> | |
| 165 | <input class="input" type="number" name="commission_value" value="$cval_esc" step="0.01" min="0" required> | |
| 166 | <div style="font-size:12px;color:#666;margin-top:4px">For percent: <code>15</code> = 15%. For flat/CPA: dollars.</div> | |
| 167 | </div> | |
| 168 | </div> | |
| 169 | <div style="margin-bottom:24px"> | |
| 170 | <label style="display:block;font-size:12px;text-transform:uppercase;letter-spacing:.05em;color:#888;margin-bottom:6px">Attribution window (days)</label> | |
| 171 | <input class="input" type="number" name="cookie_window_days" value="$win_esc" min="1" max="365" required> | |
| 172 | <div style="font-size:12px;color:#666;margin-top:4px">How long after the click a conversion still counts. 30 days is the industry default.</div> | |
| 173 | </div> | |
| 174 | <button type="submit" class="btn btn-primary btn-block btn-lg">Create program</button> | |
| 175 | </form> | |
| 176 | </div> | |
| 177 | HTML | |
| 178 | ||
| 179 | $wrap->render({ | |
| 180 | userinfo => $userinfo, | |
| 181 | title => 'New program', | |
| 182 | body => $body, | |
| 183 | }); | |
| 184 | ||
| 185 | #---------------------------------------------------------------------- | |
| 186 | sub _h { | |
| 187 | my $s = shift // ''; | |
| 188 | $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; | |
| 189 | $s =~ s/"/"/g; $s =~ s/'/'/g; | |
| 190 | return $s; | |
| 191 | } | |
| 192 | ||
| 193 | sub _qsql { | |
| 194 | my $s = shift // ''; | |
| 195 | $s =~ s/\\/\\\\/g; | |
| 196 | $s =~ s/'/\\'/g; | |
| 197 | return "'$s'"; | |
| 198 | } | |
| 199 | ||
| 200 | sub _slugify { | |
| 201 | my $s = shift // ''; | |
| 202 | $s = lc $s; | |
| 203 | $s =~ s/[^a-z0-9]+/-/g; | |
| 204 | $s =~ s/^-+|-+$//g; | |
| 205 | $s = substr($s, 0, 40); | |
| 206 | $s = 'program' unless length $s; | |
| 207 | return $s; | |
| 208 | } | |
| 209 | ||
| 210 | sub _gen_token { | |
| 211 | my $n = shift || 12; | |
| 212 | my @c = ('a'..'z', 'A'..'Z', '0'..'9'); | |
| 213 | return join '', map { $c[int(rand(@c))] } 1..$n; | |
| 214 | } |