added on WebSTLs (webstls.com) at 2026-07-01 22:27:08
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs - Visitor long-poll endpoint | |
| 4 | # | |
| 5 | # track.js calls this every ~6 seconds with the session token. We | |
| 6 | # return any new admin chat messages + any unpushed support links. | |
| 7 | # Both are marked delivered server-side so they don't return twice. | |
| 8 | #====================================================================== | |
| 9 | use strict; | |
| 10 | use warnings; | |
| 11 | ||
| 12 | use lib '/var/www/vhosts/webstls.com/httpdocs'; | |
| 13 | use CGI; | |
| 14 | use MODS::DBConnect; | |
| 15 | use MODS::WebSTLs::Config; | |
| 16 | use MODS::WebSTLs::Tracking; | |
| 17 | ||
| 18 | my $q = CGI->new; | |
| 19 | my $db = MODS::DBConnect->new; | |
| 20 | my $cfg = MODS::WebSTLs::Config->new; | |
| 21 | my $tr = MODS::WebSTLs::Tracking->new; | |
| 22 | my $DB = $cfg->settings('database_name'); | |
| 23 | ||
| 24 | $| = 1; | |
| 25 | ||
| 26 | my $token = $q->param('token') || ''; | |
| 27 | $token =~ s/[^a-f0-9-]//g; | |
| 28 | ||
| 29 | print "Content-Type: application/json\nCache-Control: no-store\n\n"; | |
| 30 | ||
| 31 | my $dbh = $db->db_connect(); | |
| 32 | unless ($tr->schema_ready($db, $dbh, $DB)) { | |
| 33 | $db->db_disconnect($dbh); | |
| 34 | print '{"ok":0,"err":"schema_not_installed"}'; | |
| 35 | exit; | |
| 36 | } | |
| 37 | ||
| 38 | my $sess = $tr->session_by_token($db, $dbh, $DB, $token); | |
| 39 | unless ($sess && $sess->{id}) { | |
| 40 | $db->db_disconnect($dbh); | |
| 41 | print '{"ok":0,"err":"no_session"}'; | |
| 42 | exit; | |
| 43 | } | |
| 44 | ||
| 45 | # Heartbeat -- this poll counts as "visitor is alive". | |
| 46 | $tr->heartbeat($db, $dbh, $DB, $sess->{id}, $q->param('page') || ''); | |
| 47 | ||
| 48 | # Admin online state -- controls whether the chat widget shows | |
| 49 | my $admin_online = $tr->admin_online($db, $dbh, $DB); | |
| 50 | ||
| 51 | my $poll = $tr->poll_for_visitor($db, $dbh, $DB, $sess->{id}); | |
| 52 | ||
| 53 | $db->db_disconnect($dbh); | |
| 54 | ||
| 55 | # Build JSON output. Manual builder so we don't pull JSON.pm. | |
| 56 | my @msg_json; | |
| 57 | foreach my $m (@{ $poll->{messages} || [] }) { | |
| 58 | my $body = defined $m->{body} ? $m->{body} : ''; | |
| 59 | $body =~ s/\\/\\\\/g; $body =~ s/"/\\"/g; | |
| 60 | $body =~ s/\n/\\n/g; $body =~ s/\r/\\r/g; | |
| 61 | push @msg_json, qq~{"id":$m->{id},"body":"$body","sent_at":"$m->{sent_at}"}~; | |
| 62 | } | |
| 63 | my @push_json; | |
| 64 | foreach my $p (@{ $poll->{pushes} || [] }) { | |
| 65 | my $url = defined $p->{url} ? $p->{url} : ''; | |
| 66 | my $label = defined $p->{label} ? $p->{label} : ''; | |
| 67 | $url =~ s/\\/\\\\/g; $url =~ s/"/\\"/g; | |
| 68 | $label =~ s/\\/\\\\/g; $label =~ s/"/\\"/g; | |
| 69 | my $mode = $p->{open_mode} || 'new_tab'; | |
| 70 | push @push_json, qq~{"id":$p->{id},"url":"$url","label":"$label","open_mode":"$mode"}~; | |
| 71 | } | |
| 72 | ||
| 73 | print '{"ok":1,"admin_online":' . ($admin_online ? 1 : 0) | |
| 74 | . ',"messages":[' . join(',', @msg_json) . ']' | |
| 75 | . ',"pushes":[' . join(',', @push_json) . ']}'; |