added on local at 2026-07-01 15:03:22
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # ContactForge -- campaign drain worker. | |
| 4 | # | |
| 5 | # Picks up any campaign whose status='sending' (left over from an | |
| 6 | # in-progress fan-out the user kicked off in /campaign_action.cgi) and | |
| 7 | # drains the next BATCH recipients per pass. Each recipient routes | |
| 8 | # through MODS::ContactForge::Mailer::send_bulk (BYO SMTP) and gets | |
| 9 | # a campaign_recipients row. | |
| 10 | # | |
| 11 | # Cron suggestion (server crontab for the vhost user): | |
| 12 | # */5 * * * * /usr/bin/perl \ | |
| 13 | # /var/www/vhosts/3dshawn.com/crm.3dshawn.com/_campaign_drain_worker.pl | |
| 14 | # | |
| 15 | # Runs through every sending campaign owned by every user. For each: | |
| 16 | # - confirms the owner still has an active, non-paused SMTP provider | |
| 17 | # - confirms the owner still has send-cap headroom (Caps::enforce) | |
| 18 | # - sends up to $BATCH recipients | |
| 19 | # - bumps stats_sent + stats_bounces | |
| 20 | # - flips status to 'sent' when no contacts remain queued | |
| 21 | #====================================================================== | |
| 22 | use strict; | |
| 23 | use warnings; | |
| 24 | use lib '/var/www/vhosts/3dshawn.com/crm.3dshawn.com'; | |
| 25 | ||
| 26 | use MODS::DBConnect; | |
| 27 | use MODS::ContactForge::Config; | |
| 28 | use MODS::ContactForge::Caps; | |
| 29 | use MODS::ContactForge::EmailProviders; | |
| 30 | use MODS::ContactForge::Mailer; | |
| 31 | ||
| 32 | my $BATCH = 500; # smaller than the inline UI batch (1000) so | |
| 33 | # cron passes finish in well under 5 min | |
| 34 | ||
| 35 | my $cfg = MODS::ContactForge::Config->new; | |
| 36 | my $db = MODS::DBConnect->new; | |
| 37 | my $DB = $cfg->settings('database_name'); | |
| 38 | my $dbh = $db->db_connect(); | |
| 39 | die "could not connect to $DB\n" unless $dbh; | |
| 40 | ||
| 41 | my $started = scalar localtime; | |
| 42 | ||
| 43 | # Find every campaign with queued work remaining. The DISTINCT keeps | |
| 44 | # one row per campaign even if there are thousands of recipients left. | |
| 45 | my @campaigns = $db->db_readwrite_multiple($dbh, qq~ | |
| 46 | SELECT c.id, c.owner_user_id, c.subject, c.body_html, c.stats_sent, c.stats_bounces | |
| 47 | FROM `${DB}`.campaigns c | |
| 48 | WHERE c.status='sending' | |
| 49 | ORDER BY c.id ASC | |
| 50 | ~, $0, __LINE__); | |
| 51 | ||
| 52 | my $total_sent = 0; | |
| 53 | my $total_fail = 0; | |
| 54 | my $total_camps = 0; | |
| 55 | ||
| 56 | my $eps = MODS::ContactForge::EmailProviders->new; | |
| 57 | my $caps = MODS::ContactForge::Caps->new; | |
| 58 | my $mailer = MODS::ContactForge::Mailer->new; | |
| 59 | ||
| 60 | foreach my $camp (@campaigns) { | |
| 61 | my $cid = $camp->{id}; | |
| 62 | my $uid = $camp->{owner_user_id}; | |
| 63 | ||
| 64 | # Bail if the owner lost their provider or paused it -- the next | |
| 65 | # campaign_action.cgi visit will surface the banner for them. | |
| 66 | my $prov = $eps->active_for_user_safe($db, $dbh, $DB, $uid); | |
| 67 | unless ($prov && !$prov->{paused_at} && $prov->{smtp_password_set}) { | |
| 68 | next; | |
| 69 | } | |
| 70 | ||
| 71 | # Bail if the owner blew through their send cap mid-batch. For | |
| 72 | # Business this is unreachable (overage allowed) but Pro will park | |
| 73 | # the campaign here. | |
| 74 | my ($cap_ok) = $caps->enforce($db, $dbh, $DB, $uid, 'sends'); | |
| 75 | next unless $cap_ok; | |
| 76 | ||
| 77 | # Pull next BATCH recipients not yet contacted for this campaign. | |
| 78 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 79 | SELECT c.id, c.email | |
| 80 | FROM `${DB}`.contacts c | |
| 81 | LEFT JOIN `${DB}`.campaign_recipients r | |
| 82 | ON r.campaign_id='$cid' AND r.contact_id=c.id | |
| 83 | WHERE c.owner_user_id='$uid' | |
| 84 | AND c.is_archived=0 | |
| 85 | AND c.email <> '' | |
| 86 | AND r.id IS NULL | |
| 87 | ORDER BY c.id ASC | |
| 88 | LIMIT $BATCH | |
| 89 | ~, $0, __LINE__); | |
| 90 | ||
| 91 | my $sent_n = 0; | |
| 92 | my $fail_n = 0; | |
| 93 | foreach my $row (@rows) { | |
| 94 | my $contact_id = $row->{id}; | |
| 95 | my $to = $row->{email}; | |
| 96 | next unless $to =~ /\@/; | |
| 97 | ||
| 98 | my ($ok, $msg) = $mailer->send_bulk( | |
| 99 | user_id => $uid, | |
| 100 | to => $to, | |
| 101 | subject => $camp->{subject}, | |
| 102 | body_html => $camp->{body_html}, | |
| 103 | ); | |
| 104 | ||
| 105 | my $st = $ok ? 'sent' : 'failed'; | |
| 106 | my $eq = $msg // ''; $eq =~ s/'/''/g; $eq = substr($eq, 0, 250); | |
| 107 | my $sent_at_sql = $ok ? 'NOW()' : 'NULL'; | |
| 108 | my $to_q = $to; $to_q =~ s/'/''/g; | |
| 109 | $db->db_readwrite($dbh, qq~ | |
| 110 | INSERT INTO `${DB}`.campaign_recipients | |
| 111 | (campaign_id, contact_id, email, status, sent_at, error) | |
| 112 | VALUES | |
| 113 | ('$cid', '$contact_id', '$to_q', '$st', $sent_at_sql, '$eq') | |
| 114 | ~, $0, __LINE__); | |
| 115 | if ($ok) { $sent_n++ } else { $fail_n++ } | |
| 116 | } | |
| 117 | ||
| 118 | # Update stats + status (flip to 'sent' if nothing left). | |
| 119 | my $remaining = $db->db_readwrite($dbh, qq~ | |
| 120 | SELECT COUNT(*) AS n | |
| 121 | FROM `${DB}`.contacts c | |
| 122 | LEFT JOIN `${DB}`.campaign_recipients r | |
| 123 | ON r.campaign_id='$cid' AND r.contact_id=c.id | |
| 124 | WHERE c.owner_user_id='$uid' AND c.is_archived=0 | |
| 125 | AND c.email <> '' AND r.id IS NULL | |
| 126 | ~, $0, __LINE__); | |
| 127 | my $remn = $remaining ? ($remaining->{n} || 0) : 0; | |
| 128 | my $new_status = $remn ? 'sending' : 'sent'; | |
| 129 | ||
| 130 | $db->db_readwrite($dbh, qq~ | |
| 131 | UPDATE `${DB}`.campaigns | |
| 132 | SET stats_sent=stats_sent + $sent_n, | |
| 133 | stats_bounces=stats_bounces + $fail_n, | |
| 134 | status='$new_status', | |
| 135 | updated_at=NOW() | |
| 136 | WHERE id='$cid' | |
| 137 | ~, $0, __LINE__); | |
| 138 | ||
| 139 | $total_sent += $sent_n; | |
| 140 | $total_fail += $fail_n; | |
| 141 | $total_camps++ if ($sent_n + $fail_n) > 0; | |
| 142 | ||
| 143 | # Log per-campaign tail. | |
| 144 | print STDERR "[$started] campaign $cid: sent=$sent_n fail=$fail_n remaining=$remn -> $new_status\n"; | |
| 145 | } | |
| 146 | ||
| 147 | $db->db_disconnect($dbh); | |
| 148 | ||
| 149 | print "[$started] campaign_drain_worker: $total_camps campaigns touched, $total_sent sent, $total_fail failed\n"; | |
| 150 | exit 0; |