added on local at 2026-07-01 13:47:26
| 1 | package MODS::AffSoft::AI; | |
| 2 | #====================================================================== | |
| 3 | # AffSoft -- AI matching via Claude API. | |
| 4 | # | |
| 5 | # Wraps Anthropic's messages API to recommend programs to affiliates | |
| 6 | # based on what they've joined, what they earn from, and the catalog | |
| 7 | # of available programs. | |
| 8 | # | |
| 9 | # Requires AFFSOFT_ANTHROPIC_KEY env var (or affsoft.anthropic_key | |
| 10 | # config setting). Without it, every call returns empty graceful. | |
| 11 | # | |
| 12 | # Model: claude-haiku-4-5 (cheap + fast, fine for ranking). | |
| 13 | # | |
| 14 | # Cache: per-affiliate, 24h, stored in users.ai_recs_json. Avoids | |
| 15 | # hammering the API every page load. | |
| 16 | # | |
| 17 | # Usage: | |
| 18 | # my $ai = MODS::AffSoft::AI->new; | |
| 19 | # my @recs = $ai->recommend_programs($db, $dbh, $DB, $affiliate_uid); | |
| 20 | # # @recs is a list of { program_id => N, reason => '...', score => 0-100 } | |
| 21 | #====================================================================== | |
| 22 | use strict; use warnings; | |
| 23 | use HTTP::Tiny; | |
| 24 | use MODS::AffSoft::Config; | |
| 25 | ||
| 26 | my $API_URL = 'https://api.anthropic.com/v1/messages'; | |
| 27 | my $MODEL = 'claude-haiku-4-5-20251001'; | |
| 28 | my $CACHE_TTL_SECONDS = 86400; # 24 hours | |
| 29 | ||
| 30 | sub new { | |
| 31 | my $class = shift; | |
| 32 | my $cfg = MODS::AffSoft::Config->new; | |
| 33 | return bless { | |
| 34 | api_key => $ENV{AFFSOFT_ANTHROPIC_KEY} | |
| 35 | || $cfg->settings('anthropic_api_key') | |
| 36 | || '', | |
| 37 | ua => HTTP::Tiny->new(timeout => 20), | |
| 38 | }, $class; | |
| 39 | } | |
| 40 | ||
| 41 | sub is_configured { | |
| 42 | my $self = shift; | |
| 43 | return $self->{api_key} =~ /^sk-/ ? 1 : 0; | |
| 44 | } | |
| 45 | ||
| 46 | # Public: get recommendations. Hits cache first. | |
| 47 | sub recommend_programs { | |
| 48 | my ($self, $db, $dbh, $DB, $uid) = @_; | |
| 49 | $uid = ($uid || 0) + 0; | |
| 50 | return () unless $uid; | |
| 51 | ||
| 52 | # Cache hit? | |
| 53 | my $cached = $db->db_readwrite($dbh, qq~ | |
| 54 | SELECT ai_recs_json, ai_recs_at, | |
| 55 | TIMESTAMPDIFF(SECOND, ai_recs_at, NOW()) AS age_s | |
| 56 | FROM ${DB}.users WHERE id = $uid LIMIT 1 | |
| 57 | ~, $0, __LINE__); | |
| 58 | if ($cached && $cached->{ai_recs_json} | |
| 59 | && defined $cached->{age_s} && $cached->{age_s} < $CACHE_TTL_SECONDS) { | |
| 60 | my @parsed = _parse_recs($cached->{ai_recs_json}); | |
| 61 | return @parsed if @parsed; | |
| 62 | } | |
| 63 | ||
| 64 | # Cache miss -- compute fresh. | |
| 65 | return () unless $self->is_configured; | |
| 66 | ||
| 67 | # Build context for the model: | |
| 68 | # 1) Affiliate's joined programs + commission stats (what they like) | |
| 69 | # 2) Open catalog (what they could pick) | |
| 70 | my @joined = $db->db_readwrite_multiple($dbh, qq~ | |
| 71 | SELECT p.id, p.name, p.description, p.commission_type, | |
| 72 | (SELECT COALESCE(SUM(commission_cents),0) | |
| 73 | FROM ${DB}.affiliate_conversions c | |
| 74 | WHERE c.affiliate_user_id = $uid | |
| 75 | AND c.program_id = p.id | |
| 76 | AND c.status IN ('approved','paid')) AS earned_cents | |
| 77 | FROM ${DB}.affiliate_programs p | |
| 78 | JOIN ${DB}.affiliate_memberships m | |
| 79 | ON m.program_id = p.id AND m.affiliate_user_id = $uid | |
| 80 | WHERE m.status = 'approved' | |
| 81 | LIMIT 20 | |
| 82 | ~, $0, __LINE__); | |
| 83 | ||
| 84 | my @catalog = $db->db_readwrite_multiple($dbh, qq~ | |
| 85 | SELECT p.id, p.name, p.description, p.commission_type, p.commission_value_cents | |
| 86 | FROM ${DB}.affiliate_programs p | |
| 87 | WHERE p.status = 'active' AND p.is_listed = 1 | |
| 88 | AND p.id NOT IN ( | |
| 89 | SELECT program_id FROM ${DB}.affiliate_memberships | |
| 90 | WHERE affiliate_user_id = $uid | |
| 91 | ) | |
| 92 | ORDER BY RAND() LIMIT 30 | |
| 93 | ~, $0, __LINE__); | |
| 94 | ||
| 95 | # Skip API call if there's nothing to recommend | |
| 96 | unless (@catalog) { | |
| 97 | $self->_write_cache($db, $dbh, $DB, $uid, '[]'); | |
| 98 | return (); | |
| 99 | } | |
| 100 | ||
| 101 | # Build prompt | |
| 102 | my $joined_text = ''; | |
| 103 | if (@joined) { | |
| 104 | $joined_text = "AFFILIATE HAS JOINED THESE PROGRAMS:\n"; | |
| 105 | for my $j (@joined) { | |
| 106 | my $earned = sprintf('%.2f', ($j->{earned_cents} || 0) / 100); | |
| 107 | my $desc = substr($j->{description} || '', 0, 200); | |
| 108 | $joined_text .= "- $j->{name} (id=$j->{id}, earned \$$earned, commission_type=$j->{commission_type}): $desc\n"; | |
| 109 | } | |
| 110 | } else { | |
| 111 | $joined_text = "AFFILIATE HAS NOT JOINED ANY PROGRAMS YET (cold start).\n"; | |
| 112 | } | |
| 113 | ||
| 114 | my $catalog_text = "AVAILABLE PROGRAMS:\n"; | |
| 115 | for my $c (@catalog) { | |
| 116 | my $desc = substr($c->{description} || '', 0, 200); | |
| 117 | $catalog_text .= "- id=$c->{id}: $c->{name} -- $desc\n"; | |
| 118 | } | |
| 119 | ||
| 120 | my $prompt = qq~You are AffSoft's program-recommendation engine. Given an affiliate's history (programs they've joined and how much they've earned from each), pick the TOP 5 programs from the catalog that best match their apparent niche / audience / earning style. | |
| 121 | ||
| 122 | $joined_text | |
| 123 | $catalog_text | |
| 124 | ||
| 125 | Return STRICTLY a JSON array (no prose, no markdown fence) of up to 5 objects: | |
| 126 | [{"program_id": 123, "reason": "one short sentence why this fits", "score": 87}, ...] | |
| 127 | ||
| 128 | Score: 0-100 (gut confidence). Highest score first.~; | |
| 129 | ||
| 130 | my $resp = $self->{ua}->post($API_URL, { | |
| 131 | headers => { | |
| 132 | 'x-api-key' => $self->{api_key}, | |
| 133 | 'anthropic-version' => '2023-06-01', | |
| 134 | 'content-type' => 'application/json', | |
| 135 | }, | |
| 136 | content => _json_encode({ | |
| 137 | model => $MODEL, | |
| 138 | max_tokens => 800, | |
| 139 | messages => [{ role => 'user', content => $prompt }], | |
| 140 | }), | |
| 141 | }); | |
| 142 | ||
| 143 | unless ($resp->{success}) { | |
| 144 | warn "[AI] Anthropic API failed: $resp->{status} $resp->{reason}"; | |
| 145 | return (); | |
| 146 | } | |
| 147 | ||
| 148 | my $body = $resp->{content} // ''; | |
| 149 | # Extract text from Anthropic response shape | |
| 150 | my ($text) = $body =~ /"text"\s*:\s*"((?:\\"|[^"])*)"/; | |
| 151 | $text //= ''; | |
| 152 | $text =~ s/\\n/\n/g; $text =~ s/\\"/"/g; | |
| 153 | # Strip any markdown fence | |
| 154 | $text =~ s/^```(?:json)?\s*//; $text =~ s/```\s*$//; | |
| 155 | ||
| 156 | # Cache + parse | |
| 157 | $self->_write_cache($db, $dbh, $DB, $uid, $text); | |
| 158 | return _parse_recs($text); | |
| 159 | } | |
| 160 | ||
| 161 | # ----- helpers -------- | |
| 162 | sub _write_cache { | |
| 163 | my ($self, $db, $dbh, $DB, $uid, $json) = @_; | |
| 164 | my $q = $json; | |
| 165 | $q =~ s/\\/\\\\/g; $q =~ s/'/\\'/g; | |
| 166 | eval { | |
| 167 | $db->db_readwrite($dbh, qq~ | |
| 168 | UPDATE ${DB}.users | |
| 169 | SET ai_recs_json = '$q', | |
| 170 | ai_recs_at = NOW() | |
| 171 | WHERE id = $uid | |
| 172 | ~, $0, __LINE__); | |
| 173 | }; | |
| 174 | } | |
| 175 | ||
| 176 | sub _parse_recs { | |
| 177 | my $text = shift // ''; | |
| 178 | return () unless $text =~ /\[/; | |
| 179 | my @recs; | |
| 180 | # Slice out objects in the array; greedy but correctness over elegance | |
| 181 | while ($text =~ /\{\s*"program_id"\s*:\s*(\d+)\s*,\s*"reason"\s*:\s*"((?:\\"|[^"])*)"\s*,\s*"score"\s*:\s*(\d+)\s*\}/g) { | |
| 182 | my ($pid, $reason, $score) = ($1, $2, $3); | |
| 183 | $reason =~ s/\\"/"/g; $reason =~ s/\\n/ /g; | |
| 184 | push @recs, { | |
| 185 | program_id => $pid + 0, | |
| 186 | reason => $reason, | |
| 187 | score => $score + 0, | |
| 188 | }; | |
| 189 | } | |
| 190 | return @recs; | |
| 191 | } | |
| 192 | ||
| 193 | sub _json_encode { | |
| 194 | my $v = shift; | |
| 195 | return 'null' unless defined $v; | |
| 196 | if (ref($v) eq 'HASH') { | |
| 197 | return '{' . join(',', map { '"' . $_ . '":' . _json_encode($v->{$_}) } sort keys %$v) . '}'; | |
| 198 | } | |
| 199 | if (ref($v) eq 'ARRAY') { | |
| 200 | return '[' . join(',', map { _json_encode($_) } @$v) . ']'; | |
| 201 | } | |
| 202 | if (!ref($v) && $v =~ /^-?\d+$/) { return $v; } | |
| 203 | my $s = "$v"; | |
| 204 | $s =~ s/\\/\\\\/g; $s =~ s/"/\\"/g; $s =~ s/\n/\\n/g; $s =~ s/\r//g; $s =~ s/\t/\\t/g; | |
| 205 | return '"' . $s . '"'; | |
| 206 | } | |
| 207 | ||
| 208 | 1; |