storm/ttyverse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Couple of bug fixes for /followers. Added /following.. Fixed the /follow command.

Browse Source
This commit is contained in:
Storm Dragon
2025-07-29 19:10:16 -04:00
parent e9ab8625bf
commit 97fc2b3082
1 changed files with 625 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ttyverse.pl
+625 -79
View File
@@ -146,6 +146,9 @@ BEGIN {
# === DIRECT MESSAGES ===
# dmpause=0 # DM refresh rate (0=use main pause)
# === NOTIFICATIONS ===
# notificationpause=0 # Notification refresh rate (0=use main pause)
# === INTERACTION ===
# mentions=0 # Show mentions in timeline
# synch=0 # Synchronous mode (blocks on requests)
@@ -237,7 +240,7 @@ EOF
signals_use_posix dostream nostreamreplies streamallreplies
nofilter
); %opts_sync = map { $_ => 1 } qw(
ansi pause dmpause ttytteristas verbose superverbose
ansi pause dmpause notificationpause ttytteristas verbose superverbose
url rlurl dmurl newline wrap notimeline lists dmidurl
queryurl track colourprompt colourme notrack
colourdm colourreply colourwarn coloursearch colourlist idurl
@@ -247,6 +250,7 @@ EOF
); %opts_urls = map {$_ => 1} qw(
url dmurl uurl rurl wurl frurl rlurl update shoreblogurl
apibase fediverseserver queryurl idurl delurl dmdelurl favsurl
notificationurl markersurl
favurl favdelurl followurl leaveurl
dmupdate credurl blockurl blockdelurl friendsurl
modifyliurl adduliurl delliurl getliurl getlisurl getfliurl
@@ -265,7 +269,7 @@ EOF
);
%opts_can_set = map { $_ => 1 } qw(
url pause dmurl dmpause dmmarkread superverbose ansi verbose
url pause dmurl dmpause notificationpause dmmarkread superverbose ansi verbose
update uurl rurl wurl avatar ttytteristas frurl track
rlurl noprompt shoreblogurl newline wrap verify autosplit
notimeline queryurl fediverseserver colourprompt colourme
@@ -672,15 +676,16 @@ if ($termrl && $termrl->ReadLine eq 'Term::ReadLine::Gnu') {
/help /? /quit /q /bye /end /e /exit
/refresh /r /thump /again /a
/dm /dmr /dmrefresh /dms /dmsent /dmagain
/notifications /notificationrefresh /nr
/replies /re /reply /timeline /timelines
/media /visibility /search /se
/media /poll /mpoll /visibility /search /se
/history /h /print /p /verbose /ve
/ruler /ru /cls /clear /url /open
/short /sh /rate /ratelimit
/track /tron /troff /trends /woeids
/notrack /set /unset /add /del
/push /pop /list /lists /listfollowers
/listfriends /dump /du /eval /ev
/listfriends /followers /following /dump /du /eval /ev
/version /update /versioncheck /updatecheck
/thread /th /entities /ent /delete
/deletelast /rtsof /vote /whois /w /me
@@ -1344,6 +1349,9 @@ $dmupdate ||= "${apibase}/statuses"; # DMs are private statuses
$dmdelurl ||= "${apibase}/statuses/%I";
$dmidurl ||= "${apibase}/statuses/%I";
$notificationurl ||= "${apibase}/notifications";
$markersurl ||= "${apibase}/markers";
$favsurl ||= "${apibase}/favourites";
$favurl ||= "${apibase}/statuses/%I/favourite";
$favdelurl ||= "${apibase}/statuses/%I/unfavourite";
@@ -1396,6 +1404,9 @@ $dmpause = 4 if (!defined $dmpause); # NOT ||= ... zero is a VALID value!
$dmpause = 0 if ($anonymous);
$dmpause = 0 if ($pause eq '0');
$dmmarkread = 1 if (!defined $dmmarkread); # Default to enabled
$notificationpause = 6 if (!defined $notificationpause); # NOT ||= ... zero is a VALID value!
$notificationpause = 0 if ($anonymous);
$notificationpause = 0 if ($pause eq '0');
$ansi = ($noansi) ? 0 :
(($ansi || $ENV{'TERM'} eq 'ansi' || $ENV{'TERM'} eq 'xterm-color')
? 1 : 0);
@@ -1404,9 +1415,11 @@ $ansi = ($noansi) ? 0 :
if ($synch) {
$pause = 0;
$dmpause = ($dmpause) ? 1 : 0;
$notificationpause = ($notificationpause) ? 1 : 0;
}
$dmcount = $dmpause;
$notificationcount = $notificationpause;
$lastshort = undef;
# ANSI sequences
@@ -2008,7 +2021,7 @@ exit(0) if (length($status));
if (length($credentials)) {
print "-- processing credentials: ";
$my_json_ref = &map_mastodon_fields(&parsejson($credentials));
$whoami = lc($my_json_ref->{'username'} || $my_json_ref->{'acct'});
$whoami = lc($my_json_ref->{'acct'} || $my_json_ref->{'username'});
if (!length($whoami)) {
print "FAILED!\nis your account suspended, or wrong token?\n";
exit;
@@ -2060,6 +2073,7 @@ if ($daemon) {
}
$parent = 0;
$dmcount = 1 if ($dmpause); # force fetch
$notificationcount = 1 if ($notificationpause); # force fetch
$is_background = 1;
DAEMONLOOP: for(;;) {
my $snooze;
@@ -2070,6 +2084,13 @@ if ($daemon) {
&update_effpause;
&refresh(0);
$dont_refresh_first_time = 0;
# Check notifications before DMs since DM refresh can return early
if ($notificationpause) {
if (!--$notificationcount) {
&notificationrefresh(0);
$notificationcount = $notificationpause;
}
}
# Move DM refresh after timeline refresh so timeline updates show even if no unread DMs
if ($dmpause) {
if (!--$dmcount) {
@@ -3124,6 +3145,12 @@ Just type to talk!
/media /path/to/file
Upload media (images, video, audio) with accessibility features
/poll Your question here
Create a single choice poll
/mpoll Your question here
Create a multiple choice poll (users can select multiple options)
/quit
Resumes your boring life.
@@ -3144,6 +3171,8 @@ USER COMMANDS:
/wagain username - combines them all
/follow username - follow a username
/leave username - stop following a username
/followers [username] - show who follows you (or username)
/following [username] - show who you follow (or username follows)
/dm username message - send a username a DM
POST AND DM SELECTION:
@@ -3239,6 +3268,7 @@ EOF
if ($dostream);
&thump;
&dmthump_no_skip if ($dmpause); # Also refresh DMs but don't skip timeline
&notificationthump if ($notificationpause); # Also refresh notifications
return 0;
}
@@ -3247,6 +3277,24 @@ EOF
my $file_path = $1;
return &handle_media_upload($file_path);
}
# Poll creation commands
if (m#^/poll\s+(.+)$#) {
my $poll_text = $1;
return &handle_poll_creation($poll_text, 0); # Single choice
}
if (m#^/poll\s*$#) {
print $stdout "-- ERROR: Poll requires question text. Usage: /poll Your question here\n";
return 0;
}
if (m#^/mpoll\s+(.+)$#) {
my $poll_text = $1;
return &handle_poll_creation($poll_text, 1); # Multiple choice
}
if (m#^/mpoll\s*$#) {
print $stdout "-- ERROR: Multiple choice poll requires question text. Usage: /mpoll Your question here\n";
return 0;
}
if (m#^/a(gain)?(\s+\+\d+)?$#) { # the asynchronous form
my $countmaybe = $2;
$countmaybe =~ s/[^\d]//g if (length($countmaybe));
@@ -3406,7 +3454,7 @@ EOF
}
# this is dual-headed and supports both lists and regular followers.
if(s#^/(frs|friends|fos|followers)(\s+\+\d+)?\s*##) {
if(s#^/(frs|friends|following|fos|followers)(\s+\+\d+)?\s*##) {
my $countmaybe = $2;
my $mode = $1;
my $arg = lc($_);
@@ -3423,9 +3471,9 @@ EOF
}
$who ||= $whoami;
if (!length($lname)) {
$what = ($mode eq 'frs' || $mode eq 'friends')
? "friends" : "followers";
$mode = ($mode eq 'frs' || $mode eq 'friends')
$what = ($mode eq 'frs' || $mode eq 'friends' || $mode eq 'following')
? "following" : "followers";
$mode = ($mode eq 'frs' || $mode eq 'friends' || $mode eq 'following')
? $friendsurl : $followersurl;
} else {
# List members/followers - fediverse only supports list members, not subscribers
@@ -3480,59 +3528,31 @@ EOF
return 0;
}
# Use proper Mastodon API endpoint with account ID
# Use proper Mastodon API endpoint with account ID - much simpler than Twitter!
my $followers_url = $mode;
$followers_url =~ s/%I/$account_id/g;
my $accounts_ref = &grabjson("$followers_url?limit=${countmaybe}", 0, 0, 0, undef, 1);
# Fediverse API directly returns account objects, no need for separate lookup
my $limit = &min($countmaybe, 80); # Mastodon default max is 80
my $accounts_ref = &grabjson("$followers_url?limit=$limit", 0, 0, 0, undef, 1);
print $stdout "-- DEBUG: API response type: " . (ref($accounts_ref) || 'not a reference') . "\n" if ($verbose);
if (ref($accounts_ref) eq 'ARRAY') {
print $stdout "-- DEBUG: Number of accounts in response: " . scalar(@{ $accounts_ref }) . "\n" if ($verbose);
}
return 0 if (!$accounts_ref || ref($accounts_ref) ne 'ARRAY');
# Fediverse (Mastodon/Pleroma/etc) returns array of account objects, extract IDs
my @ids = map { $_->{'id'} } @{ $accounts_ref };
@ids = sort { 0+$a <=> 0+$b } @ids;
# make it somewhat deterministic
my $dount = &min($countmaybe, scalar(@ids));
my $swallow = &min(100, $dount);
my @usarray = undef; shift(@usarray); # force underflow
my $l_ref = undef;
# for each block of $countper, emit
print $stdout "-- $what for $who:\n";
my $printed = 0;
FFABIO: while ($dount--) {
if (!scalar(@usarray)) {
my @next_ids;
last FFABIO if (!scalar(@ids));
# if we asked for less than 100, get
# that. otherwise,
# get the top 100 off that list (or
# the list itself, if 100 or less)
if (scalar(@ids) <= $swallow) {
@next_ids = @ids;
@ids = ();
} else {
@next_ids =
@ids[0..($swallow-1)];
@ids = @ids[$swallow..$#ids];
}
# turn it into a list to pass to
# lookupidurl and get the list
$l_ref = &postjson($lookupidurl,
"user_id=".&url_oauth_sub(join(',', @next_ids)));
last FFABIO if(ref($l_ref) ne 'ARRAY');
@usarray = sort
{ 0+($a->{'id'}) <=> 0+($b->{'id'}) }
@{ $l_ref };
last if (!scalar(@usarray));
}
&$userhandle(shift(@usarray));
for my $account (@{ $accounts_ref }) {
# Fediverse returns complete account objects - just display them
print $stdout "-- DEBUG: Processing account: " . ($account->{'username'} || 'no-username') . " / " . ($account->{'acct'} || 'no-acct') . "\n" if ($verbose);
&$userhandle($account);
$printed++;
}
print $stdout "-- sorry, no $what found for $who.\n"
if (!$printed);
print $stdout "-- sorry, no $what found for $who.\n" if (!$printed);
return 0;
}
@@ -4065,14 +4085,33 @@ m#^/(un)?f(boost|a|av|ave|avorite|avourite)? ([zZ]?[a-zA-Z]?[0-9]+)$#) {
}
# Use Mastodon's acct field (includes @domain for remote users) or username for local users
my $target;
my $acct = &descape($post->{'user'}->{'acct'} || $post->{'user'}->{'username'});
$target = $acct;
my $acct = &descape($post->{'account'}->{'acct'} || $post->{'user'}->{'acct'} || $post->{'user'}->{'username'});
# If acct doesn't include @domain and this is a remote post, construct it
if ($acct !~ /\@/ && $post->{'url'} && $post->{'url'} =~ m{^https?://([^/]+)/}) {
my $domain = $1;
if ($domain ne $fediverseserver) {
# Always ensure we have the full @domain format for federation
if ($acct =~ /\@/) {
# Already has domain, use as-is
$target = $acct;
} else {
# No domain - extract from post URL, account URI, or other sources
my $domain;
# Try multiple sources for domain information
if ($post->{'account'}->{'url'} && $post->{'account'}->{'url'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($post->{'url'} && $post->{'url'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($post->{'account'}->{'uri'} && $post->{'account'}->{'uri'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($post->{'uri'} && $post->{'uri'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
}
if ($domain) {
$target = "$acct\@$domain";
} else {
# Last resort fallback - but this should not happen for federation
print $stdout "-- WARNING: Could not determine domain for user $acct, using local server\n" if ($verbose);
$target = "$acct\@$fediverseserver";
}
}
print $stdout "-- DEBUG: Reply target acct='$post->{'user'}->{'acct'}', username='$post->{'user'}->{'username'}', url='$post->{'url'}', using='$target'\n" if ($verbose);
@@ -4105,7 +4144,36 @@ m#^/(un)?f(boost|a|av|ave|avorite|avourite)? ([zZ]?[a-zA-Z]?[0-9]+)$#) {
return 0;
}
# in the future, add DM in_reply_to here
my $target = &descape($dm->{'last_status'}->{'account'}->{'acct'} || $dm->{'last_status'}->{'account'}->{'username'});
my $acct = &descape($dm->{'last_status'}->{'account'}->{'acct'} || $dm->{'last_status'}->{'account'}->{'username'});
my $target;
# Always ensure we have the full @domain format for federation
if ($acct =~ /\@/) {
# Already has domain, use as-is
$target = $acct;
} else {
# No domain - extract from DM account URL, URI, or other sources
my $domain;
# Try multiple sources for domain information
if ($dm->{'last_status'}->{'account'}->{'url'} && $dm->{'last_status'}->{'account'}->{'url'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($dm->{'last_status'}->{'url'} && $dm->{'last_status'}->{'url'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($dm->{'last_status'}->{'account'}->{'uri'} && $dm->{'last_status'}->{'account'}->{'uri'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($dm->{'last_status'}->{'uri'} && $dm->{'last_status'}->{'uri'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
}
if ($domain) {
$target = "$acct\@$domain";
} else {
# Last resort fallback - but this should not happen for federation
print $stdout "-- WARNING: Could not determine domain for DM user $acct, using local server\n" if ($verbose);
$target = "$acct\@$fediverseserver";
}
}
if ($termrl) {
$readline_completion{'@'.lc($target)}++;
&save_completion_cache;
@@ -4128,14 +4196,33 @@ m#^/(un)?f(boost|a|av|ave|avorite|avourite)? ([zZ]?[a-zA-Z]?[0-9]+)$#) {
}
# Use Mastodon's acct field (includes @domain for remote users) or username for local users
my $target;
my $acct = &descape($post->{'user'}->{'acct'} || $post->{'user'}->{'username'});
$target = $acct;
my $acct = &descape($post->{'account'}->{'acct'} || $post->{'user'}->{'acct'} || $post->{'user'}->{'username'});
# If acct doesn't include @domain and this is a remote post, construct it
if ($acct !~ /\@/ && $post->{'url'} && $post->{'url'} =~ m{^https?://([^/]+)/}) {
my $domain = $1;
if ($domain ne $fediverseserver) {
# Always ensure we have the full @domain format for federation
if ($acct =~ /\@/) {
# Already has domain, use as-is
$target = $acct;
} else {
# No domain - extract from post URL, account URI, or other sources
my $domain;
# Try multiple sources for domain information
if ($post->{'account'}->{'url'} && $post->{'account'}->{'url'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($post->{'url'} && $post->{'url'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($post->{'account'}->{'uri'} && $post->{'account'}->{'uri'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($post->{'uri'} && $post->{'uri'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
}
if ($domain) {
$target = "$acct\@$domain";
} else {
# Last resort fallback - but this should not happen for federation
print $stdout "-- WARNING: Could not determine domain for user $acct, using local server\n" if ($verbose);
$target = "$acct\@$fediverseserver";
}
}
my $text = $_;
@@ -4284,6 +4371,12 @@ EOF
&dmthump;
return 0;
}
# Notifications
if ($_ eq '/notifications' || $_ eq '/notificationrefresh' || $_ eq '/nr') {
&notificationthump;
return 0;
}
# /dmsent, /dmagain
if (m#^/dm(s|sent|a|again)(\s+\+\d+)?$#) {
my $mode = $1;
@@ -4838,7 +4931,36 @@ sub reply_to_all {
# Get the post content and author
my $post_content = $post_ref->{'text'} || '';
my $post_author = $post_ref->{'user'}->{'acct'} || $post_ref->{'user'}->{'username'} || '';
my $acct = $post_ref->{'account'}->{'acct'} || $post_ref->{'user'}->{'acct'} || $post_ref->{'user'}->{'username'} || '';
my $post_author;
# Always ensure we have the full @domain format for federation
if ($acct =~ /\@/) {
# Already has domain, use as-is
$post_author = $acct;
} else {
# No domain - extract from post URL, account URI, or other sources
my $domain;
# Try multiple sources for domain information
if ($post_ref->{'account'}->{'url'} && $post_ref->{'account'}->{'url'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($post_ref->{'url'} && $post_ref->{'url'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($post_ref->{'account'}->{'uri'} && $post_ref->{'account'}->{'uri'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
} elsif ($post_ref->{'uri'} && $post_ref->{'uri'} =~ m{^https?://([^/]+)/}) {
$domain = $1;
}
if ($domain) {
$post_author = "$acct\@$domain";
} else {
# Last resort fallback - but this should not happen for federation
print $stdout "-- WARNING: Could not determine domain for user $acct in reply-to-all, using local server\n" if ($verbose);
$post_author = "$acct\@$fediverseserver";
}
}
# Set up reply-to ID
my $in_reply_to = $post_ref->{'id_str'} || $post_ref->{'id'};
@@ -4953,6 +5075,7 @@ sub sub_helper {
sub sync_console {
&thump;
&dmthump unless (!$dmpause);
&notificationthump unless (!$notificationpause);
}
sub sync_semaphore {
if ($synch) {
@@ -5044,6 +5167,12 @@ $stream_failure = 0;
$dm_first_time = ($dmpause) ? 1 : 0;
$dm_display_only = 0; # Flag to suppress notifications during user-initiated /dms commands
$dm_notification_sent = 0; # Flag to prevent duplicate notifications per refresh cycle
$notification_first_time = ($notificationpause) ? 1 : 0;
$notification_display_only = 0; # Flag to suppress notifications during user-initiated notification commands
$notification_notification_sent = 0; # Flag to prevent duplicate notifications per refresh cycle
$last_notification_marker = ''; # Track last read notification ID via markers API
# Notification tracking uses markers API for server-side read status
%notification_seen = (); # Hash to track seen notification IDs locally
# DM tracking now uses Mastodon's unread flag with local read tracking fallback
%dm_seen_status = (); # Hash to track seen conversation_id:last_status_id pairs
&load_dm_seen_status(); # Load persistent tracking data
@@ -5062,6 +5191,21 @@ for(;;) {
(!$effpause && !$interactive);
$dont_refresh_first_time = 0;
$previous_last_id = $last_id;
if ($notificationpause && ($effpause || $synch)) {
if ($notification_first_time) {
&notificationrefresh(0);
$notificationcount = $notificationpause;
} elsif (!$interactive) {
print $stdout "-- DEBUG: Notification countdown: $notificationcount -> " . ($notificationcount - 1) . "\n" if ($verbose);
if (!--$notificationcount) {
print $stdout "-- DEBUG: Triggering background notification refresh\n" if ($verbose);
&notificationrefresh($interactive);
$notificationcount = $notificationpause;
}
} else {
print $stdout "-- DEBUG: Skipping notification countdown (interactive=$interactive)\n" if ($verbose);
}
}
if ($dmpause && ($effpause || $synch)) {
if ($dm_first_time) {
&dmrefresh(0);
@@ -5259,7 +5403,7 @@ EOF
$key->{'tag'}->{'type'}. " ". # NO SPACES!
unpack("${pack_magic}H*", $key->{'tag'}->{'payload'}). " ".
($key->{'reblogs_count'} || "0") . " " .
($key->{'user'}->{'username'} || $key->{'user'}->{'acct'})." $ds $src|".
($key->{'user'}->{'username'} || $key->{'user'}->{'acct'})." ".($key->{'user'}->{'acct'} || $key->{'user'}->{'username'})." $ds $src|".
unpack("${pack_magic}H*", $key->{'text'}).
$space_pad), 0, 1024);
print P $key;
@@ -5414,6 +5558,11 @@ EOF
&send_repaint if ($termrl);
$dmcount = $dmpause;
goto DONT_REFRESH;
} elsif ($rout =~ /^notificationthump/) {
&notificationrefresh($interactive);
&send_repaint if ($termrl);
$notificationcount = $notificationpause;
goto DONT_REFRESH;
}
}
} else {
@@ -6661,7 +6810,23 @@ sub updatest {
} else {
if (length($user_name_dm)) {
# For DMs: include mention in status and set visibility
my $dm_status = "\@${user_name_dm} ${string}";
# Ensure we have the full @domain format for federation
my $dm_target = $user_name_dm;
if ($dm_target !~ /\@/) {
# No domain - try to find full format in completion cache
my $found_full = undef;
foreach my $cached_user (keys %readline_completion) {
if ($cached_user =~ /^\@(.+)\@(.+)$/) {
my ($cached_username) = ($1);
if (lc($cached_username) eq lc($dm_target)) {
$found_full = substr($cached_user, 1); # Remove @ prefix
last;
}
}
}
$dm_target = $found_full || $dm_target;
}
my $dm_status = "\@${dm_target} ${string}";
my $dm_urle = '';
foreach my $char (unpack("${pack_magic}C*", $dm_status)) {
my $k = chr($char);
@@ -6746,6 +6911,171 @@ EOF
return 0;
}
# refresh for notifications
sub notificationrefresh {
my $interactive = shift;
# Reset notification flag for this refresh cycle
$notification_notification_sent = 0;
if ($anonymous) {
print $stdout
"-- sorry, you can't read notifications if you're anonymous.\n"
if ($interactive);
return;
}
# no point in doing this if we can't even get to our own timeline
# (unless user specifically requested it, or our timeline is off)
return if (!$interactive && !$last_id && !$notimeline);
# Get current markers to see what's been read
my $markers_ref = &grabjson($markersurl . "?timeline[]=notifications",
0, 0, 0, undef, 1);
my $since_id = 0;
if (defined($markers_ref) && ref($markers_ref) eq 'HASH' &&
$markers_ref->{'notifications'} &&
$markers_ref->{'notifications'}->{'last_read_id'}) {
$since_id = $markers_ref->{'notifications'}->{'last_read_id'};
$last_notification_marker = $since_id;
print $stdout "-- DEBUG: Got notification marker: $since_id\n" if ($verbose);
}
# Fetch notifications since the marker
my $my_json_ref = &grabjson($notificationurl, $since_id, 0,
($interactive ? 20 : 50), undef, 1);
return if (!defined($my_json_ref) || ref($my_json_ref) ne 'ARRAY');
my $printed = 0;
my $max_id = 0;
my $disp_max = &min($print_max, scalar(@{ $my_json_ref }));
print $stdout "-- DEBUG: Notification response: " . scalar(@{ $my_json_ref }) . " notifications, disp_max=$disp_max\n" if ($verbose);
# For background refresh, check if there are any new notifications first
if (!$interactive && $disp_max) {
my $has_new = 0;
for (my $check_i = 0; $check_i < $disp_max; $check_i++) {
my $check_notif = $my_json_ref->[$check_i];
next if (!$check_notif->{'id'});
my $notif_id = $check_notif->{'id'};
# Skip if we've already seen this notification locally
if ($notification_seen{$notif_id}) {
print $stdout "-- DEBUG: Skipping notification $notif_id - already seen locally\n" if ($verbose);
next;
}
$has_new = 1;
last;
}
if (!$has_new) {
print $stdout "-- DEBUG: No new notifications found in background refresh, returning early\n" if ($verbose);
return;
}
print $stdout "-- DEBUG: Found new notifications in background refresh, proceeding\n" if ($verbose);
}
if ($disp_max) {
if ($notification_first_time) {
sleep 5 while ($suspend_output > 0);
&send_removereadline if ($termrl);
print $stdout
"-- checking for most recent notifications:\n";
$disp_max = 3;
$interactive = 1;
$notification_display_only = 1; # Suppress sounds during first-time load
print $stdout "-- DEBUG: notification_first_time: disp_max reduced to $disp_max, sounds suppressed\n" if ($verbose);
}
print $stdout "-- DEBUG: Starting notification display loop: $disp_max notifications\n" if ($verbose);
for(my $i = $disp_max; $i > 0; $i--) {
my $g = ($i-1);
my $notif = $my_json_ref->[$g];
print $stdout "-- DEBUG: Processing notification #$i (index $g)\n" if ($verbose);
# Skip if missing data
if (!$notif->{'id'} || !$notif->{'type'}) {
print $stdout "-- DEBUG: Skipping notification #$i - missing id or type\n" if ($verbose);
next;
}
my $notif_id = $notif->{'id'};
# For background refresh, skip notifications we've already seen locally
if (!$interactive) {
if ($notification_seen{$notif_id}) {
print $stdout "-- DEBUG: Skipping notification #$i - already seen locally (id: $notif_id)\n" if ($verbose);
next;
}
# Mark as seen locally for this session
$notification_seen{$notif_id} = 1;
print $stdout "-- DEBUG: Marked notification $notif_id as seen locally\n" if ($verbose);
}
# Track highest ID for marker update
my $current_id = 0+$notif_id;
$max_id = $current_id if ($current_id > $max_id);
# Process notification with proper type mapping for sounds
my $type = $notif->{'type'} || 'default';
my $sound_class = $type;
$sound_class = 'mention' if ($type eq 'mention');
$sound_class = 'boost' if ($type eq 'reblog');
$sound_class = 'favourite' if ($type eq 'favourite');
$sound_class = 'follow' if ($type eq 'follow');
print $stdout "-- DEBUG: Processing notification type '$type' as sound class '$sound_class'\n" if ($verbose);
# Use existing notification display handler
if ($notification_display_only) {
# During first-time load, display without sounds
print $stdout "-- DEBUG: Displaying notification without sound (display_only mode)\n" if ($verbose);
&$handle($notif, ''); # Empty class = no sound
} else {
&notifications_tdisplay([ $notif ]);
}
$printed++;
}
}
sleep 5 while ($suspend_output > 0);
if (($interactive || $verbose) && !$printed && !$notification_first_time) {
&send_removereadline if ($termrl);
print $stdout "-- no new notifications.\n";
$wrapseq = 1;
}
# Update marker to highest ID we processed (for background refresh or manual check)
if (!$interactive || $notification_first_time || ($interactive && $max_id > 0)) {
if ($max_id > 0) {
my $marker_data = "notifications%5Blast_read_id%5D=$max_id";
my $marker_result = &backticks($baseagent, '/dev/null', undef,
$markersurl, $marker_data, 0, @wend);
if ($? == 0) {
$last_notification_marker = $max_id;
print $stdout "-- DEBUG: Updated notification marker to $max_id\n" if ($verbose);
} else {
print $stdout "-- DEBUG: Failed to update notification marker (exit code: $?)\n" if ($verbose);
}
}
print $stdout "-- DEBUG: Updated last_notification_marker to $last_notification_marker (interactive=$interactive, notification_first_time=$notification_first_time, max_id=$max_id)\n" if ($verbose);
} else {
print $stdout "-- DEBUG: NOT updating notification marker (interactive=$interactive, keeping last_notification_marker=$last_notification_marker)\n" if ($verbose);
}
$notification_first_time = 0 if ($max_id || !scalar(@{ $my_json_ref }));
$notification_display_only = 0; # Reset sound suppression flag
print $stdout "-- notification bookmark is $last_notification_marker.\n" if ($verbose);
return 0;
}
# this dispatch routine replaces the common logic of deletest, deletedm,
# follow, leave and the favourites system.
# this is a modified, abridged version of &updatest.
@@ -6834,10 +7164,48 @@ sub foruuser {
return 1;
}
# Substitute account ID into URL template
my $api_url = $basef;
$api_url =~ s/%I/$account_id/g;
print $stdout "-- DEBUG: Calling follow/unfollow API with account_id=$account_id, basef=$basef\n" if ($verbose);
my ($en, $em) = &central_cd_dispatch("id=$account_id",
$interactive, $basef);
print $stdout "-- ok, you have $verb following user $uname.\n"
if ($interactive && !$en);
$interactive, $api_url);
print $stdout "-- DEBUG: Follow API returned - error code: $en, message length: " . length($em) . "\n" if ($verbose);
print $stdout "-- DEBUG: Follow API response: $em\n" if ($verbose && $em);
# Check for HTTP error responses in the message
if (!$en && $em && $em =~ /<title>(\d+)\s+([^<]+)<\/title>/) {
my $http_code = $1;
my $http_message = $2;
print $stdout "-- ERROR: $verb follow failed - HTTP $http_code: $http_message\n" if ($interactive);
return 1;
}
# Parse JSON response to show accurate relationship status
if (!$en && $interactive && $em) {
my $response_data = &parsejson($em);
if (ref($response_data) eq 'HASH') {
if ($verb eq 'started') {
if ($response_data->{'following'}) {
print $stdout "-- ok, you are now following user $uname.\n";
} elsif ($response_data->{'requested'}) {
print $stdout "-- ok, follow request sent to user $uname (awaiting approval).\n";
} else {
print $stdout "-- ok, you have $verb following user $uname.\n";
}
} else {
# For unfollow
if (!$response_data->{'following'} && !$response_data->{'requested'}) {
print $stdout "-- ok, you are no longer following user $uname.\n";
} else {
print $stdout "-- ok, you have $verb following user $uname.\n";
}
}
} else {
print $stdout "-- ok, you have $verb following user $uname.\n";
}
}
return 0;
}
@@ -6855,8 +7223,12 @@ sub boruuser {
return 1;
}
# Substitute account ID into URL template
my $api_url = $basef;
$api_url =~ s/%I/$account_id/g;
my ($en, $em) = &central_cd_dispatch("id=$account_id",
$interactive, $basef);
$interactive, $api_url);
print $stdout "-- ok, you have $verb blocking user $uname.\n"
if ($interactive && !$en);
return 0;
@@ -7818,17 +8190,42 @@ sub lookup_account_id {
print $stdout "-- DEBUG: Looking up account ID for username: $username\n" if ($verbose);
# Special case: if looking up our own account, use verify_credentials
if (lc($username) eq lc($whoami)) {
print $stdout "-- DEBUG: Looking up own account via verify_credentials\n" if ($verbose);
my $creds_result = &grabjson($credurl, 0, 0, 0, undef, 1);
if ($creds_result && $creds_result->{'id'}) {
print $stdout "-- DEBUG: Found own account ID: " . $creds_result->{'id'} . "\n" if ($verbose);
return $creds_result->{'id'};
}
print $stdout "-- DEBUG: Failed to get own account from verify_credentials\n" if ($verbose);
}
# Use Mastodon search API to find account
my $search_result = &grabjson("${searchurl}?q=${username}&type=accounts&limit=1", 0, 0, 0, undef, 1);
my $search_url = "${searchurl}?q=${username}&type=accounts&limit=1";
print $stdout "-- DEBUG: Search URL: $search_url\n" if ($verbose);
my $search_result = &grabjson($search_url, 0, 0, 0, undef, 1);
print $stdout "-- DEBUG: Search result: " . ($search_result ? "SUCCESS" : "FAILED") . "\n" if ($verbose);
if ($search_result && ref($search_result) eq 'HASH') {
print $stdout "-- DEBUG: Search result has accounts: " . ($search_result->{'accounts'} ? "YES" : "NO") . "\n" if ($verbose);
if ($search_result->{'accounts'}) {
print $stdout "-- DEBUG: Number of accounts found: " . scalar(@{$search_result->{'accounts'}}) . "\n" if ($verbose);
}
}
if ($search_result && $search_result->{'accounts'} && @{$search_result->{'accounts'}}) {
my $account = $search_result->{'accounts'}->[0];
my $found_username = $account->{'username'} || $account->{'acct'};
print $stdout "-- DEBUG: Found account - username: '" . ($account->{'username'} || 'null') . "', acct: '" . ($account->{'acct'} || 'null') . "'\n" if ($verbose);
# Verify we found the right account (case-insensitive match)
if (lc($found_username) eq lc($username) || lc($account->{'acct'}) eq lc($username)) {
print $stdout "-- DEBUG: Found account ID: " . $account->{'id'} . " for $username\n" if ($verbose);
return $account->{'id'};
} else {
print $stdout "-- DEBUG: Username mismatch - looking for '$username', found '$found_username'\n" if ($verbose);
}
}
@@ -7925,7 +8322,7 @@ sub defaultautocompletion {
'/orepost', '/erepost', '/frepost', '/liston',
'/listoff', '/dmsent', '/rtsof', '/rtson', '/rtsoff',
'/lists', '/withlist', '/add', '/padd', '/push',
'/pop', '/followers', '/friends', '/lfollow',
'/pop', '/followers', '/following', '/friends', '/lfollow',
'/lleave', '/listfollowers', '/listfriends',
'/unset', '/verbose', '/short', '/follow', '/unfollow',
'/doesfollow', '/search', '/tron', '/troff',
@@ -8105,8 +8502,8 @@ sub get_post {
$w->{'tag'}->{'type'},
$w->{'tag'}->{'payload'},
$w->{'reblogs_count'},
$w->{'user'}->{'username'}, $w->{'created_at'},
$l) = split(/\s/, $k, 17);
$w->{'user'}->{'username'}, $w->{'user'}->{'acct'}, $w->{'created_at'},
$l) = split(/\s/, $k, 18);
($w->{'source'}, $k) = split(/\|/, $l, 2);
$w->{'text'} = pack("H*", $k);
$w->{'place'}->{'full_name'} = pack("H*",$w->{'place'}->{'full_name'});
@@ -8220,6 +8617,7 @@ sub thump {
}
sub dmthump { print C "dmthump------------\n"; &sync_semaphore; }
sub dmthump_no_skip { print C "dmthump_no_skip----\n"; &sync_semaphore; }
sub notificationthump { print C "notificationthump--\n"; &sync_semaphore; }
sub sync_n_quit {
# Save completion cache before exiting
@@ -8663,6 +9061,154 @@ sub create_post_with_media {
}
}
##### Poll Creation Functions #####
sub handle_poll_creation {
my $poll_text = shift;
my $multiple_choice = shift || 0; # Default to single choice
my $poll_type = $multiple_choice ? "multiple choice" : "single choice";
print $stdout "Creating $poll_type poll: $poll_text\n";
# Ask for poll duration first (default 24h)
print $stdout "Poll duration (default 24h): ";
my $duration_input = <STDIN>;
chomp($duration_input);
my $expires_in = &parse_duration($duration_input);
# Collect poll options interactively
my @options = ();
my $option_num = 1;
print $stdout "Enter options (press Enter with no text to finish):\n";
while ($option_num <= 10) { # Allow up to 10 options (instance may limit to 4)
print $stdout "Option $option_num: ";
# Read user input for option
my $option = <STDIN>;
chomp($option);
# If empty input, stop collecting options
if ($option eq "") {
last;
}
# Validate option length (Mastodon limit is 50 characters)
if (length($option) > 50) {
print $stdout "-- ERROR: Option too long (max 50 characters): " . length($option) . " chars\n";
print $stdout "-- Please enter a shorter option or press Enter to skip.\n";
next; # Ask for this option again
}
# Add the option to our list
push @options, $option;
$option_num++;
}
# Validate we have at least 2 options
if (scalar(@options) < 2) {
print $stdout "-- ERROR: Poll cancelled. Need at least 2 options.\n";
return 0;
}
# Create and post the poll
return &create_poll_post($poll_text, \@options, $expires_in, $multiple_choice);
}
sub parse_duration {
my $input = shift;
# Default to 24 hours if empty
return 24 * 3600 if ($input eq "");
# Parse duration format: number + letter (h/d/m for hours/days/minutes)
if ($input =~ /^(\d+)([hdm])$/i) {
my ($num, $unit) = ($1, lc($2));
my $hours;
if ($unit eq 'h') {
$hours = $num;
} elsif ($unit eq 'd') {
$hours = $num * 24;
} elsif ($unit eq 'm') {
$hours = $num / 60.0;
}
# Validate bounds
if ($hours <= 0) {
print $stdout "-- ERROR: Invalid duration. Using default 24 hours.\n";
return 24 * 3600;
}
if ($hours > 8760) { # More than a year
print $stdout "-- WARNING: Duration capped at 365 days.\n";
$hours = 8760;
}
return int($hours * 3600); # Convert to seconds
} else {
print $stdout "-- ERROR: Invalid format. Use format like 24h, 3d, 90m. Using default 24h.\n";
return 24 * 3600;
}
}
sub create_poll_post {
my ($poll_text, $options_ref, $expires_in, $multiple_choice) = @_;
my @options = @$options_ref;
$multiple_choice = $multiple_choice || 0; # Default to single choice
# Build the poll parameters for the API
my $poll_params = '';
for my $i (0 .. $#options) {
$poll_params .= "&poll[options][]=" . &url_oauth_sub($options[$i]);
}
$poll_params .= "&poll[expires_in]=$expires_in";
$poll_params .= "&poll[multiple]=" . ($multiple_choice ? "true" : "false");
$poll_params .= "&poll[hide_totals]=false";
# Prepare the status post with poll
my $status_param = &url_oauth_sub($poll_text);
my $post_data = "status=$status_param$poll_params";
# Add visibility if set
if (defined($visibility)) {
$post_data .= "&visibility=$visibility";
}
print $stdout "-- Posting poll with " . scalar(@options) . " options...\n" if ($verbose);
# Use the same authentication method as regular posts
my $post_url = "${apibase}/statuses";
print $stdout "-- DEBUG: Poll API call: $post_url\n" if ($verbose);
print $stdout "-- DEBUG: Poll data: $post_data\n" if ($superverbose);
my $return = &backticks($baseagent, '/dev/null', undef, $post_url, $post_data, 0, @wend);
print $stdout "-- DEBUG: Poll API response length: " . length($return) . " bytes\n" if ($verbose);
if ($return =~ /"id":\s*"([^"]+)"/) {
my $post_id = $1;
print $stdout "-- Poll posted successfully (ID: $post_id)\n";
print $stdout "-- DEBUG: Poll created with ID: $post_id\n" if ($verbose);
return 1;
} else {
print $stdout "-- ERROR: Failed to create poll\n";
if ($verbose) {
print $stdout "-- DEBUG: Full poll response: $return\n";
}
# Provide helpful error messages for common issues
if ($return =~ /too many options/i || $return =~ /exceed.*options/i) {
print $stdout "-- This instance may limit polls to 4 options or fewer.\n";
} elsif ($return =~ /exceed max chars/i) {
print $stdout "-- One or more options exceed the character limit (usually 50).\n";
}
return 0;
}
}
##### optimizers -- these compile into an internal format #####
# utility routine for tquery support