#!/usr/bin/perl -s
#########################################################################
#
# TTYverse - A command-line fediverse client
# Originally based on TTYtter by Cameron Kaiser
# 
# DERIVATIVE WORK: This is a derivative work of TTYtter v2.1
# Original TTYtter (c)2007-2012 Cameron Kaiser (and contributors)
# Original source: http://www.floodgap.com/software/ttytter/
# 
# Fediverse modifications and migration from Twitter to Mastodon/ActivityPub/fediverse
# This derivative work distributed under the Floodgap Free Software License
# http://www.floodgap.com/software/ffsl/
#
# If you like and want to support TTYverse, please consider becoming a patron:
# https://patreon.com/stormux
#
# After all, we're flesh and blood. -- Oingo Boingo
# If someone writes an app and no one uses it, does his code run? -- me
#
#########################################################################

require 5.005;

use File::Path qw(make_path);


# XDG configuration will be set up in the BEGIN block

BEGIN {
	# ONLY STUFF THAT MUST RUN BEFORE INITIALIZATION GOES HERE!
	# THIS FUNCTION HAS GOTTEN TOO DAMN CLUTTERED!

#	@INC = (); # wreck intentionally for testing
	# dynamically changing PERL_SIGNALS doesn't work in Perl 5.14+ (bug
	# 92246). we deal with this by forcing -signals_use_posix if the
	# environment variable wasn't already set.
	if ($] >= 5.014000 && $ENV{'PERL_SIGNALS'} ne 'unsafe') {
		$signals_use_posix = 1;
	} else {
		$ENV{'PERL_SIGNALS'} = 'unsafe';
	}
	
	$command_line = $0; $0 = "TTYverse";
	$TTYverse_VERSION = "2025.07.30";
	# this is kludgy, yes.
	$LANG = $ENV{'LANG'} || $ENV{'GDM_LANG'} || $ENV{'LC_CTYPE'} ||
			$ENV{'ALL'};
	$my_version_string = $TTYverse_VERSION;
	(warn ("$my_version_string\n"), exit) if ($version);

	# Set up XDG directories early for -create-rc and extensions
	our $config = ($ENV{'XDG_CONFIG_HOME'} || "$ENV{'HOME'}/.config") . '/ttyverse';
	our $data = ($ENV{'XDG_DATA_HOME'} || "$ENV{'HOME'}/.local/share") . '/ttyverse';
	
	# Check if directories exist; if not, create them
	unless (-d $config) {
		eval { require File::Path; File::Path::make_path($config) };
		if ($@) {
			die "Failed to create config directory: $@";
		}
	}
	
	unless (-d $data) {
		eval { require File::Path; File::Path::make_path("$data/extensions", "$data/sounds/default") };
		if ($@) {
			die "Failed to create data directory: $@";
		}
	}

	# Handle -createrc option early
	if ($createrc) {
		my $rc_path = "$config/ttyverserc";
		
		if (-e $rc_path) {
			print STDERR "-- RC file already exists: $rc_path\n";
			print STDERR "-- Remove it first or use a different RC filename\n";
			exit 0;
		}
		
		print STDERR "-- Creating default RC file: $rc_path\n";
		
		open(my $rc_fh, '>', $rc_path) or die "-- Can't create RC file: $!\n";
		
		print $rc_fh <<'EOF';
# TTYverse Configuration File
# Uncomment and modify any option you want to change from the default
# For boolean options, use 1 to enable, 0 to disable
# Lines starting with # are ignored

# === CONNECTION SETTINGS ===
# fediverseserver=mastodon.social        # Your fediverse server
# ssl=1                                  # Use SSL/HTTPS (recommended)
# authtype=oauth2                        # Always oauth2 (fediverse standard)
# apibase=                               # Custom API base URL (auto-detected)
# oauthbase=                             # Custom OAuth base URL (auto-detected)

# === AUTHENTICATION ===
# keyfile=~/.config/ttyverse/key            # Path to OAuth key file
# anonymous=0                            # Anonymous mode (not supported for fediverse)

# === TIMELINE SETTINGS ===
# pause=auto                             # Auto-refresh rate (seconds, or 'auto')
# backload=30                            # Number of posts to load initially
# wrap=120                               # Text wrapping width
# timestamp=0                            # Show timestamps (0=off, 1=on, format string for custom)
# noreblogs=0                            # Hide boost/reblog posts
# notimeline=0                           # Disable timeline display
# searchhits=20                          # Number of search results to show

# === DISPLAY SETTINGS ===
# ansi=1                                 # Use ANSI colors
# noansi=0                               # Force disable colors
# verbose=0                              # Show debug information
# superverbose=0                         # Even more debug information
# silent=0                               # Reduce output messages
# readline=0                             # Disable readline for input (enabled by default)
# readlinerepaint=0                      # Repaint readline on signals
# vcheck=1                               # Check for updates on startup
# noprompt=0                             # Disable interactive prompts
# newline=0                              # Add extra newlines

# === POST SETTINGS ===
# post_visibility=public                 # Default post visibility (public, unlisted, private, direct)
# linelength=5000                        # Maximum post length
# autosplit=0                            # Auto-split long posts
# slowpost=0                             # Slower posting for rate limiting
# verify=0                               # Verify posts before sending

# === COLORS ===
# colourprompt=CYAN                      # Prompt color
# colourme=YELLOW                        # Your posts color
# colourdm=GREEN                         # Direct message color
# colourreply=RED                        # Reply posts color
# colourwarn=MAGENTA                     # Warning message color
# coloursearch=CYAN                      # Search result color
# colourlist=OFF                         # List posts color
# colourdefault=OFF                      # Default text color

# === STREAMING API ===
# dostream=0                             # Enable streaming API (real-time updates)
# nostreamreplies=0                      # Don't stream replies
# streamallreplies=0                     # Stream all replies (not just to you)
# eventbuf=0                             # Event buffer size for streaming

# === 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)
# maxhist=19                             # Command history size
# hold=0                                 # Hold mode for piped input
# daemon=0                               # Run as daemon (background)
# script=0                               # Script mode (non-interactive)

# === LOCATION ===
# location=0                             # Include location in posts
# lat=                                   # Latitude for location
# long=                                  # Longitude for location

# === NOTIFICATIONS ===
# notifies=                              # Comma-separated list of notification types
# notifyquiet=0                          # Quiet notifications
# notifytype=                            # Type of notifications to send

# === FILTERING ===
# track=                                 # Track keywords (space-separated)
# filter=                                # Filter out posts containing these terms
# notrack=0                              # Disable tracking
# filterusers=                           # Filter posts from specific users
# filterats=                             # Filter posts with specific @mentions
# filterrts=                             # Filter boosts
# filteratonly=                          # Only show posts with @mentions
# filterflags=                           # Filter flags
# nofilter=0                             # Disable all filtering

# === LISTS ===
# lists=                                 # Comma-separated list of lists to follow

# === URL HANDLING ===
# urlopen=echo %U                        # Command to open URLs (%U = URL) - deprecated, use cli_browser/gui_browser
# cli_browser=                           # CLI browser (w3m, elinks, lynx) - auto-detected if empty
# gui_browser=                           # GUI browser (xdg-open, firefox, etc) - auto-detected if empty
# shoreblogurl=http://is.gd/api.php?longurl=  # URL shortening service

# === SYSTEM SETTINGS ===
# seven=0                                # 7-bit mode for older terminals
# oldperl=0                              # Compatibility mode for old Perl
# signals_use_posix=0                    # Use POSIX signals (auto-detected)
# nocounter=0                            # Disable character counter
# exception_is_maskable=0                # Allow masking exceptions
# simplestart=0                          # Simple startup mode
# noratelimit=0                          # Ignore rate limiting
# notco=0                                # Disable t.co URL expansion

# === ADVANCED/TECHNICAL ===
# runcommand=                            # Command to run on startup
# twarg=                                 # Legacy argument (unused)
# user=                                  # Username override
# leader=                                # Command leader character

# === EXTENSION SETTINGS ===
# Extensions can be loaded with the -exts option
# Extension preferences use the extpref_ prefix:
# extpref_sound_command=paplay           # Sound system command
# extpref_tts_synthesizer=espeak         # Text-to-speech engine
# extpref_tts_language=en-US             # TTS language
# extpref_tts_rate=175                   # TTS speaking rate
# extpref_tts_variant=                   # TTS voice variant
EOF
		
		close($rc_fh);
		print STDERR "-- RC file created successfully!\n";
		print STDERR "-- Edit $rc_path to customize your settings\n";
		print STDERR "-- Restart TTYverse to use the new settings\n";
		exit 0;
	}

	$space_pad = " " x 1024;
	$background_is_ready = 0;

	# for multi-module extension handling
	$multi_module_mode = 0;
	$multi_module_context = 0;
	$muffle_server_messages = 0;
	undef $master_store;
	undef %push_stack;


	%opts_boolean = map { $_ => 1 } qw(
		ansi noansi verbose superverbose ttytteristas noprompt
		seven silent hold daemon script anonymous readline ssl
		newline vcheck verify noratelimit notrack noreblogs notimeline
		synch exception_is_maskable mentions simplestart
		location readlinerepaint nocounter notifyquiet
		signals_use_posix dostream nostreamreplies streamallreplies
		nofilter
	); %opts_sync = map { $_ => 1 } qw(
		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
		notifies filter colourdefault backload searchhits dmsenturl
		nostreamreplies mentions wtrendurl atrendurl filterusers
		filterats filterrts filteratonly filterflags nofilter
	); %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
		creliurl delliurl deluliurl crefliurl delfliurl
		getuliurl getufliurl dmsenturl reblogurl boostsbyurl dmidurl
		statusliurl followliurl leaveliurl followersurl
		oauthurl oauthauthurl oauthaccurl oauthbase wtrendurl
		atrendurl lookupidurl
	); %opts_secret = map { $_ => 1} qw(
		superverbose ttytteristas
	); %opts_comma_delimit = map { $_ => 1 } qw(
		lists notifytype notifies filterflags filterrts filterats
		filterusers filteratonly
	); %opts_space_delimit = map { $_ => 1 } qw(
		track
	);

	   %opts_can_set = map { $_ => 1 } qw(
		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
		colourdm colourreply colourwarn coloursearch colourlist idurl
		urlopen cli_browser gui_browser delurl notrack dmdelurl favsurl
		favurl favdelurl slowpost notifies filter colourdefault
		followurl leaveurl dmupdate mentions backload
		lat long location searchhits blockurl blockdelurl woeid
		nocounter linelength friendsurl followersurl lists
		modifyliurl adduliurl delliurl getliurl getlisurl getfliurl
		creliurl delliurl deluliurl crefliurl delfliurl atrendurl
		getuliurl getufliurl dmsenturl reblogurl boostsbyurl wtrendurl
		statusliurl followliurl leaveliurl dmidurl nostreamreplies
		frupdurl filterusers filterats filterrts filterflags
		filteratonly nofilter
	); %opts_others = map { $_ => 1 } qw(
		lynx curl seven silent maxhist noansi hold status
		daemon timestamp twarg user anonymous script readline
		leader ssl rc norc vcheck apibase notifytype exts
		noreblogs synch runcommand authtype oauthkey oauthsecret
		tokenkey tokensecret credurl keyf readlinerepaint
		simplestart exception_is_maskable oldperl notco
		notify_tool_path oauthurl oauthauthurl oauthaccurl oauthbase
		signals_use_posix dostream eventbuf streamallreplies
		createrc
	); %valid = (%opts_can_set, %opts_others);
	$rc = (defined($rc) && length($rc)) ? $rc : "";
	unless ($norc) {
		my $rcf =
			($rc =~ m#^/#) ? $rc : "$config/ttyverserc${rc}";
		if (open(W, $rcf)) {
			# 5.14 sets this lazily, so this gives us a way out
			eval 'binmode(W, ":utf8")' unless ($seven);
			while(<W>) {
				chomp;
				next if (/^\s*$/ || /^#/);
				s/^-//;
				($key, $value) = split(/\=/, $_, 2);
				if ($key eq 'rc') {
			warn "** that's stupid, setting rc in an rc file\n";
				} elsif ($key eq 'norc') {
			warn "** that's dumb, using norc in an rc file\n";
				} elsif (length $$key) {
					; # carry on
				} elsif ($valid{$key} && !length($$key)) {
					$$key = $value;
				} elsif ($key =~ /^extpref_/) {
					$$key = $value;
				} elsif (!$valid{$key}) {
			warn "** setting $key not supported in this version\n";
				}
			}
			close(W);
		} elsif (length($rc)) {
			die("couldn't access rc file $rcf: $!\n".
	"to use defaults, use -norc or don't specify the -rc option.\n\n");
		}
	}
	warn "** -twarg is deprecated\n" if (length($twarg));
	$seven ||= 0;
	$oldperl ||= 0;
	$parent = $$;
	$script = 1 if (length($runcommand));
	$supreturnto = $verbose + 0;
	$postbreak_time = 0;
	$postbreak_count = 0;

	# our minimum official support is now 5.8.6.
	if ($] < 5.008006 && !$oldperl) {
		die(<<"EOF");

*** you are using a version of Perl in "extended" support: $] ***
the minimum tested version of Perl now required by TTYverse is 5.8.6.

Perl 5.005 thru 5.8.5 probably can still run TTYverse, but they are not
tested with it. if you want to suppress this warning, specify -oldperl on
the command line, or put oldperl=1 in your .ttytterrc. bug patches will 
still be accepted for older Perls; see the TTYverse home page for info.

for Perl 5.005, remember to also specify -seven.

EOF
	}

	# defaults that our extensions can override
	$last_id = 0;
	$last_dm = 0;
	# a correct fix for -daemon would make this unlimited, but this
	# is good enough for now.
	$print_max ||= ($daemon) ? 999999 : 250; # shiver

	$suspend_output = -1;

	# Initialize SSL and HTTP protocol early for endpoint configuration
	$ssl ||= 1;
	$http_proto = ($ssl) ? 'https' : 'http';

	# Configure all API endpoints for a specific fediverse server
	sub configure_fediverse_endpoints {
		my $server = shift;
		
		# Update base URLs
		$oauthbase = "${http_proto}://${server}";
		$apibase = "${http_proto}://${server}/api/v1";
		
		# Update all API endpoints to use the new server
		$url = "${apibase}/timelines/home";
		$oauthurl = "${oauthbase}/api/v1/apps";
		$oauthauthurl = "${oauthbase}/oauth/authorize";
		$oauthaccurl = "${oauthbase}/oauth/token";
		$credurl = "${apibase}/accounts/verify_credentials";
		$update = "${apibase}/statuses";
		$rurl = "${apibase}/timelines/home"; 
		$uurl = "${apibase}/accounts/%I/statuses";
		$idurl = "${apibase}/statuses/%I";
		$delurl = "${apibase}/statuses/%I";
		$reblogurl = "${apibase}/statuses/%I/reblog";
		$wurl = "${apibase}/accounts/%I";
		$followurl = "${apibase}/accounts/%I/follow";
		$leaveurl = "${apibase}/accounts/%I/unfollow";
		$blockurl = "${apibase}/accounts/%I/block";
		$blockdelurl = "${apibase}/accounts/%I/unblock";
		$favurl = "${apibase}/statuses/%I/favourite";
		$favdelurl = "${apibase}/statuses/%I/unfavourite";
		$blockingurl = "${apibase}/accounts/relationships?id[]=%I";
		$dmurl = "${apibase}/conversations";
		$directurl = "${apibase}/conversations";
		$listurl = "${apibase}/lists/%I/accounts";
		$murl = "${apibase}/timelines/home";
		$streamurl = "${oauthbase}/api/v1/streaming/user";
		$publicurl = "${apibase}/timelines/public";
		$searchurl = "${oauthbase}/api/v2/search";
		$trendsurl = "${apibase}/trends";
	}


	# XDG config directory already set up earlier

	# Check for deprecated -keyf parameter and error out
	if (defined($keyf)) {
		die("** Error: -keyf is deprecated. Use -keyfile instead.\n** Example: ./ttyverse.pl -keyfile test -oauthwizard\n");
	}

	# Handle command line argument parsing for keyfile
	# Perl's -s flag makes -keyfile without = set $keyfile=1, so fix this
	if (defined($keyfile) && $keyfile eq '1' && @ARGV && $ARGV[0] !~ /^-/) {
		$keyfile = shift @ARGV;  # Take the next argument as the keyfile path
		# If it's a relative path, put it in the config directory
		if ($keyfile !~ m|^/|) {  # Not an absolute path
			$keyfile = "$config/$keyfile";
		}
		# Process remaining flags that Perl's -s might have missed
		while (@ARGV && $ARGV[0] =~ /^-(\w+)$/) {
			my $flag = $1;
			shift @ARGV;
			if ($flag eq 'oauthwizard') { $oauthwizard = 1; }
			elsif ($flag eq 'retoke') { $retoke = 1; }
			elsif ($flag eq 'verbose') { $verbose = 1; }
			# Add other flags as needed
		}
	}

	# try to find an OAuth keyfile if we haven't specified key+secret
	# no worries if this fails; we could be Basic Auth, after all
	my $user_specified_keyfile = length($keyfile) ? 1 : 0;
	# Only set default keyfile path if none specified
	if (!$keyfile) {
		$keyfile = "$config/key";
	}
	$whine = $user_specified_keyfile;
	$attempted_keyfile = $keyfile;
	if (!length($oauthkey) && !length($oauthsecret) # set later
			&& !length($tokenkey)
			&& !length($tokensecret) && !$oauthwizard) {
		my $keybuf = '';
		if(open(W, $keyfile)) {
			while(<W>) {
				chomp;
				s/\s+//g;
				$keybuf .= $_;
			}
			close(W);
			my (@pairs) = split(/\&/, $keybuf);
			foreach(@pairs) {
				my (@pair) = split(/\=/, $_, 2);
				# OAuth 1.0a format (fediverse legacy)
				$oauthkey = $pair[1]
					if ($pair[0] eq 'ck');
				$oauthsecret = $pair[1]
					if ($pair[0] eq 'cs');
				$tokenkey = $pair[1]
					if ($pair[0] eq 'at');
				$tokensecret = $pair[1]
					if ($pair[0] eq 'ats');
				# OAuth 2.0 format (Mastodon/fediverse)
				$oauthkey = $pair[1]
					if ($pair[0] eq 'client_id');
				$oauthsecret = $pair[1]
					if ($pair[0] eq 'client_secret');
				$tokenkey = $pair[1]
					if ($pair[0] eq 'access_token');
				$oauth2_refresh_token = $pair[1]
					if ($pair[0] eq 'refresh_token');
				# Load the server from keyfile for OAuth 2.0
				if ($pair[0] eq 'server') {
					$fediverseserver = $pair[1];
					&configure_fediverse_endpoints($fediverseserver);
				}
			}
			# Validate OAuth credentials - OAuth 2.0 doesn't need tokensecret
			my $oauth_valid = 0;
			if (length($oauthkey) && length($oauthsecret) && length($tokenkey)) {
				# Fediverse uses OAuth 2.0 format (no token secret needed)
				$oauth_valid = 1;
				$authtype = 'oauth2';
			}
			die("** tried to load OAuth tokens from $keyfile\n".
	"  but it seems corrupt or incomplete. please see the documentation,\n".
	"  or delete the file so that we can try making your keyfile again.\n")
				unless ($oauth_valid);
		} else {
			die("** couldn't open keyfile $keyfile: $!\n".
	"if you want to run the OAuth wizard to create this file, add ".
				"-oauthwizard\n")
				if ($whine);
			$keyfile = ''; # i.e., we loaded nothing from a key file
		}
	}

	# try to init Term::ReadLine if it was requested
	# (shakes fist at @br3nda, it's all her fault)
	our %readline_completion = ();
	$readline = 1 if (!defined $readline); # Enable readline by default
	print STDOUT "-- DEBUG: readline=$readline, silent=$silent, script=$script\n" if ($verbose);
	if ($readline && !$silent && !$script) {
		$ENV{"PERL_RL"} = "Gnu" if (!length($ENV{'PERL_RL'}));
		print STDOUT "-- DEBUG: PERL_RL set to: $ENV{'PERL_RL'}\n" if ($verbose);
		print STDOUT "-- DEBUG: TERM environment: $ENV{'TERM'}\n" if ($verbose);
		eval
'use Term::ReadLine; $termrl = new Term::ReadLine ("TTYverse", \*STDIN, \*STDOUT)';
		if ($@) {
			print STDOUT "-- ReadLine not available, disabling readline features\n" if ($verbose);
			$readline = 0;
			$termrl = undef;
		} else {
			$stdout = $termrl->OUT || \*STDOUT;
			$stdin = $termrl->IN || \*STDIN;
			print $stdout "-- DEBUG: ReadLine implementation: " . $termrl->ReadLine . "\n" if ($verbose);
			print $stdout "-- DEBUG: ReadLine features: " . join(", ", $termrl->Features) . "\n" if ($verbose);
		}
	}
	if (!$readline || $silent || $script || !$termrl) {
		$stdout = \*STDOUT;
		$stdin = \*STDIN;
	} else {
		$readline = '' if ($readline eq '1');
		$readline =~ s/^"//; # for optimizer
		$readline =~ s/"$//;
		#$termrl->Attribs()->{'autohistory'} = undef; # not yet
		# Merge readline config completions with existing completions (don't overwrite)
		my %config_completions = map {$_ => 1} split(/\s+/, $readline);
		%original_readline = %config_completions;
		# Add config completions to our existing hash instead of replacing it
		my $before_count = scalar(keys %readline_completion);
		%readline_completion = (%readline_completion, %config_completions);
		my $after_count = scalar(keys %readline_completion);
		print $stdout "-- merged " . scalar(keys %config_completions) . " config completions (before: $before_count, after: $after_count)\n" if ($verbose);
		# readline repaint can't be tested here. we cache our
		# result later.
	}
	$wrapseq = 0;
	$lastlinelength = -1;

	print $stdout "$leader\n" if (length($leader));

	# state information
	$lasttwit = '';
	$lastpostid = 0;

	# stub namespace for multimodules and (eventually) state saving
	undef %store;
	$store = \%store;

	$pack_magic = ($] < 5.006) ? '' : "U0";
	$utf8_encode = sub { ; };
	$utf8_decode = sub { ; };
	unless ($seven) {
		eval
'use utf8;binmode($stdin,":utf8");binmode($stdout,":utf8");return 1' ||
	die("$@\nthis perl doesn't fully support UTF-8. use -seven.\n");

	# this is for the prinput utf8 validator.
	# adapted from http://mail.nl.linux.org/linux-utf8/2003-03/msg00087.html
	# eventually this will be removed when 5.6.x support is removed,
	# and Perl will do the UTF-8 validation for us.
		$badutf8='[\x00-\x7f][\x80-\xbf]+|^[\x80-\xbf]+|'.
			 '[\xc0-\xdf][\x00-\x7f\xc0-\xff]|'.
	 		 '[\xc0-\xdf][\x80-\xbf]{2}|'.
	 		 '[\xe0-\xef][\x80-\xbf]{0,1}[\x00-\x7f\xc0-\xff]|'.
	 		 '[\xe0-\xef][\x80-\xbf]{3}|'.
	 		 '[\xf0-\xf7][\x80-\xbf]{0,2}[\x00-\x7f\xc0-\xff]|'.
	 		 '[\xf0-\xf7][\x80-\xbf]{4}|'.
	 		 '[\xf8-\xfb][\x80-\xbf]{0,3}[\x00-\x7f\xc0-\xff]|'.
	 		 '[\xf8-\xfb][\x80-\xbf]{5}|'.
	 	'[\xfc-\xfd][\x80-\xbf]{0,4}[\x00-\x7f\xc0-\xff]|'.
			'\xed[\xa0-\xbf][\x80-\xbf]|'.
			'\xef\xbf[\xbe-\xbf]|'.
 			'[\xf0-\xf7][\x8f,\x9f,\xaf,\xbf]\xbf[\xbe-\xbf]|'.
			'\xfe|\xff|'.
	 		 '[\xc0-\xc1][\x80-\xbf]|'.
	 		 '\xe0[\x80-\x9f][\x80-\xbf]|'.
	 		 '\xf0[\x80-\x8f][\x80-\xbf]{2}|'.
	 		 '\xf8[\x80-\x87][\x80-\xbf]{3}|'.
	 		 '\xfc[\x80-\x83][\x80-\xbf]{4}'; # gah!

		eval <<'EOF';
		$utf8_encode = sub { utf8::encode(shift); };
		$utf8_decode = sub { utf8::decode(shift); };
EOF
	}
	$wraptime = sub { my $x = shift; return ($x, $x); };
	if ($timestamp) {
		my $fail = "-- can't use custom timestamps.\nspecify -timestamp by itself to use fediverse's without module.\n";
		if (length($timestamp) > 1) { # pattern specified
			eval 'use Date::Parse;return 1' ||
				die("$@\nno Date::Parse $fail");
			eval 'use Date::Format;return 1' ||
				die("$@\nno Date::Format $fail");
			$timestamp = "%Y-%m-%d %k:%M:%S"
				if ($timestamp eq "default" ||
				    $timestamp eq "def");
			$wraptime = sub {
				my $time = str2time(shift);
				my $stime = time2str($timestamp, $time);
				return ($time, $stime);
			};
		}
	}
}
END {
	&killkid unless ($in_backticks || $in_buffer); # this is disgusting
}

#### COMMON STARTUP ####

# if we requested POSIX signals, or we NEED posix signals (5.14+), we
# must check if we have POSIX signals actually
if ($signals_use_posix) {
	eval 'use POSIX';
	# God help the system that doesn't have SIGTERM
	$j = eval 'return POSIX::SIGTERM' ;
	die(<<"EOF") if (!(0+$j));
*** death permeates me ***
your configuration requires using POSIX signalling (either Perl 5.14+ or
you specifically asked with -signals_use_posix). however, either you don't
have POSIX.pm, or it doesn't work. 

TTYverse requires 'unsafe' Perl signals (which are of course for its
purposes perfectly safe). unfortunately, due to Perl bug 92246 5.14+ must
use POSIX.pm, or have the switch set before starting TTYverse. run one of
 
export PERL_SIGNALS=unsafe # sh, bash, ksh, etc.
setenv PERL_SIGNALS unsafe # csh, tcsh, etc.
 
and restart TTYverse, or use Perl 5.12 or earlier (without specifying
-signals_use_posix).
EOF
}

# do we have POSIX::Termios? (usually we do)
eval 'use POSIX; $termios = new POSIX::Termios;';
print $stdout "-- termios test: $termios\n" if ($verbose);

# Term::ReadLine::Gnu is well-maintained and compatible
if ($termrl && $termrl->ReadLine eq 'Term::ReadLine::Gnu') {
	print $stdout "-- using Term::ReadLine::Gnu for enhanced readline support\n" if ($verbose);
	
	# Set up comprehensive tab completion
	my $attribs = $termrl->Attribs;
	
	# Dynamically extract all commands from the source code
	my @commands = ();
	{
		# Read our own source file to extract commands
		# Try multiple possible filenames
		my $source_file = $0;
		$source_file = 'ttyverse.pl' if (!-f $source_file && -f 'ttyverse.pl');
		$source_file = './ttyverse.pl' if (!-f $source_file && -f './ttyverse.pl');
		
		my $source = '';
		if (-f $source_file) {
			open(my $fh, '<', $source_file) or warn "Cannot read source file ($source_file): $!";
			if ($fh) {
				$source = do { local $/; <$fh> };
				close($fh);
			}
		}
		
		# If we couldn't read the source file (packaged installation), fall back to manual list
		my %seen_commands = ();
		if (!$source || length($source) < 1000) {
			print $stdout "-- using fallback command list (source file not accessible)\n" if ($verbose);
			%seen_commands = map { $_ => 1 } qw(
				/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 /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 /followers /following /dump /du /eval /ev
				/version /update /versioncheck /updatecheck
				/thread /th /entities /ent /delete
				/deletelast /rtsof /vote /whois /w /me
			);
		} else {
			# Dynamic extraction from source code
			# Pattern 1: if ($_ eq '/command' || $_ eq '/alias')
			while ($source =~ /if\s*\(\s*\$_\s+eq\s+['"]([\/][a-z?]+)['"](?:\s*\|\|\s*\$_\s+eq\s+['"]([\/][a-z?]+)['"])?/gi) {
				$seen_commands{$1}++ if defined $1;
				$seen_commands{$2}++ if defined $2;
			}
			
			# Pattern 2: if (m#^/command# or similar regex patterns
			while ($source =~ /if\s*\(\s*[^)]*m#?\^([\/][a-z?]+)/gi) {
				$seen_commands{$1}++;
			}
			
			# Pattern 3: return -1 if ($_ eq '/quit' patterns
			while ($source =~ /return\s+-1\s+if\s*\(\s*\$_\s+eq\s+['"]([\/][a-z?]+)['"](?:\s*\|\|\s*\$_\s+eq\s+['"]([\/][a-z?]+)['"])?/gi) {
				$seen_commands{$1}++ if defined $1;
				$seen_commands{$2}++ if defined $2;
			}
			
			# Some manual additions for complex patterns we might miss
			$seen_commands{'/reply'}++;  # Often has complex parsing
			$seen_commands{'/me'}++;
			$seen_commands{'/url'}++;
			$seen_commands{'/open'}++;
		}
		
		@commands = sort keys %seen_commands;
		print $stdout "-- extracted " . scalar(@commands) . " commands for tab completion\n" if ($verbose);
		print $stdout "-- commands: " . join(" ", @commands) . "\n" if ($verbose);
	}
	
	# Custom completion function
	$attribs->{attempted_completion_function} = sub {
		my ($text, $line, $start, $end) = @_;
		
		# Debug output
		print STDERR "COMPLETION DEBUG: text='$text' line='$line' start=$start end=$end\n" if ($verbose);
		my $hash_size = scalar(keys %readline_completion);
		my @hash_keys = keys %readline_completion;
		print STDERR "COMPLETION DEBUG: Hash has $hash_size entries: " . join(", ", @hash_keys) . "\n" if ($verbose);
		
		# Command completion at start of line or after whitespace
		if ($line =~ /^\s*\/\w*$/ || ($start == 0 && $text =~ /^\//) || 
			($line =~ /^\s+$/ && $text =~ /^\//)) {
			
			print STDERR "COMPLETION: Trying command completion\n" if ($verbose);
			my @matches = grep { index($_, $text) == 0 } @commands;
			print STDERR "COMPLETION: Found " . scalar(@matches) . " command matches: " . join(", ", @matches) . "\n" if ($verbose);
			
			if (@matches) {
				return $termrl->completion_matches($text, sub {
					my ($text, $state) = @_;
					return $matches[$state] // undef;
				});
			}
		}
		
		# @mention completion - check if line has @ and we're completing after it
		if ($line =~ /\@/ && $start >= 1 && substr($line, $start-1, 1) eq '@') {
			print STDERR "COMPLETION: Trying \@mention completion for '$text' (line: '$line', start: $start)\n" if ($verbose);
			print STDERR "COMPLETION: Hash reference check: " . \%readline_completion . "\n" if ($verbose);
			my @mentions = keys %readline_completion;
			print STDERR "COMPLETION: Total readline_completion keys: " . scalar(@mentions) . "\n" if ($verbose);
			print STDERR "COMPLETION: All keys: " . join(", ", @mentions) . "\n" if ($verbose);
			@mentions = grep { /^@/ } @mentions; # Only @mentions
			
			# If no @mentions in completion hash, try to extract from timeline cache
			if (!@mentions && %tl) {
				print STDERR "COMPLETION: No mentions in cache, extracting from timeline\n" if ($verbose);
				foreach my $post_id (keys %tl) {
					my $post = $tl{$post_id};
					if ($post && $post->{'user'}) {
						my $user = $post->{'user'};
						my $username = $user->{'acct'} || $user->{'username'} || $user;
						if ($username) {
							my $mention = '@' . $username;
							push @mentions, $mention;
							# Also add to completion hash for future use
							$readline_completion{$mention}++;
						}
						# Also check for boost attribution
						if ($post->{'boost_attribution'}) {
							my $booster = '@' . $post->{'boost_attribution'};
							push @mentions, $booster;
							$readline_completion{$booster}++;
						}
					}
				}
				# Remove duplicates
				my %seen = ();
				@mentions = grep { !$seen{$_}++ } @mentions;
				print STDERR "COMPLETION: Extracted " . scalar(@mentions) . " mentions from timeline\n" if ($verbose);
				&save_completion_cache if (@mentions > 0);
			}
			
			print STDERR "COMPLETION: Available mentions: " . join(", ", @mentions) . "\n" if ($verbose);
			
			# Filter matches based on what user has typed (text doesn't include @)
			# We need to match against the part after @ in the mention
			my @matches = ();
			foreach my $mention (@mentions) {
				my $username = $mention;
				$username =~ s/^@//; # Remove @ prefix for matching
				if ($text eq '' || index(lc($username), lc($text)) == 0) {
					push @matches, $username; # Return without @ since completion will add it
				}
			}
			print STDERR "COMPLETION: Filtered matches: " . join(", ", @matches) . "\n" if ($verbose);
			
			if (@matches) {
				return $termrl->completion_matches($text, sub {
					my ($text, $state) = @_;
					return $matches[$state] // undef;
				});
			}
		}
		
		# Try @ completion when user types @ anywhere  
		if ($text eq '@' || ($line =~ /\@$/ && $text eq '')) {
			print STDERR "COMPLETION: Trying bare \@ completion\n" if ($verbose);
			my @mentions = keys %readline_completion;
			@mentions = grep { /^@/ } @mentions;
			print STDERR "COMPLETION: Available mentions: " . join(", ", @mentions) . "\n" if ($verbose);
			
			if (@mentions) {
				return $termrl->completion_matches('@', sub {
					my ($text, $state) = @_;
					return $mentions[$state] // undef;
				});
			}
		}
		
		# File path completion for /media command
		if ($line =~ /^\/media\s+/ && $start > 7) {
			print STDERR "COMPLETION: Using file completion for /media\n" if ($verbose);
			# Let default filename completion handle this
			return ();
		}
		
		# Username completion for commands that take usernames
		if ($line =~ /^\/(?:whois|w|again|a|list|lists|reply)\s+/ && $text !~ /^[\/@]/) {
			print STDERR "COMPLETION: Trying username completion\n" if ($verbose);
			my @mentions = keys %readline_completion;
			@mentions = grep { /^@/ } @mentions;
			
			# Remove @ prefix for username-only completion
			my @usernames = map { substr($_, 1) } @mentions;
			@usernames = grep { index(lc($_), lc($text)) == 0 } @usernames if $text;
			print STDERR "COMPLETION: Username matches: " . join(", ", @usernames) . "\n" if ($verbose);
			
			if (@usernames) {
				return $termrl->completion_matches($text, sub {
					my ($text, $state) = @_;
					return $usernames[$state] // undef;
				});
			}
		}
		
		print STDERR "COMPLETION: No completion available\n" if ($verbose);
		# No completion
		return ();
	};
	
	# Load persistent completion cache
	my $completion_cache_file = "$config/completion_cache";
	if (-f $completion_cache_file) {
		if (open(my $cache_fh, '<', $completion_cache_file)) {
			my $read_count = 0;
			my $validated_count = 0;
			while (my $line = <$cache_fh>) {
				chomp $line;
				$read_count++;
				print STDERR "CACHE_LOAD: Read line $read_count: '$line'\n" if ($verbose);
				next unless $line;
				# Validate username format before adding
				if ($line =~ /^@[a-zA-Z0-9_.-]+(?:@[a-zA-Z0-9.-]+)?$/) {
					print STDERR "CACHE_LOAD: Validated and adding: '$line'\n" if ($verbose);
					$readline_completion{$line}++;
					$validated_count++;
				} else {
					print STDERR "CACHE_LOAD: Failed validation: '$line'\n" if ($verbose);
				}
			}
			close($cache_fh);
			my $loaded_count = scalar(grep { /^@/ } keys %readline_completion);
			print STDERR "CACHE_LOAD: Read $read_count lines, validated $validated_count, hash has $loaded_count entries\n" if ($verbose);
			my @loaded_keys = sort(grep { /^@/ } keys %readline_completion);
			print STDERR "CACHE_LOAD: Loaded keys: " . join(", ", @loaded_keys) . "\n" if ($verbose);
			print $stdout "-- loaded $loaded_count cached usernames for tab completion\n" if ($verbose);
		}
	}
	
	# Populate completion cache from existing timeline cache
	if (%tl) {
		print $stdout "-- populating completion cache from existing timeline data\n" if ($verbose);
		my $added_count = 0;
		foreach my $post_id (keys %tl) {
			my $post = $tl{$post_id};
			if ($post && $post->{'user'}) {
				my $user = $post->{'user'};
				# Extract username from user object
				my $username = $user->{'acct'} || $user->{'username'} || $user;
				if ($username) {
					$readline_completion{'@'.$username}++;
					$added_count++;
				}
				# Also check for boost attribution
				if ($post->{'boost_attribution'}) {
					$readline_completion{'@'.$post->{'boost_attribution'}}++;
					$added_count++;
				}
			}
		}
		print $stdout "-- added $added_count usernames from cached timeline to completion\n" if ($verbose);
		&save_completion_cache if ($added_count > 0);
	}
	
	print $stdout "-- tab completion enabled for commands, @mentions, and file paths\n" if ($verbose);
}

# Save completion cache to disk (with rate limiting)
our $last_cache_save = 0;
sub save_completion_cache {
	return unless ($termrl && $termrl->ReadLine eq 'Term::ReadLine::Gnu');
	
	# Rate limit saves to every 30 seconds to avoid excessive disk I/O
	my $now = time();
	return if ($now - $last_cache_save < 30);
	$last_cache_save = $now;
	
	my $completion_cache_file = "$config/completion_cache";
	
	# Create config directory if it doesn't exist
	unless (-d $config) {
		mkdir($config, 0700) or return;
	}
	
	# Get all @mentions, validate them, and save
	my @mentions = grep { /^@/ } keys %readline_completion;
	@mentions = grep { /^@[a-zA-Z0-9_.-]+(?:@[a-zA-Z0-9.-]+)?$/ } @mentions; # Validate format
	
	if (open(my $cache_fh, '>', $completion_cache_file)) {
		print $cache_fh "$_\n" for sort @mentions;
		close($cache_fh);
		print $stdout "-- saved " . scalar(@mentions) . " usernames to completion cache: " . join(", ", sort @mentions) . "\n" if ($verbose);
	}
}

# try to get signal numbers for SIG* from POSIX. use internals if failed.
eval 'use POSIX; $SIGUSR1 = POSIX::SIGUSR1; $SIGUSR2 = POSIX::SIGUSR2; $SIGHUP = POSIX::SIGHUP; $SIGTERM = POSIX::SIGTERM';
# from <sys/signal.h>
$SIGHUP ||= 1;
$SIGTERM ||= 15;
$SIGUSR1 ||= 30;
$SIGUSR2 ||= 31;
	
# set default wrap if not specified - try multiple methods to get terminal width
unless ($wrap) {
	# Try multiple methods to detect terminal width
	$wrap = $ENV{'COLUMNS'};
	if (!$wrap) {
		$wrap = `tput cols 2>/dev/null`;
		chomp($wrap) if $wrap;
	}
	if (!$wrap || $wrap !~ /^\d+$/) {
		my $stty_output = `stty size 2>/dev/null`;
		if ($stty_output =~ /\d+\s+(\d+)/) {
			$wrap = $1;
		}
	}
	# Use a more generous default for wide terminals  
	$wrap ||= 120; # Better default for modern wide terminals
	
	# If we detected a wide terminal (>100 cols), account for wrapping quirks
	# by reducing by 2 to avoid edge cases in the wwrap function
	if ($wrap > 100) {
		$wrap -= 2;
		print $stdout "-- adjusted wrap width to $wrap for wide terminal compatibility\n" if ($verbose);
	}
}
$wrap = 80 if ($wrap !~ /^\d+$/ || $wrap < 20); # Sanity check
print $stdout "-- terminal width detected: $wrap columns\n" if ($verbose);

# wrap warning
die(
"** dude, what the hell kind of terminal can't handle a 5 character line?\n")
	if ($wrap > 1 && $wrap < 5);
print $stdout "** warning: prompts not wrapped for wrap < 70\n"
	if ($wrap > 1 && $wrap < 70);

# reject stupid combinations
die("you can't use automatic ratelimits with -noratelimit.\nuse -pause=#sec\n")
	if ($noratelimit && $pause eq 'auto');
die("you can't use -synch with -script or -daemon.\n")
	if ($synch && ($script || $daemon));
die("-script and -daemon cannot be used together.\n")
	if ($script && $daemon);

# set up menu codes and caches
$is_background = 0;
$alphabet = "abcdefghijkLmnopqrstuvwxyz";
%store_hash = ();
$mini_split = 250; # i.e., 10 posts for the mini-menu (/th)
# leaving 50 posts for the foreground temporary menus
$post_counter = 0;
%dm_store_hash = ();
$dm_counter = 0;
%id_cache = ();
%filter_next = ();

# set up threading management
$in_reply_to = 0;
$expected_post_ref = undef;

# interpret -script at this level
if ($script) {
	$noansi = $noprompt = 1;
	$silent = ($verbose) ? 0 : 1;
	$pause = $vcheck = $slowpost = $verify = 0;
}

### now instantiate the TTYverse dynamic API ###
### based off the defaults later in script. ####

# resolve extension path using XDG directory only
sub resolve_extension_path {
	my $name = shift;
	
	# If absolute path, check if it exists
	if ($name =~ m{^/}) {
		return $name if (-r $name);
		return undef;
	}
	
	# If relative path (./... or ../...), use as-is if readable
	if ($name =~ m{^\.\.?/}) {
		return $name if (-r $name);
		return undef;
	}
	
	# Only location: XDG user extensions directory
	my $ext_path = "$data/extensions/$name";
	return $ext_path if (-r $ext_path);
	
	# If name doesn't end in .pl, try adding it
	unless ($name =~ /\.pl$/) {
		my $pl_path = "$data/extensions/$name.pl";
		return $pl_path if (-r $pl_path);
	}
	
	return undef; # Not found
}

# first we need to load any extensions specified by -exts.
if (length($exts) && $exts ne '0') {
	$multi_module_mode = -1; # mark as loader stage

	print "** attempting to load extensions\n" unless ($silent);
	# unescape \,
	$j=0; $xstring = "ESCAPED_STRING";
	while($exts =~ /$xstring$j/) { $j++; }
	$xstring .= $j;
	$exts =~ s/\\,/$xstring/g;
	foreach $file (split(/,/, $exts)) {
#TODO
# wildcards?
		$file =~ s/$xstring/,/g;
		my $original_file = $file;
		
		# Resolve extension path using XDG + submodule locations
		my $extension_path = &resolve_extension_path($file);
		die("** extension '$original_file' not found in any search path\n") 
			unless ($extension_path);
		
		print "** loading $extension_path\n" unless ($silent);

		die("** sorry, you cannot load the same extension twice.\n")
			if ($master_store->{$original_file}->{'loaded'});

		# prepare its working space in $store and load the module
		$master_store->{$original_file} = { 'loaded' => 1 };
		$store = \%{ $master_store->{$original_file} };
		$EM_DONT_CARE = 0;
		$EM_SCRIPT_ON = 1;
		$EM_SCRIPT_OFF = -1;
		$extension_mode = $EM_DONT_CARE;
		require $extension_path; # and die if bad
		die("** $file failed to load: $@\n") if ($@);
		die("** consistency failure: reference failure on $file\n")
			if (!$store->{'loaded'});

		# check type of extension (interactive or non-interactive). if
		# we are in the wrong mode, bail out.
		if ($extension_mode) {
			die(
"** this extension requires -script. this may conflict with other extensions\n".
"   you are loading, which may have their own requirements.\n")
			if ($extension_mode == $EM_SCRIPT_ON && !$script);
			die(
"** this extension cannot work with -script. this may conflict with other\n".
"   extensions you are loading, which may have their own requirements.\n")
			if ($extension_mode == $EM_SCRIPT_OFF && $script);
		}

		# pick off all the subroutine references it makes for storage
		# in an array to iterate and chain over later.

		# these methods are multi-module safe
		foreach $arry (qw(
			handle exception posttype conclude dmhandle dmconclude
			heartbeat precommand prepost postpost addaction
			eventhandle listhandle userhandle shutdown)) {
			if (defined($$arry)) {
				$aarry = "m_$arry";
				push(@$aarry, [ $file, $$arry ]);
				undef $$arry;
			}
		}
		# these methods are NOT multi-module safe
		# if a extension already hooked one of
		# these and another extension tries to hook it, fatal error.
		foreach $arry (qw(
			getpassword prompt main autocompletion)) {
			if (defined($$arry)) {
				$sarry = "l_$arry";
				if (defined($$sarry)) {
					die(
"** double hook of unsafe method \"$arry\" -- you cannot use this extension\n".
"   with the other extensions you are loading. see the documentation.\n");
				}
				$$sarry = $$arry;
				undef $$arry;
			}
		}
	}
	
	# Show summary of loaded extensions
	unless ($silent) {
		my @loaded_extensions = ();
		foreach my $ext_name (keys %$master_store) {
			push @loaded_extensions, $ext_name if $master_store->{$ext_name}->{'loaded'};
		}
		if (@loaded_extensions) {
			my $ext_list = join(', ', @loaded_extensions);
			print "** loaded extensions: $ext_list\n";
		}
	}
	
	# success! enable multi-module support in the TTYverse API and then
	# dispatch calls through the multi-module system instead.
	$multi_module_mode = 1; # mark as completed loader

	$handle = \&multihandle;
	$exception = \&multiexception;
	$posttype = \&multiposttype;
	$conclude = \&multiconclude;
	$dmhandle = \&multidmhandle;
	$dmconclude = \&multidmconclude;
	$heartbeat = \&multiheartbeat;
	$precommand = \&multiprecommand;
	$prepost = \&multiprepost;
	$postpost = \&multipostpost;
	$addaction = \&multiaddaction;
	$shutdown = \&multishutdown;
	$userhandle = \&multiuserhandle;
	$listhandle = \&multilisthandle;
	$eventhandle = \&multieventhandle;

} else {
	# the old API single-end-point system

	$multi_module_mode = 0; # not executing multi module endpoints

	$handle = \&defaulthandle;
	$exception = \&defaultexception;
	$posttype = \&defaultposttype;
	$conclude = \&defaultconclude;
	$dmhandle = \&defaultdmhandle;
	$dmconclude = \&defaultdmconclude;
	$heartbeat = \&defaultheartbeat;
	$precommand = \&defaultprecommand;
	$prepost = \&defaultprepost;
	$postpost = \&defaultpostpost;
	$addaction = \&defaultaddaction;
	$shutdown = \&defaultshutdown;
	$userhandle = \&defaultuserhandle;
	$listhandle = \&defaultlisthandle;
	$eventhandle = \&defaulteventhandle;
}

# unsafe methods use the single-end-point
$prompt = $l_prompt || \&defaultprompt;
$main = $l_main || \&defaultmain;
$getpassword = $l_getpassword || \&defaultgetpassword;

# $autocompletion is special:
if ($termrl) {
	$termrl->Attribs()->{'completion_function'} =
		$l_autocompletion || \&defaultautocompletion;
}

# fetch_id is based off last_id, if an extension set it
$fetch_id = $last_id || 0;

# validate the notify method the user chose, if any.
# we can't do this in BEGIN, because it may not be instantiated yet,
# and we have to do it after loading modules because it might be in one.
@notifytypes = ();

# Initialize flag to suppress notifications during initial timeline load
$initial_load_in_progress = 1;
if (length($notifytype) && $notifytype ne '0' &&
		$notifytype ne '1' && !$status) {
	# NOT $script! scripts have a use case for notifiers!

	%dupenet = ();
	foreach $nt (split(/\s*,\s*/, $notifytype)) {
		$fnt="notifier_${nt}";
		(warn("** duplicate notification $nt was ignored\n"), next)
			if ($dupenet{$fnt});
		eval 'return &$fnt(undef)' ||
			die("** invalid notification framework $nt: $@\n");
		$dupenet{$fnt}=1;
	}
	@notifytypes = keys %dupenet;
	$notifytype = join(',', @notifytypes);
	# warning if someone didn't tell us what notifies they wanted.
	warn "-- warning: you specified -notifytype, but no -notifies\n"
		if (!$silent && !length($notifies));
}

# set up track tags
if (length($tquery) && $tquery ne '0') {
	my $xtquery = &tracktags_tqueryurlify($tquery);
	die("** custom tquery is over 140 length: $xtquery\n")
		if (length($xtquery) > 139);
	@trackstrings = ($xtquery);
} else {
	&tracktags_makearray;
}

# compile filterflags
&filterflags_compile;

# compile filters
exit(1) if (!&filter_compile);
$filterusers_sub = &filteruserlist_compile(undef, $filterusers);
$filterrts_sub = &filteruserlist_compile(undef, $filterrts);
$filteratonly_sub = &filteruserlist_compile(undef, $filteratonly);
exit(1) if (!&filterats_compile);

# compile lists
exit(1) if (!&list_compile);

# finally, compile notifies. we do this regardless of notifytype, so that
# an extension can look at it if it wants to.
&notify_compile;

# check that we are using a sensible authtype, based on our guessed user agent
# Fediverse uses OAuth 2.0 exclusively
$authtype = "oauth2";
die("** TTYverse only supports OAuth 2.0 (fediverse standard)\n")
	if ($authtype ne 'oauth2');

if ($termrl) {
	$streamout = $stdout; # this is just simpler instead of dupping
        warn(<<"EOF") if ($] < 5.006);
***********************************************************
** -readline may not function correctly on Perls < 5.6.0 **
***********************************************************
EOF
	print $stdout "-- readline using ".$termrl->ReadLine."\n";
} else {
	# dup $stdout for benefit of various other scripts
	open(DUPSTDOUT, ">&STDOUT") ||
		warn("** warning: could not dup $stdout: $!\n");
	binmode(DUPSTDOUT, ":utf8") unless ($seven);
	$streamout = \*DUPSTDOUT;
}
if ($silent) {
	close($stdout);
	open($stdout, ">>/dev/null"); # KLUUUUUUUDGE
}

# after this point, die() may cause problems

# initialize our route back out so background can talk to foreground
pipe(W, P) || die("pipe() error [or your Perl doesn't support it]: $!\n");
select(P); $|++;
binmode(P, ":utf8") unless ($seven);
binmode(W, ":utf8") unless ($seven);

# default command line options

$anonymous ||= 0;
$ssl ||= 1;
$vcheck ||= 1; # Enable version checking by default
die("** -anonymous is not supported with fediverse authentication\n")
	if ($anonymous && !length($apibase));
undef $user if ($anonymous);
print $stdout "-- using SSL for default URLs.\n" if ($ssl);
$http_proto = ($ssl) ? 'https' : 'http';

$lat ||= undef;
$long ||= undef;
$location ||= 0;
$linelength ||= 5000; # Generous default, will be updated from server
$post_visibility ||= "public"; # Default post visibility: public, unlisted, private, direct
# Fediverse server configuration - defaults to mastodon.social
$fediverseserver ||= "mastodon.social";
$oauthbase ||= $apibase || "${http_proto}://${fediverseserver}";
# this needs to be AFTER oauthbase so that apibase can set oauthbase.
$apibase ||= "${http_proto}://${fediverseserver}/api/v1";
$noreblogs ||= 0;

# special case: if we explicitly refuse backload, don't load initially.
$backload = 30 if (!defined($backload)); # zero is valid!
$dont_refresh_first_time = 1 if (!$backload);

$searchhits ||= 20;
$url ||= "${apibase}/timelines/home";

# Mastodon OAuth 2.0 endpoints (not OAuth 1.0a like fediverse)
$oauthurl ||= "${oauthbase}/api/v1/apps";
$oauthauthurl ||= "${oauthbase}/oauth/authorize";
$oauthaccurl ||= "${oauthbase}/oauth/token";

$credurl ||= "${apibase}/accounts/verify_credentials";
$update ||= "${apibase}/statuses";
$rurl ||= "${apibase}/timelines/home"; # mentions are in home timeline
$uurl ||= "${apibase}/accounts/%I/statuses";
$idurl ||= "${apibase}/statuses/%I";
$delurl ||= "${apibase}/statuses/%I";

$reblogurl ||= "${apibase}/statuses/%I/reblog";
# Twitter endpoints removed - not available in fediverse
# $boostsbyurl: Use /api/v1/statuses/%I/reblogged_by instead
# $boostsofmeurl: No direct equivalent in fediverse (privacy feature)

$wurl ||= "${apibase}/accounts/%I";

# Twitter friendships API removed - use /api/v1/accounts/relationships instead
$followurl ||= "${apibase}/accounts/%I/follow";
$leaveurl ||= "${apibase}/accounts/%I/unfollow";
$blockurl ||= "${apibase}/accounts/%I/block";
$blockdelurl ||= "${apibase}/accounts/%I/unblock";
$friendsurl ||= "${apibase}/accounts/%I/following";
$followersurl ||= "${apibase}/accounts/%I/followers";
# Twitter friendships/update removed - fediverse uses individual follow/unfollow endpoints
$lookupidurl ||= "${apibase}/accounts/lookup";

$rlurl ||= "${apibase}/instance"; # Mastodon instance info instead of rate limits

$dmurl ||= "${apibase}/conversations";
$dmsenturl ||= "${apibase}/conversations"; # Same endpoint in Mastodon
$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";

# Fediverse list APIs (simplified compared to Twitter)
$getlisurl ||= "${apibase}/lists";                    # GET lists
$creliurl ||= "${apibase}/lists";                     # POST create list  
$delliurl ||= "${apibase}/lists/%I";                  # DELETE list
$modifyliurl ||= "${apibase}/lists/%I";               # PUT update list
$getliurl ||= "${apibase}/lists/%I/accounts";         # GET list members
$adduliurl ||= "${apibase}/lists/%I/accounts";        # POST add members
$deluliurl ||= "${apibase}/lists/%I/accounts";        # DELETE remove members  
$statusliurl ||= "${apibase}/lists/%I";               # GET list timeline
# Note: Fediverse doesn't have list subscriptions/followers like Twitter

$streamurl ||= "${http_proto}://${fediverseserver}/api/v1/streaming";
$dostream ||= 0;
$eventbuf ||= 0;

$queryurl ||= "${apibase}/../v2/search";
# no more $trendurl in 2.1.
$wtrendurl ||= "${apibase}/trends";
$atrendurl ||= "${apibase}/trends";

# pick ONE!
#$shoreblogurl ||= "http://api.tr.im/v1/trim_simple?url=";
$shoreblogurl ||= "http://is.gd/api.php?longurl=";

# figure out the domain to stop shortener loops
&generate_shortdomain;

$pause = (($anonymous) ? 120 : "auto") if (!defined $pause);
	# NOT ||= ... zero is a VALID value!
$superverbose ||= 0;
$avatar ||= "";
$urlopen ||= 'echo %U';
$cli_browser ||= '';
$gui_browser ||= '';
$hold ||= 0;
$daemon ||= 0;
$maxhist ||= 19;
undef $shadow_history;
$timestamp ||= 0;
$noprompt ||= 0;
$slowpost ||= 0;
$twarg ||= undef;

$verbose ||= $superverbose;
$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);

# synch overrides these options.
if ($synch) {
	$pause = 0;
	$dmpause = ($dmpause) ? 1 : 0;
	$notificationpause = ($notificationpause) ? 1 : 0;
}

$dmcount = $dmpause;
$notificationcount = $notificationpause;
$lastshort = undef;

# ANSI sequences
$colourprompt ||= "CYAN";
$colourme ||= "YELLOW";
$colourdm ||= "GREEN";
$colourreply ||= "RED";
$colourwarn ||= "MAGENTA";
$coloursearch ||= "CYAN";
$colourlist ||= "OFF";
$colourdefault ||= "OFF";
$ESC = pack("C", 27);
$BEL = pack("C", 7);
&generate_ansi;

# to force unambiguous bareword interpretation
$true = 'true';

select($stdout); $|++;

# figure out what our user agent should be
if ($lynx) {
	if (length($lynx) > 1 && -x "/$lynx") {
		$wend = $lynx;
		print $stdout "Lynx forced to $wend\n";
	} else {
		$wend = &wherecheck("trying to find Lynx", "lynx",
"specify -curl to use curl instead, or just let TTYverse autodetect stuff.\n");
	}
} else {
	if (length($curl) > 1 && -x "/$curl") {
		$wend = $curl;
		print $stdout "cURL forced to $wend\n";
	} else {
		$wend = (($curl) ? &wherecheck("trying to find cURL", "curl",
"specify -lynx to use Lynx instead, or just let TTYverse autodetect stuff.\n")
			: &wherecheck("trying to find cURL", "curl"));
		if (!$curl && !length($wend)) {
			$wend = &wherecheck("failed. trying to find Lynx",
				"lynx",
	"you must have either Lynx or cURL installed to use TTYverse.\n")
					if (!length($wend));
			$lynx = 1;
		} else {
			$curl = 1;
		}
	}
}
$baseagent = $wend;

# whoops, no Lynx here if we are not using Basic Auth
	die(
"sorry, OAuth is not currently supported with Lynx.\n".
"you must use SSL cURL, or specify -authtype=basic.\n")
		if ($lynx && $authtype ne 'basic' && !$anonymous);

# streaming API has multiple prereqs. not fatal; we just fall back on the
# REST API if not there.
unless($status) {
if (!$dostream || $authtype eq 'basic' || !$ssl || $script || $anonymous || $synch) {
		$reason = (!$dostream) ? "(no -dostream)"
			: ($script) ? "(-script)"
			: (!$ssl) ? "(no SSL)"
			: ($anonymous) ? "(-anonymous)"
			: ($synch) ? "(-synch)"
			: ($authtype eq 'basic') ? "(no OAuth)"
			: "(it's funkatron's fault)";
		print $stdout
	"-- Streaming API disabled $reason (TTYverse will use REST API only)\n";
		$dostream = 0;
	} else {
		print $stdout "-- Streaming API enabled\n";

		# streams change mentions behaviour; we get them automatically.
		# warn the user if the current settings are suboptimal.
		if ($mentions) {
			if ($nostreamreplies) {
				print $stdout
"** warning: -mentions and -nostreamreplies are very inefficient together\n";
			} else {
				print $stdout
"** warning: -mentions not generally needed in Streaming mode\n";
			}
		}
	}
} else { $dostream = 0; } # -status suppresses streaming
if (!$dostream && $streamallreplies) {
	print $stdout
"** warning: -streamallreplies only works in Streaming mode\n";
}

# create and cache the logic for our selected user agent
if ($lynx) {
	$simple_agent = "$baseagent -nostatus -source";

	@wend = ('-nostatus');
	@wind = (@wend, '-source'); # GET agent
	@wend = (@wend, '-post_data'); # POST agent
	# we don't need to have the request signed by Lynx right now;
	# it doesn't know how to pass custom headers. so this is simpler.
	$stringify_args = sub {
		my $basecom = shift;
		my $resource = shift;
		my $data = shift;
		my $dont_do_auth = shift;
		my $k = join("\n", @_);

		# if resource is an arrayref, then it's a GET with URL
		# and args (mostly generated by &grabjson)
		$resource = join('?', @{ $resource })
			if (ref($resource) eq 'ARRAY');
		die("wow, we have a bug: Lynx only works with Basic Auth\n")
			if ($authtype ne 'basic' && !$dont_do_auth);
		$k = "-auth=".$mytoken.':'.$mytokensecret."\n".$k
			unless ($dont_do_auth);
		$k .= "\n";
		$basecom = "$basecom \"$resource\" -";
		return ($basecom, $k, $data);
	};
} else {
	$simple_agent = "$baseagent -s -m 20";

	@wend = ('-s', '-m', '20', '-A', "TTYverse/$TTYverse_VERSION",
			'-H', 'Expect:');
	@wind = @wend;
	$stringify_args = sub {
		my $basecom = shift;
		my $resource = shift;
		my $data = shift;
		my $dont_do_auth = shift;
		my $p;
		my $l = '';

		foreach $p (@_) {
			if ($p =~ /^-/) {
				$l .= "\n" if (length($l));
				$l .= "$p ";
				next;
			}
			$l .= $p;
		}
		$l .= "\n";

		# sign our request with OAuth 2.0 (fediverse standard)
		unless ($dont_do_auth) {
			# OAuth 2.0 Bearer token
			my $bearer_header = &signrequest($resource, $data);
			if ($bearer_header) {
				$l .= $bearer_header . "\n";
			}
		}

		# if resource is an arrayref, then it's a GET with URL
		# and args (mostly generated by &grabjson)
		$resource = join('?', @{ $resource })
			if (ref($resource) eq 'ARRAY');
		$l .= "url = \"$resource\"\n";
		$l .= "data = \"$data\"\n" if length($data);
		return ("$basecom -K -", $l, undef);
	};
}

# update check
if ($vcheck && !length($status)) {
	$vs = &updatecheck(0);
} else {
	$vs =
"-- no version check performed (use /vcheck, or -vcheck to check on startup)\n"
	unless ($script || $status);
}
print $stdout $vs; # and then again when client starts up

## make sure we have all the authentication pieces we need for the
## chosen method (authtoken handles this for Basic Auth;
## this is where we validate OAuth)

# if we use OAuth, then don't use any Basic Auth credentials we gave
# unless we specifically say -authtype=basic
if ($authtype eq 'oauth' && length($user)) {
	print "** warning: -user is ignored when -authtype=oauth (default)\n";
	$user = undef;
}
$whoami = (split(/\:/, $user, 2))[0] unless ($anonymous || !length($user));

# yes, this is plaintext. obfuscation would be ludicrously easy to crack,
# and there is no way to hide them effectively or fully in a Perl script.
# so be a good neighbour and leave this the fark alone, okay? stealing
# credentials is mean and inconvenient to users. this is blessed by
# arrangement with fediverse. don't be a d*ck. thanks for your cooperation.
$oauthkey = (!length($oauthkey) || $oauthkey eq 'X') ?
	"XtbRXaQpPdfssFwdUmeYw" : $oauthkey;
$oauthsecret = (!length($oauthsecret) || $oauthsecret eq 'X') ?
	"csmjfTQPE8ZZ5wWuzgPJPOBR9dyvOBEtHT5cJeVVmAA" : $oauthsecret;

unless ($anonymous) {
# if we are using Basic Auth, ignore any user token we may have in
# our keyfile
if ($authtype eq 'basic') {
	$tokenkey = undef;
	$tokensecret = undef;
}
# but if we are using OAuth, we can request one, unless we are in script
elsif (($authtype eq 'oauth' || $authtype eq 'oauth2') && (!length($keyfile) || $oauthwizard)) {
	if (length($oauthkey) && length($oauthsecret) && 
			!length($tokenkey) && !length($tokensecret)) {
		# we have a key, we don't have the user token
		# but we can't get that with -script
		if ($script) {
			print $streamout <<"EOF";
AUTHENTICATION FAILURE
YOU NEED TO GET AN OAuth KEY, or use -authtype=basic
(run TTYverse without -script or -runcommand for help)
EOF
			exit;
		}
		# run the wizard, which writes a keyfile for us
		# restore keyfile path from attempted_keyfile for wizard use
		$keyfile = $attempted_keyfile;
		print $stdout <<"EOF";

+----------------------------------------------------------------------------+
|| WELCOME TO TTYverse: Authorize TTYverse by signing into your fediverse server ||
+----------------------------------------------------------------------------+
Looks like you're starting TTYverse for the first time, and/or creating a
keyfile. Welcome to the most user-hostile, highly obfuscated, spaghetti code
infested and obscenely obscure fediverse client that's out there. You'll love it.

TTYverse generates a keyfile that contains credentials for you, including your
access tokens. This needs to be done JUST ONCE. You can take this keyfile with
you to other systems. If you revoke TTYverse's access, you must remove the
keyfile and start again with a new token. You need to do this once per account
you use with TTYverse; only one account token can be stored per keyfile. If you
have multiple accounts, use -keyfile=... to specify different keyfiles. KEEP THESE
FILES SECRET.

** This wizard will overwrite $attempted_keyfile 
** (Use -keyfile=path to specify a different location)
Press RETURN/ENTER to continue or CTRL-C NOW! to abort.
EOF
		$j = <STDIN>;
		if ($authtype eq 'oauth2') {
			# OAuth 2.0 flow for Mastodon/fediverse
			&oauth2_wizard;
		} else {
			# OAuth 1.0a flow for fediverse (legacy)
			print $stdout "\nRequest from $oauthurl ...";
			($tokenkey, $tokensecret) = &tryhardfortoken($oauthurl,
				"oauth_callback=oob");
			$mytoken = $tokenkey;
			$mytokensecret = $tokensecret; # needs to be in both places
			# kludge in case user does not specify SSL and this is
			# fediverse: we know fediverse supports SSL
			($oauthauthurl =~ /fediverse/) &&
				($oauthauthurl =~ s/^http:/https:/);
			print $stdout <<"EOF";

1. Visit, in your browser, ALL ON ONE LINE,

${oauthauthurl}?oauth_token=$mytoken

2. If you are not already signed in, fill in your username and password.

3. Verify that TTYverse is the requesting application, and that its permissions
are as you expect (read your timeline, see who you follow and follow new
people, update your profile, post messages on your behalf and access your
direct messages). IF THIS IS NOT CORRECT, PRESS CTRL-C NOW!

4. Click Authorize app.

5. A PIN will appear. Enter it below.

EOF
		$j = '';
		while(!(0+$j)) {
			print $stdout "Enter PIN> ";
			chomp($j = <STDIN>);
		}
		print $stdout "\nRequest from $oauthaccurl ...";
		($tokenkey, $tokensecret) = &tryhardfortoken($oauthaccurl,
			"oauth_verifier=$j");

		$oauthkey = "X";
		$oauthsecret = "X";
		# Ensure the keyfile directory exists
		my $keyfile_dir = $keyfile;
		$keyfile_dir =~ s|[^/]*$||;  # Remove filename, keep directory path
		if ($keyfile_dir && !-d $keyfile_dir) {
			eval { make_path($keyfile_dir) };
			if ($@) {
				die("Failed to create keyfile directory $keyfile_dir: $@\n");
			}
		}
		open(W, ">$keyfile") ||
			die("Failed to write keyfile $keyfile: $!\n");
		print W <<"EOF";
ck=${oauthkey}&cs=${oauthsecret}&at=${tokenkey}&ats=${tokensecret}
EOF
		close(W);
		chmod(0600, $keyfile) || print $stdout
		"Warning: could not change permissions on $keyfile : $!\n";
		print $stdout <<"EOF";
Written keyfile $keyfile

Now, restart TTYverse to use this keyfile.
(To choose between multiple keyfiles other than the default .ttyversekey,
 tell TTYverse where the key is using -keyfile=... .)

EOF
		exit;
	}
	# if we get three of the four, this must have been command line
	if (length($oauthkey) && length($oauthsecret) && 
			(!length($tokenkey) || !length($tokensecret))) {
		my $error = undef;
		my $k;
		foreach $k (qw(oauthkey oauthsecret tokenkey tokensecret)) {
			$error .= "** you need to specify -$k\n"
				if (!length($$k));
		}
		if (length($error)) {
			print $streamout <<"EOF";

you are missing portions of the OAuth sequence. either create a keyfile
and point to it with -keyfile=... or add these missing pieces:
$error
then restart TTYverse, or use -authtype=basic.
EOF
			exit;
		}
		} # end OAuth 1.0a else block
	}
} elsif ($retoke && length($attempted_keyfile)) {
	# start the "re-toke" wizard to convert DM-less cloned app keys.
	# restore keyfile path from attempted_keyfile for wizard use
	$keyfile = $attempted_keyfile;
	# dup STDIN for systems that can only "close" it once
	open(STDIN2, "<&STDIN") || die("couldn't dup STDIN: $!\n");
	print $stdout <<"EOF";

+-------------------------------------------------------------------------+
|| The Re-Toke Wizard: Generate a new TTYverse keyfile for your app/token ||
+-------------------------------------------------------------------------+
fediverse is requiring tokens to now have specific permissions to READ
direct messages. This will be enforced by 1 July 2011. If you find you are
unable to READ direct messages, you will need this wizard. DO NOT use this
wizard if you are NOT using a cloned app key (1.2 and on) -- use -oauthwizard.

This wizard will create a new keyfile for you from your app/user keys/tokens.
You do NOT need this wizard if you are using TTYverse for a purpose that does
not require direct message access. For example, if TTYverse is acting as
your command line posting agent, or you are only using it to read your
timeline, you do NOT need a new token. You also do not need a new token to
SEND a direct message, only to READ ones this account has received.

You SHOULD NOT need this wizard if your app key was cloned after 1 June 2011.
However, you can still use it if you experience this specific issue with DMs,
or need to rebuild your keyfile for any other reason.

** This wizard will overwrite the key at $attempted_keyfile
** To change this, restart TTYverse with -retoke -keyfile=/path/to/keyfile
Press RETURN/ENTER to continue, or CTRL-C NOW! to abort.
EOF

	$j = <STDIN>;
	print $stdout <<"EOF";

First: let's get your API key, consumer key and consumer secret.
Start your browser.
1. Log into your fediverse server with your desired account.
2. Go to this URL. You must be logged into fediverse FIRST!

your-server.com/settings/applications/new

3. Click the TTYverse cloned app key you need to regenerate or upgrade.
4. Click Edit Application Settings.
5. Make sure Read, Write & Private Message is selected, and click the
   "Save application" button.
6. Select All (CTRL/Command-A) on the next screen, copy (CTRL/Command-C) it,
   and paste (CTRL/Command-V) it into this window. (You can also cut and
   paste a smaller section if I can't understand your browser's layout.)
7. Press ENTER/RETURN and CTRL-D when you have pasted the window contents.
EOF

	$q = $/;
	PASTE1LOOP: for(;;) {
		print $stdout <<"EOF";

-- Press ENTER and CTRL-D AFTER you have pasted the window contents! ---------
Go ahead:
EOF
		undef $/;
		$j = <STDIN2>;
		print $stdout <<"EOF";

-- EOF -----------------------------------------------------------------------
Processing ...

EOF
		$j =~ s/[\r\n]/ /sg;

		# process this. as a checksum, API key should == consumer key.
		$ck = '';
		$cs = '';
		($j =~ /Consumer key\s+([-a-zA-Z0-9_]{10,})\s+/) && ($ck = $1);
		($j =~ /Consumer secret\s+([-a-zA-Z0-9_]{10,})\s+/) &&
			($cs = $1);

		if (!length($ck) || !length($cs)) {
			# escape hatch
			print $stdout <<"EOF";
Something's wrong: I could not find your consumer key or consumer
secret in that text. If this was a misfired paste, please restart the wizard.
Otherwise, bug me at \@ttytter or ckaiser\@floodgap.com. Please don't send
keys or secrets to either address.

EOF
			exit;
		}
		last PASTE1LOOP;
	}
	# this part is similar to the retoke.
	$oauthkey = $ck;
	$oauthsecret = $cs;
	print $stdout "\nI'm testing this key to see if it works.\n";
	print $stdout "Request from $oauthurl ...";
	($tokenkey, $tokensecret) = &tryhardfortoken($oauthurl,
		"oauth_callback=oob");
	$mytoken = $tokenkey;
	$mytokensecret = $tokensecret;
	# kludge in case user does not specify SSL and this is
	# fediverse: we know fediverse supports SSL
	($oauthauthurl =~ /fediverse/) && ($oauthauthurl =~ s/^http:/https:/);
	$/ = $q;
	print $stdout <<"EOF";

Okay, your consumer key is ==> $ck
 and your consumer secret  ==> $cs

IF THIS IS WRONG, PRESS CTRL-C NOW AND RESTART THE WIZARD!

Now we will verify your Imperial battle station is fully operational by
signing in with OAuth.

1. Visit, in your browser, ALL ON ONE LINE (you should still be logged in),

${oauthauthurl}?oauth_token=$mytoken

2. Verify that your app is the requesting application, and that its permissions
are as you expect (read your timeline, see who you follow and follow new
people, update your profile, post messages on your behalf and access your
direct messages). IF THIS IS NOT CORRECT, PRESS CTRL-C NOW!

3. Click Authorize app.

4. A PIN will appear. Enter it below.

EOF
	print $stdout "Enter PIN> ";
	chomp($j = <STDIN>);
	print $stdout "\nRequest from $oauthaccurl ...";
	($at, $ats) = &tryhardfortoken($oauthaccurl, "oauth_verifier=$j");

	print $stdout <<"EOF";

Consumer key =========> $ck
Consumer secret ======> $cs
Access token =========> $at
Access token secret ==> $ats

EOF
	# Ensure the keyfile directory exists
	my $keyfile_dir = $keyfile;
	$keyfile_dir =~ s|[^/]*$||;  # Remove filename, keep directory path
	if ($keyfile_dir && !-d $keyfile_dir) {
		eval { make_path($keyfile_dir) };
		if ($@) {
			die("Failed to create keyfile directory $keyfile_dir: $@\n");
		}
	}
	open(W, ">$keyfile") || (print $stdout ("Unable to write to $keyfile: $!\n"),
			exit);
	print W "ck=$ck&cs=$cs&at=$at&ats=$ats\n";
	close(W);
	chmod(0600, $keyfile) || print $stdout
"Warning: could not change permissions on $keyfile : $!\n";
	print $stdout "Keys written to regenerated keyfile $keyfile\n";
	print $stdout "Now restart TTYverse.\n";	
	exit;
}

# now, get a token (either from Basic Auth, the keyfile or OAuth)
($mytoken, $mytokensecret) = &authtoken;
} # unless anonymous

# if we are testing the stream, this is where we split
if ($streamtest) {
	print $stdout ">>> STREAMING CONNECT TEST <<< (kill process to end)\n";
	&start_streaming; } # this never returns in this mode

# initial login tests and command line controls
if ($statusurl) {
	$shorstatusturl = &urlshorten($statusurl);
	$status = ((length($status)) ? "$status " : "") . $shorstatusturl;
}
$phase = 0;
$didhold = $hold;
$hold = -1 if ($hold == 1 && !$script);
$credentials = '';
$status = pack("U0C*", unpack("C*", $status))
	unless ($seven || !length($status) || $LANG =~ /8859/); # kludgy also
if ($status eq '-') {
	chomp(@status = <STDIN>);
	$status = join("\n", @status);
}
for(;;) {
	$rv = 0;
	die(
	"sorry, you can't post anonymously. use an authenticated username.\n")
		if ($anonymous && length($status));
	die(
"sorry, status too long: reduce by @{[ &length_tco($status)-$linelength ]} chars, ".
"or use -autosplit={word,char,cut}.\n")
		if (&length_tco($status) > $linelength && !$autosplit);
	($status, $next) = &csplit($status, ($autosplit eq 'char' ||
			$autosplit eq 'cut') ? 1 : 0)
		if (!length($next));
	if ($autosplit eq 'cut' && length($next)) {
		print "-- warning: input autotrimmed to $linelength bytes\n";
		$next = "";
	}
	if (!$anonymous && !length($whoami) && !length($status)) {
		# we must be using OAuth tokens. we'll need
		# to get our screen name from fediverse. we DON'T need this
		# if we're just posting with -status.
		print "(checking credentials) "; $data =
		$credentials = &backticks($baseagent, '/dev/null', undef,
			$credurl, undef, $anonymous, @wind);
		$rv = $? || &is_fail_whale($data) || &is_json_error($data);
	}
	if (!$rv && length($status) && $phase) {
		print "post attempt "; $rv = &updatest($status, 0);
	} else {
		# no longer a way to test anonymous logins
		unless ($rv || $anonymous) {
			print "test-login "; 
			$data = &backticks($baseagent, '/dev/null', undef,
					$url, undef, $anonymous, @wind);
			$rv = $?;
		}
	}
	if ($rv || &is_fail_whale($data) || &is_json_error($data)) {
		if (&is_fail_whale($data)) {
			print $stdout "FAILED -- Fail Whale detected\n";
		} elsif ($x = &is_json_error($data)) {
			print "FAILED!\n*** server reports: \"$x\"\n";
			print "check your password or configuration.\n";
		} else {
			$x = $rv >> 8;
			print
		"FAILED. ($x) bad password, login or URL? server down?\n";
		}
		print "access failure on: ";
		print (($phase) ? $update : $url);
		print "\n";
		print
	"--- data received ($hold) ---\n$data\n--- data received ($hold) ---\n"
			if ($superverbose);
		if ($hold && --$hold) {
			print
			"trying again in 1 minute, or kill process now.\n\n";
			sleep 60;
			next;
		}
		if ($didhold) {
			print "giving up after $didhold tries.\n";
		} else {
			print
			"to automatically wait for a connect, use -hold.\n";
		}
		exit(1);
	}
	if ($status && !$phase) {
		print "SUCCEEDED!\n";
		$phase++;
		next;
	}
	if (length($next)) {
		print "SUCCEEDED!\n(autosplit) ";
		$status = $next;
		$next = "";
		next;
	}
	last;
}
print "SUCCEEDED!\n";
exit(0) if (length($status));
&sigify(sub { ; }, qw(USR1 PWR XCPU));
&sigify(sub { $background_is_ready++ }, qw(USR2 SYS UNUSED XFSZ));
if (length($credentials)) {
	print "-- processing credentials: ";
	$my_json_ref = &map_mastodon_fields(&parsejson($credentials));
	$whoami = lc($my_json_ref->{'acct'} || $my_json_ref->{'username'});
	if (!length($whoami)) {
		print "FAILED!\nis your account suspended, or wrong token?\n";
		exit;
	}
	print "logged in as $whoami\n";
	$credlog = "-- you are logged in as $whoami\n";
	
	# Update server configuration (character limits, etc.)
	&update_server_config;
}

#### BOT/DAEMON MODE STARTUP ####

$last_rate_limit = undef;
$rate_limit_left = undef;
$rate_limit_rate = undef;
$rate_limit_next = 0;
$effpause = 0; # for both daemon and background
if ($daemon) {
	if (!$pause) {
		print $stdout "*** kind of stupid to run daemon with pause=0\n";
		exit 1;
	}
	if ($child = fork()) {
		print $stdout "*** detached daemon released. pid = $child\n";
		kill 15, $$;
		exit 0;
	} elsif (!defined($child)) {
		print $stdout "*** fork() failed: $!\n";
		exit 1;
	} else {
		$bufferpid = 0;
		if ($dostream) {
			&sigify(sub {
				kill $SIGHUP, $nursepid if ($nursepid);
				kill $SIGHUP, $bufferpid if ($bufferpid);
				kill 9, $curlpid if ($curlpid);
				sleep 1;
				# send myself a shutdown
				kill 9, $nursepid if ($nursepid);
				kill 9, $bufferpid if ($bufferpid);
				kill 9, $curlpid if ($curlpid);
				kill 9, $$;
			}, qw(TERM HUP PIPE));
			&sigify("IGNORE", qw(INT));
			$bufferpid = &start_streaming;
			$rin = '';	
			vec($rin, fileno(STBUF), 1) = 1;
		}
		$parent = 0;
		$dmcount = 1 if ($dmpause); # force fetch
		$notificationcount = 1 if ($notificationpause); # force fetch
		$is_background = 1;
		DAEMONLOOP: for(;;) {
			my $snooze;
			my $nfound;
			my $wake;

			&$heartbeat;
			&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) {
					&dmrefresh(0);
					$dmcount = $dmpause;
				}
			}
			# service events on the streaming socket, if
			# we have one.
			$snooze = ($effpause || 0+$pause || 60);
			$wake = time() + $snooze;
			if (!$bufferpid) {
				sleep $snooze;
			} else {
				my $read_failure = 0;
				SLEEP_AGAIN: for(;;) {
					$nfound = select($rout = $rin,
						undef, undef, $snooze);
					if ($nfound &&
					vec($rout, fileno(STBUF), 1)==1) {
						my $buf = '';
						my $rbuf = '';
						my $len;

						sysread(STBUF, $buf, 1);
						if (!length($buf)) {
							$read_failure++;
							# a stuck ready FH says
							# our buffer is dead;
							# see MONITOR: below.
							if ($read_failure>100){
print $stdout "*** unrecoverable failure of buffer process, aborting\n";
								exit;
							}
							next SLEEP_AGAIN;
						}
						$read_failure = 0;
						if ($buf !~ /^[0-9a-fA-F]+$/) {
							print $stdout
		"-- warning: bogus character(s) ".unpack("H*", $buf)."\n"
							if ($superverbose);
							next SLEEP_AGAIN;
						}
						while (length($buf) < 8) {
				# don't read 8 -- read 1. that means we can
				# skip trailing garbage without a window.
							sysread(STBUF,$rbuf,1);
						if ($rbuf =~ /[0-9a-fA-F]/) {
								$buf .= $rbuf;
							} else {
							print $stdout
	"-- warning: bogus character(s) ".unpack("H*", $rbuf)."\n"
						if ($superverbose);
							$buf = ''
							if(length($rbuf));
							}
						}
					print $stdout "-- length packet: $buf\n"
							if ($superverbose);
						$len = hex($buf);
						$buf = '';
						while (length($buf) < $len) {
							sysread(STBUF, $rbuf,
							($len-length($buf)));
							$buf .= $rbuf;
						}
						&streamevents(
							&map_mastodon_fields(&parsejson($buf)) );
						$snooze = $wake - time();
						next SLEEP_AGAIN if
							($snooze > 0);
					}
					last SLEEP_AGAIN;
				}
			}
		 }
	}
	die("uncaught fork() exception\n");
}

#### INTERACTIVE MODE and CONSOLE STARTUP ####

unless ($simplestart) {
	print <<"EOF";

========================================
TTYverse ${TTYverse_VERSION} (c)2025 Storm Dragon
all rights reserved.

https://git.stormux.org/storm/ttyverse

freeware under the floodgap free software license.
http://www.floodgap.com/software/ffsl/

forked from TTYtter by Cameron Kaiser
http://www.floodgap.com/software/ttytter/

fediverse client for Mastodon/GoToSocial/etc
========================================

when ready, hit RETURN/ENTER for a prompt.
type /help for commands or /quit to quit.
starting background monitoring process.

EOF
} else {
	print <<"EOF";
TTYverse ${TTYverse_VERSION} - A command-line fediverse client
Derivative of TTYtter (c)2012 Cameron Kaiser - Fediverse migration
Distributed under the Floodgap Free Software License.
http://www.floodgap.com/software/ffsl/

Original TTYtter: ckaiser\@floodgap.com
Type /help for commands or /quit to quit.
Starting background monitoring process.

EOF
}
if ($superverbose) {
	print $stdout "-- OMGSUPERVERBOSITYSPAM enabled.\n\n";
} else {
	print $stdout "-- verbosity enabled.\n\n" if ($verbose);
}

# Show donation message unless in silent mode
unless ($silent) {
	print $stdout "-- If you like TTYverse, consider supporting development: https://patreon.com/stormux\n";
}

sleep 3 unless ($silent);

# these three functions are outside of the usual API assertions for clarity.
# they represent the main loop, which by default is the interactive console.
# the main loop can be redefined.

sub defaultprompt {
	my $rv = ($noprompt) ? "" : "TTYverse> ";
	my $rvl = ($noprompt) ? 0 : 9;
	return ($rv, $rvl) if (shift);
	$wrapseq = 0;
	print $stdout "${CCprompt}$rv${OFF}" unless ($termrl);
}
sub defaultaddaction { return 0; }
sub defaultmain {
	if (length($runcommand)) {
		&prinput($runcommand);
		&sync_n_quit;
	}
	@history = ();
	print C "rsga---------------\n";
	$dont_use_counter = $nocounter;
	eval '$termrl->hook_no_counter';
	$tco_sub = sub { return &main::fastturntotco(shift); };
	eval '$termrl->hook_no_tco';
	if ($termrl) {
		print $stdout "-- DEBUG: Starting readline loop with implementation: " . $termrl->ReadLine . "\n" if ($verbose);
		print $stdout "-- DEBUG: Terminal capability check - can cursor move: " . ($termrl->can('Attribs') ? "yes" : "no") . "\n" if ($verbose);
		while(defined ($_ = $termrl->readline((&$prompt(1))[0]))) {
			if ($verbose && /[\x1b\[\x5b]/) {
				print $stdout "-- DEBUG: Arrow key detected in input: " . join("", map { sprintf("\\x%02x", ord($_)) } split(//, $_)) . "\n";
			}
			kill $SIGUSR1, $child; # suppress output
			$rv = &prinput($_);
			kill $SIGUSR2, $child; # resume output
			last if ($rv < 0);
			&sync_console unless (!$rv || !$synch);
			if ($dont_use_counter ne $nocounter) {
				# only if we have to -- this is expensive
				$dont_use_counter = $nocounter;
				eval '$termrl->hook_no_counter'
			}
		}
	} else {
		&$prompt;
		while(<>) { #not stdin so we can read from script files
			kill $SIGUSR1, $child; # suppress output
			$rv = &prinput(&uforcemulti($_));
			kill $SIGUSR2, $child; # resume output
			last if ($rv < 0);
			&sync_console unless (!$rv || !$synch);
			&$prompt;
		}
		&sync_n_quit if ($script);
	}
}

# SIGPIPE in particular must be trapped in case someone kills the background
# or, in streaming mode, buffer processes. we can't recover from that.
# the streamer MUST have been initialized before we start these signal
# handlers, or the streamer will try to run them too. eeek!
#
# DO NOT trap SIGCHLD: we generate child processes that die normally.
&sigify(\&end_me, qw(PIPE INT));
&sigify(\&repaint, qw(USR1 PWR XCPU));
sub sigify {
	# this routine abstracts setting signals to a subroutine reference.
	# check and see if we have to use POSIX.pm (Perl 5.14+) or we can
	# still use $SIG for proper signalling. We prefer the latter, but
	# must support the former.
	my $subref = shift;
	my $k;

	if ($signals_use_posix) {
		my @w;
		my $sigaction = POSIX::SigAction->new($subref);
		while ($k = shift) {
			my $e = &posix_signal_of($k);
			# some signals may not exist on all systems.
			next if (!(0+$e));
			POSIX::sigaction($e, $sigaction)
				|| die("sigaction failure: $! $@\n");
		}
	} else {
		while ($k = shift) { $SIG{$k} = $subref; }
	}
}
sub posix_signal_of {
	die("never call posix_signal_of if signals_use_posix is false\n")
		if (!$signals_use_posix);

	# this assumes that POSIX::SIG* returns a scalar int value.
	# not all signals exist on all systems. this ensures zeroes are
	# returned for locally bogus ones.
	return 0+(eval("return POSIX::SIG".shift));
}

sub send_repaint {
	unless ($wrapseq){
		return;
	}
	$wrapseq = 0;
	return if ($daemon);
	if ($child) {
		# we are the parent, call our repaint
		&repaint;
	} else {
		# we are not the parent, call the parent to repaint itself
		kill $SIGUSR1, $parent; # send SIGUSR1
	}
}
sub repaint {
	# try to speed this up, since we do it a lot.
	$wrapseq = 0;
	return &$repaintcache if ($repaintcache) ;

	# cache our repaint function (no-op or redisplay)
	$repaintcache = sub { ; }; # no-op
	return unless ($termrl &&
		($termrl->Features()->{'canRepaint'} || $readlinerepaint));
	return if ($daemon);
	$termrl->redisplay; $repaintcache = sub { $termrl->redisplay; };
}
sub send_removereadline {
	# this just stubs into its own removereadline
	return &$removereadlinecache if ($removereadlinecache);

	$removereadlinecache = sub { ; };
	return unless ($termrl && $termrl->Features()->{'canRemoveReadline'});
	return if ($daemon);
	$termrl->removereadline;
	$removereadlinecache = sub { $termrl->removereadline; };
}

# start the background process
# this has to be last or the background process can't see the full API
if ($child = open(C, "|-")) {
	close(P);
	binmode(C, ":utf8") unless ($seven);
} else {
	close(W);
	goto MONITOR;
}
eval'$termrl->hook_background_control' if ($termrl);
select(C); $|++; select($stdout);

# handshake for synchronicity mode, if we want it.
if ($synch) {
	# we will get two replies for this.
	print C "synm---------------\n";
	&thump;
	# the second will be cleared by the console
}

# wait for background to become ready
sleep 1 while (!$background_is_ready);

# start the 
&$main;
# loop until we quit and then we'll
&sync_n_quit if ($script);
# else
exit;

#### command processor ####

sub prinput {
	my $i;
	local($_) = shift; # bleh
	
	# Paste protection - detect multi-line input
	if (!$script && $_ =~ /\n/) {
		my @lines = split(/\n/, $_);
		my $line_count = scalar(@lines);
		
		if ($line_count > 3) {
			print $stdout "-- PASTE PROTECTION: Detected $line_count lines of input!\n";
			print $stdout "-- This looks like an accidental paste.\n";
			print $stdout "-- First few lines:\n";
			
			# Show first 3 lines as preview
			for my $j (0..($line_count > 3 ? 2 : $line_count-1)) {
				my $preview = substr($lines[$j], 0, 60);
				$preview .= "..." if length($lines[$j]) > 60;
				print $stdout "   " . ($j+1) . ": $preview\n";
			}
			
			print $stdout "-- Type 'paste' to continue or anything else to cancel: ";
			my $response = <STDIN>;
			chomp($response);
			
			if (lc($response) ne 'paste') {
				print $stdout "-- Multi-line input cancelled.\n";
				return 0;
			}
			
			print $stdout "-- Processing multi-line input...\n";
		}
		
		# Process each line separately with paste protection
		my $processed = 0;
		for my $line (@lines) {
			next if $line =~ /^\s*$/; # Skip empty lines
			my $result = &prinput($line);
			if ($result < 0) {
				return $result; # Propagate quit command (-1)
			}
			$processed++;
		}
		return $processed;
	}

	# validate this string if we are in UTF-8 mode
	unless ($seven) {
		$probe = $_;
		&$utf8_encode($probe);
		die("utf8 doesn't work right in this perl. run with -seven.\n")
			if (&ulength($probe) < length($_));
			# should be at least as big
		if ($probe =~ /($badutf8)/) {
print $stdout "*** invalid UTF-8: partial delete of a wide character?\n";
			print $stdout "*** ignoring this string\n";
			return 0;
		}
	}

	$in_reply_to = 0;
	chomp;
	$_ = &$precommand($_);
	s/^\s+//;
	s/\s+$//;
	my $cfc = 0;
	$cfc++ while (s/\033\[[0-9]?[ABCD]// || s/.[\177]// || s/.[\010]//
		|| s/[\000-\037\177]//);
	if ($cfc) {
		$history[0] = $_;
		print $stdout "*** filtered control characters; now \"$_\"\n";
	print $stdout "*** use %% for truncated version, or append to %%.\n";
		return 0;
	}

	if (/^$/) {
		return 1;
	}

	if (!$slowpost && !$verify && # we assume you know what you're doing!
		($_ eq 'h' || $_ eq 'help' || $_ eq 'quit' || $_ eq 'q' ||
			/^TTYverse>/ || $_ eq 'ls' || $_ eq '?' ||
			m#^help /# || $_ eq 'exit')) {
		
		&add_history($_);
		unless ($_ eq 'exit' || /^TTYverse>/ || $_ eq 'ls') {
			print $stdout "*** did you mean /$_ ?\n";
			print $stdout
				"*** to send this as a command, type /%%\n";
		} else {
			print $stdout
				"*** did you really mean to post \"$_\"?\n";
		}
		print $stdout "*** to post it anyway, type %%\n";
		return 0;
	}

	if (/^\%(\%|-\d+):p$/) {
		my $x = $1;
		if ($x eq '%') {
			print $stdout "=> \"$history[0]\"\n";
		} else {
			$x += 0;
			if (!$x || $x < -(scalar(@history))) {
				print $stdout "*** illegal index\n";
			} else {
				print $stdout "=> \"$history[-($x + 1)]\"\n";
			}
		}
		return 0;
	}

	# handle history substitution (including /%%, %%--, %%*, etc.)
	$i = 0; # flag

	if (/^\%(\%|-\d+)(--|-\d+|\*)?/) {
		($i, $proband, $r, $s) = &sub_helper($1, $2, $_);
		return 0 if (!$i);

		$s = quotemeta($s);
		s/^\%${r}${s}/$proband/;
	}
	if (/[^\\]\%(\%|-\d+)(--|-\d+|\*)?$/) {
		($i, $proband, $r, $s) = &sub_helper($1, $2, $_);
		return 0 if (!$i);

		$s = quotemeta($s);
		s/\%${r}${s}$/$proband/;
	}
	# handle variables second, in case they got in history somehow ...
	$i = 1 if (s/^\%URL\%/$urlshort/ || s/\%URL\%$/$urlshort/);
	$i = 1 if (s/^\%RT\%/$repost/ || s/\%RT\%$/$repost/);

	# and escaped history
	s/^\\\%/%/;

	if ($i) {
		print $stdout "(expanded to \"$_\")\n" ;
		$in_reply_to = $expected_post_ref->{'id_str'} || 0
			if (defined $expected_post_ref &&
				ref($expected_post_ref) eq 'HASH');
	} else {
		$expected_post_ref = undef;
	}

	return 0 unless length; # actually possible to happen
				# with control char filters and history.

	&add_history($_);
	$shadow_history = $_;

	# handle history display
	if ($_ eq '/history' || $_ eq '/h') {
		for ($i = scalar(@history); $i >= 1; $i--) {
			print $stdout "\t$i\t$history[($i-1)]\n";
		}
		return 0;
	}	

	my $slash_first = ($_ =~ m#^/#);

	return -1 if ($_ eq '/quit' || $_ eq '/q' || $_ eq '/bye' ||
			$_ eq '/exit');

	return 0 if (scalar(&$addaction($_)));

	# add commands here

	# dumper
	if (m#^/du(mp)? ([zZ]?[a-zA-Z]?[0-9]+)$#) {
		my $code = lc($2);
		unless ($code =~ /^d[0-9][0-9]+$/) { # this is a DM.
		my $post = &get_post($code);
		my $k;
		my $sn;
		my $id;
		my @superfields = (
			[ "user", "username" ], # must always be first
			[ "reblog", "id_str" ],
			[ "user", "geo_enabled" ],
			[ "place", "id" ],
			[ "place", "country_code" ],
			[ "place", "full_name" ],
			[ "place", "place_type" ],
			[ "tag", "type" ],
			[ "tag", "payload" ],
		);
		my $superfield;

		if (!defined($post)) {
			print $stdout "-- no such post (yet?): $code\n";
			return 0;
		}
	
		foreach $superfield (@superfields) {
			my $sfn = join('->', @{ $superfield });
			my $sfk = "{'" . join("'}->{'", @{ $superfield }) .
				"'}";
			my $sfv;
			eval "\$sfv = &descape(\$post->$sfk);";
			print $stdout
				substr("$sfn                          ", 0, 25).
				" $sfv\n";
			$sn = $sfv if (!length($sn) && length($sfv));
		}
		# geo is special
		print $stdout "geo->coordinates          (" .
			join(', ', @{ $post->{'geo'}->{'coordinates'} })
			. ")\n";
		foreach $k (sort keys %{ $post }) {
			next if (ref($post->{$k}));
			print $stdout
				substr("$k                          ", 0, 25) .
					" " . &descape($post->{$k}) . "\n";
		}
		# include a URL to the post per @augmentedfourth
		# URL construction removed for fediverse compatibility
		$urlshort = "";
		print $stdout
			"-- %URL% is now $urlshort (/short to shorten)\n";
		return 0;
		} # if dxxxx, fall through to the below.
	}

	if (m#^/du(mp)? ([dD][a-zA-Z]?[0-9]+)$#) {
		my $code = lc($2);
		my $dm = &get_dm($code);
		my $k;
		my $sn;
		my $id;
		my @superfields = (
			[ "sender", "username" ], # must always be first
		);

		if (!defined($dm)) {
			print $stdout "-- no such DM (yet?): $code\n";
			return 0;
		}
	
		foreach $superfield (@superfields) {
			my $sfn = join('->', @{ $superfield });
			my $sfk = "{'" . join("'}->{'", @{ $superfield }) .
				"'}";
			my $sfv;
			eval "\$sfv = &descape(\$dm->$sfk);";
			print $stdout
				substr("$sfn                          ", 0, 25).
				" $sfv\n";
			$sn = $sfv if (!length($sn) && length($sfv));
		}

		foreach $k (sort keys %{ $dm }) {
			next if (ref($dm->{$k}));
			print $stdout
				substr("$k                          ", 0, 25) .
					" " . &descape($dm->{$k}) . "\n";
		}
		return 0;
	}

	# evaluator
	if (m#^/ev(al)? (.+)$#) {
		$k = eval $2;
		print $stdout "==> ";
		print $streamout "$k $@\n";
		return 0;
	}

	# version check
	if (m#^/v(ersion)?check$# || m#^/u(pdate)?check$#) {
		print $stdout &updatecheck(1);
		return 0;
	}

	# url shortener routine
	if (($_ eq '/sh' || $_ eq '/short') && length($urlshort)) {
		$_ = "/short $urlshort";
		print $stdout "*** assuming you meant %URL%: $_\n";
		# and fall through to ...
	}
	if (m#^/sh(ort)? (https?|gopher)(://[^ ]+)#) {
		my $url = $2 . $3;
		my $answer = (&urlshorten($url) || 'FAILED -- %% to retry');
		print $stdout "*** shortened to: ";
		print $streamout ($answer . "\n");
		return 0;
	}

	# getter for internal value settings
	if (/^\/r(ate)?l(imit)?$/) {
		$_ = '/print rate_limit_rate';
		# and fall through to ...
	}

	if ($_ eq '/p' || $_ eq '/print') {
		foreach $key (sort keys %opts_can_set) {
			print $stdout "*** $key => $$key\n"
				if (!$opts_secret{$key});
		}
		return 0;
	}
	if (/^\/p(rint)?\s+([^ ]+)/) {
		my $key = $2;
		if ($valid{$key} ||
				$key eq 'effpause' ||
				$key eq 'rate_limit_rate' ||
				$key eq 'rate_limit_left') {
			my $value = &getvariable($key);
			print $stdout "*** ";
			print $stdout "(read-only value) "
				if (!$opts_can_set{$key});
			print $stdout "$key => $value\n";

		# I don't see a need for these in &getvariable, so they are
		# not currently supported. whine if you disagree.

		} elsif ($key eq 'tabcomp') {
			if ($termrl) {
				&generate_otabcomp;
			} else {
				print $stdout "*** readline isn't on\n";
			}
		} elsif ($key eq 'ntabcomp') { # sigh
			if ($termrl) {
				print $stdout "*** new TAB-comp entries: ";
				$did_print = 0;
				foreach(keys %readline_completion) {
					next if ($original_readline{$_});
					$did_print = 1;
					print $stdout "$_ ";
				}
				print $stdout "(none)" if (!$did_print);
				print $stdout "\n";
			} else {
				print $stdout "*** readline isn't on\n";
			}

		} else {
			print "*** not a valid option or setting: $key\n";
		}
		return 0;
	}
	if ($_ eq '/verbose' || $_ eq '/ve') {
		$verbose ^= 1;
		$_ = "/set verbose $verbose";
		print $stdout "-- verbosity.\n" if ($verbose);
		# and fall through to set
	}

	# search api integration (originally based on @kellyterryjones',
	# @vielmetti's and @br3nda's patches)
	if (/^\/se(arch)?\s+(\+\d+\s+)?(.+)\s*$/) {
		my $countmaybe = $2;
		my $kw = $3;
		$countmaybe =~ s/[^\d]//g if (length($countmaybe));
		$countmaybe += 0;
		$countmaybe ||= $searchhits;
		$kw = &url_oauth_sub($kw);
		$kw = "q=$kw" if ($kw !~ /^q=/);

		my $r = &grabjson("$queryurl?$kw", 0, 0, $countmaybe, {
					"type" => "search",
					"payload" => $k
				}, 1);
		if (defined($r) && ref($r) eq 'ARRAY' && scalar(@{ $r })) {
			&dt_tdisplay($r, 'search');
		} else {
			print $stdout "-- sorry, no results were found.\n";
		}
		&$conclude;
		return 0;
	}
	if ($_ eq '/notrack') { # special case
		print $stdout "*** all tracking keywords cancelled\n";
		$track = '';
		&setvariable('track', $track, 1);
		return 0;
	}
	if (s/^\/troff\s+// && s/\s*// && length) {
	# remove it from array, regenerate $track, call tracktags_makearray
	# and then sync
		my $k;
		my $l = '';
		my $q = 0;
		my %w;
		$_ = lc($_);
		my (@ptags) = split(/\s+/, $_);

		# filter duplicates and merge quoted strings (again)
		# but this time we're building up a hash for fast searches
		foreach $k (@ptags) {
			if ($q && $k =~ /"$/) { # this has to be first
				$l .= " $k";
				$q = 0;
			} elsif ($k =~ /^"/ || $q) {
				$l .= (length($l)) ? " $k" : $k;
				$q = 1;
				next;
			} else {
				$l = $k;
			}
			next if ($w{$l}); # ignore silently here
			$w{$l} = 1;
			$l = '';
		}
		print $stdout "-- warning: syntax error, missing quote?\n"
			if ($q);

		# now filter out of @tracktags
		@ptags = ();
		foreach $k (@tracktags) {
			push (@ptags, $k) unless ($w{$k});
		}
		unless (scalar(@ptags) < scalar(@tracktags)) {
			print $stdout "-- sorry, no track terms matched.\n";
			print $stdout (length($track) ?
				"-- you are tracking: $track\n" :
			"-- (maybe because you're not tracking anything?)\n");
			return 0;
		}
		print $stdout "*** ok, filtered @{[ keys(%w) ]}\n";
		$track = join(' ', @ptags);
		&setvariable('track', $track, 1);
		return 0;
	}

	if (s#^/tre(nds)?\s*##) {
		my $t = undef;
		my $wwoeid = (length) ? $_ : $woeid;
		$wwoeid ||= "1";
		my $r = &grabjson("${wtrendurl}?id=${wwoeid}",
				0, 0, 0, undef, 1);
		my $fr = ($wwoeid && $wwoeid ne '1') ?
			" FOR WOEID $wwoeid" : ' GLOBALLY';

		if (defined($r) && ref ($r) eq 'ARRAY') {
			$t = $r->[0]->{'trends'};
		}
		if (defined($t) && ref($t) eq 'ARRAY') {
			my $i;
			my $j;

			print $stdout "${EM}<<< TRENDING TOPICS${fr} >>>${OFF}\n";
			foreach $j (@{ $t }) {
				my $k = &descape($j->{'name'});
				my $l = ($k =~ /\sOR\s/) ? $k :
					($k =~ /^"/) ? $k :
					('"' . $k . '"');
				print $streamout "/search $l\n";
				$k =~ s/\sOR\s/ /g;
				$k = '"' . $k . '"' if ($k =~ /\s/
					&& $k !~ /^"/);
				print $streamout "/tron $k\n";
			}
			print $stdout "${EM}<<< TRENDING TOPICS >>>${OFF}\n";
		} else {
			print $stdout
"-- sorry, trends not available for WOEID $wwoeid.\n";
		}
		return 0;
	}

	# woeid finder based on lat/long
	if ($_ eq '/woeids') {
		my $max = 10;
		if (!$lat && !$long) {
			print $stdout
			"-- set your location with lat/long first.\n";
			return 0;
		}
		my $r = &grabjson("$atrendurl?lat=$lat&long=$long", 0, 0, 0,
			undef, 1);
		if (defined($r) && ref($r) eq 'ARRAY') {
			my $i;
			foreach $i (@{ $r }) {
				my $woeid = &descape($i->{'woeid'});
				my $nm = &descape($i->{'name'}) . ' (' .
					&descape($i->{'countryCode'}) .')';
				print $streamout "$nm\n/set woeid $woeid\n";
				last unless ($max--);
			}
		} else {
			print $stdout
"-- sorry, couldn't get a supported WOEID for your location.\n";
		}
		return 0;
	}

	1 if (s/^\/#([^\s]+)/\/tron #\1/);
	# /# command falls through to tron
	if (s/^\/tron\s+// && s/\s*$// && length) {
		$_ = lc($_);
		$track .= " " if (length($track));
		$_ = "/set track ${track}$_";
		# fall through to set
	}
	if (/^\/track ([^ ]+)/) {
		s#^/#/set #;
		# and fall through to set
	}

	# /listoff
	if (s/^\/list?off\s+// && s/\s*$// && length) {
		if (/,/ || /\s+/) {
			print $stdout "-- one list at a time please\n";
			return 0;
		}
		if (!scalar(@listlist)) {
			print $stdout
	"-- ok! that was easy! (you don't have any lists in your timeline)\n";
			return 0;
		}
		my $w;
		my $newlists = '';
		my $didfilter = 0;
		foreach $w (@listlist) {
			my $x = join('/', @{ $w });
			if ($x eq $_ || "$whoami$_" eq $x ||
					"$whoami/$_" eq $x) {
				print $stdout "*** ok, filtered $x\n";
				$didfilter = 1;
			} else {
				$newlists .= (length($newlists)) ? ",$x"
					: $x;
			}
		}
		if ($didfilter) {
			&setvariable('lists', $newlists, 1);
		} else {
			print $stdout "*** hmm, no such list? current value:\n";
			print $stdout "*** lists => ",
				&getvariable('lists'), "\n";
		}
		return 0;
	}

	# /liston
	if (s/^\/list?on\s+// && s/\s*$// && length) {
		if (/,/ || /\s+/) {
			print $stdout "-- one list at a time please\n";
			return 0;
		}
		my $uname;
		my $lname;
		if (m#/#) {
			($uname, $lname) = split(m#/#, $_, 2);
		} else {
			$lname = $_;
			$uname = '';
		}
		if (!length($uname) && $anonymous) {
			print $stdout
"-- you must specify a username for a list when anonymous.\n";
			return 0;
		}
		$uname ||= $whoami;

		# In fediverse, can only access your own lists (privacy feature)
		if ($uname ne $whoami) {
			print $stdout "-- Sorry, fediverse only allows access to your own lists (privacy feature)\n";
			return 0;
		}
		
		# Look up list ID by title
		my $list_id = &lookup_list_id($lname);
		if (!$list_id) {
			print $stdout "*** list '$lname' not found; use /lists to see available lists\n";
			return 0;
		}

		$_ = "/add lists $uname/$lname";
		# fall through to add
	}
	if (s/^\/a(uto)?lists?\s+// && s/\s*$// && length) {
		s/\s+/,/g if (!/,/);
		print $stdout
	"--- warning: lists aren't checked en masse; make sure they exist\n";
		$_ = "/set lists $_";
		# and fall through to set
	}

	# setter for internal value settings
	# shortcut for boolean settings
	if (/^\/s(et)? ([^ ]+)\s*$/) {
		my $key = $2;
		$_ = "/set $key 1"
			if($opts_boolean{$key} && $opts_can_set{$key});
		# fall through to three argument version
	}
	if (/^\/uns(et)? ([^ ]+)\s*$/) {
		my $key = $2;
		if ($opts_can_set{$key} && $opts_boolean{$key}) {
			&setvariable($key, 0, 1);
			return 0;
		}
		&setvariable($key, undef, 1);
		return 0;
	}
	# stubs out to set variable
	if (/^\/s(et)? ([^ ]+) (.+)\s*$/) {
		my $key = $2;
		my $value = $3;
		&setvariable($key, $value, 1);
		return 0;
	}
	# append to a variable (if not boolean)
	if (/^\/ad(d)? ([^ ]+) (.+)\s*$/) {
		my $key = $2;
		my $value = $3;
		if ($opts_boolean{$key}) {
			print $stdout
				"*** why are you appending to a boolean?\n";
			return 0;
		}
		if (length(&getvariable($key))) {
			$value = " $value" if ($opts_space_delimit{$key});
			$value = ",$value" if ($opts_comma_delimit{$key});
		}
		&setvariable($key, &getvariable($key).$value, 1);
		return 0;
	}
	# delete from a variable (if not boolean)
	if (/^\/del ([^ ]+) (.+)\s*$/) {
		my $key = $1;
		my $value = $2;
		my $old;
		if ($opts_boolean{$key}) {
			print $stdout
				"*** why are you deleting from a boolean?\n";
			return 0;
		}
		if (!length($old = &getvariable($key))) {
			print $stdout "*** $key is already empty\n";
			return 0;
		}
		my $del =
			($opts_space_delimit{$key}) ? '\s+' :
			($opts_comma_delimit{$key}) ? '\s*,\s*' :
			undef;
		if (!defined($del)) {
			# simple substitution
			1 while ($old =~ s/$value//g);
		} else {
			1 while ($old =~ s/$del$value($del)/\1/g);
			1 while ($old =~ s/^$value$del//);
			1 while ($old =~ s/$del$value//);
		}
		&setvariable($key, $old, 1);
		return 0;
	}
	# I thought about implementing a /pdel but besides being ugly
	# I don't think most people will push a truncated setting. tell me
	# if I'm wrong.

	# stackable settings
	if (/^\/pu(sh)? ([^ ]+)\s*$/) {
		my $key = $2;
		if ($opts_can_set{$key}) {
			if ($opts_boolean{$key}) {
				$_ = "/push $key 1";
				# fall through to three argument version
			} else {
				if (!$opts_can_set{$key}) {
					print $stdout
					"*** setting is not stackable: $key\n";
					return 0;
				}
				my $old = &getvariable($key);
				push(@{ $push_stack{$key} }, $old);
				print $stdout
					"--- saved on stack for $key: $old\n";
				return 0;
			}
		}
	}

	# common code for set and append
	if (/^\/(pu|push|pad|padd) ([^ ]+) (.+)\s*$/) {
		my $comm = $1;
		my $key = $2;
		my $value = $3;
		$comm = ($comm =~ /^pu/) ? "push" : "padd";
		if ($opts_boolean{$key} && $comm eq 'padd') {
			print $stdout
				"*** why are you appending to a boolean?\n";
			return 0;
		}
		if (!$opts_can_set{$key}) {
			print $stdout
				"*** setting is not stackable: $key\n";
			return 0;
		}
		my $old = &getvariable($key);
		$old += 0 if ($opts_boolean{$key});
		push(@{ $push_stack{$key} }, $old);
		print $stdout "--- saved on stack for $key: $old\n";
		if ($comm eq 'padd' && length($old)) {
			$value = " $value" if ($opts_space_delimit{$key});
			$value = ",$value" if ($opts_comma_delimit{$key});
			$old .= $value;
		} else {
			$old = $value;
		}
		&setvariable($key, $old, 1);
		return 0;
	}
	# we assume that if the setting is in the push stack, it's valid
	if (/^\/pop ([^ ]+)\s*$/) {
		my $key = $1;
		if (!scalar(@{ $push_stack{$key} })) {
			print $stdout
				"*** setting is not stacked: $key\n";
			return 0;
		}
		&setvariable($key, pop(@{ $push_stack{$key} }), 1);
		return 0;
	}

	# shell escape
	if (s/^\/\!// && s/\s*$// && length) {
		system("$_");
		$x = $? >> 8;
		print $stdout "*** exited with $x\n" if ($x);
		return 0;
	}

	if ($_ eq '/help' || $_ eq '/?') {
		print <<'EOF';

*** BASIC COMMANDS ***

IMPORTANT: Anything without a leading / is sent as a post!
Just type to talk!

/refresh
  Grabs the newest posts right away (or tells you if there 
  is nothing new) by checking the background process.

/again  
  Displays most recent posts, both old and new.

/dm and /dmagain
  For direct messages.

/replies
  Shows replies and mentions.

/timelines
  Lists available timelines to view.

/timeline <name>
  Switch to timeline (home, local, federated, notifications, etc.)

/visibility [level]
  Show current post visibility or set to: public, unlisted, private, direct

/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.

REMEMBER: Many commands and all posts are ASYNCHRONOUS and might 
not always respond immediately!

USE + FOR A COUNT: /re +30 => last 30 replies

EOF
		&linein("PRESS RETURN/ENTER>");
		print <<"EOF";

*** MORE COMMANDS ***

USER COMMANDS:
  /whois username        - displays info about username
  /again username        - views their most recent posts
  /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:
All DMs and posts have menu codes (letters + number, d for DMs).
Example:
  a5> <user> Send me Dr Pepper http://example.com
  [DM da0][user/Sun Jan 32 1969] I think you are cute

  /reply a5 message      - replies to post a5
  /thread a5             - show all posts in thread if a5 is threaded
  /url a5                - opens all URLs in post a5
  /delete a5             - deletes post a5, if it's your post
  /boost a5              - boosts post a5
  /vote a5 2             - vote for option 2 on poll in post a5
  /vote a5 1,3           - vote for options 1 and 3 (if multiple choice)
  /replyall a5 message   - reply to all users mentioned in post a5
  /ra a5 message         - same as /replyall (shorter alias)

Abbreviations: /re, /th, /url, /del, /ra
Menu codes wrap around at end.

Note: /reply, /delete and /url work for direct message menu codes too!

EOF
		&linein("PRESS RETURN/ENTER>");
		print <<"EOF";

*** LISTS (FEDIVERSE PRIVACY-AWARE) ***

  /lists                 - show your lists
  /liston listname       - add list to your timeline
  /listoff listname      - remove list from timeline
  /again @me/listname    - view posts from specific list
  
LIST MANAGEMENT:
  /withlist listname create public    - create new public list
  /withlist listname create private   - create new private list
  /withlist listname delete           - delete list (with confirmation)
  /withlist listname add username     - add user to list
  /withlist listname delete username  - remove user from list
  /withlist listname desc "new description" - update description
  /withlist listname name "new title" - rename list

FEDIVERSE PRIVACY: Lists respect ActivityPub privacy principles.
You can only access and manage your own lists (not other users' lists).

*** CONFIGURATION ***

Use /set to turn on options or set them at runtime.

EXAMPLES:
  /set ansi 1      - Enable ANSI colors (or use -ansi command line option)
  /set verify 1    - Verify posts before posting (or use -verify option)

For more options like readline support, UTF-8, SSL, proxies, etc., 
see the documentation.

*** ABOUT TTYverse ***

TTYverse $TTYverse_VERSION - Command-line fediverse client
Fediverse-only client for Mastodon, Pleroma, GoToSocial and other ActivityPub servers
Derived from TTYtter by Cameron Kaiser

This software is offered AS IS, with no guarantees.
It is not endorsed by any fediverse server operators or developers.

Supports: Mastodon, Pleroma, GoToSocial, and other ActivityPub-compatible servers
Privacy-focused: Respects fediverse privacy principles (own lists only, etc.)
Suggestions: mention \@stormux\@social.stormux.org

EOF
		return 0;
	}
	if ($_ eq '/ruler' || $_ eq '/ru') {
		my ($prompt, $prolen) = (&$prompt(1));
		$prolen = " " x $prolen;
		print $stdout <<"EOF";
${prolen}         1         2         3         4         5         6         7         8         9         0         1         2         3        XX
${prompt}1...5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5...XX
EOF
		return 0;
	}
	if ($_ eq '/cls' || $_ eq '/clear') {
		if ($ansi) {
			print $stdout "${ESC}[H${ESC}[2J\n";
		} else {
			print $stdout ("\n" x ($ENV{'ROWS'} || 50));
		}
		return 0;
	}
	if ($_ eq '/refresh' || $_ eq '/thump' || $_ eq '/r') {
		print $stdout "-- /refresh in streaming mode is pretty impatient\n"
			if ($dostream);
		&thump;
		&dmthump_no_skip if ($dmpause);  # Also refresh DMs but don't skip timeline
		&notificationthump if ($notificationpause);  # Also refresh notifications
		return 0;
	}
	
	# Media upload command
	if (m#^/media\s+(.+)$#) {
		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));
		$countmaybe += 0;
		if ($countmaybe > 999) {
			print $stdout "-- greedy bastard, try +fewer.\n";
			return 0;
		}
		$countmaybe = sprintf("%03i", $countmaybe);
		print $stdout "-- background request sent\n" unless ($synch);
		
		print C "reset${countmaybe}-----------\n";
		&sync_semaphore;
		return 0;
	}

	# this is for users -- list form is below
	if ($_ =~ m#^/(w)?a(gain)?\s+(\+\d+\s+)?([^\s/]+)$#) { #synchronous form
		my $mode = $1;
		my $uname = lc($4);

		my $countmaybe = $3;
		$countmaybe =~ s/[^\d]//g if (length($countmaybe));
		$countmaybe += 0;
		
		$uname =~ s/^\@//;
		if ($termrl) {
			$readline_completion{'@'.$uname}++; 
			&save_completion_cache;
		}
		print $stdout
		"-- synchronous /again command for $uname ($countmaybe)\n"
			if ($verbose);
		
		# Look up account ID for the username
		my $account_id = &lookup_account_id($uname);
		if (!$account_id) {
			&report_account_not_found($uname, 1);
			return 0;
		}
		
		# Use proper Mastodon API endpoint with account ID
		my $user_statuses_url = $uurl;
		$user_statuses_url =~ s/%I/$account_id/g;
		my $my_json_ref = &grabjson($user_statuses_url, 0, 0, $countmaybe, undef, 1);
		&dt_tdisplay($my_json_ref, 'again');
		unless ($mode eq 'w' || $mode eq 'wf') {
			return 0;
		} # else fallthrough
	}
	if ($_ =~ m#^/w(hois|a|again)?\s+(\+\d+\s+)?\@?([^\s]+)#) {
		my $uname = lc($3);
		$uname =~ s/^\@//;
		if ($termrl) {
			$readline_completion{'@'.$uname}++; 
			&save_completion_cache;
		}
		print $stdout "-- synchronous /whois command for $uname\n"
			if ($verbose);
		
		# Look up account ID for the username
		my $account_id = &lookup_account_id($uname);
		if (!$account_id) {
			&report_account_not_found($uname, 1);
			return 0;
		}
		
		# Use proper Mastodon API endpoint with account ID
		my $user_info_url = $wurl;
		$user_info_url =~ s/%I/$account_id/g;
		my $my_json_ref = &grabjson($user_info_url, 0, 0, 0, undef, 1);

		if (defined($my_json_ref) && ref($my_json_ref) eq 'HASH' &&
				length($my_json_ref->{'username'} || $my_json_ref->{'acct'})) {
			my $sturl = undef;
			my $purl =
				&descape($my_json_ref->{'profile_image_url'});
			if ($avatar && length($purl) && $purl !~
m#^http://[^.]+\.(twimg\.com|fediverse\.com).+/images/default_profile_\d+_normal.png#) {
				my $exec = $avatar;
				my $fext;
				($purl =~ /\.([a-z0-9A-Z]+)$/) &&
					($fext = $1);
				if ($purl !~ /['\\]/) { # careful!
					$exec =~ s/\%U/'$purl'/g;
					$exec =~ s/\%N/$uname/g;
					$exec =~ s/\%E/$fext/g;
					print $stdout "\n";
					print $stdout "($exec)\n"
						if ($verbose);
					system($exec);
				}
			}
			print $streamout "\n";
			&userline($my_json_ref, $streamout);
			print $streamout &wwrap(
"\"@{[ &strim(&descape($my_json_ref->{'description'})) ]}\"\n")
			if (length(&strim($my_json_ref->{'description'})));
			if (length($my_json_ref->{'url'})) {
				$sturl = 
				$urlshort = &descape($my_json_ref->{'url'});
				$urlshort =~ s/^\s+//;
				$urlshort =~ s/\s+$//;
				print $streamout "${EM}URL:${OFF}\t\t$urlshort\n";
			}
			print $streamout &wwrap(
"${EM}Location:${OFF}\t@{[ &descape($my_json_ref->{'location'}) ]}\n")
				if (length($my_json_ref->{'location'}));
			print $streamout <<"EOF";
${EM}Picture:${OFF}\t@{[ &descape($my_json_ref->{'profile_image_url'}) ]}

EOF
			unless ($anonymous || $whoami eq $uname) {
				# Use Mastodon relationships API with account ID
				my $relationship_url = $blockingurl;
				$relationship_url =~ s/%I/$account_id/g;
				my $g = &grabjson($relationship_url, 0, 0, 0, undef, 1);
				
				if (ref($g) eq 'ARRAY' && @$g > 0) {
					my $rel = $g->[0]; # relationships API returns array
					print $streamout &wwrap(
	"${EM}Do you follow${OFF} this user? ... ${EM}$rel->{'following'}${OFF}\n");
					print $streamout &wwrap(
"${EM}Does this user follow${OFF} you? ... ${EM}$rel->{'followed_by'}${OFF}\n");
				}
				print $streamout "\n";
			}
			print $stdout &wwrap(
	"-- %URL% is now $urlshort (/short shortens, /url opens)\n")
				if (defined($sturl));
		}
		return 0;
	}
		
	if (m#^/(df|doesfollow)\s+\@?([^\s]+)$#) {
		if ($anonymous) {
			print $stdout "-- who follows anonymous anyway?\n";
			return 0;
		}
		$_ = "/doesfollow $2 $whoami";
		print $stdout "*** assuming you meant: $_\n";
		# fall through to ...
	}
	if (m#^/(df|doesfollow)\s+\@?([^\s]+)\s+\@?([^\s]+)$#) {
		my $user_a = $2;
		my $user_b = $3;
		if ($user_a =~ m#/# || $user_b =~ m#/#) {
			print $stdout "--- sorry, this won't work on lists.\n";
			return 0;
		}
		# Note: Fediverse APIs don't support checking arbitrary user relationships
		# You can only check your own relationships via /api/v1/accounts/relationships
		print $stdout "-- Sorry, /doesfollow is not supported in fediverse (privacy feature)\n";
		print $stdout "-- You can only check your own relationships with /whois \@username\n";
		return 0;
		return 0;
	}

	# this is dual-headed and supports both lists and regular followers.
	if(s#^/(frs|friends|following|fos|followers)(\s+\+\d+)?\s*##) {
		my $countmaybe = $2;
		my $mode = $1;
		my $arg = lc($_);
		my $lname = '';
		my $user = '';
		my $what = '';
		$arg =~ s/^@//;
		$who = $arg;
		($who, $lname) = split(m#/#, $arg, 2) if (m#/#);
		if (length($lname) && !length($user) && $anonymous) {
			print $stdout
		"-- you must specify a username for a list when anonymous.\n";
			return 0;
		}
		$who ||= $whoami;
		if (!length($lname)) {
			$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
			if ($mode eq 'fos' || $mode eq 'followers') {
				print $stdout "-- Sorry, fediverse lists don't have followers/subscribers (privacy feature)\n";
				return 0;
			}
			
			# Check list ownership (fediverse privacy)
			if ($who ne $whoami) {
				print $stdout "-- Sorry, fediverse only allows access to your own list members (privacy feature)\n";
				return 0;
			}
			
			# Look up list ID
			my $list_id = &lookup_list_id($lname);
			if (!$list_id) {
				print $stdout "*** list '$lname' not found; use /lists to see available lists\n";
				return 0;
			}
			
			$what = "list members";
			$mode = $getliurl;
			$mode =~ s/%I/$list_id/g;
			$user = ""; # No additional parameters needed
			$who = "list $lname";
		}
		$countmaybe =~ s/[^\d]//g if (length($countmaybe));
		$countmaybe += 0;
		$countmaybe ||= 20;

		# we use the undocumented count= support to, by default,
		# reduce the JSON parsing overhead. if we always had to take
		# all 100, we really eat it on parsing. the downside is that,
		# per @episod, the stuff we get is "less" fresh.
		my $countper = ($countmaybe < 100) ? $countmaybe : 100;

		if (!length($lname)) {
			# we need to get IDs, then call lookup. right now it's
			# limited to 5000 because that is the limit for API 1.1
			# without having to do pagination here too. sorry.
			if ($countmaybe >= 5000) {
				print $stdout
"-- who do you think you are? Scoble? currently limited to 4999 or less\n";
				return 0;
			}

			# Look up account ID for the username
			my $account_id = &lookup_account_id($who);
			if (!$account_id) {
				&report_account_not_found($who, 1);
				return 0;
			}
			
			# Use proper Mastodon API endpoint with account ID - much simpler than Twitter!
			my $followers_url = $mode;
			$followers_url =~ s/%I/$account_id/g;
			
			# 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');
			
			print $stdout "-- $what for $who:\n";
			my $printed = 0;
			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);
			return 0;
		}

		# lists
		# loop through using the cursor until desired number.
		my $cursor = -1; # initial value
		my $printed = 0;
		my $nofetch = 0; 
		my $json_ref = undef;
		my @usarray = undef; shift(@usarray); # force underflow

		# this is a simpler version of the above.
		FABIO: while($countmaybe--) {
			if(!scalar(@usarray)) {
				last FABIO if ($nofetch);
				$json_ref = &grabjson(
			"${mode}?limit=${countper}&cursor=${cursor}${user}",
					0, 0, 0, undef, 1);
				@usarray = @{ $json_ref->{'users'} };
				last FABIO if (!scalar(@usarray));
				$cursor = $json_ref->{'next_cursor_str'} ||
					$json_ref->{'next_cursor'} || -1;
				$nofetch = ($cursor < 1) ? 1 : 0;
			}
			&$userhandle(shift(@usarray));
			$printed++;
		}
		print $stdout "-- sorry, no $what found for $who.\n"
			if (!$printed);
		return 0;
	}

	# threading
	if (m#^/th(read)?\s+(\+\d+\s+)?([zZ]?[a-zA-Z]?[0-9]+)$#) {
		my $countmaybe = $2;
		if (length($countmaybe)) {
			print $stdout
			"-- /thread does not (yet) support +count\n";
			return 0;
		}
		my $code = lc($3);
		my $post = &get_post($code);
		if (!defined($post)) {
			print $stdout "-- no such post (yet?): $code\n";
			return 0;
		}
		my $limit = 9;
		my $id = $post->{'reblog'}->{'id_str'} ||
			$post->{'in_reply_to_status_id_str'};
		my $thread_ref = [ $post ];
		while ($id && $limit) {
			print $stdout "-- thread: fetching $id\n"
				if ($verbose);
			my $next = &grabjson("${idurl}?id=${id}", 0, 0, 0,
				undef, 1);
			$id = 0;
			$limit--;
			if (defined($next) && ref($next) eq 'HASH') {
				push(@{ $thread_ref },
					&fix_geo_api_data($next));
				$id = $next->{'reblog'}->{'id_str'}
					|| $next->{'in_reply_to_status_id_str'}
					|| 0;
			}
		}
		&tdisplay($thread_ref, 'thread', 0, 1); # use the mini-menu
		return 0;
	}

	# pull out entities. this works for DMs and posts.
	# btw: T.CO IS WACK.
	if (m#^/ent?(ities)? ([dDzZ]?[a-zA-Z]?[0-9]+)$#) {
		my $v;
		my $w;
		my $thing;
		my $genurl;
		my $code = lc($2);
		my $hash;
		if ($code !~ /[a-z]/) {
			# this is an optimization: we don't need to get
			# the old post since we're going to fetch it anyway.
			$hash = { "id_str" => $code };
			$thing = "post";
			$genurl = $idurl;
		} elsif ($code =~ /^d.[0-9]+$/) {
			$hash = &get_dm($code);
			$thing = "DM";
			$genurl = $dmidurl;
		} else {
			$hash = &get_post($code);
			$thing = "post";
			$genurl = $idurl;
		}

		if (!defined($hash)) {
			print $stdout "-- no such $thing (yet?): $code\n";
			return 0;
		}

		my $id = $hash->{'id_str'};
		$hash = &grabjson("${genurl}?id=${id}", 0, 0, 0, undef, 1);
		if (!defined($hash) || ref($hash) ne 'HASH') {
		print $stdout "-- failed to get entities from server, sorry\n";
				return 0;
		}

		# if a reposted status, get the status.
		$hash = $hash->{'reblog'}
			if (defined($hash->{'reblog'}) &&
				ref($hash->{'reblog'}) eq 'HASH');
		
		my $didprint = 0;
		# fediverse puts entities in multiple fields.
		foreach $w (qw(media urls)) {
			my $p = $hash->{'entities'}->{$w};
			next if (!defined($p) || ref($p) ne 'ARRAY');
			foreach $v (@{ $p }) {
				next if (!defined($v) || ref($v) ne 'HASH');
				next if (!length($v->{'url'}) ||
					(!length($v->{'expanded_url'}) &&
					 !length($v->{'media_url'})));
				my $u1 = &descape($v->{'url'});
				my $u2 = &descape($v->{'expanded_url'});
				my $u3 = &descape($v->{'media_url'});
				my $u4 = &descape($v->{'media_url_https'});
				$u2 = $u4 || $u3 || $u2;
				print $stdout "$u1 => $u2\n";
				$urlshort = $u4 || $u3 || $u1;
				$didprint++;
			}
		}
		if ($didprint) {
			print $stdout &wwrap(
	"-- %URL% is now $urlshort (/url opens)\n");
		} else {
			print $stdout "-- no entities or URLs found\n";
		}
		return 0;
	}

	if (($_ eq '/url' || $_ eq '/open') && length($urlshort)) {
		$_ = "/url $urlshort";
		print $stdout "*** assuming you meant %URL%: $_\n";
		# and fall through to ...
	}
	if (m#^/(url|open)\s+(http|gopher|https|ftp)://.+# &&
			s#^/(url|open)\s+##) {
		&openurl($_);
		return 0;
	}
	if (m#^/(url|open) ([dDzZ]?[a-zA-Z]?[0-9]+)$#) {
		my $code = lc($2);
		my $post;
		my $genurl = undef;
		$urlshort = undef;

		if ($code =~ /^d/ && length($code) > 2) {
			$post = &get_dm($code); # USO!
			if (!defined($post)) {
				print $stdout
					"-- no such DM (yet?): $code\n";
				return 0;
			}
			$genurl = $dmidurl;
		} else {
			$post = &get_post($code);
			if (!defined($post)) {
				print $stdout
					"-- no such post (yet?): $code\n";
				return 0;
			}
			$genurl = $idurl;
		} 

		# Extract URLs from Mastodon post content
		my $didprint = 0;
		
		# First, try to get the FULL post data from the API to access structured URL fields
		my $full_post = undef;
		if (defined($genurl) && defined($post->{'id_str'})) {
			my $post_id = $post->{'id_str'};
			# Replace %I placeholder with actual post ID
			my $api_url = $genurl;
			$api_url =~ s/%I/$post_id/g;
			print STDERR "-- DEBUG: Fetching full post data from API for URL extraction: $api_url\n" if ($superverbose);
			$full_post = &grabjson($api_url, 0, 0, 0, undef, 1);
		}
		
		# Use full post data if available, otherwise fall back to cached data
		my $working_post = (defined($full_post) && ref($full_post) eq 'HASH') ? $full_post : $post;
		
		# DEBUG: Show what we have in the post structure
		print STDERR "-- DEBUG: URL parsing - using " . (defined($full_post) ? "FULL" : "CACHED") . " post data\n" if ($superverbose);
		print STDERR "-- DEBUG: URL parsing - post keys: " . join(", ", keys %$working_post) . "\n" if ($superverbose);
		print STDERR "-- DEBUG: URL parsing - content field: '" . ($working_post->{'content'} || 'UNDEFINED') . "'\n" if ($superverbose);
		print STDERR "-- DEBUG: URL parsing - text field: '" . ($working_post->{'text'} || 'UNDEFINED') . "'\n" if ($superverbose);
		
		# PRIORITY 1: Extract URLs from Mastodon's structured URL data (card/preview_url)
		if (defined($working_post->{'card'}) && ref($working_post->{'card'}) eq 'HASH') {
			my $card = $working_post->{'card'};
			if (defined($card->{'url'}) && length($card->{'url'})) {
				print STDERR "-- DEBUG: Found card URL: " . $card->{'url'} . "\n" if ($superverbose);
				&openurl($card->{'url'});
				$didprint++;
			}
		}
		
		# PRIORITY 2: Extract URLs from preview_url field (some servers use this)
		if (!$didprint && defined($working_post->{'preview_url'}) && length($working_post->{'preview_url'})) {
			print STDERR "-- DEBUG: Found preview_url: " . $working_post->{'preview_url'} . "\n" if ($superverbose);
			&openurl($working_post->{'preview_url'});
			$didprint++;
		}
		
		# PRIORITY 3: Media attachments
		if (!$didprint && defined($working_post->{'media_attachments'}) && 
		    ref($working_post->{'media_attachments'}) eq 'ARRAY') {
			foreach my $media (@{ $working_post->{'media_attachments'} }) {
				if (defined($media->{'url'}) && length($media->{'url'})) {
					print STDERR "-- DEBUG: Found media URL: " . $media->{'url'} . "\n" if ($superverbose);
					&openurl($media->{'url'});
					$didprint++;
				}
			}
		}
		
		# PRIORITY 4: Parse URLs from HTML content (href attributes)
		if (!$didprint) {
			my $content = $working_post->{'content'} || $working_post->{'text'} || '';
			if (length($content)) {
				# Extract URLs from href attributes in HTML
				while ($content =~ s/<a[^>]+href=["']([^"']+)["'][^>]*>[^<]*<\/a>//i) {
					my $url = $1;
					next if ($url =~ /^#/); # Skip hashtag links
					next if ($url =~ /^\@/); # Skip mention links
					print STDERR "-- DEBUG: Found HTML href URL: " . $url . "\n" if ($superverbose);
					&openurl($url);
					$didprint++;
				}
			}
		}
		
		if ($didprint) {
			return 0;
		}
		# PRIORITY 5: Final fallback - parse plain text URLs from display text
		# This handles truncated URLs in display text as a last resort
		if (!$didprint) {
			# Re-get content since we may have modified it above with regex substitutions
			my $original_content = $working_post->{'content'} || $working_post->{'text'} || '';
			my $plain_content = &html_to_text($original_content);
			$plain_content = &descape($plain_content);
			
			print STDERR "-- DEBUG: Parsing plain text content: '$plain_content'\n" if ($superverbose);
			
			# findallurls - extract any remaining URLs from plain text
			# First try URLs with protocols
			while ($plain_content
		=~ s#(h?ttp|h?ttps|ftp|gopher)://([a-zA-Z0-9_~/:%\-\+\.\=\&\?\#,]+)##){
				my $url = $1 . "://$2";
				$url = "h$url" if ($url =~ /^ttps?:/);
				$url =~ s/[\.\?]$//;
				print STDERR "-- DEBUG: Found plain text URL with protocol: " . $url . "\n" if ($superverbose);
				&openurl($url);
				$didprint++;
			}
			
			# Then try URLs without protocols (assume https) - WARNING: may be truncated
			while ($plain_content
		=~ s#\b([a-zA-Z0-9\-]+\.[a-zA-Z]{2,}(?:/[a-zA-Z0-9_~/%:\-\+\.\=\&\?\#,]*)?)\b##){
				my $url = "https://$1";
				$url =~ s/[\.\?]$//;
				print STDERR "-- DEBUG: Found plain text URL without protocol (may be truncated): " . $url . "\n" if ($superverbose);
				print $stdout "-- WARNING: URL may be truncated from display text: $url\n";
				&openurl($url);
				$didprint++;
			}
		}
		
		print $stdout "-- sorry, couldn't find any URL.\n"
			if (!$didprint);
		return 0;
	}

#TODO
	if (s/^\/(favourites|favorites|faves|favs|fl)(\s+\+\d+)?\s*//) {
		my $my_json_ref;
		my $countmaybe = $2;
		$countmaybe =~ s/[^\d]//g if (length($countmaybe));
		$countmaybe += 0;

		if (length) {
			# Look up account ID for the username
			my $account_id = &lookup_account_id($_);
			if (!$account_id) {
				print $stdout "-- ERROR: Could not find account for user: $_\n";
				return 0;
			}
			
			# Use fediverse accounts/{id}/favourites endpoint
			$my_json_ref = &grabjson("${apibase}/accounts/${account_id}/favourites?limit=${countmaybe}",
				0, 0, 0, undef, 1);
		} else {
			if ($anonymous) {
				print $stdout
		"-- sorry, you can't haz favourites if you're anonymous.\n";
			} else {
				print $stdout
				"-- synchronous /favourites user command\n"
					if ($verbose);
				$my_json_ref = &grabjson($favsurl, 0, 0,
					$countmaybe, undef, 1);
			}
		}
		if (defined($my_json_ref)
				&& ref($my_json_ref) eq 'ARRAY') {
			if (scalar(@{ $my_json_ref })) {
				my $w = "-==- favourites " x 10;
				$w = $EM . substr($w, 0, $wrap || 79) . $OFF;
				print $stdout "$w\n";
				&tdisplay($my_json_ref, "favourites");
				print $stdout "$w\n";
			} else {
				print $stdout
		"-- no favourites found, boring impartiality concluded.\n";
			}
		}
		&$conclude;
		return 0;
	}
	if (
m#^/(un)?f(boost|a|av|ave|avorite|avourite)? ([zZ]?[a-zA-Z]?[0-9]+)$#) {
		my $mode = $1;
		my $secondmode = $2;
		my $code = lc($3);
		$secondmode = ($secondmode eq 'boost') ? 'boost' : $secondmode;
		if ($mode eq 'un' && $secondmode eq 'boost') {
			print $stdout
				"-- hmm. seems contradictory. no dice.\n";
			return 0;
		}
		my $post = &get_post($code);
		if (!defined($post)) {
			print $stdout "-- no such post (yet?): $code\n";
			return 0;
		}
		&cordfav($post->{'id_str'}, 1,
			(($mode eq 'un') ? $favdelurl : $favurl),
			  &descape($post->{'text'}),
			(($mode eq 'un') ? 'removed' : 'created'));
		if ($secondmode eq 'boost') {
			$_ = "/boost $code";
			# and fall through
		} else {
			return 0;
		}
	}

	# Boost API (fediverse equivalent of reposts)
	if (s#^/([oe]?)boost ([zZ]?[a-zA-Z]?[0-9]+)\s*##) {
		my $mode = $1;
		my $code = lc($2);
		my $post = &get_post($code);
		if (!defined($post)) {
			print $stdout "-- no such post (yet?): $code\n";
			return 0;
		}
		# use a native repost unless we can't (or user used /ort /ert)
		unless ($noreblogs || length || length($mode)) {
			# we don't always get rs->text, so we simulate it.
			my $text = &descape($post->{'text'});
			$text =~ s/^RT \@[^\s]+:\s+//
				if ($post->{'reblog'}->{'id_str'});
			print $stdout "-- status boosted\n"
				unless(&updatest($text, 1, 0, undef,
					$post->{'reblog'}->{'id_str'}
					|| $post->{'id_str'}));
			return 0;
		}
		# we can't or user requested /ert /ort
		$repost = "boost @" .
			&descape($post->{'user'}->{'acct'} || $post->{'user'}->{'username'}) .
			": " . &descape($post->{'text'});
		if ($mode eq 'e') {
			&add_history($repost);
			print $stdout &wwrap(
				"-- ok, %RT% and %% are now \"$repost\"\n");
			return 0;
		}
		$_ = (length) ? "$repost $_" : $repost;
		print $stdout &wwrap("(expanded to \"$_\")");
		print $stdout "\n";
		goto POSTPRINT; # fugly! FUGLY!
	}

        if (m#^/(re)?rts?of?me?(\s+\+\d+)?$# && !$noreblogs) {
#TODO
# when more fields are added, integrate them over the JSON_ref
                my $mode = $1;
                my $countmaybe = $2;
                $countmaybe =~ s/[^\d]//g if (length($countmaybe));
                $countmaybe += 0;
                
                # "Reposts of me" not available in fediverse (privacy feature)
                print $stdout "-- Sorry, fediverse doesn't provide 'reposts of me' (privacy feature)\n";
                return 0;
        }
	if (m#^/rts?of\s+([zZ]?[a-zA-Z]?[0-9]+)$# && !$noreblogs) {
		my $code = lc($1);
		my $post = &get_post($code);
		my $id;

		if (!defined($post)) {
			print $stdout "-- no such post (yet?): $code\n";
			return 0;
		}
		$id = $post->{'reblog'}->{'id_str'} ||
			$post->{'id_str'};
		if (!$id) {
			print $stdout "-- hmmm, that post is major bogus.\n";
			return 0;
		}
		my $url = $boostsbyurl;
		$url =~ s/%I/$id/;
		my $users_ref = &grabjson("$url", 0, 0, 100, undef, 1);
		return if (!defined($users_ref) || ref($users_ref) ne 'ARRAY');
		my $k = scalar(@{ $users_ref });
		if (!$k) {
			print $stdout
				"-- no known boosters, or they're private.\n";
			return 0;
		}
		my $j;
		foreach $j (@{ $users_ref }) {
			&$userhandle($j->{'user'});
		}
		return 0;
	}

	# enable and disable NewRTs from users
	# we allow this even if newRTs are off from -noreblogs
	if (s#^/rts(on|off)\s+## && length) {
		&rtsonoffuser($_, 1, ($1 eq 'on'));
		return 0;
	}

	if (m#^/del(ete)?\s+([zZ]?[a-zA-Z]?[0-9]+)$#) {
		my $code = lc($2);
		unless ($code =~ /^d[0-9][0-9]+$/) { # this is a DM.
		my $post = &get_post($code);
		if (!defined($post)) {
			print $stdout "-- no such post (yet?): $code\n";
			return 0;
		}
		if (lc(&descape($post->{'user'}->{'username'} || $post->{'user'}->{'acct'}))
				ne lc($whoami)) {
			print $stdout
			"-- not allowed to delete somebody's else's posts\n";
			return 0;
		}
		print $stdout &wwrap(
"-- verify you want to delete: \"@{[ &descape($post->{'text'}) ]}\"");
		print $stdout "\n";
		$answer = lc(&linein(
	"-- sure you want to delete? (only y or Y is affirmative):"));
		if ($answer ne 'y') {
			print $stdout "-- ok, post is NOT deleted.\n";
			return 0;
		}
		$lastpostid = -1 if ($post->{'id_str'} == $lastpostid);
		&deletest($post->{'id_str'}, 1);
		return 0;
		} # dxxx falls through to ...
	}
	# DM delete version
	if (m#^/del(ete)? ([dD][a-zA-Z]?[0-9]+)$#) {
		my $code = lc($2);
		my $dm = &get_dm($code);
		if (!defined($dm)) {
			print $stdout "-- no such DM (yet?): $code\n";
			return 0;
		}
		my $sender = &descape($dm->{'last_status'}->{'account'}->{'username'} || $dm->{'last_status'}->{'account'}->{'acct'});
		my $text = &descape(&html_to_text($dm->{'last_status'}->{'content'}));
		print $stdout &wwrap(
			"-- verify you want to delete: " .
			"(from \@${sender}) \"${text}\"");
		print $stdout "\n";
		$answer = lc(&linein(
	"-- sure you want to delete? (only y or Y is affirmative):"));
		if ($answer ne 'y') {
			print $stdout "-- ok, DM is NOT deleted.\n";
			return 0;
		}
		&deletedm($dm->{'id_str'}, 1);
		return 0;
	}
	# /deletelast
	if (m#^/de?l?e?t?e?last$#) {
		if (!$lastpostid) {
			print $stdout "-- you haven't posted yet this time!\n";
			return 0;
		}
		if ($lastpostid == -1) {
			print $stdout "-- you already deleted it!\n";
			return 0;
		}
		print $stdout &wwrap(
"-- verify you want to delete: \"$lasttwit\"");
		print $stdout "\n";
		$answer = lc(&linein(
	"-- sure you want to delete? (only y or Y is affirmative):"));
		if ($answer ne 'y') {
			print $stdout "-- ok, post is NOT deleted.\n";
			return 0;
		}
		&deletest($lastpostid, 1);
		$lastpostid = -1;
		return 0;
	}

	if (s#^/(v)?re(ply)? ([zZ]?[a-zA-Z]?[0-9]+) ## && length) {
		my $mode = $1;
		my $code = lc($3);
		unless ($code =~ /^d[0-9][0-9]+/) { # this is a DM
		my $post = &get_post($code);
		if (!defined($post)) {
			print $stdout "-- no such post (yet?): $code\n";
			return 0;
		}
		# Use Mastodon's acct field (includes @domain for remote users) or username for local users
		my $target;
		my $acct = &descape($post->{'account'}->{'acct'} || $post->{'user'}->{'acct'} || $post->{'user'}->{'username'});
		
		# 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);
		$_ = '@' . $target . " $_";
		unless ($mode eq 'v') {
			$in_reply_to = $post->{'id_str'};
			$expected_post_ref = $post;
		} else {
			$_ = ".$_";
		}
		if ($termrl) {
			$readline_completion{'@'.lc($target)}++; 
			&save_completion_cache;
		}
		print $stdout &wwrap("(expanded to \"$_\")");
		print $stdout "\n";
		goto POSTPRINT; # fugly! FUGLY!
		}  else {
			# this is a DM, reconstruct it
			$_ = "/${mode}re $code $_";
			# and fall through to ...
		}
	}
	# DM reply version
	if (s#^/(dm)?re(ply)? ([dD][a-zA-Z]?[0-9]+) ## && length) {
		my $code = lc($3);
		my $dm = &get_dm($code);
		if (!defined($dm)) {
			print $stdout "-- no such DM (yet?): $code\n";
			return 0;
		}
		# in the future, add DM in_reply_to here
		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;
		}
		$_ = "/dm $target $_";
		print $stdout &wwrap("(expanded to \"$_\")");
		print $stdout "\n";
		# and fall through to /dm
	}
	# replyall (based on @FunnelFiasco's extension)
	if (s#^/(v)?r(eply)?(to)?a(ll)? ([zZ]?[a-zA-Z]?[0-9]+) ## && length) {
		my $mode = $1;
		my $code = $5;

		# common code from /vreply
		my $post = &get_post($code);
		if (!defined($post)) {
			print $stdout "-- no such post (yet?): $code\n";
			return 0;
		}
		# Use Mastodon's acct field (includes @domain for remote users) or username for local users
		my $target;
		my $acct = &descape($post->{'account'}->{'acct'} || $post->{'user'}->{'acct'} || $post->{'user'}->{'username'});
		
		# 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 = $_;
		$_ = '@' . $target;
		unless ($mode eq 'v') {
			$in_reply_to = $post->{'id_str'};
			$expected_post_ref = $post;
		} else {
			$_ = ".$_";
		}

		# don't repeat the target or myself; track other mentions
		my %did_mentions = map { $_ => 1 } (lc($target));
		my $reply_post = &descape($post->{'text'});

		while($reply_post =~ s/\@(\w+(?:\@[\w.-]+)?)//) {
			my $name = $1;
			my $mame = lc($name); # preserve camel case
			next if ($mame eq $whoami || $did_mentions{$mame}++);
			$_ .= " \@$name";
		}
		$_ .= " $text";

		# add everyone in did_mentions to readline_completion
		if ($termrl) {
			grep { $readline_completion{'@'.$_}++ } (keys %did_mentions);
			&save_completion_cache;
		}

		# and fall through to post
		print $stdout &wwrap("(expanded to \"$_\")");
		print $stdout "\n";
		goto POSTPRINT; # fugly! FUGLY!
	}

	if (m#^/re(plies)?(\s+\+\d+)?$#) {
		my $countmaybe = $2;
		$countmaybe =~ s/[^\d]//g if (length($countmaybe));
		$countmaybe += 0;
		
		if ($anonymous) {
			print $stdout
		"-- sorry, how can anyone reply to you if you're anonymous?\n";
		} else {
			# we are intentionally not keeping track of "last_re"
			# in this version because it is not automatically
			# updated and may not act as we expect.
			print $stdout "-- synchronous /replies command\n"
				if ($verbose);
			my $my_json_ref = &grabjson($rurl, 0, 0, $countmaybe,
				undef, 1);
			&dt_tdisplay($my_json_ref, "replies");
		}
		return 0;
	}

	# Timeline management commands
	if ($_ eq '/timelines') {
		print $stdout <<"EOF";
Available timelines:
  /timeline home        - Your main feed (default)
  /timeline public      - Local public timeline
  /timeline federated   - Federated public timeline
  /timeline notifications - Your notifications (mentions, boosts, etc.)
  /timeline bookmarks   - Your bookmarked posts
  /timeline favourites  - Your favourite posts

Current timeline: home
EOF
		return 0;
	}

	if (m#^/timeline\s+(\w+)(\s+\+\d+)?$#) {
		my $timeline_name = lc($1);
		my $countmaybe = $2;
		$countmaybe =~ s/[^\d]//g if (length($countmaybe));
		$countmaybe += 0;

		my $timeline_url;
		my $timeline_display_name;

		# Map timeline names to API endpoints
		if ($timeline_name eq 'home') {
			$timeline_url = "${apibase}/timelines/home";
			$timeline_display_name = "home feed";
		} elsif ($timeline_name eq 'public') {
			$timeline_url = "${apibase}/timelines/public?local=true";
			$timeline_display_name = "local public timeline";
		} elsif ($timeline_name eq 'federated') {
			$timeline_url = "${apibase}/timelines/public";
			$timeline_display_name = "federated timeline";
		} elsif ($timeline_name eq 'notifications') {
			$timeline_url = "${apibase}/notifications";
			$timeline_display_name = "notifications";
		} elsif ($timeline_name eq 'bookmarks') {
			$timeline_url = "${apibase}/bookmarks";
			$timeline_display_name = "bookmarks";
		} elsif ($timeline_name eq 'favourites' || $timeline_name eq 'favorites') {
			$timeline_url = "${apibase}/favourites";
			$timeline_display_name = "favourites";
		} else {
			print $stdout "-- unknown timeline: $timeline_name\n";
			print $stdout "-- use /timelines to see available timelines\n";
			return 0;
		}

		print $stdout "-- fetching $timeline_display_name...\n" if ($verbose);
		my $my_json_ref = &grabjson($timeline_url, 0, 0, $countmaybe || 20, undef, 1);
		
		if ($timeline_name eq 'notifications') {
			# Notifications need individual type mapping for sound alerts
			&notifications_tdisplay($my_json_ref);
		} else {
			&dt_tdisplay($my_json_ref, $timeline_name);
		}
		return 0;
	}

	# Visibility management commands
	if ($_ eq '/visibility') {
		my @visibilities = ('public', 'unlisted', 'private', 'direct');
		print $stdout "Available post visibility levels:\n";
		foreach my $vis (@visibilities) {
			my $marker = ($vis eq $post_visibility) ? "* " : "  ";
			print $stdout "${marker}${vis}\n";
		}
		return 0;
	}
	
	if (m#^/visibility\s+(\w+)$#) {
		my $new_visibility = lc($1);
		my @valid_visibilities = ('public', 'unlisted', 'private', 'direct');
		
		if (grep { $_ eq $new_visibility } @valid_visibilities) {
			$post_visibility = $new_visibility;
			print $stdout "-- post visibility set to: $post_visibility\n";
		} else {
			print $stdout "-- invalid visibility level: $new_visibility\n";
			print $stdout "-- valid options: " . join(', ', @valid_visibilities) . "\n";
		}
		return 0;
	}

	# DMs
	if ($_ eq '/dm' || $_ eq '/dmrefresh' || $_ eq '/dmr') {
		&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;
		my $countmaybe = $2;
		$countmaybe =~ s/[^\d]//g if (length($countmaybe));
		$countmaybe += 0;
		if ($countmaybe > 999) {
			print $stdout "-- greedy bastard, try +fewer.\n";
			return 0;
		}
		$countmaybe = sprintf("%03i", $countmaybe);
		print $stdout "-- background request sent\n" unless ($synch);
		
		$mode = ($mode eq 'sent') ? 's' : 'd';
		print C "${mode}mreset${countmaybe}---------\n";
		&sync_semaphore;
		return 0;
	}
	if (s#^/dm \@?([^\s]+)\s+## && length)  {
		return &common_split_post($_, undef, $1);
	}

	# vote on polls
	if (m#^/vote\s+([a-z]\d+)\s+(.+)$#i) {
		my $post_code = $1;
		my $choices = $2;
		return &vote_on_poll($post_code, $choices);
	}

	# reply to all mentioned users
	if (m#^/(replyall|ra|replytoall)\s+([a-z]\d+)\s+(.+)$#i) {
		my $post_code = $2;
		my $reply_text = $3;
		return &reply_to_all($post_code, $reply_text);
	}

	# follow and leave users
	if (m#^/(follow|leave|unfollow) \@?([^\s/]+)$#) {
		my $m = $1;
		my $u = lc($2);
		&foruuser($u, 1,
			(($m eq 'follow') ? $followurl : $leaveurl),
			(($m eq 'follow') ? 'started' : 'stopped'));
		return 0;
	}

	# follow and leave lists. this is, frankly, pointless; it does
	# nothing other than to mark you. otherwise, /liston and /listoff
	# actually add lists to your timeline.
	if (m#^/(l?follow|l?leave|l?unfollow) \@?([^\s/]*)/([^\s/]+)$#) {
		my $m = $1;
		my $uname = lc($2);
		my $lname = lc($3);

		if (!length($uname) || $uname eq $whoami) {
			print $stdout &wwrap(
"** you can't mark/unmark yourself as a follower of your own lists!\n");
			print $stdout &wwrap(
"** to add/remove your own lists from your timeline, use /liston /listoff\n");
			return 0;
		}
		if ($m !~ /^l/) {
			print $stdout &wwrap(
"-- to mark/unmark you as a follower of a list, use /lfollow /lleave\n");
			print $stdout &wwrap(
"-- to add/remove your own lists from your timeline, use /liston /listoff\n");
			return 0;
		}

		# List subscriptions not available in fediverse (privacy feature)
		print $stdout "-- Sorry, fediverse doesn't support list subscriptions (privacy feature)\n";
		print $stdout "-- You can only access your own lists, not follow others' lists\n";
		return 0;	
	}

	# block and unblock users
	if (m#^/(block|unblock) \@?([^\s/]+)$#) {
		my $m = $1;
		my $u = lc($2);
		if ($m eq 'block') {	
			$answer = lc(&linein(
	"-- sure you want to block $u? (only y or Y is affirmative):"));
			if ($answer ne 'y') {
				print $stdout "-- ok, $u is NOT blocked.\n";
				return 0;
			}
		}
		&boruuser($u, 1,
			(($m eq 'block') ? $blockurl : $blockdelurl),
			(($m eq 'block') ? 'started' : 'stopped'));
		return 0;
	}

	# list support
	# /withlist (/withlis, /with, /wl)
	if (s#^/(withlist|withlis|withl|with|wl)\s+([^/\s]+)\s+## &&
			($lname=lc($2)) && s/\s*$// && length) {
		my $comm = '';
		my $args = '';
		my $dont_return = 0;
		if ($anonymous) {
			print $stdout "-- no list love for anonymous\n";
			return 0;
		}
		if (/\s+/) {
			($comm, $args) = split(/\s+/, $_, 2);
		} else {
			$comm = $_;
		}
		
		# Get list ID for fediverse API operations
		my $list_id = &lookup_list_id($lname);
		if (!$list_id && $comm ne 'create') {
			print $stdout "*** list '$lname' not found; use /lists to see available lists\n";
			return 0;
		}
		
		my $return;
		my $state = "modified list $lname";
		if ($comm eq 'create') {
			my $desc;
			($args, $desc) = split(/\s+/, $args, 2)
				if ($args =~ /\s+/);
			if ($args ne 'public' && $args ne 'private') {
				print $stdout
					"-- must specify public or private\n";
				return 0;
			}
			$state = "created new list $lname (mode $args)";
			$desc = "description=".&url_oauth_sub($desc)."&"
				if (length($desc));
			$return = &postjson($creliurl,
				"${desc}mode=$args&name=$lname");
		} elsif ($comm eq 'private' || $comm eq 'public') {
			my $url = $modifyliurl;
			$url =~ s/%I/$list_id/;
			$return = &postjson($url, "replies_policy=$comm");
		} elsif ($comm eq 'desc' || $comm eq 'description') {
			if (!length($args)) {
				print $stdout "-- $comm needs an argument\n";
				return 0;
			}
			my $url = $modifyliurl;
			$url =~ s/%I/$list_id/;
			$return = &postjson($url, "description=".&url_oauth_sub($args));
		} elsif ($comm eq 'name') {
			if (!length($args)) {
				print $stdout "-- $comm needs an argument\n";
				return 0;
			}
			my $url = $modifyliurl;
			$url =~ s/%I/$list_id/;
			$return = &postjson($url, "title=".&url_oauth_sub($args));
			$state = "renamed list $lname to $args";
		} elsif ($comm eq 'add' || $comm eq 'adduser' ||
				($comm eq 'delete' && length($args))) {
			my $u = ($comm eq 'delete') ? $deluliurl : $adduliurl;
			$state = ($comm eq 'delete')
				? "user(s) deleted from list $lname"
				: "user(s) added to list $lname";
			if ($args !~ /,/ || $args =~ /\s+/) {
				1 while ($args =~ s/\s+/,/);
			}
			if ($args =~ /\s*,\s+/ || $args =~ /\s+,\s*/) {
				1 while ($args =~ s/\s+//);
			}
			if (!length($args)) {
				print $stdout "-- illegal/missing argument\n";
				return 0;
			}
			# Convert usernames to account IDs for fediverse API
			my @usernames = split(/,/, $args);
			my @account_ids = ();
			for my $username (@usernames) {
				$username =~ s/^@//; # Remove @ if present
				my $account_id = &lookup_account_id($username);
				if (!$account_id) {
					print $stdout "-- ERROR: Could not find account for user: $username\n";
					return 0;
				}
				push @account_ids, $account_id;
			}
			
			my $url = $u;
			$url =~ s/%I/$list_id/;
			
			# Fediverse API expects account_ids array parameter
			my $account_ids_param = join(',', @account_ids);
			$return = &postjson($url, "account_ids=$account_ids_param");
		} elsif ($comm eq 'delete' && !length($args)) {
			$state = "deleted list $lname";
			print $stdout
				"-- verify you want to delete list $lname\n";
			my $answer = lc(&linein(
		"-- sure you want to delete? (only y or Y is affirmative):"));
			if ($answer ne 'y') {
				print $stdout "-- ok, list is NOT deleted.\n";
				return 0;
			}
			my $url = $delliurl;
			$url =~ s/%I/$list_id/;
			$return = &postjson($url, "");
			if ($return) {
				# check and see if this is in our autolists.
				# if it is, delete it there too.
				my $value = &getvariable('lists');
				&setvariable('lists', $value, 1)
				if ($value=~s#(^|,)${whoami}/${lname}($|,)##);
			}
		} elsif ($comm eq 'list') { # synonym for /list
			$_ = "/list /$lname";
			$dont_return = 1; # and fall through
		} else {
			print $stdout "*** illegal list operation $comm\n";
		}
		if ($return) {
			print $stdout "*** ok, $state\n";
		}
		return 0 unless ($dont_return);
	}
	
	# /a to show statuses in a list
	if (m#^/a(gain)?\s+(\+\d+\s+)?\@?([^\s/]*)/([^\s/]+)#) {
		my $uname = lc($3);
		if ($anonymous && !length($uname)) {
	print $stdout "-- you must specify a username when anonymous.\n";
			return 0;
		}
		my $lname = lc($4);
		my $countmaybe = $2;
		$countmaybe =~ s/[^\d]//g if (length($countmaybe));
		$countmaybe += 0;
		$uname ||= $whoami;

		# In fediverse, can only access your own lists (privacy feature)
		if ($uname ne $whoami) {
			print $stdout "-- Sorry, fediverse only allows access to your own lists (privacy feature)\n";
			return 0;
		}
		
		# Look up list ID by title
		my $list_id = &lookup_list_id($lname);
		if (!$list_id) {
			print $stdout "*** list '$lname' not found; use /lists to see available lists\n";
			return 0;
		}
		
		# Get list timeline using proper fediverse endpoint
		my $list_timeline_url = $statusliurl;
		$list_timeline_url =~ s/%I/$list_id/g;
		my $my_json_ref = &grabjson($list_timeline_url, 0, 0, $countmaybe, undef, 1);
		&dt_tdisplay($my_json_ref, "again");
		return 0;
	}

	# /lists command: if @, show their lists. if @?../... show that list.
	# trivially duplicates /frs and /fos for lists
	# also handles /listfos and /listfrs
	if (length($whoami) &&
			(m#^/list?s?$# || m#^/list?f[ro](llower|iend)?s$#)) {
		$_ .= " $whoami";
	}
	if (m#^/lis(t|ts|t?fos|tfollowers|t?frs|tfriends)?\s+(\+\d+\s+)?(\@?[^\s]+)$#) {
		my $mode = $1;
		my $countmaybe = $2;
		my $uname = lc($3);
		my $lname = '';

		$mode = ($mode =~ /^t?fo/) ? 'fo' :
			($mode =~ /^t?fr/) ? 'fr' :
			'';
		$uname =~ s/^\@//;
		($uname, $lname) = split(m#/#, $uname, 2) if ($uname =~ m#/#);
		if ($anonymous && !length($uname) && length($mode)) {
	print $stdout "-- you must specify a username when anonymous.\n";
			return 0;
		}
		$uname ||= $whoami;
		if (length($lname) && length($mode)) {
			print $stdout "-- specify username only\n";
			return 0;
		}
		
		# Fediverse privacy: only allow access to own lists
		if ($uname ne $whoami) {
			print $stdout "-- Sorry, fediverse only allows access to your own lists (privacy feature)\n";
			return 0;
		}

		$countmaybe =~ s/[^\d]//g if (length($countmaybe));
		$countmaybe += 0;
		$countmaybe ||= 20;

		# this is copied from /friends and /followers (q.v.)
		my $countper = ($countmaybe < 100) ? $countmaybe : 100;

		my $cursor = -1; # initial value
		my $nofetch = 0; 
		my $printed = 0;
		my $json_ref = undef;
		my @usarray = undef; shift(@usarray); # force underflow
		
		# Build fediverse API URL
		my $furl;
		if (length($lname)) {
			# Get specific list members
			my $list_id = &lookup_list_id($lname);
			if (!$list_id) {
				print $stdout "*** list '$lname' not found; use /lists to see available lists\n";
				return 0;
			}
			$furl = $getliurl;
			$furl =~ s/%I/$list_id/;
		} elsif ($mode eq '') {
			# Get all lists for user
			$furl = $getlisurl;
		} else {
			# Following/followers of lists - not supported in fediverse
			print $stdout "-- Sorry, list following/followers not supported in fediverse (privacy feature)\n";
			return 0;
		}

		LABIO: while($countmaybe--) {
			if(!scalar(@usarray)) {
				last LABIO if ($nofetch);
				$json_ref = &grabjson(
			"${furl}&limit=${countper}&cursor=${cursor}", 0, 0, 0,
					undef, 1);
				@usarray = @{ ((length($lname)) ?
					$json_ref->{'users'} :
					$json_ref
				) };
				last LABIO if (!scalar(@usarray));
				if (length($lname)) {
				$cursor = $json_ref->{'next_cursor_str'} ||
					$json_ref->{'next_cursor'} || -1;
				$nofetch = ($cursor < 1) ? 1 : 0;
				} else { $nofetch = 1; }
			}
			my $list_ref = shift(@usarray);
			if (length($lname)) {
				&$userhandle($list_ref);
			} else {
				# lists/list returns their lists AND the
				# ones they subscribe to, different from 1.0.
				# right now we just deal with that.
				#next if ($uname ne
				#	$list_ref->{'user'}->{'username'} || $list_ref->{'user'}->{'acct'});

				# listhandle?
				my $list_name =
"\@".($list_ref->{'user'}->{'username'} || $list_ref->{'user'}->{'acct'})."/@{[ &descape($list_ref->{'slug'}) ]}";
				my $list_full_name =
					(length($list_ref->{'name'})) ?
&descape($list_ref->{'name'})."${OFF} ($list_name)" : $list_name;
				my $list_mode =
			(lc(&descape($list_ref->{'mode'})) ne 'public') ?
" ${EM}(@{[ ucfirst(&descape($list_ref->{'mode'})) ]})${OFF}" : "";
				print $streamout <<"EOF";
${CCprompt}$list_full_name${OFF} (f:$list_ref->{'member_count'}/$list_ref->{'subscriber_count'})$list_mode
EOF
			my $desc = &strim(&descape($list_ref->{'description'}));
				my $klen = ($wrap || 79) - 9;
				$klen = 10 if ($klen < 0);
				$desc = substr($desc, 0, $klen)."..."
					if (length($desc) > $klen);
				print $streamout (' "' . $desc . '"' . "\n")
					if (length($desc));
			}
			$printed++;
		}
		if (!$printed) {
			print $stdout ((length($lname))
			? "-- list $uname/$lname does not follow anyone.\n"
				: ($mode eq 'fr')
			? "-- user $uname doesn't follow any lists.\n"
				: ($mode eq 'fo')
			? "-- user $uname isn't followed by any lists.\n"
			: "-- no lists found for user $uname.\n");
		}
		return 0;
	}

	&sync_n_quit if ($_ eq '/end' || $_ eq '/e');

	#####
	#
	# below this point, we are posting
	#
	#####

	if (m#^/me\s#) {
		$slash_first = 0; # kludge!
	}

	if ($slash_first) {
		if (!m#^//#) {
			print $stdout "*** invalid command\n";
			print $stdout "*** to pass as a post, type /%%\n";
			return 0;
		}
		s#^/##; # leave the second slash on
	}

POSTPRINT: # fugly! FUGLY!
	return &common_split_post($_, $in_reply_to, undef);
}

# this is the common code used by standard updates and by the /dm command.
sub common_split_post {
	my $k = shift;
	my $in_reply_to = shift;
	my $dm_user = shift;
	
	my $dm_lead = (length($dm_user)) ? "/dm $dm_user " : '';
	my $ol = "$dm_lead$k";

	my (@poststack) = &csplit($k, ($autosplit eq 'char' ||
		$autosplit eq 'cut') ? 1 : 0);
	my $m = shift(@poststack);
	if (scalar(@poststack)) {
		$l = "$dm_lead$m";
		$history[0] = $l;
		if (!$autosplit) {
			print $stdout &wwrap(
"*** sorry, too long to send; ".
"truncated to \"$l\" (@{[ length($m) ]} chars)\n");
	print $stdout "*** use %% for truncated version, or append to %%.\n";
			return 0;
		}
		print $stdout &wwrap(
			"*** over $linelength; autosplitting to \"$l\"\n");
	}
	# there was an error; stop autosplit, restore original command
	if (&updatest($m, 1, $in_reply_to, $dm_user)) {
		$history[0] = $ol;
		return 0;
	}
	if (scalar(@poststack)) {
		$k = shift(@poststack);
		$l = "$dm_lead$k";
		&add_history($l);
		print $stdout &wwrap("*** next part is ready: \"$l\"\n");
		print $stdout "*** (this will also be automatically split)\n"
			if (length($k) > $linelength);
		print $stdout
		"*** to send this next portion, use %%.\n";
	}
	return 1;
}

# vote on a poll
sub vote_on_poll {
	my $post_code = shift;
	my $choices = shift;
	
	# Find the post by its menu code
	my $post_ref = &findtarget($post_code);
	unless ($post_ref) {
		print $stdout "-- no such post: $post_code\n";
		return 0;
	}
	
	# Check if post has a poll
	unless (exists($post_ref->{'poll'}) && $post_ref->{'poll'}) {
		print $stdout "-- post $post_code does not have a poll\n";
		return 0;
	}
	
	my $poll = $post_ref->{'poll'};
	
	# Check if poll is expired or already voted
	if ($poll->{'expired'}) {
		print $stdout "-- poll has expired\n";
		return 0;
	}
	
	if ($poll->{'voted'}) {
		print $stdout "-- you have already voted on this poll\n";
		return 0;
	}
	
	# Parse choices (support both single numbers and comma-separated)
	my @choice_nums = split(/[\s,]+/, $choices);
	my @valid_choices = ();
	my $max_options = scalar(@{$poll->{'options'}});
	
	foreach my $choice (@choice_nums) {
		$choice =~ s/\D//g; # remove non-digits
		if ($choice < 1 || $choice > $max_options) {
			print $stdout "-- invalid choice: $choice (must be 1-$max_options)\n";
			return 0;
		}
		push @valid_choices, ($choice - 1); # Convert to 0-based index
	}
	
	unless (@valid_choices) {
		print $stdout "-- no valid choices specified\n";
		return 0;
	}
	
	# Check if multiple choices are allowed
	if (!$poll->{'multiple'} && scalar(@valid_choices) > 1) {
		print $stdout "-- this poll only allows single choice\n";
		return 0;
	}
	
	# Submit the vote
	my $post_id = $post_ref->{'id_str'} || $post_ref->{'id'};
	my $vote_url = "$apibase/polls/$poll->{'id'}/votes";
	
	# Build POST data with choices
	my $post_data = '';
	foreach my $choice_idx (@valid_choices) {
		$post_data .= "&choices[]=$choice_idx";
	}
	$post_data =~ s/^&//; # remove leading &
	
	print $stdout "-- submitting vote on poll...\n";
	
	my $result = &backticks($useragent, '/dev/null', undef, $vote_url, $post_data, 1, @agentopts);
	
	if ($result) {
		print $stdout "-- vote submitted successfully\n";
		
		# Show which options were selected
		my @chosen_titles = ();
		foreach my $choice_idx (@valid_choices) {
			my $title = $poll->{'options'}->[$choice_idx]->{'title'} || '';
			push @chosen_titles, ($choice_idx + 1) . ". $title";
		}
		print $stdout "-- voted for: " . join(', ', @chosen_titles) . "\n";
		
		return 1;
	} else {
		print $stdout "-- failed to submit vote\n";
		return 0;
	}
}

# reply to all users mentioned in a post
sub reply_to_all {
	my $post_code = shift;
	my $reply_text = shift;
	
	# Find the post by its menu code
	my $post_ref = &findtarget($post_code);
	unless ($post_ref) {
		print $stdout "-- no such post: $post_code\n";
		return 0;
	}
	
	# Get the post content and author
	my $post_content = $post_ref->{'text'} || '';
	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'};
	
	# Extract all @mentions from the post content using fediverse format
	my %mentioned_users = ();
	
	# Look for @user@domain format (full fediverse mentions)
	while ($post_content =~ m/(@\w+@[\w\.-]+)/g) {
		my $mention = $1;
		# Don't mention ourselves or the original author
		unless (lc($mention) eq lc("\@$whoami") || lc($mention) eq lc("\@$post_author")) {
			$mentioned_users{lc($mention)} = $mention;
		}
	}
	
	# Also look for @user format (local mentions) and convert to full format
	while ($post_content =~ m/(@\w+)(?!@)/g) {
		my $local_mention = $1;
		# Don't mention ourselves or the original author
		unless (lc($local_mention) eq lc("\@$whoami") || lc($local_mention) eq lc("\@$post_author")) {
			# For local mentions, we need to determine the domain
			# Check if the post has mentions array with full acct info
			if (exists($post_ref->{'mentions'}) && ref($post_ref->{'mentions'}) eq 'ARRAY') {
				foreach my $mention_obj (@{$post_ref->{'mentions'}}) {
					my $username = $mention_obj->{'username'} || '';
					my $acct = $mention_obj->{'acct'} || '';
					if (lc($local_mention) eq lc("\@$username") && $acct) {
						$mentioned_users{lc("\@$acct")} = "\@$acct";
						last;
					}
				}
			}
		}
	}
	
	# Build the reply text with all mentions
	my $mentions_text = '';
	if (%mentioned_users) {
		$mentions_text = join(' ', values %mentioned_users) . ' ';
	}
	
	# Construct the full reply: @author mentions reply_text
	my $full_reply = "\@$post_author $mentions_text$reply_text";
	
	print $stdout "-- replying to all: $full_reply\n" if ($verbose);
	
	# Use the existing post sending mechanism
	return &common_split_post($full_reply, $in_reply_to, undef);
}

# helper functions for the command line processor.
sub add_history {
	my $h = shift;

	@history = (($h, @history)[0..&min(scalar(@history), $maxhist)]);
	if ($termrl) {
		if ($termrl->Features()->{'canSetTopHistory'}) {
			$termrl->settophistory($h);
		} else {
			$termrl->addhistory($h);
		}
	}
}
sub sub_helper {
	my $r = shift;
	my $s = shift;
	my $g = shift;
	my $x;
	my $q = 0;
	my $proband;

	if ($r eq '%') {
		$x = -1;
	} else {
		$x = $r + 0;
	}
	if (!$x || $x < -(scalar(@history))) {
		print $stdout "*** illegal history index\n";
		return (0, $_, undef, undef, undef);
	}
	$proband = $history[-($x + 1)];
	if ($s eq '--') {
		$q = 1;
	} elsif ($s eq '*') {
		if ($x != -1 || !length($shadow_history)) {
			print $stdout
				"*** can only %%* on most recent command\n";
			return (0, $_, undef, undef, undef);
		}
		# we assume it's at the end; it's only relevant there
		$proband = substr($shadow_history, length($g)-(2+length($r)));
	} else {
		$q = -(0+$s);
	} 
	if ($q) {
		my $j;
		my $c;
		for($j=0; $j<$q; $j++) {
			$c++ if ($proband =~ s/\s+[^\s]+$//);
		}
		if ($j != $c) {
			print $stdout "*** illegal word index\n";
			return (0, $_, undef, undef, undef);
		}
	}
	return (1, $proband, $r, $s);
}

# this is used for synchronicity mode to make sure we receive the
# GA semaphore from the background before printing another prompt.
sub sync_console {
	&thump;
	&dmthump unless (!$dmpause);
	&notificationthump unless (!$notificationpause);
}
sub sync_semaphore {
	if ($synch) {
		my $k = '';

		while(!length($k)) {
			read(W, $k, 1);
		} # wait for semaphore
	}
}

# wrapper function to get a line from the terminal.
sub linein {
	my $prompt = shift;
	my $return;

	return 'y' if ($script);

	$prompt .= " ";
	if ($termrl) {
		$dont_use_counter = 1;
		eval '$termrl->hook_no_counter';
		$return = $termrl->readline($prompt);
		$dont_use_counter = $nocounter;
		eval '$termrl->hook_no_counter';
	} else {
		print $stdout $prompt;
		chomp($return = lc(<$stdin>));
	}
	return $return;
}

#### this is the background part of the process ####

MONITOR:
%store_hash = ();
$is_background = 1;
$first_synch = $synchronous_mode = 0;
$rin = '';
vec($rin,fileno(STDIN),1) = 1;
# paranoia
binmode($stdout, ":crlf") if ($termrl);
unless ($seven) {
	binmode(STDIN, ":utf8");
	binmode($stdout, ":utf8");
}

# allow foreground process to squelch us
# we have to cover all the various versions of 30/31 signals on various
# systems just in case we are on a system without POSIX.pm. this set should
# cover Linux 2.x/3.x, AIX, Mac OS X, *BSD and Solaris. we have to assert
# these signals before starting streaming, or we may "kill" ourselves by
# accident because it is possible to process a post before these are
# operational.
&sigify(sub {
	$suspend_output ^= 1 if ($suspend_output != -1);
	$we_got_signal = 1;
}, qw(USR1 PWR XCPU));
&sigify( sub {
	$suspend_output = -1; $we_got_signal = 1;
}, qw(USR2 SYS UNUSED XFSZ));
&sigify("IGNORE", qw(INT)); # don't let slowpost kill us

# now we can safely initialize streaming
if ($dostream) {
	@events = ();
	$lasteventtime = time();
	&sigify(sub {
		print $stdout "-- killing processes $nursepid $bufferpid\n"
			if ($verbose);
		kill $SIGHUP, $nursepid if ($nursepid);
		kill $SIGHUP, $bufferpid if ($bufferpid);
		kill 9, $curlpid if ($curlpid);
		sleep 1;
		# send myself a shutdown
		kill 9, $nursepid if ($nursepid);
		kill 9, $bufferpid if ($bufferpid);
		kill $SIGTERM, $$;
	}, qw(HUP)); # use SIGHUP etc. from parent process to signal end
	$bufferpid = &start_streaming;
	vec($rin, fileno(STBUF), 1) = 1;
} else {
	&sigify("IGNORE", qw(HUP)); # we only respond to SIGKILL/SIGTERM
}

$interactive = $previous_last_id = $we_got_signal = 0;
$suspend_output = -1;
$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
$stuck_stdin = 0;

# tell the foreground we are ready
kill $SIGUSR2, $parent;

# loop until we are killed or told to stop.
# we receive instructions on stdin, and send data back on our pipe().
for(;;) {
	&$heartbeat;
	&update_effpause;
	$wrapseq = 0; # remember, we don't know when commands are sent.
	&refresh($interactive, $previous_last_id) unless
		(!$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);
			$dmcount = $dmpause;
		} elsif (!$interactive) {
			print $stdout "-- DEBUG: DM countdown: $dmcount -> " . ($dmcount - 1) . "\n" if ($verbose);
			if (!--$dmcount) {
				print $stdout "-- DEBUG: Triggering background DM refresh\n" if ($verbose);
				&dmrefresh($interactive); # using dm_first_time
				$dmcount = $dmpause;
			}
		} else {
			print $stdout "-- DEBUG: Skipping DM countdown (interactive=$interactive)\n" if ($verbose);
		}
	}
DONT_REFRESH:
	# nrvs is tricky with synchronicity
	if (!$synch || ($synch && $synchronous_mode && !$dm_first_time)) {
		$k = length($notify_rate) + length($vs) + length($credlog);
		if ($k) {
			&send_removereadline if ($termrl);
			print $stdout $notify_rate;
			print $stdout $vs;
			print $stdout $credlog;
			$wrapseq = 1;
		}
		$notify_rate = "";
		$vs = "";
		$credlog = "";
	}
	print P "0" if ($synchronous_mode && $interactive);
	&send_repaint if ($termrl);

	# this core loop is tricky. most signals will not restart the call.
	# -- respond to alarms if we are ignoring our timeout.
	# -- do not respond to bogus packets if a signal handler triggered it.
	# -- clear our flag when we detect a signal handler has been called.

	# if our master select is interrupted, we must restart with the
	# appropriate time taken from effpause. however, most implementations
	# don't report timeleft, so we must.
	$restarttime = time() + $effpause;
RESTART_SELECT:
	&send_repaint if ($termrl);
	$interactive = 0;
	$we_got_signal = 0; # acknowledge all signals
	if ($effpause == undef) { # -script and anonymous have no effpause.
		print $stdout "-- select() loops forever\n" if ($verbose);
		$nfound = select($rout = $rin, undef, undef, undef);
	} else {
		$actualtime = $restarttime - time();
		print $stdout "-- select pending ($actualtime sec left)\n"
			if ($superverbose);
		if ($actualtime <= 0) {
			$nfound = 0;
		} else {
			$nfound = select(
				$rout = $rin, undef, undef, $actualtime);
		}
	}
	if ($nfound > 0) {
		my $len;

		# service the streaming socket first, if we have one.
		if ($dostream) {
		if (vec($rout, fileno(STBUF), 1) == 1) {
			my $json_ref;
			my $buf = '';
			my $rbuf;
			my $reads = 0;

			print $stdout "-- data on streaming socket\n"
				if ($superverbose);
			
			# read until we get eight hex digits. this forces the
			# data stream to synchronize.
			# first, however, make sure we actually have valid
			# data, or we sit here and slow down the user.
			sysread(STBUF, $buf, 1);
			if (!length($buf)) {
				# if we get a "ready" but there's actually
				# no data, that means either 1) a signal
				# occurred on the buffer, which we need to
				# ignore, or 2) something killed the
				# buffer, which is unrecoverable. if we keep
				# getting repeated ready-no data situations,
				# it's probably the latter.
				$stream_failure++;
				&screech(<<"EOF") if ($stream_failure > 100);

*** fatal error ***
something killed the streaming buffer process. I can't recover from this.
please restart TTYverse.
EOF
				goto DONESTREAM;
			}
			$stream_failure = 0;
			if ($buf !~ /^[0-9a-fA-F]+$/) {
				print $stdout
	"-- warning: bogus character(s) ".unpack("H*", $buf)."\n"
						if ($superverbose);
				goto DONESTREAM;
			}
			while (length($buf) < 8) {
				# don't read 8 -- read 1. that means we can
				# skip trailing garbage without a window.
				sysread(STBUF, $rbuf, 1);
				$reads++;
				if ($rbuf =~ /[0-9a-fA-F]/) {
					$buf .= $rbuf;
					$reads = 0;
				} else {
					print $stdout
	"-- warning: bogus character(s) ".unpack("H*", $rbuf)."\n"
						if ($superverbose);
					$buf = ''
					if (length($rbuf)); # bogus data
				}
				print $stdout
	"-- master, I am stuck: $reads reads on stream and no valid data\n"
				if ($reads > 0 && ($reads % 1000) == 0);
			}
			print $stdout "-- length packet: $buf\n"
				if ($superverbose);
			$len = hex($buf);
			$buf = '';
			while (length($buf) < $len) {
				sysread(STBUF, $rbuf, ($len-length($buf)));
				$buf .= $rbuf;
			}

			print $stdout
	"-- streaming data ($len) --\n$buf\n-- streaming data --\n\n" 
				if ($superverbose);
			$json_ref = &parsejson($buf);
			push(@events, $json_ref);

			if (scalar(@events) > $eventbuf || (scalar(@events) &&
					(time()-$lasteventtime) > $effpause)){
				sleep 5 while ($suspend_output > 0);
				&streamevents(@events);
				&send_repaint if ($termrl);
				@events = ();
				$lasteventtime = time();
			}
		}
		DONESTREAM: print $stdout "-- done with streaming events\n"
			if ($superverbose);
		}

		# then, check if there is data on our control socket.
		# command packets should always be (initially) 20 characters.
		# if we come up short, it's either a bug, signal or timeout.
		if ($we_got_signal) {
			goto RESTART_SELECT;
		}
		goto RESTART_SELECT if(vec($rout, fileno(STDIN), 1) != 1);
		print $stdout "-- waiting for data ", scalar localtime, "\n"
			if ($superverbose);
		if(read(STDIN, $rout, 20) != 20) {
			# if we get repeated "ready" but no data on STDIN,
			# like the streaming buffer, we probably lost our
			# IPC and we should die here.
			if (++$stuck_stdin > 100) {
				print $stdout "parent is dead; we die too\n";
				kill 9,$$;
			}
			goto RESTART_SELECT;
		}
		$stuck_stdin = 0;
		# background communications central command code
		# we received a command from the console, so let's look at it.
		print $stdout "-- command received ", scalar
				localtime, " $rout" if ($verbose);
		if ($rout =~ /^rsga/) {
			$suspend_output = 0; # reset our status
			goto RESTART_SELECT;
		} elsif ($rout =~ /^pipet (..)/) {
			my $key = &get_post($1);
			my $ms = $key->{'menu_select'} || 'XX';
			my $ds = $key->{'created_at'} || 'argh, no created_at';
			$ds =~ s/\s/_/g;
			my $src = $key->{'source'} || 'unknown';
			$src =~ s/\|//g; # shouldn't be any anyway.
			$key = substr(( "$ms ".($key->{'id_str'})." ".
		($key->{'in_reply_to_status_id_str'})." ".
		($key->{'reblog'}->{'id_str'})." ".
		($key->{'user'}->{'geo_enabled'} || "false") . " ".
		($key->{'geo'}->{'coordinates'}->[0]). " ".
		($key->{'geo'}->{'coordinates'}->[1]). " ".
		$key->{'place'}->{'id'} . " ".
		$key->{'place'}->{'country_code'} ." ".
		$key->{'place'}->{'place_type'} . " ".
		unpack("${pack_magic}H*", $key->{'place'}->{'full_name'})." ".
		$key->{'tag'}->{'type'}. " ". # NO SPACES!
		unpack("${pack_magic}H*", $key->{'tag'}->{'payload'}). " ".
		($key->{'reblogs_count'} || "0") . " " .
		($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;
			goto RESTART_SELECT;
		} elsif ($rout =~ /^piped (..)/) {
			my $key = $dm_store_hash{$1};
			my $ms = $key->{'menu_select'} || 'XX';
			my $ds = $key->{'last_status'}->{'created_at'} || 'argh, no created_at';
			$ds =~ s/\s/_/g;
			my $sender = $key->{'last_status'}->{'account'}->{'acct'} || $key->{'last_status'}->{'account'}->{'username'};
			my $content = $key->{'last_status'}->{'content'};
			$key = substr(( "$ms ".($key->{'id'})." ".
		$sender." $ds ".
			unpack("${pack_magic}H*", $content).
			$space_pad), 0, 1024);
			print P $key;
			goto RESTART_SELECT;
		} elsif ($rout =~ /^ki ([^\s]+) /) {
			my $key = $1;
			my $module;
			read(STDIN, $module, 1024);
			$module =~ s/\s+$//;
			$module = pack("H*", $module);
			print $stdout "-- fetch for module $module key $key\n"
				if ($verbose);
			print P substr(unpack("${pack_magic}H*",
				$master_store->{$module}->{$key}).$space_pad,
					0, 1024);
			goto RESTART_SELECT;
		} elsif ($rout =~ /^kn ([^\s]+) /) {
			my $key = $1;
			my $module;
			read(STDIN, $module, 1024);
			$module =~ s/\s+$//;
			$module = pack("H*", $module);
			print $stdout "-- nulled module $module key $key\n"
				if ($verbose);
			$master_store->{$module}->{$key} = undef;
			goto RESTART_SELECT;
		} elsif ($rout =~ /^ko ([^\s]+) /) {
			my $key = $1;
			my $value;
			my $module;
			read(STDIN, $module, 1024);
			$module =~ s/\s+$//;
			$module = pack("H*", $module);
			read(STDIN, $value, 1024);
			$value =~ s/\s+$//;
			print $stdout
				"-- set module $module key $key = $value\n"
				if ($verbose);
			$master_store->{$module}->{$key} = pack("H*", $value);
			goto RESTART_SELECT;
		} elsif ($rout =~ /^sync/) {
			print $stdout "-- synced; exiting at ",
					scalar localtime, "\n"
				if ($verbose);
			exit $laststatus;
		} elsif ($rout =~ /^synm/) {
			$first_synch = $synchronous_mode = 1;
			print $stdout "-- background is now synchronous\n"
				if ($verbose);
		} elsif ($rout =~ /([\=\?\+])([^ ]+)/) {
			$comm = $1;
			$key =$2;
			if ($comm eq '?') {
				print P substr("${$key}$space_pad", 0, 1024);
			} else {
				read(STDIN, $value, 1024);
				$value =~ s/\s+$//;
				$interactive = ($comm eq '+') ? 0 : 1;
				if ($key eq 'tquery') {
					print $stdout
					"*** custom query installed\n"
						if ($interactive || $verbose);
					print $stdout
					"$value" if ($verbose);
					@trackstrings = ();
					# already URL encoded
					push(@trackstrings, $value);
				} else {
					$$key = $value;
					print $stdout
					"*** changed: $key => $$key\n"
						if ($interactive || $verbose);

					&generate_ansi if ($key eq 'ansi' ||
						$key =~ /^colour/);
					$rate_limit_next = 0
						if ($key eq 'pause' &&
							$value eq 'auto');
					&tracktags_makearray
						if ($key eq 'track');
					&filter_compile
						if ($key eq 'filter');
					&notify_compile
						if ($key eq 'notifies');
					&list_compile
						if ($key eq 'lists');
					&filterflags_compile
						if ($key eq 'filterflags');
					$filterrts_sub =
						&filteruserlist_compile(
							$filterrts_sub, $value)
						if ($key eq 'filterrts');
					$filterusers_sub =
						&filteruserlist_compile(
							$filterusers_sub,$value)
						if ($key eq 'filterusers');
					$filteratonly_sub =
						&filteruserlist_compile(
							$filteratonly_sub,
								$value)
						if ($key eq 'filteratonly');
					&filterats_compile
						if ($key eq 'filterats');
				}
			}
			goto RESTART_SELECT;
		} else {
			$interactive = 1;
			($fetchwanted = 0+$1, $fetch_id = 0, $last_id = 0)
				if ($rout =~ /^reset(\d+)/);
			($dmfetchwanted = 0+$1, $last_dm = 0)
				if ($rout =~ /^dmreset(\d+)/);
			if ($rout =~ /^dmreset/) { # /dms (received)
				$dmfetchwanted = 0+$1
					if ($rout =~ /(\d+)/);
				$dm_display_only = 1;  # Suppress notifications for user-initiated /dms
				&dmrefresh(1, 0);  # interactive=1, sent_dm=0 
				$dm_display_only = 0;  # Reset flag
				&send_repaint if ($termrl);
				# we do not want to force a refresh.
				goto DONT_REFRESH;
			} elsif ($rout =~ /^smreset/) { # /dmsent
				$dmfetchwanted = 0+$1
					if ($rout =~ /(\d+)/);
				$dm_display_only = 1;  # Suppress notifications for user-initiated /dmsent
				&dmrefresh(1, 1);  # interactive=1, sent_dm=1
				$dm_display_only = 0;  # Reset flag
				&send_repaint if ($termrl);
				# we do not want to force a refresh.
				goto DONT_REFRESH;
			}
			if ($rout =~ /^dmthump_no_skip/) {
				&dmrefresh(0);  # Force background-style refresh to update last_dm
				&send_repaint if ($termrl);
				$dmcount = $dmpause;
				# Don't skip - let timeline refresh continue
			} elsif ($rout =~ /^dm/) {
				&dmrefresh($interactive);
				&send_repaint if ($termrl);
				$dmcount = $dmpause;
				goto DONT_REFRESH;
			} elsif ($rout =~ /^notificationthump/) {
				&notificationrefresh($interactive);
				&send_repaint if ($termrl);
				$notificationcount = $notificationpause;
				goto DONT_REFRESH;
			}
		}
	} else {
		if ($we_got_signal || $nfound == -1) {
			# we need to restart the call. we might be waiting
			# longer, but this is unavoidable.
			goto RESTART_SELECT;
		}
		print $stdout
"-- routine refresh (effpause = $effpause, $dmcount to next dm) ",
			scalar localtime, "\n" if ($verbose);
	}
}

#### internal implementation functions for the fediverse API. DON'T ALTER ####

# manage automatic rate limiting by checking our max.
#TODO
# autoslowdown as we run out of requests, then speed up when hour
# has passed.
sub update_effpause {
	return ($effpause = undef) if ($script); # for select()
	if ($pause ne 'auto' && $noratelimit) {
		$effpause = (0+$pause) || undef;
		return;
	}
	$effpause = (0+$pause) || undef
		 if ($anonymous || (!$pause && $pause ne 'auto'));
	if (!$rate_limit_next && !$anonymous && ($pause > 0 ||
		$pause eq 'auto')) {

		# fediverse 1.0 used a simple remaining_hits and
		# hourly_limit. 1.1 uses multiple rate endpoints. we
		# are only interested in certain specific ones, though
		# we currently fetch them all and we might use more later.

		$rate_limit_next = 5;
		
		# For fediverse servers, rate limits come from HTTP headers, not JSON endpoints
		if ($authtype eq 'oauth2') {
			# Fediverse servers provide rate limits in HTTP headers from any API call
			# We'll extract them from the next API response we make
			$rate_limit_left = 300;  # Default assumption for fediverse
			$rate_limit_rate = 300;  # Most fediverse servers are quite generous
		} else {
			# fediverse OAuth 1.0a rate limiting (legacy)
			$rate_limit_ref = &grabjson($rlurl, 0, 0, 0, undef, 1);

			if (defined $rate_limit_ref &&
					ref($rate_limit_ref) eq 'HASH') {

				# of mentions_timeline, home_timeline and search/posts,
			# choose the MOST restrictive and normalize that.

				$rate_limit_left = &min(
	0+$rate_limit_ref->{'resources'}->{'statuses'}->{'\\/statuses\\/home_timeline'}->{'remaining'},
					&min(
	0+$rate_limit_ref->{'resources'}->{'statuses'}->{'\\/statuses\\/mentions_timeline'}->{'remaining'},
	0+$rate_limit_ref->{'resources'}->{'search'}->{'\\/search\\/posts'}->{'remaining'}));
				$rate_limit_rate = &min(
	0+$rate_limit_ref->{'resources'}->{'statuses'}->{'\\/statuses\\/home_timeline'}->{'limit'},
					&min(
	0+$rate_limit_ref->{'resources'}->{'statuses'}->{'\\/statuses\\/mentions_timeline'}->{'limit'},
	0+$rate_limit_ref->{'resources'}->{'search'}->{'\\/search\\/posts'}->{'limit'}));
			}
		}
		if ($rate_limit_left < 3 && $rate_limit_rate) {
			$estring = 
"*** warning: API rate limit imminent";
			if ($pause eq 'auto') {
				$estring .=
			"; temporarily halting autofetch";
				$effpause = 0;
			}
			&$exception(5, "$estring\n");
		} else {
			if ($pause eq 'auto') {

# the new rate limits do not require us to reduce our fetching for mentions,
# direct messages or search, because they pull from different buckets, and
# their rate limits are roughly the same.
				$effpause = 5*$rate_limit_rate;
				# Cap refresh rate for fediverse servers (generous rate limits)
				if ($effpause > 120) {
					$effpause = 120;  # Maximum 2 minutes for fediverse
				}
				# this will usually be 120s (fediverse rate limit cap)
# for lists, however, we have to drain the list bucket faster, so for every
# list AFTER THE FIRST ONE we subscribe to, add rate_limit_rate to slow.
# for search, it has 180 requests, so we don't care so much. if this
# changes later, we will probably need something similar to this for
# cases where the search array is > 1.
				$effpause += ((scalar(@listlist)-1)*
					$rate_limit_rate)
					if (scalar(@listlist) > 1);

				if (!$effpause) {
				if ($authtype eq 'oauth2') {
					print $stdout
"-- rate limit info unavailable: using 30 second fallback\n";
					$effpause = 30; # More reasonable for fediverse
				} else {
					print $stdout
"-- rate limit rate failure: using 180 second fallback\n";
					$effpause = 180; # fediverse fallback
				}
			}

				# we don't go under sixty.
				$effpause = 60 if ($effpause < 60);
			} else {
				$effpause = 0+$pause;
			}
			print $stdout
"-- rate limit check: $rate_limit_left/$rate_limit_rate (rate is $effpause sec)\n"
				if ($verbose);
			$adverb = (!$last_rate_limit) ? ' currently' :
		($last_rate_limit < $rate_limit_rate) ? ' INCREASED to':
		($last_rate_limit > $rate_limit_rate) ? ' REDUCED to':
					'';
			print $stdout 
"-- notification: API rate limit is${adverb} ${rate_limit_rate} req/15min\n"
				if ($last_rate_limit != $rate_limit_rate);
			$last_rate_limit = $rate_limit_rate;
		}
		# } else {
		#	$rate_limit_next = 0;
		#	$effpause = ($pause eq 'auto') ? 180 : 0+$pause;
		#	print $stdout
		#"-- failed to fetch rate limit (rate is $effpause sec)\n"
		#		if ($verbose);
		# }
	# } else {
	#	$rate_limit_next-- unless ($anonymous);
	# }
	
	# Fediverse fallback: ensure auto-refresh works even if rate limiting fails
	if (defined($pause) && $pause eq 'auto' && (!defined($effpause) || $effpause == 0)) {
		$effpause = 120;  # 2 minutes - consistent with fediverse cap
		print $stdout "-- using fallback refresh rate: $effpause seconds\n";
	}
	
	# Debug: always show current effpause value
	print $stdout "-- current effpause: " . (defined($effpause) ? $effpause : 'undefined') . " seconds\n" if ($verbose);
}

# streaming API support routines

### INITIALIZE STREAMING
### spin off a nurse process to proxy data from curl, and a buffer process
### to protect the background process from signals curl may generate.

sub start_streaming {
	$bufferpid = 0;
	unless ($streamtest) {
		if($bufferpid = open(STBUF, "-|")) {
			# streaming processes initialized
			return $bufferpid;
		}
	}

	# now within buffer process
	# verbosity does not work here, so force both off.
	$verbose = 0;
	$superverbose = 0;

	$0 = "TTYverse (streaming buffer thread)";
	$in_buffer = 1;
	# set up signal handlers
	$streampid = 0;
	&sigify(sub {
		# in an earlier version we wrote a disconnect packet to the
		# pipe in this handler. THIS IS NOT SAFE on certain OS/Perl
		# combinations. I moved this down to the HELLOAGAINNURSE loop,
		# or otherwise you get random seg faults.
		$i = $streampid;
		$streampid = 0;
		waitpid $i, 0 if ($i);
	}, qw(CHLD PIPE));
	&sigify(sub {
		$i = $streampid;
		$streampid = 0; # suppress handler above
		kill ($SIGHUP, $i) if ($i);
		waitpid $i, 0 if ($i);
		kill 9, $curlpid if ($curlpid && !$i);
		kill 9, $$;
	}, qw(HUP TERM));
	&sigify("IGNORE", qw(INT));

	$packets_read = 0; # part of exponential backoff
	$wait_time = 0;

	# open the nurse process
	HELLOAGAINNURSE: $w = "{\"packet\" : \"connect\", \"payload\" : {} }";
	select(STDOUT); $|++;
	printf STDOUT ("%08x%s", length($w), $w);
	close(NURSE);
	if (!$packets_read) { $wait_time += (($wait_time) ? $wait_time : 1) }
		else { $wait_time = 0; }
	$packets_read = 0;
	$wait_time = ($wait_time > 60) ? 60 : $wait_time;
	if ($streampid = open(NURSE, "-|")) {
		# within the buffer process
		select(NURSE); $|++; select(STDOUT);
		my $rin = '';
		vec($rin,fileno(NURSE),1) = 1;
		my $datasize = 0;
		my $buf = '';
		my $cuf = '';
		my $duf = '';

		# read the curlpid from the stream
		read(NURSE, $curlpax, 8);
		$curlpid = hex($curlpax);

		# if we are testing the socket, just emit data.
		if ($streamtest) {
			my $c;

			for(;;) {
				sysread(NURSE, $c, 1);
				print STDOUT $c;
			}
		}
		HELLONURSE: while(1) {
			# restart nurse process if it/curl died
			goto HELLOAGAINNURSE if(!$streampid);

			# read a line of text (hopefully numbers)
			chomp($buf = <NURSE>);
			# should be nothing but digits and whitespace.
			# if anything else, we're getting garbage, and we
			# should reconnect.
			if ($buf =~ /[^0-9\r\l\n\s]+/s) {
				close(NURSE);
				kill 9, $streampid if ($streampid);
					# and SIGCHLD will reap
				kill 9, $curlpid if ($curlpid);
				goto HELLOAGAINNURSE;
			}
			$datasize = 0+$buf;
			next HELLONURSE if (!$datasize);
			$datasize--;
			read(NURSE, $duf, $datasize);
			# don't send broken entries
			next HELLONURSE if (length($duf) < $datasize);
			# yank out all \r\n
			1 while $duf =~ s/[\r\n]//g;
			$duf = "{ \"packet\" : \"data\", \"pid\" : \"$streampid\", \"curlpid\" : \"$curlpid\", \"payload\" : $duf }";
			printf STDOUT ("%08x%s", length($duf), $duf);
			$packets_read++;
		}
	} else {
		# within the nurse process
		$0 = "TTYverse (waiting $wait_time sec to connect to stream)";
		sleep $wait_time;
		$curlpid = 0;
		$replarg = ($streamallreplies) ? '&replies=all' : '';
		&sigify(sub {
			kill 9, $curlpid if ($curlpid);
			waitpid $curlpid, 0 unless (!$curlpid);
			$curlpid = 0;
			kill 9, $$;
		}, qw(CHLD PIPE));
		&sigify(sub {
			kill 9, $curlpid if ($curlpid);
		}, qw(INT HUP TERM)); # which will cascade into SIGCHLD
		# Build streaming URL with appropriate parameters
		my $stream_endpoint;
		if ($authtype eq 'oauth2') {
			# Mastodon streaming - use Server-Sent Events
			$stream_endpoint = "$streamurl?stream=user";
		} else {
			# fediverse legacy streaming
			$stream_endpoint = "$streamurl?delimited=length${replarg}";
		}
		
		($comm, $args, $data) = &$stringify_args($baseagent,
			[ $stream_endpoint ],
			undef, undef,
			'-s',
			'-A', "TTYverse_Streaming/$TTYverse_VERSION",
			'-N',
			'-H', 'Expect:');
		($curlpid = open(K, "|$comm")) || die("failed curl: $!\n");
		printf STDOUT ("%08x", $curlpid);

		# "DIE QUICKLY"
		$0 = "TTYverse (streaming socket nurse thread to ${curlpid})";

		select(K); $|++; select(STDOUT); $|++;
		print K "$args\n";
		close(K);
		waitpid $curlpid, 0;
		$curlpid = 0;
		kill 9, $$;
	}
}

# handle a set of events acquired from the streaming socket.
# ordinarily only the background is calling this.
sub streamevents {
	my (@events) = (@_);
	my $w;
	my @x;
	my %k; # need temporary dedupe

	foreach $w (@events) {
		my $tmp;

		# Handle both fediverse (legacy) and Mastodon streaming formats
		if ($authtype eq 'oauth2') {
			# Mastodon streaming format - events have 'event' and 'payload' fields
			next unless (exists($w->{'event'}) && exists($w->{'payload'}));
			&handle_mastodon_stream_event($w);
		} else {
			# fediverse legacy format
			next if ($w->{'packet'} ne 'data');
			&handle_fediverse_stream_event($w);
		}
	}
}

sub handle_fediverse_stream_event {
	my $w = shift;
	my $tmp;

	# try to get PID information if available for faster shutdown
	$nnursepid = 0+($w->{'pid'});
	if ($nnursepid != $nursepid) {
		$nursepid = $nnursepid;
		print $stdout
"-- got new pid of streaming nurse socket process: $nursepid\n"
			if ($verbose);
	}
	$ncurlpid = 0+($w->{'curlpid'});
	if ($ncurlpid != $curlpid) {
		$curlpid = $ncurlpid;
		print $stdout
"-- got new pid of streaming curl process: $ncurlpid\n"
			if ($verbose);
	}

	# we don't use this (yet).
	return if ($w->{'payload'}->{'friends'});

	sleep 5 while ($suspend_output > 0);

	# dispatch posts
	if ($w->{'payload'}->{'text'} && !$notimeline) {
		# normalize the post first.
		my $payload = &normalizejson($w->{'payload'});
		my $sid = $payload->{'id_str'};

		$payload->{'tag'}->{'type'} = 'timeline';
		$payload->{'tag'}->{'payload'} = 'stream';

		# filter replies from streaming socket if the
		# user requested it. use $posttype to determine
		# this so the user can interpose custom logic.
		if ($nostreamreplies) {
			my $sn = &descape(
				$payload->{'user'}->{'username'} || $payload->{'user'}->{'acct'});
			my $text = &descape($payload->{'text'});
			return if (&$posttype($payload, $sn, $text) eq
				'reply');
		}

		# finally, filter everything else and dedupe.
		unless (length($id_cache{$sid}) ||
				$filter_next{$sid} ||
					$main::k{$sid}) {
			&tdisplay([ $payload ]);
			$main::k{$sid}++;
		}

		# roll *_id so that we don't do unnecessary work	
		# testing the API. don't roll fetch_id, search uses
		# it. don't roll if last_id was zero, because that
		# means we are streaming *before* the API backfetch.
		$last_id = $sid unless (!$last_id);
	}

	# dispatch DMs
	elsif (($tmp = $w->{'payload'}->{'direct_message'}) &&
			$dmpause) {
		&dmrefresh(0, 0, [ $tmp ]);
		# don't roll last_dm yet.
	}

	# must be an event. see if standardevent can make sense of it.
	elsif (!$notimeline) {
		$w = $w->{'payload'};
		my $sou_sn =
			&descape($w->{'source'}->{'username'} || $w->{'source'}->{'acct'});
		if (!length($sou_sn) || !$filterusers_sub ||
				!&$filterusers_sub($sou_sn)) {
			&send_removereadline if ($termrl);
			&$eventhandle($w);
			$wrapseq = 1;
			&send_repaint if ($termrl);
		}
	}
}

sub handle_mastodon_stream_event {
	my $w = shift;
	my $event_type = $w->{'event'};
	my $payload_json = $w->{'payload'};
	
	# Parse the JSON payload (Mastodon sends JSON as string)
	my $payload = &map_mastodon_fields(&parsejson($payload_json));
	
	sleep 5 while ($suspend_output > 0);
	
	# Handle different Mastodon event types
	if ($event_type eq 'update' && !$notimeline) {
		# New status/post
		my $sid = $payload->{'id_str'} || $payload->{'id'};
		
		$payload->{'tag'}->{'type'} = 'timeline';
		$payload->{'tag'}->{'payload'} = 'stream';
		
		# Filter replies if requested
		if ($nostreamreplies) {
			my $sn = &descape($payload->{'user'}->{'username'} || $payload->{'user'}->{'acct'});
			my $text = &descape($payload->{'text'});
			return if (&$posttype($payload, $sn, $text) eq 'reply');
		}
		
		# Filter and dedupe
		unless (length($id_cache{$sid}) ||
				$filter_next{$sid} ||
					$main::k{$sid}) {
			&tdisplay([ $payload ]);
			$main::k{$sid}++;
		}
		
		$last_id = $sid unless (!$last_id);
	}
	elsif ($event_type eq 'delete') {
		# Status deleted - payload is just the ID
		print $streamout "-- post $payload_json deleted\n" if ($verbose);
	}
	elsif ($event_type eq 'notification') {
		# New notification (follow, mention, boost, favourite)
		&send_removereadline if ($termrl);
		&$eventhandle($payload);
		$wrapseq = 1;
		&send_repaint if ($termrl);
	}
	elsif ($event_type eq 'conversation') {
		# Direct message update
		if ($dmpause) {
			&dmrefresh(0, 0, [ $payload ]);
		}
	}
	else {
		# Unknown event type
		print $streamout "-- unknown streaming event: $event_type\n" if ($verbose);
	}
}

# REST API support
#
# thump for timeline
# THIS MUST ONLY BE RUN BY THE BACKGROUND.
sub refresh {
	my $interactive = shift;
	my $relative_last_id = shift;
	my $k;
	my $my_json_ref = undef;
	my $i;
	my @streams = ();
	my $dont_roll_back_too_far = 0;

	# this mixes all the post streams (timeline, hashtags, replies
	# and lists) into a single unified data river.
	# backload can be zero, but this will still work since &grabjson
	# sees a count of zero as "default."

	# first, get my own timeline
	# note that anonymous has no timeline (but they can sample the
	# stream)
	unless ($notimeline || $anonymous) {
		# in streaming mode, use $last_id
		# in API mode, use $fetch_id
		my $since_id = ($dostream) ? $last_id : $fetch_id;
		print $stdout "-- DEBUG: Calling timeline API with since_id='$since_id', dostream=$dostream, last_id='$last_id', fetch_id='$fetch_id'\n" if ($verbose);
		my $base_json_ref = &grabjson($url,
			$since_id,
			0,
			(($last_id) ? 250 : $fetchwanted || $backload), {
				"type" => "timeline",
				"payload" => "api"
			}, 1);
		# if I can't get my own timeline, ABORT! highest priority!
		if (!defined($base_json_ref) || ref($base_json_ref) ne 'ARRAY') {
			print $stdout "-- DEBUG: grabjson failed for timeline - base_json_ref is " . 
				(defined($base_json_ref) ? ref($base_json_ref) : 'undefined') . "\n" if ($verbose);
			return;
		}
		print $stdout "-- DEBUG: grabjson returned " . scalar(@{ $base_json_ref }) . " posts from timeline\n" if ($verbose);

		# we have to filter against the ID cache right now, because
		# we might not have any other streams!
		if ($fetch_id && $last_id) {
			print $stdout "-- DEBUG: Filtering timeline posts (fetch_id=$fetch_id, last_id=$last_id)\n" if ($verbose);
			$my_json_ref = [];
			my $l;
			my %k; # need temporary dedupe
			my $filtered_count = 0;
			foreach $l (@{ $base_json_ref }) {
				if (length($id_cache{$l->{'id_str'}}) ||
						$filter_next{$l->{'id_str'}} ||
						$k{$l->{'id_str'}}) {
					$filtered_count++;
				} else {
					push(@{ $my_json_ref }, $l);
					$k{$l->{'id_str'}}++;
				}
			}
			print $stdout "-- DEBUG: After filtering: " . scalar(@{ $my_json_ref }) . " posts remain, $filtered_count filtered out\n" if ($verbose);
		} else {
			print $stdout "-- DEBUG: No filtering applied (fetch_id=$fetch_id, last_id=$last_id)\n" if ($verbose);
			$my_json_ref = $base_json_ref;
		}
	}

	# add stream for replies, if requested
	if ($mentions) {
		# same thing
		my $r = &grabjson($rurl,
			($dostream && !$nostreamreplies) ? $last_id : $fetch_id,
			0,
			(($last_id) ? 250
			: $fetchwanted || $backload), {
				"type" => "reply",
				"payload" => ""
			}, 1);
		push(@streams, $r)
			if (defined($r) &&
				ref($r) eq 'ARRAY' &&
				scalar(@{ $r }));
	}

	# next handle hashtags and tracktags
	# failure here does not abort, because search may be down independently
	# of the main timeline.
	if (!$notrack && scalar(@trackstrings)) {
		my $r;
		my $k;
		my $l;

		if (!$last_id) {
			$l = &min($backload, $searchhits);
		} else {
			$l = (($fetchwanted) ? $fetchwanted :
				&max(100, $searchhits));
		}
		# temporarily squelch server complaints (see below)
		$muffle_server_messages = 1 unless ($verbose);
		foreach $k (@trackstrings) {
		# use fetch_id here in both modes.
		$r = &grabjson("$queryurl?${k}&result_type=recent",
				$fetch_id, 0, $l, {
					"type" => "search",
					"payload" => $k
				}, 1);
		# depending on the state of the search API, we might be using
		# a bogus search ID that is too far back. so if this fails,
		# try again with last_id, but not if we're streaming (it
		# will always fetch zero).
			if (!defined($r) || ref($r) ne 'ARRAY' || !$dostream) {
		print $stdout "-- search retry $k attempted with last_id\n"
				if ($verbose);
		$r = &grabjson("$queryurl?${k}&result_type=recent",
				$last_id, 0, $l, {
					"type" => "search",
					"payload" => $k
				}, 1);
				$dont_roll_back_too_far = 1;
			}
		# or maybe not even then?
			if (!defined($r) || ref($r) ne 'ARRAY') {
		print $stdout "-- search retry $k attempted with zero!\n"
				if ($verbose);
		$r = &grabjson("$queryurl?${k}&result_type=recent",
				0, 0, $l, {
					"type" => "search",
					"payload" => $k
				}, 1);
				$dont_roll_back_too_far = 1;
			}
			push(@streams, $r)
				if (defined($r) &&
					ref($r) eq 'ARRAY' &&
					scalar(@{ $r }));
		}
		$muffle_server_messages = 0;
	}

	# add stream for lists we have on with /set lists, and tag it with
	# the list.
	if (scalar(@listlist)) {
		foreach $k (@listlist) {
			# Fediverse privacy: only allow access to own lists
			if ($k->[0] ne $whoami) {
				print $stdout "-- Skipping $k->[0]/$k->[1]: fediverse only allows access to your own lists (privacy feature)\n" if ($verbose);
				next;
			}
			
			# Convert list name to ID for fediverse API
			my $list_id = &lookup_list_id($k->[1]);
			if (!$list_id) {
				print $stdout "-- Skipping $k->[1]: list not found\n" if ($verbose);
				next;
			}
			
			# Build fediverse list timeline URL
			my $list_url = $statusliurl;
			$list_url =~ s/%I/$list_id/;
			
			# always use fetch_id
			my $r = &grabjson($list_url,
				$fetch_id, 0,
				(($last_id) ? 250 : $fetchwanted), {
					"type" => "list",
					"payload" => "$k->[1]"
				}, 1);
			push(@streams, $r)
				if (defined($r) && ref($r) eq 'ARRAY' &&
					scalar(@{ $r }));
		}
	}

	$fetchwanted = 0; # done with that.
	# now, streamix all the streams into my_json_ref, discarding duplicates
	# a simple hash lookup is no good; it has to be iterative. because of
	# that, we might as well just splice it in here and save a sort later.
	# the streammix logic is unnecessarily complex, probably.
	# remember, the most recent posts are FIRST.
	if (scalar(@streams)) {
		my $j;
		my $k;
		my $l = scalar(@{ $my_json_ref });
		my $m;
		my $n;

		foreach $n (@streams) {
			SMIX0: foreach $j (@{ $n }) {
				my $id = $j->{'id_str'}; # for ease of use
				# possible to happen if search tryhard is on
				next SMIX0 if ($id < $fetch_id);

				# filter this lot against the id cache
				# and any posts we just filtered.
				next SMIX0 if (length($id_cache{$id}) &&
					$fetch_id);
				next SMIX0 if ($filter_next{$id} &&
					$fetch_id);

				if (!$l) { # degenerate case
					push (@{ $my_json_ref }, $j);
					$l++;
					next SMIX0;
				}

				# find the same ID, or one just before,
				# and splice in
				$m = -1;
				SMIX1: for($i=0; $i<$l; $i++) {
					next SMIX0 # it's a duplicate
					if($my_json_ref->[$i]->{'id_str'} == $id);
					if($my_json_ref->[$i]->{'id_str'} < $id) {
						$m = $i;
						last SMIX1; # got it
					}
				}
				if ($m == -1) { # didn't find
					push (@{ $my_json_ref }, $j);
				} elsif ($m == 0) { # degenerate case
					unshift (@{ $my_json_ref }, $j);
				} else { # did find, so splice
					splice(@{ $my_json_ref }, $m, 0,
						$j);
				} 
				$l++;
			}
		}
	}
	%filter_next = ();

	# fetch_id gyration. initially start with last_id, then roll. we
	# want to keep a window, though, so we try to pick a sensible value
	# that doesn't fetch too much but includes some overlap. we can't
	# do computations on the ID itself, because it's "opaque."
	$fetch_id = 0 if ($last_id == 0);
	&send_removereadline if ($termrl);
	if ($dont_refresh_first_time) {
		print $stdout "-- DEBUG: First time startup path - posts in array: " . scalar(@{ $my_json_ref || [] }) . "\n" if ($verbose);
		if (scalar(@{ $my_json_ref || [] }) > 0 && defined($my_json_ref->[0]->{'id_str'})) {
			print $stdout "-- DEBUG: First time startup - setting last_id from '" . $my_json_ref->[0]->{'id_str'} . "'\n" if ($verbose);
			$last_id = &max($my_json_ref->[0]->{'id_str'}, $last_id);
		} else {
			print $stdout "-- DEBUG: First time startup - no posts or invalid ID, keeping last_id='$last_id'\n" if ($verbose);
		}
	} else {
		($last_id, $crap) =
			&tdisplay($my_json_ref, undef, $relative_last_id);
	}
	my $new_fi = (scalar(@{ $my_json_ref })) ?
		$my_json_ref->[(scalar(@{ $my_json_ref })-1)]->{'id_str'} :
		'';
	# try to widen the window to a "reasonable amount"
	$fetch_id = ($fetch_id == 0) ? $last_id :
		(length($new_fi) && $new_fi ne $last_id
			&& $new_fi > $fetch_id) ? $new_fi :
		($relative_last_id > 0 && $relative_last_id ne $last_id &&
				$relative_last_id > $fetch_id) ?
			$relative_last_id : $fetch_id;
	
	print $stdout
"-- last_id $last_id, fetch_id $fetch_id, rollback $relative_last_id\n".
"-- (@{[ scalar(keys %id_cache) ]} cached)\n"
		if ($verbose);
	
	# Clear initial load flag after first timeline display
	if ($initial_load_in_progress) {
		$initial_load_in_progress = 0;
		print $stdout "-- DEBUG: Initial timeline load complete, notifications now enabled\n" if ($verbose);
	}
	
	&send_removereadline if ($termrl);
	&$conclude;
	$wrapseq = 1;
	&send_repaint if ($termrl);
} 

# convenience function for filters (see below)
sub killtw { my $j = shift; $filtered++; $filter_next{$j->{'id_str'}}++
		if ($is_background); }

# handle (i.e., display) an array of posts in standard format
sub tdisplay { # used by both synchronous /again and asynchronous refreshes
	my $my_json_ref = shift;
	my $class = shift;
	my $relative_last_id = shift;
	my $mini_id = shift;
	my $printed = 0;
	my $disp_max = &min($print_max, scalar(@{ $my_json_ref }));
	my $save_counter = -1;
	my $i;
	my $j;

	if ($disp_max) { # null list may be valid if we get code 304
		unless ($is_background) { # reset store hash each console
			if ($mini_id) {
#TODO
# generalize this at some point instead of hardcoded menu codes
# maybe an ma0-mz9?
				$save_counter = $post_counter;
				$post_counter = $mini_split;
				for(0..9) {
					undef $store_hash{"zz$_"};
				}
			}# else {
			#	$post_counter = $back_split;
			#	%store_hash = ();
			#}
		}
		for($i = $disp_max; $i > 0; $i--) {
			my $g = ($i-1);
			$j = $my_json_ref->[$g];
			my $id = $j->{'id_str'};
			my $sn = $j->{'user'}->{'username'} || $j->{'user'}->{'acct'};
			next if (!length($sn));
			$sn = lc(&descape($sn));
			
			# Debug: Check what data is in the processing loop for boost posts
			if (exists($j->{'boost_attribution'}) && $j->{'boost_attribution'}) {
				my $text_debug = $j->{'text'} || '';
				print $stdout "-- DEBUG: Processing loop received boost - user: '$sn', text: '$text_debug', boost_attribution: '" . $j->{'boost_attribution'} . "'\n" if ($verbose);
			}

			#
			# implement filter stages:
			# do so in such a way that we can toss posts out
			# quickly, because multiple layers eat CPU!
			#

			# zeroth: if this is us, do not filter.
			if (($anonymous || $sn ne $whoami) && !($nofilter)) {

			# first, filterusers. this is very fast.
			# do for the post
			(&killtw($j), next) if
				($filterusers_sub &&
				&$filterusers_sub($sn));
			# and if the post has a reposted status, do for
			# that.
			(&killtw($j), next) if
				($j->{'reblog'} &&
				 $filterusers_sub &&
				&$filterusers_sub(lc(&descape($j->
					{'reblog'}->
					{'user'}->{'username'} || $j->{'user'}->{'acct'}))));

			# second, filterrts. this is almost as fast.
			(&killtw($j), next) if
				($filterrts_sub &&
				 length($j->{'reblog'}->{'id_str'})&&
				&$filterrts_sub($sn));

			# third, filteratonly. this has a fast case and a
			# slow case.
			my $tex = &descape($j->{'text'});
			(&killtw($j), next) if
				($filteratonly_sub &&
				&$filteratonly_sub($sn) && # fast test
				 $tex !~ /\@$whoami\b/i);  # slow test

			# fourth, filterats. this is somewhat expensive.
			(&killtw($j), next) if ($filterats_c &&
				&$filterats_c($tex));
			
			# finally, classic -filter. this is the most expensive.
			(&killtw($j), next) if ($filter_c && &$filter_c($tex));
			}

			# damn it, user may actually want this post.
			# assign menu codes and place into caches
			$key = (($is_background) ? '' : 'z' ).
				substr($alphabet, $post_counter/10, 1) .
				$post_counter % 10;
			$post_counter = 
				($post_counter == 259) ? $mini_split :
				($post_counter == ($mini_split - 1))
					? 0 : ($post_counter+1);
			$j->{'menu_select'} = $key;
			$key = lc($key);

			# recover ID cache memory: find the old ID with this
			# menu code and remove it, then add the new one
			# except if this is the foreground. we don't use this
			# in the foreground.
			if ($is_background) {
				delete $id_cache{$store_hash{$key}->{'id_str'}};
				$id_cache{$id} = $key;
			}

			# finally store in menu code cache
			$store_hash{$key} = $j;

			sleep 5 while ($suspend_output > 0);
			&send_removereadline if ($termrl);
			$wrapseq++;

			$printed += scalar(&$handle($j,
			($class || (($id le $relative_last_id) ? 'again' :
				undef))));
		}
	}
	$post_counter = $save_counter if ($save_counter > -1);
	sleep 5 while ($suspend_output > 0);
	&$exception(6,"*** warning: more posts than menu codes; truncated\n")
		if (scalar(@{ $my_json_ref }) > $print_max);
	if (($interactive || $verbose) && !$printed) {
		&send_removereadline if ($termrl);
		print $stdout "-- sorry, nothing to display.\n";
		$wrapseq = 1;
	}
	# Safe ID calculation - handle empty arrays
	my $new_max_id;
	if (scalar(@{ $my_json_ref }) > 0 && defined($my_json_ref->[0]->{'id_str'})) {
		my $first_post_id = $my_json_ref->[0]->{'id_str'};
		print $stdout "-- DEBUG: First post ID: '$first_post_id', current last_id: '$last_id'\n" if ($verbose);
		$new_max_id = &max($first_post_id, $last_id);
		print $stdout "-- DEBUG: max('$first_post_id', '$last_id') = '$new_max_id'\n" if ($verbose);
	} else {
		$new_max_id = $last_id;
		print $stdout "-- DEBUG: No valid posts for ID calculation, using last_id='$last_id'\n" if ($verbose);
	}
	print $stdout "-- DEBUG: tdisplay returning max_id='$new_max_id' (from " . scalar(@{ $my_json_ref }) . " posts)\n" if ($verbose);
	
	# Save completion cache after timeline processing
	if ($termrl && $termrl->ReadLine eq 'Term::ReadLine::Gnu') {
		my $cache_count = scalar(grep { /^@/ } keys %readline_completion);
		if ($cache_count > 0) {
			$last_cache_save = 0; # Force save
			&save_completion_cache;
			print $stdout "-- saved completion cache after timeline processing ($cache_count entries)\n" if ($verbose);
		}
	}
	
	return ($new_max_id, $j);
}

sub dt_tdisplay {
	my $my_json_ref = shift;
	my $class = shift;
	if (defined($my_json_ref)
		&& ref($my_json_ref) eq 'ARRAY'
			&& scalar(@{ $my_json_ref })) {
		my ($crap, $art) = &tdisplay($my_json_ref, $class);
		unless ($timestamp) {
			my ($time, $ts1) = &$wraptime(
$my_json_ref->[(&min($print_max,scalar(@{ $my_json_ref }))-1)]->{'created_at'});
			my ($time, $ts2) = &$wraptime($art->{'created_at'});
			print $stdout &wwrap(
				"-- update covers $ts1 thru $ts2\n");
		}
		&$conclude;
	}
}

sub notifications_tdisplay {
	my $my_json_ref = shift;
	if (defined($my_json_ref)
		&& ref($my_json_ref) eq 'ARRAY'
			&& scalar(@{ $my_json_ref })) {
		
		# Process each notification with proper type mapping
		for my $notification (@{ $my_json_ref }) {
			my $type = $notification->{'type'} || 'default';
			# Map Mastodon notification types to sound categories
			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');
			
			# Process as individual post with proper class
			&$handle($notification, $sound_class);
		}
		
		unless ($timestamp) {
			my ($time, $ts1) = &$wraptime(
$my_json_ref->[(&min($print_max,scalar(@{ $my_json_ref }))-1)]->{'created_at'});
			my ($time, $ts2) = &$wraptime($my_json_ref->[0]->{'created_at'});
			print $stdout &wwrap(
				"-- update covers $ts1 thru $ts2\n");
		}
		&$conclude;
	}
}

# thump for DMs
sub dmrefresh {
	my $interactive = shift;
	my $sent_dm = shift;
	# for streaming API to inject DMs it receives
	my $my_json_ref = shift;
	
	# Reset notification flag for this refresh cycle
	$dm_notification_sent = 0;

	if ($anonymous) {
		print $stdout
			"-- sorry, you can't read DMs 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); # NOT last_dm

	$my_json_ref = &grabjson((($sent_dm) ? $dmsenturl : $dmurl),
		(($sent_dm) ? 0 : $last_dm), 0, $dmfetchwanted, undef, 1)
			if (!defined($my_json_ref) ||
				ref($my_json_ref) ne 'ARRAY');
	return if (!defined($my_json_ref)
		|| ref($my_json_ref) ne 'ARRAY');

	my $orig_last_dm = $last_dm;
	$last_dm = 0 if ($sent_dm);

	$dmfetchwanted = 0;
	my $printed = 0;
	my $max = 0;
	my $disp_max = &min($print_max, scalar(@{ $my_json_ref }));
	my $i;
	my $g;
	my $key;

	print $stdout "-- DEBUG: DM response: " . scalar(@{ $my_json_ref }) . " conversations, disp_max=$disp_max\n" if ($verbose);

	# For background refresh, check if there are any unread DMs first
	if (!$interactive && !$sent_dm && $disp_max) {
		my $has_unread = 0;
		for (my $check_i = 0; $check_i < $disp_max; $check_i++) {
			my $check_j = $my_json_ref->[$check_i];
			next if (!$check_j->{'accounts'} || !@{$check_j->{'accounts'}} || !$check_j->{'last_status'});
			if ($check_j->{'unread'}) {
				$has_unread = 1;
				last;
			}
		}
		if (!$has_unread) {
			print $stdout "-- DEBUG: No unread DMs found in background refresh, returning early\n" if ($verbose);
			return;
		}
		print $stdout "-- DEBUG: Found unread DMs in background refresh, proceeding\n" if ($verbose);
	}

	if ($disp_max) { # an empty list can be valid
		if ($dm_first_time) {
			sleep 5 while ($suspend_output > 0);
			&send_removereadline if ($termrl);
			print $stdout
			"-- checking for most recent direct messages:\n";
			$disp_max = 2;
			$interactive = 1;
			print $stdout "-- DEBUG: dm_first_time: disp_max reduced to $disp_max\n" if ($verbose);
		}
		print $stdout "-- DEBUG: Starting DM display loop: $disp_max conversations\n" if ($verbose);
		for($i = $disp_max; $i > 0; $i--) {
			$g = ($i-1);
			my $j = $my_json_ref->[$g];
			print $stdout "-- DEBUG: Processing DM #$i (index $g)\n" if ($verbose);
			
			# Skip if missing data
			if (!$j->{'accounts'} || !@{$j->{'accounts'}} || !$j->{'last_status'}) {
				print $stdout "-- DEBUG: Skipping DM #$i - missing data (accounts=" . (defined($j->{'accounts'}) ? scalar(@{$j->{'accounts'}}) : 'undef') . ")\n" if ($verbose);
				next;
			}
			
			# For background refresh (interactive=0), use unread flag detection with local tracking fallback
			if (!$interactive && !$sent_dm) {
				my $is_unread = $j->{'unread'} || 0;
				my $conversation_id = $j->{'id'};
				my $last_status_id = $j->{'last_status'}->{'id'} || $j->{'last_status'}->{'id_str'};
				my $tracking_key = "${conversation_id}:${last_status_id}";
				
				print $stdout "-- DEBUG: DM #$i unread flag: " . ($is_unread ? "true" : "false") . ", tracking_key: $tracking_key\n" if ($verbose);
				
				# Check if we've already seen this exact conversation+status combination
				if ($dm_seen_status{$tracking_key}) {
					print $stdout "-- DEBUG: Skipping DM #$i - already seen locally (key: $tracking_key)\n" if ($verbose);
					next;
				}
				
				# For servers that support unread flag, also check that
				if (!$is_unread && !$dm_seen_status{$tracking_key}) {
					print $stdout "-- DEBUG: Skipping DM #$i - already read (unread=false)\n" if ($verbose);
					next;
				}
				
				# Only play sound for the first unread conversation to avoid spam
				if ($dm_notification_sent) {
					print $stdout "-- DEBUG: Suppressing notification for DM #$i - already notified this cycle\n" if ($verbose);
					# Still display the DM but suppress notification
				} else {
					# Mark that we will send a notification for this unread DM
					print $stdout "-- DEBUG: Will send notification for unread DM #$i\n" if ($verbose);
				}
			}

			$key = substr($alphabet, $dm_counter/10, 1) .
				$dm_counter % 10;
			$dm_counter = 
				($dm_counter == 259) ? 0 :
				($dm_counter+1);
			$j->{'menu_select'} = $key;
			$dm_store_hash{lc($key)} = $j;

			sleep 5 while ($suspend_output > 0);
			&send_removereadline if ($termrl);
			$wrapseq++;

			print $stdout "-- DEBUG: Calling dmhandle for DM #$i\n" if ($verbose);
			my $dm_result = scalar(&$dmhandle($j));
			print $stdout "-- DEBUG: dmhandle returned: $dm_result\n" if ($verbose);
			$printed += $dm_result;
		}
		$max = $my_json_ref->[0]->{'id'};
	}
	sleep 5 while ($suspend_output > 0);
	if (($interactive || $verbose) && !$printed && !$dm_first_time) {
		&send_removereadline if ($termrl);
		print $stdout (($sent_dm)
			? "-- you haven't sent anything yet.\n"
			: "-- sorry, no new direct messages.\n");
		$wrapseq = 1;
	}
	# Update last_dm for background refresh AND manual /dms 
	# Background calls: $interactive=0
	# Manual /dms: $interactive=1, $sent_dm=0 (receives messages, should update read marker)
	# Manual /dmsent: $interactive=1, $sent_dm=1 (shows sent messages, don't update)
	if (!$interactive || $dm_first_time || ($interactive && !$sent_dm)) {
		$last_dm = ($sent_dm) ? $orig_last_dm 
			: &max($last_dm, $max);
		
		# Update content bookmark for the newest DM (index 0)
		if (!$sent_dm && scalar(@{ $my_json_ref }) > 0) {
			my $newest_dm = $my_json_ref->[0];
			if ($newest_dm->{'last_status'}) {
				# Track newest DM for next comparison (unread flag handles change detection)
			}
		}
		
		print $stdout "-- DEBUG: Updated last_dm to $last_dm (interactive=$interactive, dm_first_time=$dm_first_time, sent_dm=$sent_dm)\n" if ($verbose);
	} else {
		print $stdout "-- DEBUG: NOT updating last_dm (interactive=$interactive, keeping last_dm=$last_dm)\n" if ($verbose);
	}
	$dm_first_time = 0 if ($last_dm || !scalar(@{ $my_json_ref }));
	print $stdout "-- dm bookmark is $last_dm.\n" if ($verbose);
	
	# Save completion cache after processing DMs
	my $dm_users_added = scalar(grep { /^@/ } keys %readline_completion) - 10; # original timeline users
	if ($dm_users_added > 0) {
		print $stdout "-- saving completion cache after DM processing ($dm_users_added DM users added)\n" if ($verbose);
		&save_completion_cache;
	}
	
	&$dmconclude;
	&send_repaint if ($termrl);
}	

# post an update
# this is a general API function that handles status updates and sending DMs.
sub updatest {
	my $string = shift;
	my $interactive = shift;
	my $in_reply_to = shift;
	my $user_name_dm = shift;
	my $rt_id = shift; # even if this is set, string should also be set.
	my $urle = '';
	my $i;
	my $subpid;
	my $istring;

	my $verb = (length($user_name_dm)) ? "DM $user_name_dm" :
			($rt_id) ? 'RE-post' :
			'post';

	if ($anonymous) {
		print $stdout
		"-- sorry, you can't $verb if you're anonymous.\n"
			if ($interactive);
		return 99;
	}

	# "the pastebrake" - enhanced paste protection
	if (!$slowpost && !$verify && !$script) {
		my $current_time = time();
		
		# Check if posting too fast (more than 2 posts in 3 seconds)
		if (($current_time - $postbreak_time) < 3) {
			$postbreak_count++;
			
			# First warning after 2 rapid posts
			if ($postbreak_count == 2) {
				print $stdout
		"-- PASTE PROTECTION: You're posting very fast!\n".
		"-- This might be an accidental paste. Press CTRL-C to abort!\n".
		"-- Waiting 5 seconds... (posts will be ignored during this time)\n";
				
				# Install signal handler for interrupt
				local $SIG{INT} = sub {
					print $stdout "\n-- PASTE ABORTED by user! No more posts will be sent.\n";
					$postbreak_count = 999; # Block further posts
					die "User aborted paste sequence\n";
				};
				
				# Wait with interrupt checking
				for my $i (1..5) {
					print $stdout "-- $i... ";
					sleep 1;
				}
				print $stdout "\n-- Continuing (press CTRL-C quickly to abort next posts)\n";
			}
			
			# After 4 posts, require confirmation
			if ($postbreak_count >= 4) {
				print $stdout
		"-- PASTE PROTECTION: Blocking rapid posts!\n".
		"-- You've posted $postbreak_count times in quick succession.\n".
		"-- Type 'continue' to keep posting, or CTRL-C to abort: ";
				
				my $response = <STDIN>;
				chomp($response);
				
				if (lc($response) ne 'continue') {
					print $stdout "-- Paste sequence aborted by user.\n";
					return 98; # Return without posting
				}
				
				print $stdout "-- Continuing paste sequence...\n";
				$postbreak_count = 0; # Reset after confirmation
			}
		} else {
			# Reset counter if enough time has passed
			$postbreak_count = 0;
		}
		$postbreak_time = $current_time;
	}

	my $payload = 'status'; # Always use 'status' for Mastodon
	$string = &$prepost($string) unless ($rt_id);

	# YES, you *can* verify and slowpost. I thought about this and I
	# think I want to allow it.
	if ($verify && !$status) {
		my $answer;

		print $stdout
			&wwrap("-- verify you want to $verb: \"$string\"\n");
		$answer = lc(&linein(
			"-- send to server? (only y or Y is affirmative):"));
		if ($answer ne 'y') {
			print $stdout "-- ok, NOT sent to server.\n";
			return 97;
		}
	}

	unless ($rt_id) {
		$urle = '';
		foreach $i (unpack("${pack_magic}C*", $string)) {
			my $k = chr($i);
			if ($k =~ /[-._~a-zA-Z0-9]/) {
				$urle .= $k;
			} else {
				$k = sprintf("%02X", $i);
				$urle .= "%$k";
			}
		}
	}

	# Keep $user_name_dm as-is for Mastodon DM handling

	my $i = '';
	$i .= "source=TTYverse&" if ($authtype eq 'basic');
	$i .= "in_reply_to_status_id=${in_reply_to}&" if ($in_reply_to > 0);
	if (!$rt_id && defined $lat && defined $long && $location) {
		print $stdout "-- using lat/long: ($lat, $long)\n";
		$i .= "lat=${lat}&long=${long}&";
	} elsif ((defined $lat || defined $long) && $location && !$rt_id) {
		print $stdout
		"-- warning: incomplete location ($lat, $long) ignored\n";
	}
	if ($rt_id) {
		$i .= "id=$rt_id";
	} else {
		if (length($user_name_dm)) {
			# For DMs: include mention in status and set visibility
			# 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);
				if ($k =~ /[-._~a-zA-Z0-9]/) {
					$dm_urle .= $k;
				} else {
					$k = sprintf("%02X", $char);
					$dm_urle .= "%$k";
				}
			}
			$i .= "${payload}=${dm_urle}&";
			$i .= "visibility=direct&";
		} else {
			$i .= "${payload}=${urle}&";
			$i .= "visibility=${post_visibility}&";
		}
	}
	$slowpost += 0; if ($slowpost && !$script && !$status && !$silent) {
		if($pid = open(SLOWPOST, '-|')) {
			# pause background so that it doesn't kill itself
			# when this signal occurs.
			kill $SIGUSR1, $child;
			print $stdout &wwrap(
	"-- waiting $slowpost seconds to $verb, ^C cancels: \"$string\"\n");
			close(SLOWPOST); # this should wait for us
			if ($? > 256) {
				print $stdout
					"\n-- not sent, cancelled by user\n";
				return 97;
			}
			print $stdout "-- sending to server\n";
			kill $SIGUSR2, $child;
			&send_removereadline if ($termrl && $dostream);
		} else {
			$in_backticks = 1; # defeat END sub
			&sigify(sub { exit 254; }, qw(BREAK INT TERM PIPE));
			sleep $slowpost;
			exit 0;
		}
	}
	my $return = &backticks($baseagent, '/dev/null', undef,
		($rt_id) ? ($reblogurl =~ s/%I/$rt_id/gr) : $update,
		$i, 0, @wend);
	print $stdout "-- return --\n$return\n-- return --\n"
		if ($superverbose);
	if ($? > 0) {
		$x = $? >> 8;
		print $stdout <<"EOF" if ($interactive);
${MAGENTA}*** warning: connect timeout or no confirmation received ($x)
*** to attempt a resend, type %%${OFF}
EOF
		return $?;
	}
	my $ec;
	if ($ec = &is_json_error($return)) {
		print $stdout <<"EOF" if ($interactive);
${MAGENTA}*** warning: server error message received
*** "$ec"${OFF}
EOF
		return 98;
	}
	if ($ec = &is_fail_whale($return) ||
			$return =~ /^\[?\]?<!DOCTYPE\s+html/i ||
			$return =~ /^(Status:\s*)?50[0-9]\s/ ||
			$return =~ /^<html>/i ||
			$return =~ /^<\??xml\s+/) {
		print $stdout <<"EOF" if ($interactive);
${MAGENTA}*** warning: Server temporarily unavailable${OFF}
EOF
		return 98;
	}
	$lastpostid = &map_mastodon_fields(&parsejson($return))->{'id_str'};
	unless ($user_name_dm || $rt_id) {
		$lasttwit = $string;
		&$postpost($string);
	}
	
	# Send "me" notification for outgoing DMs  
	if ($user_name_dm) {
		&notifytype_dispatch('me', $string, undef);
	}
	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 {
				# Call handle directly with the proper sound class
				print $stdout "-- DEBUG: Calling handle with sound class '$sound_class'\n" if ($verbose);
				&$handle($notif, $sound_class);
			}
			$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.
sub central_cd_dispatch {
	my ($payload, $interactive, $update) = (@_);
	my $return = &backticks($baseagent, '/dev/null', undef,
		$update, $payload, 0, @wend);
	print $stdout "-- return --\n$return\n-- return --\n"
		if ($superverbose);
	if ($? > 0) {
		$x = $? >> 8;
		print $stdout <<"EOF" if ($interactive);
${MAGENTA}*** warning: connect timeout or no confirmation received ($x)
*** to attempt again, type %%${OFF}
EOF
		return ($?, '');
	}
	my $ec;
	if ($ec = &is_json_error($return)) {
		print $stdout <<"EOF" if ($interactive);
${MAGENTA}*** warning: server error message received
*** "$ec"${OFF}
EOF
		return (98, $return);
	}
	return (0, $return);
}

# the following functions may be user-exposed in a future version of
# TTYverse, but are officially still "private interfaces."
# delete a status
sub deletest {
	my $id = shift;
	my $interactive = shift;
	my $url = $delurl;

	$url =~ s/%I/$id/;
	my ($en, $em) = &central_cd_dispatch("id=$id", $interactive, $url);
	print $stdout "-- post id #${id} has been removed\n"
		if ($interactive && !$en);
	print $stdout "*** (was the post already deleted?)\n"
		if ($interactive && $en);
	return 0;
}

# delete a DM
sub deletedm {
	my $id = shift;
	my $interactive = shift;

	my ($en, $em) = &central_cd_dispatch("id=$id", $interactive, $dmdelurl);
	print $stdout "-- DM id #${id} has been removed\n"
		if ($interactive && !$en);
	print $stdout "*** (was the DM already deleted?)\n"
		if ($interactive && $en);
	return 0;
}

# create or destroy a favourite
sub cordfav {
	my $id = shift;
	my $interactive = shift;
	my $basefav = shift;
	my $text = shift;
	my $verb = shift;

	my ($en, $em) = &central_cd_dispatch("id=$id", $interactive, $basefav);
	print $stdout "-- favourite $verb for post id #${id}: \"$text\"\n"
		if ($interactive && !$en);
	print $stdout "*** (was the favourite already ${verb}?)\n"
		if ($interactive && $en);
	return 0;
}

# follow or unfollow a user
sub foruuser {
	my $uname = shift;
	my $interactive = shift;
	my $basef = shift;
	my $verb = shift;

	# Look up account ID for the username
	my $account_id = &lookup_account_id($uname);
	if (!$account_id) {
		&report_account_not_found($uname, $interactive);
		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, $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;
}

# block or unblock a user
sub boruuser {
	my $uname = shift;
	my $interactive = shift;
	my $basef = shift;
	my $verb = shift;

	# Look up account ID for the username
	my $account_id = &lookup_account_id($uname);
	if (!$account_id) {
		&report_account_not_found($uname, $interactive);
		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, $api_url);
	print $stdout "-- ok, you have $verb blocking user $uname.\n"
		if ($interactive && !$en);
	return 0;
}

# enable or disable reposts for a user
sub rtsonoffuser {
	my $uname = shift;
	my $interactive = shift;
	my $selection = shift;
	my $verb = ($selection) ? 'enabled' : 'disabled';
	my $tval = ($selection) ? 'true' : 'false';

	# Look up account ID for the username
	my $account_id = &lookup_account_id($uname);
	if (!$account_id) {
		&report_account_not_found($uname, $interactive);
		return 1;
	}

	my ($en, $em) = &central_cd_dispatch(
		"reposts=${tval}&id=${account_id}",
		$interactive, $frupdurl);
	print $stdout "-- ok, you have ${verb} boosts for user $uname.\n"
		if ($interactive && !$en);
	return 0;
}

#### TTYverse internal API utility functions ####
# ... which your API *can* call

# gets and returns the contents of a URL (optionally pass a POST body)
sub graburl {
	my $resource = shift;
	my $data = shift;
	
	return &backticks($baseagent,
		'/dev/null', undef, $resource, $data,
		1, @wind);
}

# format a post based on user options
sub standardpost {
	my $ref = shift;
	my $nocolour = shift;

	my $sn = &descape($ref->{'user'}->{'acct'} || $ref->{'user'}->{'username'});
	my $post = &descape($ref->{'text'});
	
	# Add usernames to completion cache
	if ($termrl && $sn) {
		$readline_completion{'@'.$sn}++;
		my $total_keys = scalar(keys %readline_completion);
		print STDERR "COMPLETION: Added \@$sn to completion cache (total: $total_keys)\n" if ($verbose);
		# Don't save on every add - let the final save handle it
	}
	
	# Debug boost display
	if (exists($ref->{'boost_attribution'}) && $ref->{'boost_attribution'}) {
		print $stdout "-- DEBUG: standardpost - user: '$sn', text: '$post', boost_attribution: '" . $ref->{'boost_attribution'} . "'\n" if ($verbose);
		
		# Also add boost attribution to completion cache
		if ($termrl) {
			my $booster = &descape($ref->{'boost_attribution'});
			if ($booster) {
				$readline_completion{'@'.$booster}++;
				my $total_keys = scalar(keys %readline_completion);
				print STDERR "COMPLETION: Added \@$booster (booster) to completion cache (total: $total_keys)\n" if ($verbose);
				# Don't save on every add - let the final save handle it
			}
		}
	}
	
	my $colour;
	my $g;
	my $h;

	# wordwrap really ruins our day here, thanks a lot, @augmentedfourth
	# have to insinuate the ansi sequences after the string is wordwrapped

	$g = $colour = ${'CC' . scalar(&$posttype($ref, $sn, $post)) }
		unless ($nocolour);
	$colour = $OFF . $colour
		unless ($nocolour);

	# prepend screen name "badges"
	$sn = "\@$sn" if ($ref->{'in_reply_to_status_id_str'} > 0);
	$sn = "+$sn" if ($ref->{'user'}->{'geo_enabled'} eq 'true' &&
		(($ref->{'geo'}->{'coordinates'}->[0] ne 'undef' &&
		length($ref->{'geo'}->{'coordinates'}->[0]) &&
		$ref->{'geo'}->{'coordinates'}->[1] ne 'undef' &&
		length($ref->{'geo'}->{'coordinates'}->[0])) ||
		length($ref->{'place'}->{'id'})));
	$sn = "%$sn" if (length($ref->{'reblog'}->{'id_str'}));
	$sn = "*$sn" if ($ref->{'source'} =~ /TTYverse/ && $ttytteristas);
	# prepend list information, if this post originated from a list
	$sn = "($ref->{'tag'}->{'payload'})$sn"	
		if (length($ref->{'tag'}->{'payload'}) &&
			$ref->{'tag'}->{'type'} eq 'list');

	# Build the metadata/info line: <user> [boost] (time) via client
	my $info_line = "<$sn>";
	
	# Add boost attribution if this is a boosted post
	if (exists($ref->{'boost_attribution'}) && $ref->{'boost_attribution'}) {
		my $booster = &descape($ref->{'boost_attribution'});
		$info_line .= " [boosted $booster]";
	}
	
	# Add relative time and client info
	my $relative_time = &format_relative_time($ref->{'created_at'});
	my $client_info = &format_client_info($ref);
	
	$info_line .= " ($relative_time)" if ($relative_time);
	$info_line .= " via $client_info" if ($client_info);
	
	# Add visibility indicator
	my $visibility = $ref->{'visibility'} || 'public';  # Default to public if not specified
	my $vis_display = '';
	my $vis_color = '';
	
	if ($visibility eq 'public') {
		$vis_display = '[Public]';
		$vis_color = $CYAN;  # Subtle cyan for public
	} elsif ($visibility eq 'unlisted') {
		$vis_display = '[Unlisted]';
		$vis_color = $MAGENTA;  # Purple for unlisted
	} elsif ($visibility eq 'private') {
		$vis_display = '[Followers]';
		$vis_color = $YELLOW;  # Yellow for followers-only
	} elsif ($visibility eq 'direct') {
		$vis_display = '[Direct]';
		$vis_color = $RED;  # Red for direct messages
	}
	
	if ($vis_display) {
		if ($nocolour) {
			$info_line .= " $vis_display";
		} else {
			$info_line .= " ${vis_color}${vis_display}${OFF}";
		}
	}
	
	# Add poll indicator if this post has a poll
	if (exists($ref->{'poll'}) && $ref->{'poll'}) {
		my $poll_indicator = '[Poll]';
		if ($nocolour) {
			$info_line .= " $poll_indicator";
		} else {
			$info_line .= " ${GREEN}${poll_indicator}${OFF}";
		}
	}
	
	# Add content warning/title if present
	my $cw_text = '';
	if (exists($ref->{'reblog'}) && $ref->{'reblog'} && exists($ref->{'reblog'}->{'spoiler_text'})) {
		# For boost posts, check original post's content warning
		$cw_text = $ref->{'reblog'}->{'spoiler_text'};
	} elsif (exists($ref->{'spoiler_text'})) {
		# Regular post content warning
		$cw_text = $ref->{'spoiler_text'};
	}
	
	if ($cw_text && length($cw_text)) {
		$cw_text = &descape($cw_text);
		$info_line .= " [$cw_text]";
	}
	
	# fediverse doesn't always do this right.
	$h = $ref->{'reblogs_count'}; $h += 0; #$h = "${h}+" if ($h >= 100);
	# fediverse doesn't always handle single reposts right. good f'n grief.
	$info_line = "(x${h}) $info_line" if ($h > 1 && !$noreblogs);
	
	# br3nda's modified timestamp patch (absolute timestamp)
	if ($timestamp) {
		my ($time, $ts) = &$wraptime($ref->{'created_at'});
		$info_line = "[$ts] $info_line";
	}
	
	# Combine info line + content with newline separation
	$post = $info_line . "\n" . $post;
	
	# Add poll information if this post has a poll
	if (exists($ref->{'poll'}) && $ref->{'poll'}) {
		my $poll_info = &format_poll_display($ref->{'poll'});
		$post .= "\n$poll_info" if ($poll_info);
	}
	
	# pull it all together
	$post = &wwrap($post, ($wrapseq <= 1) ? ((&$prompt(1))[1]) : 0)
		if ($wrap); # remember to account for prompt length on #1
	$post =~ s/^([^<]*)<([^>]+)>/${g}\1<${EM}\2${colour}>/
		unless ($nocolour);
	$post =~ s/\n*$//;
	$post .= ($nocolour) ? "\n" : "$OFF\n";

	# highlight anything that we have in track
	if(scalar(@tracktags)) { # I'm paranoid
		foreach $h (@tracktags) {
			$h =~ s/^"//; $h =~ s/"$//; # just in case
$post =~ s/(^|[^a-zA-Z0-9])($h)([^a-zA-Z0-9]|$)/\1${EM}\2${colour}\3/ig
			unless ($nocolour);
		}
	}

	# smb's underline/bold patch goes on last (modified for lists)
	unless ($nocolour) {
		# only do this after the < > portion.
		my $k = index($post, ">");
		my $botsub = substr($post, $k);
		my $topsub = substr($post, 0, $k);
		$botsub =~
s/(^|[^a-zA-Z0-9_])\@([a-zA-Z0-9_\/]+)/\1\@${UNDER}\2${colour}/g;
		$post = $topsub . $botsub;
	}

	return $post;
}

# format poll information for display
sub format_poll_display {
	my $poll = shift;
	return '' unless ($poll && ref($poll) eq 'HASH');
	
	my @options = @{$poll->{'options'} || []};
	return '' unless (@options);
	
	my $poll_text = "Poll:";
	my $option_num = 1;
	
	# Display each option with number and vote count
	foreach my $option (@options) {
		my $title = &descape($option->{'title'} || '');
		my $votes = $option->{'votes_count'} || 0;
		$poll_text .= "\n  $option_num. $title ($votes votes)";
		$option_num++;
	}
	
	# Add poll metadata
	my $total_votes = $poll->{'votes_count'} || 0;
	my $expires_at = $poll->{'expires_at'};
	my $expired = $poll->{'expired'} || 0;
	my $multiple = $poll->{'multiple'} || 0;
	my $voted = $poll->{'voted'} || 0;
	
	$poll_text .= "\n  Total: $total_votes votes";
	$poll_text .= $multiple ? " (multiple choice)" : " (single choice)";
	
	if ($expired) {
		$poll_text .= " - EXPIRED";
	} elsif ($expires_at) {
		$poll_text .= " - expires $expires_at";
	}
	
	if ($voted) {
		$poll_text .= " - Already voted";
	} else {
		$poll_text .= " - Use /vote to participate";
	}
	
	return $poll_text;
}

# format relative time (e.g., "5 minutes ago", "2 hours ago")
sub format_relative_time {
	my $created_at = shift;
	return '' unless ($created_at);
	
	# Parse the fediverse timestamp format (ISO 8601)
	# Example: "2025-07-26T12:34:56.000Z"
	my ($year, $month, $day, $hour, $min, $sec);
	if ($created_at =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})/) {
		($year, $month, $day, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6);
	} else {
		return '';
	}
	
	# Convert to Unix timestamp
	my $post_time = eval {
		require Time::Local;
		Time::Local::timegm($sec, $min, $hour, $day, $month - 1, $year);
	};
	return '' if (!defined($post_time) || $@);
	
	my $now = time();
	my $diff = $now - $post_time;
	
	# Handle future timestamps (clock skew)
	return "just now" if ($diff < 0);
	
	# Calculate relative time
	if ($diff < 60) {
		return "just now";
	} elsif ($diff < 3600) { # Less than 1 hour
		my $minutes = int($diff / 60);
		return "${minutes}m ago";
	} elsif ($diff < 86400) { # Less than 1 day
		my $hours = int($diff / 3600);
		return "${hours}h ago";
	} elsif ($diff < 604800) { # Less than 1 week
		my $days = int($diff / 86400);
		return "${days}d ago";
	} elsif ($diff < 2629746) { # Less than 1 month (30.44 days)
		my $weeks = int($diff / 604800);
		return "${weeks}w ago";
	} elsif ($diff < 31556952) { # Less than 1 year
		my $months = int($diff / 2629746);
		return "${months}mo ago";
	} else {
		my $years = int($diff / 31556952);
		return "${years}y ago";
	}
}

# format client application info
sub format_client_info {
	my $ref = shift;
	
	# For boost posts, show client of original post
	my $app_data;
	if (exists($ref->{'reblog'}) && $ref->{'reblog'} && exists($ref->{'reblog'}->{'application'})) {
		$app_data = $ref->{'reblog'}->{'application'};
	} elsif (exists($ref->{'application'})) {
		$app_data = $ref->{'application'};
	}
	
	return '' unless ($app_data && ref($app_data) eq 'HASH');
	
	my $client_name = $app_data->{'name'} || '';
	return '' unless ($client_name);
	
	# Clean up common client names for better display
	if ($client_name =~ /^mastodon/i) {
		return "Web" if ($client_name =~ /web/i);
		return "Mobile" if ($client_name =~ /mobile|android|ios/i);
	}
	
	# Handle common clients
	$client_name = "Tusky" if ($client_name =~ /tusky/i);
	$client_name = "Subway Tooter" if ($client_name =~ /subway.*tooter/i);
	$client_name = "Fedilab" if ($client_name =~ /fedilab/i);
	$client_name = "TTYverse" if ($client_name =~ /ttyverse/i);
	
	return $client_name;
}

# format a DM based on standard user options
sub standarddm {
	my $ref = shift;
	my $nocolour = shift;

	my ($time, $ts) = &$wraptime($ref->{'last_status'}->{'created_at'});
	my $text = &descape(&html_to_text($ref->{'last_status'}->{'content'}));
	my $sns = &descape($ref->{'last_status'}->{'account'}->{'username'} || $ref->{'last_status'}->{'account'}->{'acct'});
	
	# Add relative time for DMs
	my $relative_time = &format_relative_time($ref->{'last_status'}->{'created_at'});
	
	# Build DM info line: [DM code][user] (relative_time)
	my $dm_info = "[DM d$ref->{'menu_select'}][$sns]";
	$dm_info .= " ($relative_time)" if ($relative_time);
	
	# Combine info line + content with newline (new two-line format)
	my $g = &wwrap($dm_info . "\n" . $text, ($wrapseq <= 1) ? ((&$prompt(1))[1]) : 0);

	$g =~ s/^\[DM ([^\/]+)\//${CCdm}[DM ${EM}\1${OFF}${CCdm}\//
		unless ($nocolour);
	$g =~ s/\n*$//;
	$g .= ($nocolour) ? "\n" : "$OFF\n";
	$g =~ s/(^|[^a-zA-Z0-9_])\@(\w+)/\1\@${UNDER}\2${OFF}${CCdm}/g
		unless ($nocolour);
	return $g;
}

# format an event record based on standard user options (mostly for
# streaming API, perhaps REST API one day)
sub standardevent {
	my $ref = shift;
	my $nocolour = shift;

	my $g = '>>> ';
	my $verb = &descape($ref->{'event'});
	
	# ActivityPub streaming API messages

	if (length($verb)) { # see below for server-level events
		my $tar_sn = '@'.&descape($ref->{'target'}->{'acct'} || $ref->{'target'}->{'username'});
		my $sou_sn = '@'.&descape($ref->{'source'}->{'acct'} || $ref->{'source'}->{'username'});
		
		my $tar_list_name = '';
		my $tar_list_desc = '';
		
		# For all verbs starting with "list", get name and desc
		if ($verb =~ m/^list/ ) {
			$tar_list_name = &descape($ref->{'target_object'}->{'full_name'});
			$tar_list_desc = &descape($ref->{'target_object'}->{'description'});
		}
		
		if ($verb eq 'favorite' || $verb eq 'unfavorite') {
			my $rto = &destroy_all_tco($ref->{'target_object'});
			my $txt = &descape($rto->{'text'});
			$g .=
		"$sou_sn just ${verb}d ${tar_sn}'s post: \"$txt\"";
		} elsif ($verb eq 'follow') {
			$g .= "$sou_sn is now following $tar_sn";
		} elsif ($verb eq 'user_update') {
		$g .= "$sou_sn updated their profile (/whois $sou_sn to see)";
		} elsif ($verb eq 'list_member_added') {
			$g .= "$sou_sn added $tar_sn to the list \"$tar_list_desc\" ($tar_list_name)";
		} elsif ($verb eq 'list_member_removed') {
			$g .= "$sou_sn removed $tar_sn from the list \"$tar_list_desc\" ($tar_list_name)";
		} elsif ($verb eq 'list_user_subscribed') {
			$g .= "$sou_sn is now following the list \"$tar_list_desc\" ($tar_list_name) from $tar_sn";
		} elsif ($verb eq 'list_user_unsubscribed') {
		$g .= "$sou_sn is no longer following the list \"$tar_list_desc\" ($tar_list_name) from $tar_sn";
		} elsif ($verb eq 'list_created') {
			$g .= "$sou_sn created the new list \"$tar_list_desc\" ($tar_list_name)";
		} elsif ($verb eq 'list_destroyed') {
			$g .= "$sou_sn destroyed the list \"$tar_list_desc\" ($tar_list_name)";
		} elsif ($verb eq 'list_updated') {
			$g .= "$sou_sn updated the list \"$tar_list_desc\" ($tar_list_name)";
		} elsif ($verb eq 'block' || $verb eq 'unblock') {
			$g .= "$sou_sn ${verb}ed $tar_sn ($tar_sn is not ".
				"notified)";
		} elsif ($verb eq 'access_revoked') {
			$g .= "$sou_sn revoked oAuth access to $tar_sn";
		} elsif ($verb eq 'access_unrevoked') {
			$g .= "$sou_sn restored oAuth access to $tar_sn";
		} else {
			# try to handle new types of events we don't
			# recognize yet.
			$verb .= ($verb =~ /e$/) ? 'd' : 'ed';
			$g .= "$sou_sn $verb $tar_sn (basic)";
		}

	# server events ("public stream messages") are handled differently.
	# we support almost all except for the ones that are irrelevant to
	# this medium.

	} elsif ($ref->{'delete'}) {
		# this is the best we can do -- it's already on the screen!
		# we don't want to make it easy which post it is, since that
		# would be embarrassing, so just say a delete occurred.
		$g .=
		"post ID# ".$ref->{'delete'}->{'status'}->{'id_str'}.
			" deleted by server";
	} elsif ($ref->{'status_withheld'}) {
		# fediverse doesn't document id_str as available here. check.
		if (!length($ref->{'status_withheld'}->{'id_str'})) {
			# do nothing right now
		} else { $g .=
		"post ID# ".$ref->{'status_withheld'}->{'id_str'}.
			" censored by server in your country";
		}
	} elsif ($ref->{'user_withheld'}) {
		$g .=
		"user ID# ".$ref->{'user_withheld'}->{'user_id'}.
			" censored by server in your country";
	} elsif ($ref->{'disconnect'}) {
		$g .=
		"DISCONNECTED BY SERVER (".$ref->{'disconnect'}->{'code'}.
			"); will retry: ".$ref->{'disconnect'}->{'reason'};
	} else {
		# we have no idea what this is. just BS our way out.
		$g .= "unknown server event received (non-fatal)";
	}

	if ($timestamp) {
		my ($time, $ts) = &$wraptime($ref->{'created_at'});
		$g = "[$ts] $g";
	}

	$g = &wwrap("$g\n", ($wrapseq <= 1) ? ((&$prompt(1))[1]) : 0);
	# highlight screen names
	$g =~
s/(^|[^a-zA-Z0-9_])\@([a-zA-Z0-9_\-\/]+)/\1\@${UNDER}\2${OFF}/g
		unless ($nocolour);

	return $g;
}

# for future expansion: this is the declared API callable method
# for executing a command as if the console had typed it.
sub ucommand {
	die("** can't call &ucommand during multi-module loading.\n")
		if ($multi_module_mode == -1);
	&prinput(@_);
}

# your application can also call &grabjson to get a hashref
# corresponding to parsed JSON from an arbitrary resource.
# see that function later on.


#### DEFAULT TTYverse INTERNAL API METHODS ####
# don't change these here. instead, use -exts=yourlibrary.pl and set there.
# note that these are all anonymous subroutine references.
# anything you don't define is overwritten by the defaults.
# it's better'n'superclasses.
# NOTE: defaultaddaction, defaultmain and defaultprompt
# are all defined in the "console" section above for
# clarity.

# this first set are the multi-module aware ones.

# the standard iterator for multi-module methods
sub multi_module_dispatch {
	my $default = shift;
	my $dispatch_chain = shift;
	my $rv_handler = shift;
	my @args = @_;

	local $dispatch_ref; # on purpose; get_key/set_key may need it
	# $*_call_default is a global
	$did_call_default = 0;
	$this_call_default = 0;
	$multi_module_context = 0;

	if ($rv_handler == 0) {
		$rv_handler = sub {
			return 0;
		};
	}

	# fall through to default if no dispatch chain
	if (!scalar(@{ $dispatch_chain })) {
		return &$default(@args);
	}
	foreach $dispatch_ref (@{ $dispatch_chain }) {
		# each reference has the code, and the file that specified it.
		# set up a multi-module context and run that function. if the
		# default ever gets called, we log it to tell the multi-module
		# handler to call the default at the end.

		my $rv;
		my $irv;
		my $caller = (caller(1))[3];
		$caller =~ s/^main::multi//;

		$multi_module_context = 1; # defaults then know to defer
		$this_call_default = 0;
		$store = $master_store->{ $dispatch_ref->[0] };
		print "-- calling \$$caller in $dispatch_ref->[0]\n"
			if ($verbose);
		my $code_ref = $dispatch_ref->[1];
		$rv = &$rv_handler(@irv = &$code_ref(@args));
		$multi_module_context = 0;
		if ($rv & 4) {
			# rv_handler indicating to call default and halt
			# if it was called.
			return &$default(@args) if ($did_call_default);
		}
		if ($rv & 2) {
			# rv_handler indicating to make new @args from @irv
			@args = @irv;
		}
		if ($rv & 1) {
			# rv_handler indicating to halt early. do so.
			return (wantarray) ? @irv : $irv[0];
		}
	}
	$multi_module_context = 0;
	return &$default(@args) if ($did_call_default);
	return (wantarray) ? @irv : $irv[0];
}
		
# these are the stubs that call the dispatcher.
sub multiaddaction {
	&multi_module_dispatch(\&defaultaddaction, \@m_addaction, sub{
		# return immediately on the first extension to accept
		return (shift>0);
	}, @_);
}
sub multiconclude {
	&multi_module_dispatch(\&defaultconclude, \@m_conclude, 0, @_);
}
sub multidmconclude {
	&multi_module_dispatch(\&defaultdmconclude, \@m_dmconclude, 0, @_);
}
sub multidmhandle {
	&multi_module_dispatch(\&defaultdmhandle, \@m_dmhandle, sub {
		my $rv = shift;

		# skip default calls.
		return 0 if ($this_call_default);

		# if not a default call, and the DM was refused for
		# processing by this extension, then the DM is now
		# suppressed. do not call any other extensions after this.
		# even if it ends in suppression, we still call the default
		# if it was ever called before.
		return 5 if ($rv == 0);

		# if accepted in any manner, keep calling.
		return 0;
	}, @_);
}
sub multieventhandle {
	&multi_module_dispatch(\&defaulteventhandle, \@m_eventhandle, sub {
		my $rv = shift;

		# skip default calls.
		return 0 if ($this_call_default);

		# if not a default call, and the event was refused for
		# processing by this extension, then the event is now
		# suppressed. do not call any other extensions after this.
		# even if it ends in suppression, we still call the default
		# if it was ever called before.
		return 5 if ($rv == 0);

		# if accepted in any manner, keep calling.
		return 0;
	}, @_);
}
sub multiexception {
	# this is a secret option for people who want to suppress errors.
	if ($exception_is_maskable) {
		&multi_module_dispatch(\&defaultexception, \@m_exception, sub {
			my $rv = shift;

			# same logic as handle/dmhandle, except return -1-
			# to mask from subsequent extensions.
			return 0 if ($this_call_default);
			return 5 if ($rv);
			return 0;
		}, @_);
	} else {
		&multi_module_dispatch(
			\&defaultexception, \@m_exception, 0, @_);
	}
}
sub multishutdown {
	return if ($shutdown_already_called++);
	&multi_module_dispatch(\&defaultshutdown, \@m_shutdown, 0, @_);
}

sub multiuserhandle {
	&multi_module_dispatch(\&defaultuserhandle, \@m_userhandle, sub{
		# skip default calls.
		return 0 if ($this_call_default);

		# return immediately on the first extension to accept
		return (shift>0);
	}, @_);
}
sub multilisthandle {
	&multi_module_dispatch(\&defaultlisthandle, \@m_listhandle, sub{
		# skip default calls.
		return 0 if ($this_call_default);

		# return immediately on the first extension to accept
		return (shift>0);
	}, @_);
}
sub multihandle {
	&multi_module_dispatch(\&defaulthandle, \@m_handle, sub {
		my $rv = shift;

		# skip default calls.
		return 0 if ($this_call_default);

		# if not a default call, and the post was refused for
		# processing by this extension, then the post is now
		# suppressed. do not call any other extensions after this.
		# even if it ends in suppression, we still call the default
		# if it was ever called before.
		return 5 if ($rv==0);

		# if accepted in any manner, keep calling.
		return 0;
	}, @_);
}
sub multiheartbeat {
	&multi_module_dispatch(\&defaultheartbeat, \@m_heartbeat, 0, @_);
}
sub multiprecommand {
	&multi_module_dispatch(\&defaultprecommand, \@m_precommand, sub {
		return 2; # feed subsequent chains the result.
	}, @_);
}
sub multiprepost {
	&multi_module_dispatch(\&defaultprepost, \@m_prepost, sub {
		return 2; # feed subsequent chains the result.
	}, @_);
}
sub multipostpost {
	&multi_module_dispatch(\&defaultpostpost, \@m_postpost, 0, @_);
}
sub multiposttype {
	&multi_module_dispatch(\&defaultposttype, \@m_posttype, sub {
		# if this module DID NOT call default, exit now.
		return (!$this_call_default);
	}, @_);
}

sub flag_default_call { $this_call_default++; $did_call_default++; }

# now the actual default methods

sub defaultexception {
	(&flag_default_call, return) if ($multi_module_context);
	my $msg_code = shift;
	return if ($msg_code == 2 && $muffle_server_messages);
	my $message = "@_";
	$message =~ s/\n*$//sg;
	if ($timestamp) {
		my ($time, $ts) = &$wraptime(scalar(localtime));
		$message = "[$ts] $message";
		$message =~ s/\n/\n[$ts] /sg;
	}
	&send_removereadline if ($termrl);
	$wrapseq = 1;
	print $stdout "${MAGENTA}${message}${OFF}\n";
	&send_repaint if ($termrl);
	$laststatus = 1;
}
sub defaultshutdown { 
	(&flag_default_call, return) if ($multi_module_context);
}
sub defaultlisthandle {
	(&flag_default_call, return) if ($multi_module_context);
	my $list_ref = shift;

	print $streamout "*** for future expansion ***\n";

	return 1;
}
sub defaulthandle {
	(&flag_default_call, return) if ($multi_module_context);
	my $post_ref = shift;
	my $class = shift;
	my $dclass = ($verbose) ? "{$class,$post_ref->{'id_str'}} " :  '';
	my $sn = &descape($post_ref->{'user'}->{'acct'} || $post_ref->{'user'}->{'username'});
	my $post = &descape($post_ref->{'text'});
	
	# Debug: Check what data defaulthandle receives for boost posts
	if (exists($post_ref->{'boost_attribution'}) && $post_ref->{'boost_attribution'}) {
		print $stdout "-- DEBUG: defaulthandle received boost - user: '$sn', text: '$post', boost_attribution: '" . $post_ref->{'boost_attribution'} . "'\n" if ($verbose);
	}
	my $spost = &standardpost($post_ref);
	my $menu_select = $post_ref->{'menu_select'};
	
	$menu_select = (length($menu_select) && !$script)
		? (($menu_select =~ /^z/) ?
			"${EM}${menu_select}>${OFF} " :
			"${menu_select}> ")
		: '';

	print $streamout $menu_select . $dclass . $spost;
	print $stdout "-- DEBUG: defaulthandle about to call sendnotifies with class='$class'\n" if ($verbose);
	&sendnotifies($post_ref, $class);
	return 1;
}
sub defaultuserhandle {
	(&flag_default_call, return) if ($multi_module_context);

	my $user_ref = shift;
	&userline($user_ref, $streamout);
	my $desc = &strim(&descape($user_ref->{'description'}));
	my $klen = ($wrap || 79) - 9;
	$klen = 10 if ($klen < 0);
	$desc = substr($desc, 0, $klen)."..." if (length($desc) > $klen);
	print $streamout (' "' . $desc . '"' . "\n") if (length($desc));
	return 1;
}
sub userline { # used by both $userhandle and /whois
	my $my_json_ref = shift;
	my $fh = shift;

	my $verified =
		($my_json_ref->{'verified'} eq 'true') ?
		"${EM}(Verified)${OFF} " : '';
	my $protected =
		($my_json_ref->{'protected'} eq 'true') ?
		"${EM}(Protected)${OFF} " : '';
	print $fh <<"EOF"; 
${CCprompt}@{[ &descape($my_json_ref->{'name'}) ]}${OFF} (@{[ &descape($my_json_ref->{'username'} || $my_json_ref->{'acct'}) ]}) (following:$my_json_ref->{'friends_count'} followers:$my_json_ref->{'followers_count'} posts:$my_json_ref->{'statuses_count'}) ${verified}${protected}
EOF
	return;
}
sub sendnotifies { # this is a default subroutine of a sort, right?
	my $post_ref = shift;
	my $class = shift;

	my $sn = &descape($post_ref->{'user'}->{'acct'} || $post_ref->{'user'}->{'username'});
	my $post = &descape($post_ref->{'text'});

	# Debug: Show what we received
	print $stdout "-- DEBUG: sendnotifies called with class='$class', sn='$sn'\n" if ($verbose);

	# If no class provided, determine it from post content
	if (!length($class) && length($post)) {
		$class = scalar(&$posttype($post_ref, $sn, $post));
		print $stdout "-- DEBUG: sendnotifies determined class='$class'\n" if ($verbose);
	}
	
	# Debug: Show notify_list status
	my $notify_enabled = $notify_list{$class} ? 'YES' : 'NO';
	print $stdout "-- DEBUG: notify_list{$class} = $notify_enabled\n" if ($verbose);
	
	# Send notification if we have a valid class, it's enabled, AND initial load is complete
	if (length($class) && $notify_list{$class} && !$initial_load_in_progress) {
		print $stdout "-- DEBUG: Calling notifytype_dispatch for class='$class'\n" if ($verbose);
		&notifytype_dispatch($class,
				&standardpost($post_ref, 1), $post_ref);
	} else {
		my $reason = !length($class) ? "no class" : 
		            !$notify_list{$class} ? "disabled" : 
		            $initial_load_in_progress ? "initial load" : "unknown";
		print $stdout "-- DEBUG: NOT calling notifytype_dispatch - class='$class', reason='$reason'\n" if ($verbose);
	}
}

sub defaultposttype {
	(&flag_default_call, return) if ($multi_module_context);
	my $ref = shift;
	my $sn = shift;
	my $post = shift;

	# Check for boost/reblog posts first
	if (exists($ref->{'boost_attribution'}) && $ref->{'boost_attribution'}) {
		print $stdout "-- DEBUG: defaultposttype detected boost post\n" if ($verbose);
		return 'boost';
	}
	
	# Check for favourited posts
	if (exists($ref->{'favorited'}) && $ref->{'favorited'}) {
		print $stdout "-- DEBUG: defaultposttype detected favourite post\n" if ($verbose);
		return 'favourite';
	}

	# br3nda's and smb's modified colour patch
	unless ($anonymous) {
		if (lc($sn) eq $whoami) {
			# if it's me speaking, colour the line yellow
			return 'me';
		} elsif ($post =~ /\@$whoami(\b|$)/i) {
			# if I'm in the post, colour red
			return 'reply';
		} 
	}
	if ($ref->{'class'} eq 'search') { # anonymous allows this too
		# if this is a search result, colour cyan
		return 'search';
	}
	if ($ref->{'tag'}->{'type'} eq 'list') { # anonymous allows this too
		return 'list';
	}
	return 'default';
}

sub defaultconclude {
	(&flag_default_call, return) if ($multi_module_context);
	if ($filtered && $filter_attribs{'count'}) {
		print $stdout "-- (filtered $filtered posts)\n";
		$filtered = 0;
	}
}

sub defaultdmhandle {
	(&flag_default_call, return) if ($multi_module_context);
	my $dm_ref = shift;
	my $sns = &descape($dm_ref->{'last_status'}->{'account'}->{'acct'} || $dm_ref->{'last_status'}->{'account'}->{'username'});

	# Add DM username to completion cache
	print STDERR "DM_DEBUG: sns='$sns', whoami='$whoami'\n" if ($verbose && $sns);
	if ($sns && $sns ne $whoami) {
		my $username = $sns;
		$username = '@' . $username unless $username =~ /^@/;
		print STDERR "DM_DEBUG: Processing username '$username' for completion\n" if ($verbose);
		if (!exists $readline_completion{$username}) {
			$readline_completion{$username}++;
			my $total = scalar(grep { /^@/ } keys %readline_completion);
			print STDERR "COMPLETION: Added $username (DM user) to completion cache (total: $total)\n" if ($verbose);
		} else {
			print STDERR "DM_DEBUG: Username '$username' already in completion cache\n" if ($verbose);
		}
	}

	my $dm_content = &standarddm($dm_ref);
	print $streamout $dm_content;
	print $stdout "-- DEBUG: DM displayed: " . substr($dm_content, 0, 50) . "...\n" if ($verbose);
	&senddmnotifies($dm_ref) if ($sns ne $whoami);
	
	# Mark conversation as read if it was unread (can be disabled with dmmarkread=0)
	if ($dm_ref->{'unread'} && (!defined($dmmarkread) || $dmmarkread)) {
		my $mark_result = &mark_conversation_read($dm_ref->{'id'});
		
		# If server-side mark-as-read failed, track locally to prevent re-showing
		if (!$mark_result) {
			my $conversation_id = $dm_ref->{'id'};
			my $last_status_id = $dm_ref->{'last_status'}->{'id'} || $dm_ref->{'last_status'}->{'id_str'};
			my $tracking_key = "${conversation_id}:${last_status_id}";
			$dm_seen_status{$tracking_key} = time();  # Store timestamp when seen
			print $stdout "-- DEBUG: Marked DM as seen locally (key: $tracking_key)\n" if ($verbose);
			&save_dm_seen_status();  # Persist the change
		}
	}
	
	return 1;
}

sub senddmnotifies {
	my $dm_ref = shift;
	# Only send notification if we haven't already sent one this refresh cycle
	# and we're not in initial load (either timeline or DM first time)
	# and we're not in display-only mode (user-initiated /dms commands)
	if ($notify_list{'dm'} && !$initial_load_in_progress && !$dm_first_time && !$dm_notification_sent && !$dm_display_only) {
		&notifytype_dispatch('dm', &standarddm($dm_ref, 1), $dm_ref);
		$dm_notification_sent = 1;
	}
}

sub mark_conversation_read {
	my $conversation_id = shift;
	return unless ($conversation_id);
	
	print $stdout "-- DEBUG: Marking conversation $conversation_id as read\n" if ($verbose);
	
	# Build the URL for marking conversation as read
	my $read_url = "${apibase}/conversations/$conversation_id/read";
	print $stdout "-- DEBUG: Mark-as-read URL: $read_url\n" if ($verbose);
	
	# Make POST request with shorter timeout for mark-as-read
	my $old_timeout = $timeout;
	my $old_exception = $exception;
	$timeout = 5; # Short timeout for non-critical operation
	
	# Use a custom exception handler to capture detailed error info
	$exception = sub {
		my ($severity, $message) = @_;
		print $stdout "-- DEBUG: Mark-as-read API call failed (severity=$severity): $message" if ($verbose);
		# Don't show user warning for this - it's not critical, but log the error
	};
	
	my $result = &postjson($read_url, "");
	
	# Restore original handlers
	$timeout = $old_timeout;
	$exception = $old_exception;
	
	if ($result) {
		print $stdout "-- DEBUG: Successfully marked conversation $conversation_id as read\n" if ($verbose);
		return 1;
	} else {
		print $stdout "-- DEBUG: Failed to mark conversation $conversation_id as read - trying alternative method\n" if ($verbose);
		
		# Fallback: Some servers might need different approach
		# Try sending empty message to conversation (some implementations mark as read this way)
		my $alt_url = "${apibase}/conversations/$conversation_id";
		print $stdout "-- DEBUG: Trying alternative approach: GET $alt_url\n" if ($verbose);
		
		my $alt_result = &grabjson($alt_url, 0, 0, 1, undef, 1);
		if ($alt_result) {
			print $stdout "-- DEBUG: Alternative method succeeded (conversation fetched)\n" if ($verbose);
			return 1;
		} else {
			print $stdout "-- DEBUG: All methods failed - server may not support conversation read API\n" if ($verbose);
			return 0;
		}
	}
}

sub lookup_account_id {
	my $username = shift;
	return unless ($username);
	
	# Remove @ prefix if present
	$username =~ s/^@//;
	
	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_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);
		}
	}
	
	print $stdout "-- DEBUG: Could not find account ID for username: $username\n" if ($verbose);
	return undef;
}

sub lookup_list_id {
	my $list_title = shift;
	return unless ($list_title);
	
	print $stdout "-- DEBUG: Looking up list ID for title: $list_title\n" if ($verbose);
	
	# Get all lists for current user
	my $lists_result = &grabjson($getlisurl, 0, 0, 0, undef, 1);
	
	if ($lists_result && ref($lists_result) eq 'ARRAY') {
		for my $list (@{$lists_result}) {
			my $title = $list->{'title'} || '';
			if (lc($title) eq lc($list_title)) {
				print $stdout "-- DEBUG: Found list ID: " . $list->{'id'} . " for $list_title\n" if ($verbose);
				return $list->{'id'};
			}
		}
	}
	
	print $stdout "-- DEBUG: Could not find list ID for title: $list_title\n" if ($verbose);
	return undef;
}

# Helper function for consistent error reporting
sub report_account_not_found {
	my ($username, $interactive) = @_;
	return unless ($interactive || $verbose);
	print $stdout "-- ERROR: Could not find account for user: $username\n";
}

sub defaulteventhandle {
	(&flag_default_call, return) if ($multi_module_context);
	my $event_ref = shift;
	# in this version, we silently filter delete events, but your
	# extension would still get them delivered.
	return 1 if ($event_ref->{'delete'});
	print $streamout &standardevent($event_ref);
	return 1;
}

sub defaultdmconclude {
	(&flag_default_call, return) if ($multi_module_context);
}

sub defaultheartbeat {
	(&flag_default_call, return) if ($multi_module_context);
}

# not much sense to multi-module protect these.
sub defaultprecommand { return ("@_"); }
sub defaultprepost { return ("@_"); }

sub defaultpostpost {
	(&flag_default_call, return) if ($multi_module_context);
	my $line = shift;
	return if (!$termrl);

	# populate %readline_completion if readline is on
	while($line =~ s/^\@(\w+)\s+//) {
		if ($termrl) {
			$readline_completion{'@'.lc($1)}++; 
			&save_completion_cache;
		}
	}
	if ($line =~ /^[dD]\s+(\w+)\s+/) {
		if ($termrl) {
			$readline_completion{'@'.lc($1)}++; 
			&save_completion_cache;
		}
	}
}

sub defaultautocompletion {
	my ($text, $line, $start) = (@_);
	my $qmtext = quotemeta($text);
	my @proband;
	my @rlkeys;

	# handle / completion
	if ($start == 0 && $text =~ m#^/#) {
		return sort grep(/^$qmtext/i, '/history',
			'/print', '/quit', '/bye', '/again',
			'/wagain', '/whois', '/thump', '/dm',
			'/refresh', '/dmagain', '/set', '/help',
			'/reply', '/url', '/thread', '/repost', '/replyall',
			'/replies', '/timelines', '/timeline', '/visibility', '/ruler', '/exit', '/me', '/vcheck',
			'/orepost', '/erepost', '/frepost', '/liston',
			'/listoff', '/dmsent', '/rtsof', '/rtson', '/rtsoff',
			'/lists', '/withlist', '/add', '/padd', '/push',
			'/pop', '/followers', '/following', '/friends', '/lfollow',
			'/lleave', '/listfollowers', '/listfriends',
			'/unset', '/verbose', '/short', '/follow', '/unfollow',
			'/doesfollow', '/search', '/tron', '/troff',
			'/delete', '/deletelast', '/dump',
			'/track', '/trends', '/block', '/unblock',
			'/fave', '/faves', '/unfave', '/eval');
	}
	@rlkeys = keys(%readline_completion);

	# handle @ completion. this works slightly weird because
	# readline hands us the string WITHOUT the @, so we have to
	# test somewhat blindly. this works even if a future readline
	# DOES give us the word with @. also handles D, /wa, /wagain,
	# /a, /again, etc.
	if (($line =~ m#^(D|/wa|/wagain|/a|/again) #i) ||
		($start == 1 && substr($line, 0, 1) eq '@') ||
		# this code is needed to prevent inline @ from flipping out
		($start >= 1 && substr($line, ($start-2), 2) eq ' @')) {
		@proband = grep(/^\@$qmtext/i, @rlkeys);
		if (scalar(@proband)) {
			@proband = map { s/^\@//;$_ } @proband;
			return @proband;
		}
	}
	# definites that are left over, including @ if it were included
	if(scalar(@proband = grep(/^$qmtext/i, @rlkeys))) {
		return @proband;
	}

	# heuristics
	# URL completion (this doesn't always work of course)
	if ($text =~ m#https?://#) {
		return (&urlshorten($text) || $text);
	}

	# "I got nothing."
	return ();
}

#### built-in notification routines ####

# growl for Mac OS X
sub notifier_growl {
	my $class = shift;
	my $text = shift;
	my $ref = shift; # not used in this version

	if (!defined($class) || !length($notify_tool_path)) {
		# we are being asked to initialize
		$notify_tool_path = &wherecheck("trying to find growlnotify",
			"growlnotify",
"growlnotify must be installed to use growl notifications. check your\n" .
			"documentation for how to do this.\n")
				unless ($notify_tool_path);
		if (!defined($class)) {
			return 1 if ($script || $notifyquiet);
			$class = 'Growl support activated';
			$text = 
'You can configure notifications for TTYverse in the Growl preference pane.';
		}
	}
	# handle this in the background for faster performance.
	# to avoid problems with SIGCHLD, we fork ourselves twice (mmm!),
	# leaving an orphan which init should grab (we need SIGCHLD for
	# proper backticks, so it can't be IGNOREd).
	my $gchild;
	if ($gchild = fork()) {
		# the parent harvests the child, which will die immediately.
		waitpid($gchild, 0);
		return 1;
	} elsif (!defined ($gchild)) {
		print $stdout "warning: failed growl fork: $!\n";
		return 1;
	}
	# this is the child. spawn, then exit and abandon our own child,
	# which init will reap. the problem with teen pregnancy is mounting.
	$in_backticks = 1;
	my $hchild;
	if ($hchild = fork()) {
		exit;
	} elsif (!defined ($hchild)) {
		print $stdout "warning: failed growl fork: $!\n";
		exit;
	}
	# this is the subchild, which is abandoned at a fire sta^W^W^Winit.
	open(GROWL, "|$notify_tool_path -n 'TTYverse' 'TTYverse: $class'");
	binmode(GROWL, ":utf8") unless ($seven);
	print GROWL $text;
	close(GROWL);
	exit;
}

# libnotify for {Linux,whatevs}
# this is EXPERIMENTAL, and requires this patch to notify-send:
# http://www.floodgap.com/software/ttytter/libnotifypatch.txt
# why it has not already been applied is fricking beyond me, it makes
# sense. would YOU want arbitrary characters on the command line
# separated only from overwriting your home directory by a quoting routine?
sub notifier_libnotify {
	my $class = shift;
	my $text = shift;
	my $ref = shift; # not used in this version

	if (!defined($class) || !defined($notify_tool_path)) {
		# we are being asked to initialize
		$notify_tool_path = &wherecheck("trying to find notify-send",
			"notify-send",
"notify-send must be installed to use libnotify, and it must be modified\n".
"for standard input. see the documentation for how to do this.\n")
			unless ($notify_tool_path);
		if (!defined($class)) {
			return 1 if ($script || $notifyquiet);
			$class = 'libnotify support activated';
			$text =
'Congratulations, your notify-send is correctly configured for TTYverse.';
		}
	}
	# figure out the time to display based on length of post
	my $t = 1000+50*length($text); # about 150-180wpm read speed
	open(NOTIFYSEND,
		"|$notify_tool_path -t $t -f - 'TTYverse: $class'");
	binmode(NOTIFYSEND, ":utf8") unless ($seven);
	print NOTIFYSEND $text;
	close(NOTIFYSEND);
	return 1;
}

#### IPC routines for communicating between the foreground + background ####

# this is the central routine that takes a rolling post code, figures
# out where that post is, and returns something approximating a post
# structure (or the actual post structure itself if it can).
sub get_post {
	my $code = lc(shift);

#TODO
# implement querying the id_cache here. we need IPC for it, though.
	# if the code is all numbers, treat it like an id_str, and try
	# to get it from the server. we have similar code in get_dm.
	# the first post that is of relevance is ID 20. try /dump 20 :)
	return &grabjson("${idurl}?id=${code}", 0, 0, 0, undef, 1)
		if ($code =~ /^[0-9]+$/ && (0+$code > 19));

	return undef if ($code !~ /^z?[a-z][0-9]$/);
	my $source = ($code =~ /^z/) ? 1 : 0;
	my $k = '';
	my $l = '';
	my $w = {'user' => {}};

	if ($is_background) {
		if ($source == 1) { # foreground only
			return undef;
		}
		return $store_hash{$code};
	}
	return $store_hash{$code} if ($source); # foreground c/foreground twt

	print $stdout "-- querying background: $code\n" if ($verbose);
	kill $SIGUSR2, $child if ($child);
	print C "pipet $code ----------\n";
	while(length($k) < 1024) {
		read(W, $l, 1024);
		$k .= $l;
	}
	return undef if ($k !~ /[^\s]/);
	$k =~ s/\s+$//; # remove trailing spaces
	print $stdout "-- background store fetch: $k\n" if ($verbose);
	($w->{'menu_select'}, $w->{'id_str'}, $w->{'in_reply_to_status_id_str'},
		$w->{'reblog'}->{'id_str'},
		$w->{'user'}->{'geo_enabled'},
		$w->{'geo'}->{'coordinates'}->[0],
		$w->{'geo'}->{'coordinates'}->[1],
		$w->{'place'}->{'id'},
		$w->{'place'}->{'country_code'},
		$w->{'place'}->{'place_type'},
		$w->{'place'}->{'full_name'},
		$w->{'tag'}->{'type'},
		$w->{'tag'}->{'payload'},
		$w->{'reblogs_count'}, 
		$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'});
	$w->{'tag'}->{'payload'} = pack("H*", $w->{'tag'}->{'payload'});
	return undef if (!length($w->{'text'})); # unpossible
	$w->{'created_at'} =~ s/_/ /g;
	return $w;
}

# this is the analogous function for a rolling DM code. it is somewhat
# simpler as DM codes are always rolling and have no foreground store
# currently, so it always executes a background request.
sub get_dm {
	my $code = lc(shift);
	my $k = '';
	my $l = '';
	my $w = {'sender' => {}};
	return undef if (length($code) < 3 || $code !~ s/^d//);

	# Handle foreground/background like get_post does
	if ($is_background) {
		return $dm_store_hash{$code};
	}

	# this is the aforementioned "similar code" (see get_post).
	# optimization: I doubt ANY of us can get DMIDs less than 9.
	return &grabjson("${dmidurl}?id=$code", 0, 0, 0, undef, 1)
		if ($code =~ /^[0-9]+$/ && (0+$code > 9));

	return undef if ($code !~ /^[a-z][0-9]$/);

	kill $SIGUSR2, $child if ($child); # prime pipe
	print C "piped $code ----------\n"; # internally two alphanum, recall
	while(length($k) < 1024) {
		read(W, $l, 1024);
		$k .= $l;
	}
	return undef if ($k !~ /[^\s]/);
	$k =~ s/\s+$//; # remove trailing spaces
	print $stdout "-- background store fetch: $k\n" if ($verbose);
	my ($menu_select, $id, $sender, $created_at, $hex_content) = split(/\s/, $k, 5);
	
	# Reconstruct Mastodon conversation format
	$w->{'menu_select'} = $menu_select;
	$w->{'id'} = $id;
	$w->{'last_status'} = {
		'created_at' => $created_at,
		'content' => pack("H*", $hex_content),
		'account' => {
			'username' => $sender,
			'acct' => $sender
		}
	};
	return undef if (!length($w->{'last_status'}->{'content'})); # not possible
	$w->{'last_status'}->{'created_at'} =~ s/_/ /g;
	return $w;
}

# this function requests a $store key from the background. it only works
# if foreground.
sub getbackgroundkey {
	if ($is_background) {
		print $stdout "*** can't call getbackgroundkey from background\n";
		return undef;
	}
	my $key = shift;
	my $l;
	my $k;
	print C substr("ki $key ---------------------", 0, 19)."\n";
	my $ref = (length($dispatch_ref->[0])) ? ($dispatch_ref->[0]) :
		"DEFAULT";
	print C substr(unpack("${pack_magic}H*", $ref).$space_pad, 0, 1024);
	while(length($k) < 1024) {
		read(W, $l, 1024);
		$k .= $l;
	}
	$k =~ s/[^0-9a-fA-F]//g;
	print $stdout "-- background store fetch: $k\n" if ($verbose);
	return pack("H*", $k);
}

# this function sends a $store key to the background. it only works if
# foreground.
sub sendbackgroundkey {
	if ($is_background) {
		print $stdout "*** can't call sendbackgroundkey from background\n";
		return;
	}
	my $key = shift;
	my $value = shift;
	if (ref($value)) {
		print $stdout "*** send_key only supported for scalars\n";
		return;
	}
	if (!length($value)) {
		print C substr("kn $key ---------------------", 0, 19)."\n";
	} else {
		print C substr("ko $key ---------------------", 0, 19)."\n";
	}
	my $ref = (length($dispatch_ref->[0])) ? ($dispatch_ref->[0]) :
		"DEFAULT";
	print C substr(unpack("${pack_magic}H*", $ref).$space_pad, 0, 1024);
	return if (!length($value));
	print C substr(unpack("${pack_magic}H*", $value).$space_pad, 0, 1024);
}

sub thump { 
	print $stdout "-- DEBUG: Manual refresh requested, sending update command to background\n" if ($verbose);
	print C "update-------------\n"; 
	&sync_semaphore; 
}
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
	if ($termrl && $termrl->ReadLine eq 'Term::ReadLine::Gnu') {
		$last_cache_save = 0; # Force save on exit
		&save_completion_cache;
	}
	
	if ($child) {
		print $stdout "waiting for child ...\n" unless ($silent);
		print C "sync---------------\n";
		waitpid $child, 0;
		$child = 0;
		print $stdout "exiting.\n" unless ($silent);
		exit ($? >> 8);
	}
	exit;
}

# setter for internal variables, with all the needed side effects for those
# variables that are programmed to trigger internal actions when changed.
sub setvariable {
	my $key = shift;
	my $value = shift;
	my $interactive = 0+shift;

	$value =~ s/^\s+//;
	$value =~ s/\s+$//; # mostly to avoid problems with /(p)add

	if ($key eq 'script') { # this can never be changed by this routine
		print $stdout "*** script may only be changed on init\n";
		return 1;
	}
	if ($key eq 'tquery' && $value eq '0') { # undo tqueries
		$tquery = undef;
		$key = 'track';
		$value = $track; # falls thru to sync
		&tracktags_makearray;
	}
	if ($opts_can_set{$key} ||
			# we CAN set read-only variables during initialization
			($multi_module_mode == -1 && $valid{$key})) {
		if (length($value) > 1023) {
			# can't transmit this in a packet
			print $stdout "*** value too long\n";
			return 1;
		} elsif ($opts_boolean{$key} && $value ne '0' &&
				$value ne '1') {
			print $stdout "*** 0|1 only (boolean): $key\n";
			return 1;
		} elsif ($opts_urls{$key} &&
	$value !~ m#^(http|https|gopher)://#) {
			print $stdout "*** must be valid URL: $key\n";
			return 1;
		} else {
			KEYAGAIN: $$key = $value;
			print $stdout "*** changed: $key => $$key\n"
				if ($interactive || $verbose);

			# handle special values
			&generate_ansi if ($key eq 'ansi' ||
				$key =~ /^colour/);
			&generate_shortdomain if ($key eq 'shoreblogurl');
			&tracktags_makearray if ($key eq 'track');
			&filter_compile if ($key eq 'filter');
			&notify_compile if ($key eq 'notifies');
			&list_compile if ($key eq 'lists');
			&filterflags_compile if ($key eq 'filterflags');
			$filterrts_sub = &filteruserlist_compile(
				$filterrts_sub, $value)
					if ($key eq 'filterrts');
			$filterusers_sub = &filteruserlist_compile(
				$filterusers_sub,$value)
					if ($key eq 'filterusers');
			$filteratonly_sub = &filteruserlist_compile(
				$filteratonly_sub, $value)
					if ($key eq 'filteratonly');
			&filterats_compile if ($key eq 'filterats');

			# transmit to background process sync-ed values
			if ($opts_sync{$key}) {
				&synckey($key, $value, $interactive);
			}
			if ($key eq 'superverbose') {
				if ($value eq '0') {
					$key = 'verbose';
					$value = $supreturnto;
					goto KEYAGAIN;
				}
				$supreturnto = $verbose;
			}
		}
	# virtual keys
	} elsif ($key eq 'tquery') {
		my $ivalue = &tracktags_tqueryurlify($value);
		if (length($ivalue) > 139) {
			print $stdout
		"*** custom query is too long (encoded: $ivalue)\n";
			return 1;
		} else {
			$tquery = $value;
			&synckey($key, $ivalue, $interactive);
		}
	} elsif ($valid{$key}) {
		print $stdout
		"*** read-only, must change on command line: $key\n";
		return 1;
	} else {
		print $stdout
		"*** not a valid option or setting: $key\n";
		return 1;
	}
	return 0;
}
sub synckey {
	my $key = shift;
	my $value = shift;
	my $interactive = 0+shift;
	my $commchar = ($interactive) ? '=' : '+';
	print $stdout "*** (transmitting to background)\n"
		if ($interactive || $verbose);
	return if (!$child); 
	kill $SIGUSR2, $child if ($child);
	print C
	(substr("${commchar}$key                           ", 0, 19) . "\n");
	print C (substr(($value . $space_pad), 0, 1024));
	sleep 1;
}

# getter for internal variables. right now this just returns the variable by
# name and a couple virtuals, but in the future this might be expanded.
sub getvariable {
	my $key = shift;
	if ($valid{$key}) {
		return $$key;
	}
	if ($key eq 'effpause' ||
			$key eq 'rate_limit_rate' ||
			$key eq 'rate_limit_left') {
		my $value;
		kill $SIGUSR2, $child if ($child);
		print C (substr("?$key                    ", 0, 19) . "\n");
		sysread(W, $value, 1024);
		$value =~ s/\s+$//;
		return $value;
	}
	return undef;
}

# compatibility stub for extensions calling the old wraptime
sub wraptime { return &$wraptime(@_); }

#### url management (/url, /short) ####

sub generate_shortdomain {
	my $x;
	my $y;

	undef $shoreblogurldomain;
	($shoreblogurl =~ m#^http://([^/]+)/#) && ($x = $1);
	# chop off any leading hostname stuff (like api., etc.)
	while(1) {
		$y = $x;
		$x =~ s/^[^\.]*\.//;
		if ($x !~ /\./) { # a cut too far
			$shoreblogurldomain = "http://$y/";
			last;
		}
	}
	print $stdout "-- warning: couldn't parse shortener service\n"
		if (!length($shoreblogurldomain));
}

sub detect_browser {
	my $is_gui = defined($ENV{'DISPLAY'}) && length($ENV{'DISPLAY'});
	my $browser;
	
	if ($is_gui) {
		# GUI environment - check gui_browser setting first
		if (length($gui_browser)) {
			return ($gui_browser, 1);  # Return browser and background flag
		}
		
		# Try xdg-open first (most reliable on Linux)
		if (system("which xdg-open >/dev/null 2>&1") == 0) {
			return ('xdg-open %U', 1);
		}
		
		# Fallback GUI browsers
		my @gui_browsers = qw(brave chromium firefox google-chrome);
		foreach my $br (@gui_browsers) {
			if (system("which $br >/dev/null 2>&1") == 0) {
				return ("$br %U", 1);
			}
		}
		
		# If no GUI browser found, fall back to CLI
		print STDERR "-- warning: no GUI browser found, falling back to CLI browser\n";
	}
	
	# CLI environment or fallback - check cli_browser setting first
	if (length($cli_browser)) {
		return ($cli_browser, 0);  # CLI browsers are blocking
	}
	
	# Try CLI browsers in order of preference
	my @cli_browsers = qw(w3m elinks lynx);
	foreach my $br (@cli_browsers) {
		if (system("which $br >/dev/null 2>&1") == 0) {
			return ("$br %U", 0);
		}
	}
	
	# Ultimate fallback - use the old urlopen setting
	return ($urlopen, 0);
}

sub openurl {
	my $url = shift;
	my ($comm, $should_background) = &detect_browser();
	
	# Handle gopher URLs through gateway if not using lynx
	$url = "http://gopher.floodgap.com/gopher/gw?".&url_oauth_sub($url)
		if ($url =~ m#^gopher://# && $comm !~ /^[^\s]*lynx/);
	
	$urlshort = $url;
	$comm =~ s/\%U/'$url'/g;
	
	if ($should_background) {
		# Background GUI browsers
		$comm .= " &";
		print $stdout "($comm)\n";
		system("$comm");
	} else {
		# CLI browsers run in foreground
		print $stdout "($comm)\n";
		system("$comm");
	}
}

sub urlshorten {
	my $url = shift;
	my $rc;
	my $cl;

	$url = "http://gopher.floodgap.com/gopher/gw?".&url_oauth_sub($url)
		if ($url =~ m#^gopher://#);
	return $url if ($url =~ /^$shoreblogurldomain/i); # stop loops
	$url = &url_oauth_sub($url);
	$cl = "$simple_agent \"${shoreblogurl}$url\"";
	print $stdout "$cl\n" if ($superverbose);
	chomp($rc = `$cl`);
	return ($urlshort = (($rc =~ m#^http://#) ? $rc : undef));
}

##### Media Upload Functions #####

sub handle_media_upload {
	my $file_path = shift;
	
	# Validate file exists and is readable
	unless (-f $file_path && -r $file_path) {
		print $stdout "-- ERROR: File '$file_path' not found or not readable\n";
		return 0;
	}
	
	# Check file size (Mastodon limit is typically 8MB for images, 40MB for video)
	my $file_size = -s $file_path;
	if ($file_size > 40 * 1024 * 1024) {  # 40MB
		print $stdout "-- ERROR: File too large (max 40MB)\n";
		return 0;
	}
	
	# Detect MIME type
	my $mime_type = &detect_mime_type($file_path);
	unless ($mime_type) {
		print $stdout "-- ERROR: Unable to determine file type\n";
		return 0;
	}
	
	print $stdout "-- Detected file type: $mime_type\n" if ($verbose);
	
	# Handle alt-text for images (REQUIRED for accessibility)
	my $alt_text = "";
	if ($mime_type =~ /^image\//) {
		print $stdout "-- Images require alt-text for accessibility\n";
		$alt_text = &linein("Enter alt text for " . (split('/', $file_path))[-1] . ": ");
		
		# Empty alt-text cancels the upload (enforce accessibility)
		unless (defined($alt_text) && length($alt_text) > 0) {
			print $stdout "-- Upload cancelled: Alt-text is required for images\n";
			print $stdout "-- If you're going to use a client maintained by a blind guy, you can damn well describe your images!\n";
			return 0;
		}
	}
	
	# Get optional post message
	my $post_message = &linein("Enter post message (optional): ");
	$post_message = "" unless defined($post_message);
	
	# Upload media and create post
	return &upload_media_and_post($file_path, $mime_type, $alt_text, $post_message);
}

sub detect_mime_type {
	my $file_path = shift;
	
	# Try using 'file' command first (most reliable)
	my $file_output = `file -b --mime-type "$file_path" 2>/dev/null`;
	chomp($file_output);
	if ($file_output && $file_output =~ /^[\w-]+\/[\w-]+$/) {
		return $file_output;
	}
	
	# Fallback to file extension
	my $extension = lc((split(/\./, $file_path))[-1]);
	my %ext_to_mime = (
		'jpg'  => 'image/jpeg',
		'jpeg' => 'image/jpeg', 
		'png'  => 'image/png',
		'gif'  => 'image/gif',
		'webp' => 'image/webp',
		'mp4'  => 'video/mp4',
		'webm' => 'video/webm',
		'mov'  => 'video/quicktime',
		'mp3'  => 'audio/mpeg',
		'ogg'  => 'audio/ogg',
		'wav'  => 'audio/wav',
		'flac' => 'audio/flac'
	);
	
	return $ext_to_mime{$extension} || undef;
}

sub upload_media_and_post {
	my ($file_path, $mime_type, $alt_text, $post_message) = @_;
	
	print $stdout "-- Uploading media file...\n";
	
	# Step 1: Upload media to get media ID
	my $media_id = &upload_media_file($file_path, $mime_type, $alt_text);
	unless ($media_id) {
		print $stdout "-- ERROR: Media upload failed\n";
		return 0;
	}
	
	print $stdout "-- Media uploaded successfully (ID: $media_id)\n";
	
	# Step 2: Create post with media attachment
	return &create_post_with_media($media_id, $post_message);
}

sub upload_media_file {
	my ($file_path, $mime_type, $alt_text) = @_;
	
	# Mastodon media upload endpoint
	my $media_url = "${apibase}/media";
	
	# Build curl command for multipart file upload
	my $curl_cmd = "$baseagent";
	
	# Add standard auth and options (from @wend)
	foreach my $arg (@wend) {
		$curl_cmd .= " '$arg'";
	}
	
	# Add OAuth Bearer token authentication
	my $bearer_header = &signrequest($media_url, '');
	if ($bearer_header) {
		$curl_cmd .= " $bearer_header";
	}
	
	# Add multipart form data
	$curl_cmd .= " -X POST";
	$curl_cmd .= " -F 'file=\@$file_path;type=$mime_type'";
	
	# Add alt-text if provided (for images)
	if (length($alt_text)) {
		my $escaped_alt = $alt_text;
		$escaped_alt =~ s/'/'\\''/g;  # Escape single quotes for shell
		$curl_cmd .= " -F 'description=$escaped_alt'";
	}
	
	$curl_cmd .= " '$media_url'";
	
	print $stdout "-- DEBUG: Upload command: $curl_cmd\n" if ($superverbose);
	print $stdout "-- DEBUG: Uploading to $media_url\n" if ($verbose);
	
	# Execute the upload
	my $response = `$curl_cmd 2>/dev/null`;
	my $exit_code = $? >> 8;
	
	if ($exit_code != 0) {
		print $stdout "-- ERROR: Upload failed (curl exit code: $exit_code)\n";
		return undef;
	}
	
	print $stdout "-- DEBUG: Upload response: $response\n" if ($superverbose);
	
	# Parse JSON response to get media ID
	my $media_data = &parsejson($response);
	unless ($media_data && ref($media_data) eq 'HASH') {
		print $stdout "-- ERROR: Invalid response from media upload\n";
		print $stdout "-- Response: $response\n" if ($verbose);
		return undef;
	}
	
	my $media_id = $media_data->{'id'};
	unless ($media_id) {
		print $stdout "-- ERROR: No media ID in response\n";
		print $stdout "-- Response: $response\n" if ($verbose);
		return undef;
	}
	
	return $media_id;
}

sub create_post_with_media {
	my ($media_id, $post_message) = @_;
	
	# Build post data
	my $post_data = "media_ids[]=$media_id";
	if (length($post_message)) {
		$post_data .= "&status=" . &url_oauth_sub($post_message);
	}
	
	# Add current visibility setting
	$post_data .= "&visibility=$post_visibility" if defined($post_visibility);
	
	print $stdout "-- Creating post with media attachment...\n";
	
	# Use existing postjson function for creating the post
	my $result = &postjson($update, $post_data);
	
	if ($result) {
		print $stdout "-- Post created successfully!\n";
		return 1;
	} else {
		print $stdout "-- ERROR: Failed to create post\n";
		return 0;
	}
}

##### 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
sub tracktags_tqueryurlify {
	my $value = shift;
	$value =~ s/([^ a-z0-9A-Z_])/"%".unpack("H2",$1)/eg;
	$value =~ s/\s/+/g;
	$value = "q=$value" if ($value !~ /^q=/);
	return $value;
}

# tracking subroutines
# run when a string is passed
sub tracktags_makearray {
	@tracktags = ();
	$track =~ s/^'//; $track =~ s/'$//; $track = lc($track);
	if (!length($track)) {
		@trackstrings = ();
		return;
	}
	my $k;
	my $l = '';
	my $q = 0;
	my %w;
	my (@ptags) = split(/\s+/, $track);

	# filter duplicates and merge quoted strings
	foreach $k (@ptags) {
		if ($q && $k =~ /"$/) { # this has to be first
			$l .= " $k";
			$q = 0;
		} elsif ($k =~ /^"/ || $q) {
			$l .= (length($l)) ? " $k" : $k;
			$q = 1;
			next;
		} else {
			$l = $k;
		}
			
		if ($w{$l}) {
			print $stdout
			"-- warning: dropping duplicate track term \"$l\"\n";
		} elsif (uc($l) eq 'OR' || uc($l) eq 'AND') {
			print $stdout
			"-- warning: dropping unnecessary logical op \"$l\"\n";
		} else {
			$w{$l} = 1;
			push(@tracktags, $l);
		}
		$l = '';
	}
	print $stdout "-- warning: syntax error, missing quote?\n" if ($q);
	$track = join(' ', @tracktags);
	&tracktags_compile;
}	
# run when array is altered (based on @kellyterryjones' code)
sub tracktags_compile {
	@trackstrings = ();
	return if (!scalar(@tracktags));

	my $k;
	my $l = '';
	# need to limit track tags to a certain number of pieces
	TAGBAG: foreach $k (@tracktags) {
		if (length($k) > 130) { # I mean, really
			print $stdout
				"-- warning: track tag \"$k\" is TOO LONG\n";
			next TAGBAG;
		}
		if (length($l)+length($k) > 150) { # balance of size/querytime
			push(@trackstrings, "q=".&url_oauth_sub($l));
			$l = '';
		}
		$l = (length($l)) ? "${l} OR ${k}" : "${k}";
	}
	push(@trackstrings, "q=".&url_oauth_sub($l)) if (length($l));
}

# notification multidispatch
sub notifytype_dispatch {
	print $stdout "-- DEBUG: notifytype_dispatch called with " . scalar(@notifytypes) . " notifiers\n" if ($verbose);
	return if (!scalar(@notifytypes));
	my $nt; foreach $nt (@notifytypes) { 
		print $stdout "-- DEBUG: Calling notifier function: $nt\n" if ($verbose);
		&$nt(@_); 
	}
}

# notifications compiler
sub notify_compile {
	if ($notifies) {
		my $w;

		undef %notify_list;
		foreach $w (split(/\s*,\s*/, $notifies)) {
			$notify_list{$w} = 1;
		}
		$notifies = join(',', keys %notify_list);
		print $stdout "-- DEBUG: notify_list compiled: " . join(',', keys %notify_list) . "\n" if ($verbose);
	}
}

# lists compiler
# we don't check the validity of lists here; /liston and /listoff do that.
sub list_compile {
	my @oldlistlist = @listlist;
	my %already;

	undef @listlist;
	if ($lists) {
		my $w;
		my $u;
		my $l;
		foreach $w (split(/\s*,\s*/, $lists)) {
			$w =~ s/^@//;
			if ($w =~ m#/#) {
				($u, $l) = split(m#\s*/\s*#, $w, 2);
			} else {
				$l = $w;
			}
			if (!length($u) && $anonymous) {
print $stdout "*** must use fully specified lists when anonymous\n";
				@listlist = @oldlistlist;
				return 0;
			}
			$u ||= $whoami;
			if ($l =~ m#/#) {
print $stdout "*** syntax error in list $u/$l\n";
				@listlist = @oldlistlist;
				return 0;
			}
			if ($already{"$u/$l"}++) {
			print $stdout "*** duplicate list $u/$l ignored\n";
			} else {
				push(@listlist, [ $u, $l ]);
			}
		}
		$lists = join(',', keys %already);
	}
	return 1;
}

# -filterflags compiler (replaces old -filter syntax)
sub filterflags_compile {
	my $s = $filterflags;
	undef %filter_attribs;
	$s =~ s/^\s*['"]?\s*//;
	$s =~ s/\s*['"]?\s*$//;
	return if (!length($s));
	%filter_attribs = map { $_ => 1 } split(/\s*,\s*/, $s);
}

# -filterrts and -filterusers compiler. these simply use a list of usernames,
# so they are fast and the same code suffices. emit code to compile that
# just is one if-expression after another.
sub filteruserlist_compile {
	my $old = shift;
	my $s = shift;
	undef $k;
	$s =~ s/^\s*['"]?\s*//;
	$s =~ s/\s*['"]?\s*$//;
	return $k if (!length($s));
	my @us = map { $k=lc($_); "\$sn eq '$k'" } split(/\s*,\s*/, $s);
	my $uus = join(' || ', @us);
	my $uuus = <<"EOF";
		\$k = sub {
			my \$sn = shift;
			return 1 if ($uus);
			return 0;
		};
EOF
#	print $stdout $uuus;
	eval $uuus;
	if (!defined($k)) {
		print $stdout "** bogus name in user list (error = $@)\n";
		return $old;
	}
	return $k;
}

# -filterats compiler. this takes a list of usernames and then compiles a
# whole bunch of regexes.
sub filterats_compile {
	undef $filterats_c;
	my $s = $filterats;
	$s =~ s/^\s*['"]?\s*//;
	$s =~ s/\s*['"]?\s*$//;
	return 1 if (!length($s)); # undef
	my @us = map { $k=lc($_); "\$x=~/\\\@$k\\b/i" } split(/\s*,\s*/, $s);
	my $uus = join(' || ', @us);
	my $uuus = <<"EOF";
		\$filterats_c = sub {
			my \$x = shift;
			return 1 if ($uus);
			return 0;
		};
EOF
#	print $stdout $uuus;
	eval $uuus;
	if (!defined($filterats_c)) {
		print $stdout "** bogus name in user list (error = $@)\n";
		return 0;
	}
	return 1;
}

# -filter compiler. this is the generic case.
sub filter_compile {
	undef %filter_attribs unless (length($filterflags));
	undef $filter_c;
	if (length($filter)) {
		my $tfilter = $filter;
		$tfilter =~ s/^['"]//;
		$tfilter =~ s/['"]$//;
		# note attributes (compatibility)
		while ($tfilter =~ s/^([a-z]+),//) {
			my $atkey = $1;
			$filter_attribs{$atkey}++;
			print $stdout
		"** $atkey filter parameter should be in -filterflags\n";
		}
		my $b = <<"EOF";
		\$filter_c = sub {
			local \$_ = shift;
			return ($tfilter);
		};
EOF
		#print $b;
		eval $b;
		if (!defined($filter_c)) {
			print $stdout ("** syntax error in your filter: $@\n");
			return 0;
		}
	}
	return 1;
}

#### common system subroutines follow ####

sub updatecheck {
	my $update_url = shift;
	my $vs = '';
	
	# Git-based version checking for TTYverse
	my $repo_url = "https://git.stormux.org/storm/ttyverse";
	my $current_version = $TTYverse_VERSION;
	my $latest_version = '';
	
	
	# Term::ReadLine::Gnu doesn't need version checking - it's maintained on CPAN

	print $stdout "-- checking TTYverse version...\n";
	# Git-based version checking - no longer using remote URL
	$vvs = '';
	# Git-based version checking
	my $tag_output = '';
	
	# Use curl-only approach for version checking
	my $curl_cmd = `which curl 2>/dev/null`;
	chomp($curl_cmd);
	
	if ($curl_cmd) {
		print $stdout "-- using curl to check for latest version...\n" if ($verbose);
		
		# Try multiple approaches for Gitea
		my @api_attempts = (
			# Try different possible API paths for Gitea
			"https://git.stormux.org/api/v1/repos/storm/ttyverse/tags",
			"https://git.stormux.org/api/v1/repos/storm/ttyverse/releases",
			# Try web scraping the releases/tags page if API doesn't work
			"https://git.stormux.org/storm/ttyverse/releases",
			"https://git.stormux.org/storm/ttyverse/tags"
		);
		
		foreach my $url (@api_attempts) {
			print $stdout "-- trying: $url\n" if ($verbose);
			my $response = `$curl_cmd -s -f "$url" 2>/dev/null`;
			
			if ($response && length($response) > 10) {
				print $stdout "-- got response from $url\n" if ($verbose);
				
				# Try to parse as JSON first (for API responses)
				my @json_tags = $response =~ /"name"\s*:\s*"([^"]+)"/g;
				if (@json_tags) {
					my @tags = sort { $b cmp $a } @json_tags;
					$tag_output = $tags[0];
					print $stdout "-- found tags via JSON: " . join(", ", @tags[0..2]) . "\n" if ($verbose && @tags > 2);
					last;
				}
				
				# Try to parse as HTML (for web interface)
				my @html_tags = $response =~ /\/releases\/tag\/([^"'\s>]+)/g;
				if (@html_tags) {
					my @tags = sort { $b cmp $a } @html_tags;
					$tag_output = $tags[0];
					print $stdout "-- found tags via HTML: " . join(", ", @tags[0..2]) . "\n" if ($verbose && @tags > 2);
					last;
				}
				
				# Try alternate HTML patterns
				@html_tags = $response =~ /tag\/([0-9]{4}\.[0-9]{2}\.[0-9]{2}[^"'\s>]*)/g;
				if (@html_tags) {
					my @tags = sort { $b cmp $a } @html_tags;
					$tag_output = $tags[0];
					print $stdout "-- found version tags: " . join(", ", @tags[0..2]) . "\n" if ($verbose && @tags > 2);
					last;
				}
			}
		}
		
		# Fallback: Try local git if we're in a repository and curl failed
		if (!$tag_output && -d '.git') {
			print $stdout "-- curl failed, trying local git...\n" if ($verbose);
			$tag_output = `git tag --list --sort=-version:refname 2>/dev/null | head -1`;
			chomp($tag_output);
		}
	} else {
		# No curl available, try git only if in repository
		if (-d '.git') {
			print $stdout "-- no curl available, using local git...\n" if ($verbose);
			$tag_output = `git tag --list --sort=-version:refname 2>/dev/null | head -1`;
			chomp($tag_output);
		}
	}
	
	if ($tag_output) {
		$latest_version = $tag_output;
		
		# Compare versions
		if ($latest_version gt $current_version) {
			$vs .= "** NEW TTYverse VERSION AVAILABLE: $latest_version **\n";
			$vs .= "** (you have: $current_version)\n";
			$vs .= "** get it: $repo_url\n";
			if ($update_url) {
				$vs .= "-- %URL% is now $repo_url (/short shortens, /url opens)\n";
				$urlshort = $repo_url;
			}
		} elsif ($latest_version eq $current_version) {
			$vs .= "-- your version of TTYverse is up to date ($current_version)\n";
		} else {
			# Local version is newer - check if we're in a git repo
			if (-d '.git') {
				$vs .= "-- your version ($current_version) is newer than latest remote ($latest_version)\n";
				$vs .= "-- you may have unpushed changes or unreleased version\n";
			} else {
				$vs .= "-- you appear to have a development version ($current_version)\n";
				$vs .= "-- latest stable release: $latest_version\n";
			}
		}
	} else {
		$vs .= "-- warning: unable to determine latest version\n";
		$vs .= "-- git and HTTP methods both failed\n";
		$vs .= "-- you have: $current_version\n";
		$vs .= "-- please visit $repo_url to check for updates manually\n";
	}
	
	return $vs;
	
	# Old TTYtter logic (commented out)
	if (0) {
		if ($my_version_string eq $bversion) {
			$vs .=
"** REMINDER: you are using a beta version (${my_version_string}b${TTYverse_RC_NUMBER})\n";
			$vs .=
"** NEW TTYverse RELEASE CANDIDATE AVAILABLE: build $rcnum **\n" .
"** get it: $bdownload\n$s2"
			if ($TTYverse_RC_NUMBER < $rcnum);
			$vs .= "** (this is the most current beta)\n"
				if ($TTYverse_RC_NUMBER == $rcnum);
			$vs .= "$s1$s3";
			if ($TTYverse_RC_NUMBER < $rcnum) {
				if ($update_url) {
					$vs .=
"-- %URL% is now $bdownload (/short shortens, /url opens)\n";
					$urlshort = $bdownload;
				}
			} elsif (length($update_trlt) && $update_url) {
				$urlshort = $update_trlt;
	$vs .= "-- %URL% is now $urlshort (/short shortens, /url opens)\n";
			}
			return $vs;
		}
		if ($my_version_string eq $inversion && $TTYverse_RC_NUMBER) {
			$vs .=
"** FINAL TTYverse RELEASE NOW AVAILABLE for version $inversion **\n" .
"** get it: $download\n$s2$s1";
			if ($update_url) {
				$vs .=
"-- %URL% is now $bdownload (/short shortens, /url opens)\n";
				$urlshort = $bdownload;
			}
			return $vs;
		}
		($inversion =~/^(\d+\.\d+)\.(\d+)$/) && ($maj = 0+$1,
			$min = 0+$2);
		if (0+$TTYverse_VERSION < $maj ||
				(0+$TTYverse_VERSION == $maj &&
				 $TTYverse_PATCH_VERSION < $min)) {
			$vs .=
	"** NEWER TTYverse VERSION NOW AVAILABLE: $inversion **\n" .
	"** get it: $download\n$s2$s1";
			if ($update_url) {
				$vs .=
"-- %URL% is now $download (/short shortens, /url opens)\n";
				$urlshort = $download;
			}
			return $vs;
		} elsif (0+$TTYverse_VERSION > $maj ||
				(0+$TTYverse_VERSION == $maj &&
				 $TTYverse_PATCH_VERSION > $min)) {
			$vs .= 
	"** unable to identify your version of TTYverse\n$s1";
		} else {
			$vs .=
	"-- your version of TTYverse is up to date ($inversion)\n$s1";
		}
	}

	# if we got this far, then there is no TTYverse update, but maybe a
	# T:RL:T update, so we offer that as the URL
	if (length($update_trlt) && $update_url) {
		$urlshort = $update_trlt;
		$vs .= "-- %URL% is now $urlshort (/short shortens, /url opens)\n";
	}
	return $vs;
}

sub generate_otabcomp {
	if (scalar(@j = keys(%readline_completion))) {
		# print optimized readline. include all that we
		# manually specified, plus/including top @s, total 10.
		@keys = sort { $readline_completion{$b} <=>
			$readline_completion{$a} } @j;
		$factor = $readline_completion{$keys[0]};
		foreach(keys %original_readline) {
			$readline_completion{$_} += $factor;
		}
		print $stdout "*** optimized readline:\n";
		@keys = sort { $readline_completion{$b} <=>
			$readline_completion{$a} } keys
				%readline_completion;
		@keys = @keys[0..14] if (scalar(@keys) > 15);
		print $stdout "-readline=\"@keys\"\n";
	}
}
sub end_me { exit; } # which falls through to, via END, ...
sub killkid {
	# for streaming assistance
	if ($child) {
		print $stdout "\n\ncleaning up.\n";
		kill $SIGHUP, $child; # warn it about shutdown
		if (length($track)) {
			print $stdout "*** you were tracking:\n";
			print $stdout "-track='$track'\n";
		}
		if (length($filter)) {
			print $stdout "*** your current filter expression:\n";
			print $stdout "-filter='$filter'\n";
		}
		&generate_otabcomp if ($verbose);
		sleep 2 if ($dostream);
		kill 9, $curlpid if ($curlpid);
		kill 9, $child;
	}
	&$shutdown unless (!$shutdown);
}

sub generate_ansi {
	my $k;

	$BLUE = ($ansi) ? "${ESC}[34;1m" : '';
	$RED = ($ansi) ? "${ESC}[31;1m" : '';
	$GREEN = ($ansi) ? "${ESC}[32;1m" : '';
	$YELLOW = ($ansi) ? "${ESC}[33m" : '';
	$MAGENTA = ($ansi) ? "${ESC}[35m" : '';
	$CYAN = ($ansi) ? "${ESC}[36m" : '';

	$EM = ($ansi) ? "${ESC}[1m" : '';
	$UNDER = ($ansi) ? "${ESC}[4m" : '';
	$OFF = ($ansi) ? "${ESC}[0m" : '';

	foreach $k (qw(prompt me dm reply warn search list default)) {
		${"colour$k"} = uc(${"colour$k"});
		if (!defined($${"colour$k"})) {
			print $stdout
		"-- warning: bogus colour '".${"colour$k"}."'\n";
		} else {
			eval("\$CC$k = \$".${"colour$k"});
		}
	}

	eval '$termrl->hook_use_ansi' if ($termrl);
}

# always POST
sub postjson {
	my $url = shift;
	my $postdata = shift; # add _method=DELETE for delete
	my $data;

	# this is copied mostly verbatim from grabjson
	chomp($data = &backticks($baseagent, '/dev/null', undef, $url,
		$postdata, 0, @wend));
	my $k = $? >> 8;

	$data =~ s/[\r\l\n\s]*$//s;
	$data =~ s/^[\r\l\n\s]*//s;

	if (!length($data) || $k == 28 || $k == 7 || $k == 35) {
		&$exception(1, "*** warning: timeout or no data\n");
		return undef;
	}

	# old non-JSON based error reporting code still supported
	if ($data =~ /^\[?\]?<!DOCTYPE\s+html/i || $data =~ /^(Status:\s*)?50[0-9]\s/ || $data =~ /^<html>/i || $data =~ /^<\??xml\s+/) {
		print $stdout $data if ($superverbose);
		if (&is_fail_whale($data)) {
			&$exception(2, "*** warning: Server temporarily unavailable\n");
		} else {
		&$exception(2, "*** warning: server error message received\n" .
			(($data =~ /<title>([^<]+)</) ?
				"*** \"$1\"\n" : ''));
		}
		return undef;
	}
	if ($data =~ /^rate\s*limit/i) {
		print $stdout $data if ($superverbose);
		&$exception(3,
"*** warning: exceeded API rate limit for this interval.\n" .
"*** no updates available until interval ends.\n");
		return undef;
	}

	if ($k > 0) {
		&$exception(4,
"*** warning: unexpected error code ($k) from user agent\n");
		return undef;
	}

	# handle things like 304, or other things that look like HTTP
	# error codes
	if ($data =~ m#^HTTP/\d\.\d\s+(\d+)\s+#) {
		$code = 0+$1;
		print $stdout $data if ($superverbose);

		# Handle successful HTTP responses properly for fediverse APIs
		if ($code == 200) {
			# 200 OK with content - continue processing
		} elsif ($code == 204) {
			# 204 No Content - successful but empty (normal for some API calls)
			print $stdout "-- No new content (HTTP 204)\n" if ($verbose);
			return [];
		} elsif ($code == 304) {
			# 304 Not Modified - no new content since last fetch
			print $stdout "-- No new content since last fetch (HTTP 304)\n" if ($verbose);
			return [];
		} else {
			&$exception(4,
"*** warning: unexpected HTTP return code $code from server\n");
			return undef;
		}
	}

	# test for error/warning conditions with trivial case
	if ($data =~ /^\s*\{\s*(['"])(warning|error)\1\s*:\s*\1([^\1]*?)\1/s
		|| $data =~ /(['"])(warning|error)\1\s*:\s*\1([^\1]*?)\1\}/s) {
		print $stdout $data if ($superverbose);
		&$exception(2, "*** warning: server $2 message received\n" .
			"*** \"$3\"\n");
		return undef;
	}

	return &map_mastodon_fields(&parsejson($data));
}

# always GET
sub grabjson {
	my $data;
	my $url = shift;
	my $last_id = shift;
	my $is_anon = shift;
	my $count = shift;
	my $tag = shift;
	my $do_entities = shift;

	my $kludge_search_api_adjust = 0;
	my $my_json_ref = undef; # durrr hat go on foot
	my $i;
	my $tdata;
	my $seed;

	#undef $/; $data = <STDIN>;

	# we may need to sort our args for more flexibility here.
	my @xargs = (); my $i = index($url, "?");
	if ($i > -1) {
		# throw an error if "?" is at the end.
		push(@xargs, split(/\&/, substr($url, ($i+1))));
		$url = substr($url, 0, $i);
	}

	# limit parameter for Mastodon API (replaces Twitter's count parameter)
	push(@xargs, "limit=$count") if ($count);
	# timeline control. this speeds up parsing since there's less data.
	# can't use skip_user: no SN
	push (@xargs, "since_id=${last_id}") if ($last_id);

	# include_entities is Twitter-specific, not needed for Mastodon
	# push (@xargs, "include_entities=1") if ($do_entities);

	my $resource = (scalar(@xargs)) ?
		[ $url, join('&', sort @xargs) ] : $url;
	
	# Debug: show the actual API call being made
	if ($verbose && ref($resource) eq 'ARRAY') {
		print $stdout "-- DEBUG: API call: $resource->[0]?$resource->[1]\n";
	} elsif ($verbose) {
		print $stdout "-- DEBUG: API call: $resource\n";
	}

	chomp($data = &backticks($baseagent,
			'/dev/null', undef, $resource, undef,
			$is_anon + $anonymous, @wind));
	my $k = $? >> 8;

	$data =~ s/[\r\l\n\s]*$//s;
	$data =~ s/^[\r\l\n\s]*//s;

	if (!length($data) || $k == 28 || $k == 7 || $k == 35) {
		&$exception(1, "*** warning: timeout or no data\n");
		return undef;
	}

	# old non-JSON based error reporting code still supported
	if ($data =~ /^\[?\]?<!DOCTYPE\s+html/i || $data =~ /^(Status:\s*)?50[0-9]\s/ || $data =~ /^<html>/i || $data =~ /^<\??xml\s+/) {
		print $stdout $data if ($superverbose);
		if (&is_fail_whale($data)) {
			&$exception(2, "*** warning: Server temporarily unavailable\n");
		} else {
		&$exception(2, "*** warning: server error message received\n" .
			(($data =~ /<title>([^<]+)</) ?
				"*** \"$1\"\n" : ''));
		}
		return undef;
	}
	if ($data =~ /^rate\s*limit/i) {
		print $stdout $data if ($superverbose);
		&$exception(3,
"*** warning: exceeded API rate limit for this interval.\n" .
"*** no updates available until interval ends.\n");
		return undef;
	}

	if ($k > 0) {
		&$exception(4,
"*** warning: unexpected error code ($k) from user agent\n");
		return undef;
	}

	# handle things like 304, or other things that look like HTTP
	# error codes
	if ($data =~ m#^HTTP/\d\.\d\s+(\d+)\s+#) {
		$code = 0+$1;
		print $stdout $data if ($superverbose);

		# Handle successful HTTP responses properly for fediverse APIs
		if ($code == 200) {
			# 200 OK with content - continue processing
		} elsif ($code == 204) {
			# 204 No Content - successful but empty (normal for some API calls)
			print $stdout "-- No new content (HTTP 204)\n" if ($verbose);
			return [];
		} elsif ($code == 304) {
			# 304 Not Modified - no new content since last fetch
			print $stdout "-- No new content since last fetch (HTTP 304)\n" if ($verbose);
			return [];
		} else {
			&$exception(4,
"*** warning: unexpected HTTP return code $code from server\n");
			return undef;
		}
	}

	# test for error/warning conditions with trivial case
	if ($data =~ /^\s*\{\s*(['"])(warning|error)\1\s*:\s*\1([^\1]*?)\1/s
		|| $data =~ /(['"])(warning|error)\1\s*:\s*\1([^\1]*?)\1\}/s) {
		print $stdout $data if ($superverbose);
		&$exception(2, "*** warning: server $2 message received\n" .
			"*** \"$3\"\n");
		return undef;
	}

	# if wrapped in statuses object, unwrap it
	# (and tag it to do more later)
        if ($data =~ s/^\s*(\{)\s*['"]statuses['"]\s*:\s*(\[.*\]).*$/$2/isg) {
		$kludge_search_api_adjust = 1;
	}

	$my_json_ref = &map_mastodon_fields(&parsejson($data));

	# normalize the data into a standard form.
	# single posts such as from statuses/show aren't arrays, so
	# we special-case for them.
	if (defined($my_json_ref) && ref($my_json_ref) eq 'HASH' &&
		$my_json_ref->{'favorited'} &&
		$my_json_ref->{'source'} &&
		((0+$my_json_ref->{'id'}) ||
			length($my_json_ref->{'id_str'}))) {
		$my_json_ref = &normalizejson($my_json_ref);
	}
	if (defined($my_json_ref) && ref($my_json_ref) eq 'ARRAY') {
		foreach $i (@{ $my_json_ref }) {
			$i = &normalizejson($i,$kludge_search_api_adjust,$tag);
		}
	}

	$laststatus = 0;
	return &map_mastodon_fields($my_json_ref);
}

# convert t.co into actual URLs. separate from normalizejson because other
# things need this. modified from /entities.
sub destroy_all_tco {
	my $hash = shift;
	return $hash if ($notco);
	my $v;
	my $w;

	# fediverse puts entities in multiple fields.
	foreach $w (qw(media urls)) {
		my $p = $hash->{'entities'}->{$w};
		next if (!defined($p) || ref($p) ne 'ARRAY');
		foreach $v (@{ $p }) {
			next if (!defined($v) || ref($v) ne 'HASH');
			next if (!length($v->{'url'}) ||
				(!length($v->{'expanded_url'}) &&
				 !length($v->{'media_url'})));
			my $u1 = quotemeta($v->{'url'});
			my $u2 = $v->{'expanded_url'};
			my $u3 = $v->{'media_url'};
			my $u4 = $v->{'media_url_https'};
			$u2 = $u4 || $u3 || $u2;
			$hash->{'text'} =~ s/$u1/$u2/;
		}
	}
	return $hash;
}

# takes a post structure and normalizes it according to settings.
# what this currently does is the following gyrations:
# - if there is no id_str, see if we can convert id into one. if
#   there is loss of precision, warn the user. same for
#   in_reply_to_status_id_str.
# - if the source of this JSON data source is the Search API, translate
#   its fields into the standard API.
# - if the calling function has specified a tag, tag the posts, since
#   we're iterating through them anyway. the tag should be a hashref payload.
# - if the post is an newRT, unwrap it so that the full post text is
#   revealed (unless -noreblogs).
# - if this appears to be a post, put in a stub geo hash if one does
#   not yet exist.
# - if coordinates are flat string 'null', turn into a real null.
# one day I would like this code to go the hell away.
sub normalizejson {
	my $i = shift;
	my $kludge_search_api_adjust = shift;
	my $tag = shift;
	my $rt;

	# tag the post
	$i->{'tag'} = $tag if (defined($tag));

	# id -> id_str if needed
	if (!length($i->{'id_str'})) {
		# Fediverse servers use string IDs - copy directly without numeric conversion
		if (defined($i->{'id'})) {
			$i->{'id_str'} = $i->{'id'};
		}
	}
	# irtsid -> irtsid_str (if there is one)
	if (!length($i->{'in_reply_to_status_id_str'}) &&
			$i->{'in_reply_to_status_id'}) {
		# Fediverse servers use string IDs - copy directly without numeric conversion
		$i->{'in_reply_to_status_id_str'} = $i->{'in_reply_to_status_id'};
	}

	# normalize geo. if this has a source and it has a
	# favorited, then it is probably a post and we will
	# add a stub geo hash if one doesn't exist yet.
	if ($kludge_search_api_adjust || 
			($i->{'favorited'} && $i->{'source'})){
		$i = &fix_geo_api_data($i);
	}

	# hooray! this just tags it
	if ($kludge_search_api_adjust) {
		$i->{'class'} = "search";
	}

	# normalize newRTs
	# if we get newRTs with -noreblogs, oh well
	my $boost_content = '';
	my $boost_attribution = '';
	my $boost_user = undef;
	
	if (!$noreblogs && ($rt = $i->{'reblog'})) {
		# reconstruct the boost in fediverse format: <author> [boosted <booster@domain>] content
		# without truncation, but detco it first
		$rt = &destroy_all_tco($rt);
		$i->{'reblog'} = $rt;
		
		# Get original author and content
		my $original_author = $rt->{'user'}->{'acct'} || $rt->{'user'}->{'username'} || 'unknown_user';
		my $content = $rt->{'text'} || '';
		
		# Get booster (who shared this)
		my $booster = $i->{'user'}->{'acct'} || $i->{'user'}->{'username'} || 'unknown_booster';
		
		print $stdout "-- DEBUG: Boost - original: '$original_author', booster: '$booster', content: '$content'\n" if ($verbose);
		
		# Store boost data to apply after destroy_all_tco
		$boost_content = $content;
		my $original_acct = $rt->{'user'}->{'acct'} || $rt->{'user'}->{'username'} || $original_author;
		$boost_attribution = $original_acct;
		
		# Set booster as the main user (who performed the boost action)
		$boost_user = {
			'username' => $booster,
			'acct' => $booster
		};
	}

	# Apply destroy_all_tco first
	$i = &destroy_all_tco($i);
	
	# Now apply boost data after destroy_all_tco processing
	if ($boost_content) {
		$i->{'text'} = $boost_content;
		$i->{'boost_attribution'} = $boost_attribution;
		$i->{'user'} = $boost_user;
		print $stdout "-- DEBUG: Final boost data applied - text: '$boost_content', attribution: '$boost_attribution'\n" if ($verbose);
	}
	
	# Handle poll data - check for polls in boost-aware manner (Bifrost pattern)
	my $poll_data = undef;
	if (exists($i->{'reblog'}) && exists($i->{'reblog'}->{'poll'})) {
		# Poll is in the boosted post
		$poll_data = $i->{'reblog'}->{'poll'};
		print $stdout "-- DEBUG: Found poll in boosted post\n" if ($verbose);
	} elsif (exists($i->{'poll'})) {
		# Poll is in the main post
		$poll_data = $i->{'poll'};
		print $stdout "-- DEBUG: Found poll in main post\n" if ($verbose);
	}
	
	# Store poll data for display - but only if it's a valid poll with options
	if ($poll_data && ref($poll_data) eq 'HASH' && exists($poll_data->{'options'}) && @{$poll_data->{'options'}}) {
		$i->{'poll'} = $poll_data;
		print $stdout "-- DEBUG: Poll data stored for display\n" if ($verbose);
	} else {
		# Clear any false poll data
		delete $i->{'poll'} if exists($i->{'poll'});
		print $stdout "-- DEBUG: No valid poll data found, cleared poll flag\n" if ($verbose && $poll_data);
	}
	
	return $i;
}

# process the JSON data ... simplemindedly, because I just write utter crap,
# am not a professional programmer, and don't give a flying fig whether
# kludges suck or no. this used to be part of grabjson, but I split it out.
sub parsejson {
	my $data = shift;
	my $my_json_ref = undef; # durrr hat go on foot
	
	# Early filtering for HTTP error responses in fediverse mode
	if ($authtype eq 'oauth2' && defined($data)) {
		# Filter out obvious HTTP error responses before processing
		if ($data =~ /^HTTP\/\d\.\d\s+\d+/ ||
		    $data =~ /\b(405|404|403|401|500)\s+(Method\s+Not\s+Allowed|Not\s+Found|Forbidden|Unauthorized|Internal\s+Server\s+Error)/i ||
		    $data =~ /^\s*\d{3}\s+\w+\s*$/) {
			return undef;
		}
	}
	my $i;
	my $tdata;
	my $seed;
	my $bbqqmask;
	my $ddqqmask;
	my $ssqqmask;

	# test for single logicals
	return {
		'ok' => 1,
		'result' => (($1 eq 'true') ? 1 : 0),
		'literal' => $1,
			} if ($data =~ /^['"]?(true|false)['"]?$/);

	# first isolate escaped backslashes with a unique sequence.
	$bbqqmask = "BBQQ";
	$seed = 0;
	$seed++ while ($data =~ /$bbqqmask$seed/);
	$bbqqmask .= $seed;
	$data =~ s/\\\\/$bbqqmask/g;

	# next isolate escaped quotes with another unique sequence.
	$ddqqmask = "DDQQ";
	$seed = 0;
	$seed++ while ($data =~ /$ddqqmask$seed/);
	$ddqqmask .= $seed;
	$data =~ s/\\\"/$ddqqmask/g;

	# then turn literal ' into another unique sequence. you'll see
	# why momentarily.
	$ssqqmask = "SSQQ";
	$seed = 0;
	$seed++ while ($data =~ /$ssqqmask$seed/);
	$ssqqmask .= $seed;
	$data =~ s/\'/$ssqqmask/g;

	# here's why: we're going to turn doublequoted strings into single
	# quoted strings to avoid nastiness like variable interpolation.
	$data =~ s/\"/\'/g;

	# and then we're going to turn the inline ones all back except
	# ssqq, which we'll do last so that our syntax checker still works.
	$data =~ s/$bbqqmask/\\\\/g;
	$data =~ s/$ddqqmask/"/g;

	print $stdout "$data\n" if ($superverbose);

	# trust, but verify. I'm sure fediverse wouldn't send us malicious
	# or bogus JSON, but one day this might talk to something that would.
	# in particular, need to make sure nothing in this will eval badly or
	# run arbitrary code. that would really suck!
	# first, generate a syntax tree.
	$tdata = $data;
	1 while $tdata =~ s/'[^']*'//; # empty strings are valid too ...
	$tdata =~ s/-?[0-9]+\.?[0-9]*([eE][+-][0-9]+)?//g;
		# have to handle floats *and* their exponents
	$tdata =~ s/(true|false|null)//g;
	$tdata =~ s/\s//g;

	print $stdout "$tdata\n" if ($superverbose);

	# now verify the syntax tree.
	# the remaining stuff should just be enclosed in [ ], and only {}:,
	# for example, imagine if a bare semicolon were in this ...
	# Special case: empty array is valid in fediverse APIs
	if ($tdata eq "[]") {
		return [];
	}
	if ($tdata !~ s/^\[// || $tdata !~ s/\]$// || $tdata =~ /[^{}:,]/) {
		$tdata =~ s/'[^']*$//; # cut trailing strings
		if (($tdata =~ /^\[/ && $tdata !~ /\]$/)
				|| ($tdata =~ /^\{/ && $tdata !~ /\}$/)) {
			# incomplete transmission
			&$exception(10, "*** JSON warning: connection cut\n");
			return undef;
		}
# it seems that :[], or :[]} should be accepted as valid in the syntax tree
# since some APIs use this as possible for null properties
# ,[], shouldn't be, etc.
		if ($tdata =~ /(^|[^:])\[\]($|[^},])/) { # oddity
			&$exception(11, "*** JSON warning: null list\n");
			return undef;
		}
		# at this point all we should have are structural elements.
		# if something other than JSON structure is visible, then
		# the syntax tree is mangled. don't try to run it, it
		# might be unsafe. this exception was formerly uniformly
		# fatal. it is now non-fatal as of 2.1.
		# For fediverse JSON, we're more permissive as it includes 
		# boolean, null, and number values that are valid JSON.
		# Also filter out HTTP status lines and error responses that might appear
		if ($authtype eq 'oauth2') {
			# For fediverse, be more permissive with HTTP error responses
			if ($tdata =~ /^HTTP\/\d\.\d\s+\d+/ || 
			    $tdata =~ /\b\d{3}\s+(method|not\s+found|forbidden|unauthorized)/i ||
			    $tdata =~ /\b(405|404|403|401|500)\s+\w+/i) {
				# Skip validation for HTTP error responses
				return undef;
			}
		}
		my $json_check = ($authtype eq 'oauth2') 
			? qr/[^\[\]\{\}:,\s\w\d\.\-"'@#\/%]/  # More permissive for fediverse (allow @, #, /, %, etc.)
			: qr/[^\[\]\{\}:,]/;                   # Strict check for fediverse
		if ($tdata =~ /$json_check/) {
			&$exception(99, "*** JSON syntax error\n");
			print $stdout <<"EOF" if ($verbose);
--- data received ---
$data
--- syntax tree ---
$tdata
--- JSON PARSING ABORTED DUE TO SYNTAX TREE FAILURE --
EOF
			return undef;
		}
	}

	# syntax tree passed, so let's turn it into a Perl reference.
	# have to turn colons into ,s or Perl will gripe. but INTELLIGENTLY!
	1 while
	($data =~ s/([^'])'\s*:\s*(true|false|null|\'|\{|\[|-?[0-9])/\1\',\2/);

	# finally, single quotes, just before interpretation.
	$data =~ s/$ssqqmask/\\'/g;

	# now somewhat validated, so safe (?) to eval() into a Perl struct
	eval "\$my_json_ref = $data;";
	print $stdout "$data => $my_json_ref $@\n"  if ($superverbose);

	# do a sanity check
	if (!defined($my_json_ref)) {
		&$exception(99, "*** JSON syntax error\n");
		print $stdout <<"EOF" if ($verbose);
--- data received ---
$data
--- syntax tree ---
$tdata
--- JSON PARSING FAILED --
$@
--- JSON PARSING FAILED --
EOF
	}

	return $my_json_ref;
}

# Map Mastodon/ActivityPub JSON fields to fediverse-compatible field names
# This maintains compatibility with existing display logic
sub map_mastodon_fields {
	my $json_ref = shift;
	return $json_ref unless ($authtype eq 'oauth2'); # Only for fediverse
	
	# Handle single status objects
	if (ref($json_ref) eq 'HASH' && exists($json_ref->{'content'})) {
		$json_ref = &map_single_status($json_ref, 0);
	}
	# Handle user/account objects (verify_credentials, etc.)
	elsif (ref($json_ref) eq 'HASH' && exists($json_ref->{'username'})) {
		$json_ref = &map_user_object($json_ref);
	}
	# Handle arrays of statuses (timelines)
	elsif (ref($json_ref) eq 'ARRAY') {
		for my $i (0..$#{$json_ref}) {
			$json_ref->[$i] = &map_single_status($json_ref->[$i], 0) 
				if (ref($json_ref->[$i]) eq 'HASH');
		}
	}
	
	return $json_ref;
}

sub map_single_status {
	my $status = shift;
	my $recursion_depth = shift || 0;
	return $status unless (ref($status) eq 'HASH');
	
	# Prevent infinite recursion - limit depth to 1 level
	return $status if ($recursion_depth > 1);
	
	# Skip re-processing if this is already a processed boost post
	if (exists($status->{'boost_attribution'}) && $status->{'boost_attribution'}) {
		print $stdout "-- DEBUG: Skipping re-processing of already processed boost post\n" if ($verbose);
		return $status;
	}
	
	# Debug: Check if this is a boost
	if (exists($status->{'reblog'}) && $status->{'reblog'}) {
		print $stdout "-- DEBUG: Found boost - original account: " . ($status->{'account'}->{'acct'} || 'unknown') . "\n" if ($verbose);
		print $stdout "-- DEBUG: Reblog content present: " . (exists($status->{'reblog'}->{'content'}) ? 'yes' : 'no') . "\n" if ($verbose);
		print $stdout "-- DEBUG: Reblog account present: " . (exists($status->{'reblog'}->{'account'}) ? 'yes' : 'no') . "\n" if ($verbose);
	}
	
	# Core Mastodon → fediverse field mappings
	if (exists($status->{'content'})) {
		$status->{'text'} = &html_to_text($status->{'content'});
	}
	$status->{'user'} = $status->{'account'} if exists($status->{'account'});
	# reblog and reblogs_count fields are already in correct format for ActivityPub
	$status->{'favorite_count'} = $status->{'favourites_count'} if exists($status->{'favourites_count'});
	$status->{'in_reply_to_status_id_str'} = $status->{'in_reply_to_id'} if exists($status->{'in_reply_to_id'});
	
	# User/Account field mappings - native fediverse fields preferred
	if (exists($status->{'user'}) && ref($status->{'user'}) eq 'HASH') {
		my $user = $status->{'user'};
		# Map display fields only for compatibility with display functions
		$user->{'name'} = $user->{'display_name'} if exists($user->{'display_name'});
		$user->{'profile_image_url'} = $user->{'avatar'} if exists($user->{'avatar'});
		# Native fediverse fields: username, acct (username@domain.com)
	}
	
	# Recursively map reblogged status - with depth limit to prevent infinite recursion
	if (exists($status->{'reblog'})) {
		print $stdout "-- DEBUG: Processing reblogged status recursively (depth: $recursion_depth)\n" if ($verbose);
		$status->{'reblog'} = &map_single_status($status->{'reblog'}, $recursion_depth + 1);
	}
	
	return $status;
}

sub map_user_object {
	my $user = shift;
	
	# Map display-only fields for legacy compatibility
	$user->{'name'} = $user->{'display_name'} if exists($user->{'display_name'});
	$user->{'profile_image_url'} = $user->{'avatar'} if exists($user->{'avatar'});
	# Count fields use native names already
	$user->{'followers_count'} = $user->{'followers_count'} if exists($user->{'followers_count'});
	$user->{'friends_count'} = $user->{'following_count'} if exists($user->{'following_count'});
	$user->{'statuses_count'} = $user->{'statuses_count'} if exists($user->{'statuses_count'});
	# Use native fediverse username/acct fields directly
	
	return $user;
}

# Get server configuration and update character limits
sub update_server_config {
	return unless ($authtype eq 'oauth2'); # Only for fediverse servers
	
	my $instance_url = "${http_proto}://${fediverseserver}/api/v1/instance";
	print $stdout "-- checking server configuration...\n" if ($verbose);
	
	my $config_json = &grabjson($instance_url);
	if (!$config_json) {
		print $stdout "-- server configuration unavailable (using defaults)\n" if ($verbose);
		return;
	}
	
	# Extract character limit from server configuration
	if (exists($config_json->{'configuration'}->{'statuses'}->{'max_characters'})) {
		my $server_limit = $config_json->{'configuration'}->{'statuses'}->{'max_characters'};
		if ($server_limit > 0 && $server_limit != $linelength) {
			print $stdout "-- server character limit: $server_limit (was $linelength)\n" if ($verbose);
			$linelength = $server_limit;
		}
	}
	
	# Check for streaming support based on server software
	my $server_software = $config_json->{'version'} || '';
	if ($server_software =~ /(mastodon|pleroma|akkoma|misskey|foundkey|calckey|firefish)/i) {
		print $stdout "-- streaming supported by $1\n" if ($verbose);
		print $stdout "-- enable with -dostream for real-time updates\n" if ($verbose && !$dostream);
	} elsif ($server_software =~ /gotosocial/i) {
		print $stdout "-- GoToSocial detected (streaming available)\n" if ($verbose);
		print $stdout "-- enable with -dostream for real-time updates\n" if ($verbose && !$dostream);
	}
	
	# Also check for other useful server info
	if (exists($config_json->{'title'})) {
		print $stdout "-- connected to: " . $config_json->{'title'} . "\n" if ($verbose);
	}
}

sub fix_geo_api_data {
	my $ref = shift;
	$ref->{'geo'}->{'coordinates'} = undef
		if ($ref->{'geo'}->{'coordinates'} eq 'null' ||
		    $ref->{'geo'}->{'coordinates'}->[0] eq '' ||
		    $ref->{'geo'}->{'coordinates'}->[1] eq '');
	$ref->{'geo'}->{'coordinates'} ||= [ "undef", "undef" ];
	return $ref;
}

sub is_fail_whale {
	# is this actually the dump from a fail whale?
	my $data = shift;
	return ($data =~ m#<title>.*Over.+capacity.*</title>#i ||
		$data =~ m#[\r\l\n\s]*DB_DataObject Error: Connect failed#s);
}

# {'errors':[{'message':'Rate limit exceeded','code':88}]}
sub is_json_error {
	# is this actually a JSON error message? if so, extract it
	my $data = shift;
	if ($data =~ /(['"])(warning|errors?)\1\s*:\s*/s) {
		if ($data =~ /^\s*\{/s) { # JSON object?
			my $dref = &map_mastodon_fields(&parsejson($data));
			print $stdout "*** is_json_error returning true\n"
				if ($verbose);
			# support 1.0 and 1.1 error objects
			return $dref->{'error'} if (length($dref->{'error'}));
			return $dref->{'errors'}->[0]->{'message'}
				if (length($dref->{'errors'}->[0]->{'message'}));
			return (split(/\\n/, $dref->{'errors'}))[0]
				if(length($dref->{'errors'}));
		}
		return $data;
	}
	return undef;
}

sub backticks {
	# more efficient/flexible backticks system
	my $comm = shift;
	my $rerr = shift;
	my $rout = shift;
	my $resource = shift;
	my $data = shift;
	my $dont_do_auth = shift;
	my $buf = '';
	my $undersave = $_;
	my $pid;
	my $args;

	($comm, $args, $data) = &$stringify_args($comm, $resource,
		$data, $dont_do_auth, @_);
	print $stdout "$comm\n$args\n$data\n" if ($superverbose);
	if(open(BACTIX, '-|')) {
		while(<BACTIX>) {
			$buf .= $_;
		} close(BACTIX);
		$_ = $undersave;
		return $buf; # and $? is still in $?
	} else {
		$in_backticks = 1;
		&sigify(sub {
			die(
		"** user agent not honouring timeout (caught by sigalarm)\n");
		}, qw(ALRM));
		alarm 120; # this should be sufficient
		if (length($rerr)) {
			close(STDERR); 
			open(STDERR, ">$rerr");
		}
		if (length($rout)) {
			close(STDOUT);
			open(STDOUT, ">$rout");
		}
		if(open(FRONTIX, "|$comm")) {
			print FRONTIX "$args\n";
			print FRONTIX "$data" if (length($data));
			close(FRONTIX);
		} else {
			die(
			"backticks() failure for $comm $rerr $rout @_: $!\n");
		}
		$rv = $? >> 8;
		exit $rv;
	}
}

sub wherecheck {
	my ($prompt, $filename, $fatal) = (@_);
	my (@paths) = split(/\:/, $ENV{'PATH'});
	my $setv = '';

	push(@paths, '/usr/bin'); # the usual place
	@paths = ('') if ($filename =~ m#^/#); # for absolute paths

	print $stdout "$prompt ... " unless ($silent);
	foreach(@paths) {
		if (-r "$_/$filename") {
			$setv = "$_/$filename";
			1 while $setv =~ s#//#/#;
			print $stdout "$setv\n" unless ($silent);
			last;
		}
	}
	if (!length($setv)) {
		print $stdout "not found.\n";
		if ($fatal) {
			print $stdout $fatal;
			exit(1);
		}
	}
	return $setv;
}

sub screech {
	print $stdout "\n\n${BEL}${BEL}@_";
	if ($is_background) {
		kill 9, $parent;
		kill 9, $$;
	} elsif ($child) {
		kill 9, $child;
		kill 9, $$;
	}
	die("death not achieved conventionally");
}

# &in($x, @y) returns true if $x is a member of @y
sub in { my $key = shift; my %mat = map { $_ => 1 } @_;
	return $mat{$key}; }

sub descape {
	my $x = shift;
	my $mode = shift;

	$x =~ s#\\/#/#g;

	# try to do something sensible with unicode
	if ($mode) { # this probably needs to be revised
		$x =~ s/\\u([0-9a-fA-F]{4})/"&#" . hex($1) . ";"/eg;
	} else {
		# intermediate form if HTML entities get in
		$x =~ s/\&\#([0-9]+);/'\u' . sprintf("%04x", $1)/eg;

		$x =~ s/\\u202[89]/\\n/g;

		# canonicalize Unicode whitespace
		1 while ($x =~ s/\\u(00[aA]0)/ /g);
		1 while ($x =~ s/\\u(200[0-9aA])/ /g);
		1 while ($x =~ s/\\u(20[25][fF])/ /g);
		if ($seven) {
			# known UTF-8 entities (char for char only)
			$x =~ s/\\u201[89]/\'/g;
			$x =~ s/\\u201[cCdD]/\"/g;

			# 7-bit entities (32-126) also ok
	$x =~ s/\\u00([2-7][0-9a-fA-F])/chr(((hex($1)==127)?46:hex($1)))/eg;

			# dot out the rest
			$x =~ s/\\u([0-9a-fA-F]{4})/./g;
			$x =~ s/[\x80-\xff]/./g;
		} else {
			# try to promote to UTF-8
			&$utf8_decode($x);

			# fediverse uses UTF-16 for high code points, which
			# Perl's UTF-8 support does not like as surrogates.
			# try to decode these here; they are always back-to-
			# back surrogates of the form \uDxxx\uDxxx
			$x =~
s/\\u([dD][890abAB][0-9a-fA-F]{2})\\u([dD][cdefCDEF][0-9a-fA-F]{2})/&deutf16($1,$2)/eg;

			# decode the rest
			$x =~ s/\\u([0-9a-fA-F]{4})/chr(hex($1))/eg;
			$x = &uforcemulti($x);
		}
		$x =~ s/\&quot;/"/g;
		$x =~ s/\&apos;/'/g;
		$x =~ s/\&lt;/\</g;
		$x =~ s/\&gt;/\>/g;
		$x =~ s/\&amp;/\&/g;
	}
	if ($newline) {
		$x =~ s/\\n/\n/sg;
		$x =~ s/\\r//sg;
	}
	return $x;
}

sub html_to_text {
	my $html = shift;
	return "" unless defined($html);
	
	# Convert common HTML elements to text equivalents
	$html =~ s/<br\s*\/?>/\n/gi;           # Line breaks
	$html =~ s/<\/p>\s*<p[^>]*>/\n\n/gi;   # Paragraph breaks
	$html =~ s/<p[^>]*>//gi;               # Remove opening <p> tags
	$html =~ s/<\/p>//gi;                  # Remove closing </p> tags
	
	# Handle links - extract just the URL and hashtag text
	$html =~ s/<a[^>]*href="([^"]*)"[^>]*><span[^>]*>[^<]*<\/span><span[^>]*>([^<]*)<\/span><span[^>]*>[^<]*<\/span><\/a>/$2/gi; # Mastodon link format
	$html =~ s/<a[^>]*class="mention hashtag"[^>]*>#<span>([^<]*)<\/span><\/a>/#$1/gi; # Hashtags
	$html =~ s/<a[^>]*href="([^"]*)"[^>]*>([^<]*)<\/a>/$2/gi; # Simple links - show text
	
	# Remove all remaining HTML tags
	$html =~ s/<[^>]*>//g;
	
	# Decode HTML entities
	$html =~ s/&quot;/"/g;
	$html =~ s/&apos;/'/g;
	$html =~ s/&lt;/</g;
	$html =~ s/&gt;/>/g;
	$html =~ s/&amp;/&/g;
	
	# Clean up whitespace
	$html =~ s/\s+/ /g;           # Multiple spaces to single space
	$html =~ s/^\s+|\s+$//g;      # Trim leading/trailing whitespace
	$html =~ s/\n\s+/\n/g;        # Remove spaces after newlines
	
	return $html;
}

# used by descape: turn UTF-16 surrogates into a Unicode character
sub deutf16 {
	my $one = hex(shift);
	my $two = hex(shift);
	# subtract 55296 from $one to yield top ten bits
	$one -= 55296; # $d800
	# subtract 56320 from $two to yield bottom ten bits
	$two -= 56320; # $dc00

	# experimentally, fediverse uses this endianness below (we have no BOM)
	# see RFC 2781 4.3
	return chr(($one << 10) + $two + 65536);
}
sub max { 
	# Fediverse-only: use string comparison for post IDs
	return ($_[0] gt $_[1]) ? $_[0] : $_[1];
}
sub min { return ($_[0] < $_[1]) ? $_[0] : $_[1]; }
sub prolog { my $k = shift; 
	return "" if (!scalar(@_));
	my $l = shift; return (&$k($l) . &$k(@_)); }
# this is mostly a utility function for /eval. it is a recursive descent
# pretty printer.
sub a {
	my $w;
	my $x;
	return '' if(scalar(@_) < 1);
	if(scalar(@_) > 1) { $x = "(";
		foreach $w (@_) {
			$x .= &a($w);
		}
		return $x."), ";
	}
	$w = shift;
	if(ref($w) eq 'SCALAR') { return "\\\"". $$w . "\", "; }
	if(ref($w) eq 'HASH') { my %m = %{ $w };
		return "\n\t{".&prolog(\&a, %m)."}, "; }
	if(ref($w) eq 'ARRAY') { return "\n\t[".&prolog(\&a, @{ $w })."], "; }
	return "\"$w\", ";
}
sub ssa   { return (scalar(@_) ? ("('" . join("', '", @_) . "')") : "NULL"); }

sub strim { my $x=shift; $x=~ s/^\s+//; $x=~ s/\s+$//; return $x; }

sub wwrap {
	return shift if (!$wrap);

	my $k;
	my $klop = ($wrap > 1) ? $wrap : ($ENV{'COLUMNS'} || 79);
	$klop--; # don't ask me why
	my $lop;
	my $buf = '';
	my $string = shift;
	my $indent = shift; # for very first time with the prompt
	my $needspad = 0;
	my $stringpad = " " x 3;

	$indent += 4; # for the menu select string

	$lop = $klop - $indent;
	W: while($k = length($string)) {
		$lop += $indent if ($lop < $klop);
		($buf .= $string, last W) if ($k <= $lop && $string !~ /\n/);
		($string =~ s/^\s*\n//) && ($buf .= "\n",
			$needspad = 1,
			next W);
		if ($needspad) {
			$string = "   $string";
			$needspad = 0;
		}
		# Smart URL handling - keep URLs on one line if possible
		if ($string =~ s#^(https?://\S+)\s*##) {
			$buf .= "$1\n";
			next W;
		}
		
		# Also handle URLs that might appear mid-text
		if ($string =~ /^(.{0,20})(https?:\/\/\S+)(.*)$/ && length($2) <= $lop) {
			my ($before, $url, $after) = ($1, $2, $3);
			if (length($before) + length($url) <= $lop) {
				$string = $after;
				$buf .= "$before$url\n";
				next W;
			}
		}
		
		# Try to break on word boundaries with smart lookback
		if ($string =~ s/^(.{4,$lop})\s+/   /) {
			$buf .= "$1\n";
			next W;
		}
		
		# If no space found, look for punctuation boundaries
		if ($string =~ s/^(.{4,$lop})([.,;:!?\)\]\}])/   $2/) {
			$buf .= "$1\n";
			next W;
		}
		
		# Last resort: try to find ANY whitespace or break point within reasonable distance
		my $search_back = int($lop * 0.8); # Allow up to 20% shorter lines to avoid mid-word breaks
		if ($search_back > 10 && $string =~ s/^(.{$search_back,$lop})\s+/   /) {
			$buf .= "$1\n";
			next W;
		}
		
		# Ultimate fallback: break at line length (original behavior)
		if ($string =~ s/^(.{$lop})/   /) {
			$buf .= "$1\n";
			next W;
		}
		warn
		"-- pathologic string somehow failed wordwrap! \"$string\"\n";
		return $buf;
	}               
	1 while ($buf =~ s/\n\n\n/\n\n/s); # mostly paranoia
	$buf =~ s/[ \t]+$//;
	return $buf;
}

# these subs look weird, but they're encoding-independent and run anywhere
sub uforcemulti { # forces multi-byte interpretation by abusing Perl
	my $x = shift;
	return $x if ($seven);
	$x = "\x{263A}".$x;
	return pack("${pack_magic}H*", substr(unpack("${pack_magic}H*",$x),6));
}
sub ulength { my @k; return (scalar(@k = unpack("${pack_magic}C*", shift))); }
sub uhex {
	# URL-encode an arbitrary string, even UTF-8
	# more versatile than the miniature one in &updatest
	my $k = '';
	my $s = shift;
	&$utf8_encode($s);

	foreach(split(//, $s)) {
		my $j = unpack("H256", $_);
		while(length($j)) {
			$k .= '%' . substr($j, 0, 2);
			$j = substr($j, 2);
		}
	}
	return $k;
}

# for t.co
# adapted from github.com/fediverse/fediverse-text-js/blob/master/fediverse-text.js
# this is very hard to get right, and I know there are edge cases. this first
# one is designed to be quick and dirty because it needs to be fast more than
# it needs to be accurate, since T:RL:T calls it a LOT. however, it can be
# fooled, see below.
sub fastturntotco {
	my $s = shift;
	my $w;

	# turn domain names into http urls. this should look at .com, .net,
	# .etc., but things like you.suck.too probably *should* hit this
	# filter. this uses the heuristic that a domain name over some limit
	# is probably not actually a domain name.
	($s =~ s#\b(([a-zA-Z0-9-_]\.)+([a-zA-Z]){2,})\b#((length($w="$1")>45)?$w:"http://$w")#eg);

	# now turn all http and https URLs into t.co strings
	($s =~ s#\b(https?)://[a-zA-Z0-9-_]+[^\s]*?('|\\|\s|[\.;:,!\?]\s+|[\.;:,!\?]$|$)#\1://t.co/1234567\2#gi);
	return $s;
}
# slow t.co converter. this is for future expansion.
sub turntotco {
	return &fastturntotco(shift);
}

sub ulength_tco {
	my $w = shift;
	return &ulength(($notco) ? $w : &turntotco($w));
}
sub length_tco {
	my $w = shift;
	return length(($notco) ? $w : &turntotco($w));
}
# take a string and return up to $linelength CHARS plus the rest.
sub csplit { return &cosplit(@_, sub { return  &length_tco(shift); }); }
# take a string and return up to $linelength BYTES plus the rest.
sub usplit { return &cosplit(@_, sub { return &ulength_tco(shift); }); }
sub cosplit {
	# this is the common code for &csplit and &usplit.
	# this is tricky because we don't want to split up UTF-8 sequences, so
        # we let Perl do the work since it internally knows where they end.
	my $orig_k = shift;
	my $mode = shift;
	my $lengthsub = shift;
	my $z;
	my @m;
	my $q;
	my $r;

	$mode += 0;
	$k = $orig_k;

	# optimize whitespace
	$k =~ s/^\s+//;
	$k =~ s/\s+$//;
	$k =~ s/\s+/ /g;
	$z = &$lengthsub($k);
	return ($k) if ($z <= $linelength); # also handles the trivial case

	# this needs to be reply-aware, so we put @'s at the beginning of
	# the second half too (and also Ds for DMs)
	$r .= $1 while ($k =~ s/^(\@[^\s]+\s)\s*// ||
			$k =~ s/^(D\s+[^\s]+\s)\s*//);  # we have r/a, so while
	$k = "$r$k";

	my $i = $linelength;
	$i-- while(($z = &$lengthsub($q = substr($k, 0, $i))) > $linelength);
	$m = substr($k, $i);

	# if we just wanted split-on-byte, return now (mode = 1)
	if ($mode) {
		# optimize again in case we split on whitespace
		$q =~ s/\s+$//;
		$m =~ s/^\s+//;
		return ($q, "$r$m");
	}

	# else try to do word boundary and cut even more
	if (!$autosplit) { # use old mechanism first: drop trailing non-alfanum
		($q =~ s/([^a-zA-Z0-9]+)$//) && ($m = "$1$m");
		# optimize again in case we split on whitespace
		$q =~ s/\s+$//;
		return (&cosplit($orig_k, 1, $lengthsub))
			if (!length($q) && !$mode);
			# it totally failed. fall back on charsplit.
		if (&$lengthsub($q) < $linelength) {
			$m =~ s/^\s+//;
			return($q, "$r$m")
		}
	}
	($q =~ s/\s+([^\s]+)$//) && ($m = "$1$m");
	return (&cosplit($orig_k, 1, $lengthsub)) if (!length($q) && !$mode);
		# it totally failed. fall back on charsplit.
	return ($q, "$r$m");
}

### OAuth methods, including our own homegrown SHA-1 and HMAC ###
### no Digest:* required! ###
### these routines are not byte-safe and need a use bytes; before you call ###

# this is a modified, deciphered and deobfuscated version of the famous Perl
# one-liner SHA-1 written by John Allen. hope he doesn't mind.
sub sha1 {
	my $string = shift;
	print $stdout "string length: @{[ length($string) ]}\n"
		if ($showwork);

	my $constant = "D9T4C`>_-JXF8NMS^\$#)4=L/2X?!:\@GF9;MGKH8\\;O-S*8L'6";
	my @A = unpack('N*', unpack('u', $constant));
	my @K = splice(@A, 5, 4);
	my $M  = sub { # 64-bit warning
		my $x;
		my $m;
		($x = pop @_) - ($m=4294967296) * int($x / $m);
	};
	my $L = sub { # 64-bit warning
		my $n = pop @_;
		my $x;
		((($x = pop @_) << $n) | ((2 ** $n - 1) & ($x >> 32 - $n))) &
			4294967295;
	};
	my $l = '';
	my $r;
	my $a;
	my $b;
	my $c;
	my $d;
	my $e;
	my $us;
	my @nuA;
	my $p = 0;
	$string = unpack("H*", $string);

	do {
		my $i;
		$us = substr($string, 0, 128);
		$string = substr($string, 128);
		$l += $r = (length($us) / 2);
		print $stdout "pad length: $r\n" if ($showwork);
		($r++, $us .= "80") if ($r < 64 && !$p++);
		my @W = unpack('N16', pack("H*", $us) . "\000" x 7);
		$W[15] = $l * 8 if ($r < 57);
		foreach $i (16 .. 79) {
		    push(@W,
		&$L($W[$i - 3] ^ $W[$i - 8] ^ $W[$i - 14] ^ $W[$i - 16], 1));
		}
		($a, $b, $c, $d, $e) = @A;
		foreach $i (0 .. 79) {
		   my $qq = ($i < 20) ? ($b & ($c ^ $d) ^ $d) :
				($i < 40) ? ($b ^ $c ^ $d) :
				($i < 60) ? (($b | $c) & $d | $b & $c) :
				($b ^ $c ^ $d);
		    $t = &$M($qq + $e + $W[$i] + $K[$i / 20] + &$L($a, 5));
		    $e = $d;
		    $d = $c;
		    $c = &$L($b, 30);
		    $b = $a;
		    $a = $t;
		}
		@nuA = ($a, $b, $c, $d, $e);
		print $stdout "$a $b $c $d $e\n" if ($showwork);
		$i = 0;
		@A = map({ &$M($_ + $nuA[$i++]); } @A);
	} while ($r > 56);
	my $x = sprintf('%.8x' x 5, @A);
	@A = unpack("C*", pack("H*", $x));
	return($x, @A);
}

# heavily modified from MIME::Base64
sub simple_encode_base64 {
	my $result = '';
	my $input = shift;

	pos($input) = 0;
	while($input =~ /(.{1,45})/gs) {
		$result .= substr(pack("u", $1), 1);
		chop($result);
	}
	$result =~ tr|` -_|AA-Za-z0-9+/|;
	my $padding = (3 - length($input) % 3) % 3;
	$result =~ s/.{$padding}$/("=" x $padding)/e if ($padding);

	return $result;
}

# from RFC 2104/RFC 2202

sub hmac_sha1 {
	my $message = shift;
	my @key = (@_);
	my $opad;
	my $ipad;
	my $i;
	my @j;
	
	# sha1 blocksize is 512, so key should be 64 bytes

print $stdout " KEY HASH \n" if ($showwork);
	($i, @key) = &sha1(pack("C*", @key)) while (scalar(@key) > 64);
	push(@key, 0) while(scalar(@key) < 64);
	$opad = pack("C*", map { ($_ ^ 92) } @key);
	$ipad = pack("C*", map { ($_ ^ 54) } @key);

print $stdout " MESSAGE HASH \n" if ($showwork);
	($i, @j) = &sha1($ipad . $message);
print $stdout " FINAL HASH \n" if ($showwork);
	$i = pack("C*", @j); # output hash is 160 bits
	($i, @j) = &sha1($opad . $i);
	$i = &simple_encode_base64(pack("C20", @j));

	return $i;
}

# simple encoder for OAuth modified URL encoding (used for lots of things,
# actually)
# this is NOT UTF-8 safe
sub url_oauth_sub {
	my $x = shift;
	$x =~ s/([^-0-9a-zA-Z._~])/"%".uc(unpack("H*",$1))/eg; return $x;
}

# default method of getting password: ask for it. only relevant for Basic Auth,
# which is no longer the default.
sub defaultgetpassword {
	# original idea by @jcscoobyrs, heavily modified
	my $k;
	my $l;
	my $pass;

	$l = "no termios; password WILL";
	if ($termios) {
		$termios->getattr(fileno($stdin));
		$k = $termios->getlflag;
		$termios->setlflag($k ^ &POSIX::ECHO);
		$termios->setattr(fileno($stdin));
		$l = "password WILL NOT";
	}
	print $stdout "enter password for $whoami ($l be echoed): ";
	chomp($pass = <$stdin>);
	if ($termios) {
		print $stdout "\n";
		$termios->setlflag($k);
		$termios->setattr(fileno($stdin));
	}
	return $pass;
}

# this returns an immutable token corresponding to the current authenticated
# session. in the case of Basic Auth, it is simply the user:password pair.
# it does not handle OAuth -- that is run by a separate wizard.
# the function then returns (token,secret) which for Basic Auth is token,undef.
# most of the time we will be using tokens in a keyfile, however, so this
# function runs in that case as a stub.
sub authtoken {
	my @foo;
	my $pass;
	my $sig;
	my $return;
	my $tries = ($hold > 3) ? $hold : 3;
		# give up on token if we don't get one

	return (undef,undef) if ($anonymous);
	
	# OAuth 2.0 mode - return access token (no token secret needed)
	if ($authtype eq 'oauth2') {
		return ($tokenkey, undef) if (length($tokenkey));
		die("OAuth 2.0 access token required. Run with -oauthwizard to set up.\n");
	}
	
	# OAuth 1.0a mode - return both tokens
	return ($tokenkey,$tokensecret)
		if (length($tokenkey) && length($tokensecret));
		
	# Basic auth mode - return username/password
	@foo = split(/:/, $user, 2);
	$whoami = $foo[0];
	die("choose -user=username[:password], or -anonymous.\n")
		if (!length($whoami) || $whoami eq '1');
	$pass = length($foo[1]) ? $foo[1] : &$getpassword;
	die("a password must be specified.\n") if (!length($pass));
	return ($whoami, $pass);
}

# OAuth 2.0 wizard for Mastodon/fediverse
sub oauth2_wizard {
	# Step 0: Ask user for their fediverse instance
	print $stdout "\n" . "="x70 . "\n";
	print $stdout "FEDIVERSE INSTANCE SELECTION\n";
	print $stdout "="x70 . "\n";
	print $stdout "TTYverse can connect to any Mastodon-compatible fediverse server.\n";
	print $stdout "Popular instances include:\n\n";
	print $stdout "  • mastodon.social (flagship instance)\n";
	print $stdout "  • fosstodon.org (FOSS community)\n";
	print $stdout "  • hachyderm.io (tech community)\n";
	print $stdout "  • mas.to (general community)\n";
	print $stdout "  • mstdn.social (another general instance)\n\n";
	print $stdout "Enter the domain name of your fediverse instance\n";
	print $stdout "(without https://, just the domain like 'mastodon.social')\n\n";
	
	my $user_instance;
	while (1) {
		print $stdout "Instance domain: ";
		chomp($user_instance = <STDIN>);
		
		if (!length($user_instance)) {
			print $stdout "ERROR: Please enter an instance domain.\n\n";
			next;
		}
		
		# Clean up the input - remove protocol, trailing slashes, etc.
		$user_instance =~ s/^https?:\/\///;
		$user_instance =~ s/\/$//;
		$user_instance =~ s/^\s+|\s+$//g; # trim whitespace
		
		if ($user_instance !~ /^[a-zA-Z0-9.-]+\.[a-zA-Z]{2,}$/) {
			print $stdout "ERROR: '$user_instance' doesn't look like a valid domain.\n";
			print $stdout "Please enter just the domain (like 'mastodon.social')\n\n";
			next;
		}
		
		last;
	}
	
	# Update the global configuration to use user's instance
	$fediverseserver = $user_instance;
	&configure_fediverse_endpoints($fediverseserver);
	
	print $stdout "\nRegistering TTYverse with $fediverseserver ...\n";
	
	# Step 1: Register the application with Mastodon
	my $app_data = "client_name=TTYverse&redirect_uris=urn%3Aietf%3Awg%3Aoauth%3A2.0%3Aoob&scopes=read write follow push";
	my $app_response = &postjson($oauthurl, $app_data);
	
	unless ($app_response) {
		print $stdout "FAILED! Could not register application with server.\n";
		exit;
	}
	
	# Extract client credentials from response
	my $client_id = $app_response->{'client_id'};
	my $client_secret = $app_response->{'client_secret'};
	
	unless ($client_id && $client_secret) {
		print $stdout "FAILED! Server did not return valid client credentials.\n";
		print $stdout "Response debugging available in verbose mode\n" if ($verbose);
		exit;
	}
	
	print $stdout "SUCCESS! Application registered.\n";
	print $stdout "Client ID: $client_id\n" if ($verbose);
	
	# Step 2: Get authorization from user
	my $auth_url = "${oauthauthurl}?client_id=${client_id}&scope=read+write+follow+push&response_type=code&redirect_uri=urn%3Aietf%3Awg%3Aoauth%3A2.0%3Aoob";
	
	print $stdout "\n1. Visit this URL in your browser:\n\n";
	print $stdout "$auth_url\n\n";
	print $stdout "2. Sign in to your $fediverseserver account if prompted.\n\n";
	print $stdout "3. Authorize TTYverse to access your account.\n\n";
	print $stdout "4. Copy the authorization code shown and paste it below.\n\n";
	
	print $stdout "Enter authorization code: ";
	chomp(my $auth_code = <STDIN>);
	
	unless (length($auth_code)) {
		print $stdout "ERROR: No authorization code provided.\n";
		exit;
	}
	
	# Step 3: Exchange authorization code for access token
	print $stdout "\nExchanging authorization code for access token...\n";
	my $token_data = "client_id=${client_id}&client_secret=${client_secret}&redirect_uri=urn%3Aietf%3Awg%3Aoauth%3A2.0%3Aoob&grant_type=authorization_code&code=${auth_code}&scope=read write follow push";
	my $token_response = &postjson($oauthaccurl, $token_data);
	
	unless ($token_response) {
		print $stdout "FAILED! Could not exchange authorization code for token.\n";
		exit;
	}
	
	my $access_token = $token_response->{'access_token'};
	
	unless ($access_token) {
		print $stdout "FAILED! Server did not return a valid access token.\n";
		print $stdout "Response debugging available in verbose mode\n" if ($verbose);
		exit;
	}
	
	print $stdout "SUCCESS! Access token obtained.\n";
	
	# Step 4: Save credentials to keyfile
	my $keyfile_content = "client_id=${client_id}&client_secret=${client_secret}&access_token=${access_token}&server=${fediverseserver}";
	
	# Ensure the keyfile directory exists
	my $keyfile_dir = $keyfile;
	$keyfile_dir =~ s|[^/]*$||;  # Remove filename, keep directory path
	if ($keyfile_dir && !-d $keyfile_dir) {
		eval { make_path($keyfile_dir) };
		if ($@) {
			die("Failed to create keyfile directory $keyfile_dir: $@\n");
		}
	}
	
	open(W, ">$keyfile") || die("couldn't write keyfile $keyfile: $!\n");
	chmod 0600, $keyfile;
	print W $keyfile_content;
	close(W);
	
	print $stdout "\nKeyfile $keyfile written successfully!\n";
	print $stdout "You can now use TTYverse with your $fediverseserver account.\n";
	
	exit;
}

# this is a sucky nonce generator. I was looking for an awesome nonce
# generator, and then I realized it would only be used once, so who cares?
# *rimshot*
sub generate_nonce { unpack("H9000", pack("u", rand($$).$$.time())); }

# this signs a request with the token and token secret. the result is undef if
# Basic Auth. payload should already be URL encoded and *sorted*.
# this is typically called by stringify_args to get authentication information.
sub signrequest {
	my $resource = shift;
	my $payload = shift;

	# OAuth 2.0 Bearer token support (fediverse standard)
	return undef if (!length($tokenkey));
	return "-H \"Authorization: Bearer $tokenkey\"";
}

# Load locally tracked DM seen status from persistent storage
sub load_dm_seen_status {
	my $seen_file = "$config/dm_seen_status";
	return unless (-r $seen_file);
	
	if (open(SEEN, '<', $seen_file)) {
		print $stdout "-- DEBUG: Loading DM seen status from $seen_file\n" if ($verbose);
		my $count = 0;
		while (my $line = <SEEN>) {
			chomp($line);
			next unless ($line =~ /^(.+):(\d+)$/);
			my ($tracking_key, $timestamp) = ($1, $2);
			
			# Skip entries older than 30 days to prevent infinite growth
			if (time() - $timestamp < 30 * 24 * 3600) {
				$dm_seen_status{$tracking_key} = $timestamp;
				$count++;
			}
		}
		close(SEEN);
		print $stdout "-- DEBUG: Loaded $count DM seen entries\n" if ($verbose);
	}
}

# Save locally tracked DM seen status to persistent storage
sub save_dm_seen_status {
	my $seen_file = "$config/dm_seen_status";
	
	# Ensure config directory exists
	unless (-d $config) {
		mkdir($config, 0700) || do {
			print $stdout "-- DEBUG: Could not create config directory $config: $!\n" if ($verbose);
			return;
		};
	}
	
	if (open(SEEN, '>', $seen_file)) {
		print $stdout "-- DEBUG: Saving DM seen status to $seen_file\n" if ($superverbose);
		my $count = 0;
		for my $key (keys %dm_seen_status) {
			my $timestamp = $dm_seen_status{$key};
			# Only save entries from last 30 days
			if (time() - $timestamp < 30 * 24 * 3600) {
				print SEEN "$key:$timestamp\n";
				$count++;
			}
		}
		close(SEEN);
		chmod(0600, $seen_file);  # Keep private
		print $stdout "-- DEBUG: Saved $count DM seen entries\n" if ($superverbose);
	} else {
		print $stdout "-- DEBUG: Could not save DM seen status to $seen_file: $!\n" if ($verbose);
	}
}

}