added on local at 2026-07-01 16:01:18
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # ABForge -- /c.cgi visitor event collector. | |
| 4 | # Accepts a JSON POST body with: k (public key), u (uid), s (sid), | |
| 5 | # t (event type), p (page path), and event-specific fields. Writes | |
| 6 | # pageviews / events / heartbeats / heatmap rows. | |
| 7 | # | |
| 8 | # CORS-open: customer sites are on arbitrary origins. Replies with | |
| 9 | # Access-Control-Allow-Origin: * because no credentials are passed. | |
| 10 | #====================================================================== | |
| 11 | use strict; | |
| 12 | use warnings; | |
| 13 | use lib '/var/www/vhosts/3dshawn.com/abforge.3dshawn.com'; | |
| 14 | ||
| 15 | # Read STDIN BEFORE loading CGI (which would consume it for form-parsing) | |
| 16 | my $raw = ''; | |
| 17 | if (($ENV{REQUEST_METHOD} || '') eq 'POST') { | |
| 18 | my $len = int($ENV{CONTENT_LENGTH} || 0); | |
| 19 | if ($len > 0 && $len < 1_048_576) { | |
| 20 | read STDIN, $raw, $len; | |
| 21 | } | |
| 22 | } | |
| 23 | ||
| 24 | use MODS::DBConnect; | |
| 25 | use MODS::ABForge::Tracking; | |
| 26 | use JSON::PP; | |
| 27 | ||
| 28 | my $db = MODS::DBConnect->new; | |
| 29 | my $trk = MODS::ABForge::Tracking->new; | |
| 30 | my $DB = 'abforge3dshawn'; | |
| 31 | ||
| 32 | print "Access-Control-Allow-Origin: *\n"; | |
| 33 | print "Access-Control-Allow-Methods: POST, OPTIONS\n"; | |
| 34 | print "Access-Control-Allow-Headers: Content-Type\n"; | |
| 35 | print "Access-Control-Max-Age: 86400\n"; | |
| 36 | print "Cache-Control: no-store\n"; | |
| 37 | ||
| 38 | if (($ENV{REQUEST_METHOD} || '') eq 'OPTIONS') { | |
| 39 | print "Content-Type: text/plain\n\nok"; | |
| 40 | exit; | |
| 41 | } | |
| 42 | ||
| 43 | print "Content-Type: application/json\n\n"; | |
| 44 | my $body = eval { JSON::PP::decode_json($raw) }; | |
| 45 | $body ||= {}; | |
| 46 | ||
| 47 | my $dbh = $db->db_connect(); | |
| 48 | unless ($dbh) { | |
| 49 | print '{"ok":0,"error":"db_unavailable"}'; | |
| 50 | exit; | |
| 51 | } | |
| 52 | ||
| 53 | my $res = eval { $trk->ingest($dbh, $DB, $body) }; | |
| 54 | $res ||= { ok => 0, error => 'ingest_failed' }; | |
| 55 | $db->db_disconnect($dbh); | |
| 56 | ||
| 57 | print JSON::PP::encode_json($res); |