# Announces new Trump posts via trumpstruth.org RSS
# Feed: https://www.trumpstruth.org/feed
# Detects ridiculous Trump-isms using pattern matching

catch {setudef flag enabletruth}
catch {setudef flag enableTruth}

namespace eval ::trumptruthrss {
  variable cfg
  array set cfg {
    feed_url          "https://www.trumpstruth.org/feed"
    poll_seconds      3600
    curl              "/usr/bin/curl"
    curl_timeout      15
    user_agent        "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/143.0.0.0 Safari/537.36"
    state_file        "trumptruthrss.state"
    max_chars         420
    strip_non_ascii   1
    exclude_retruths  1
    max_new_announce  5
    debug             0
    min_findings      1
  }

  variable last_guid ""
  variable in_progress 0
  variable timer_id ""
}

if {[info commands lreverse] eq ""} {
  proc lreverse {lst} {
    set out {}
    foreach x $lst { set out [linsert $out 0 $x] }
    return $out
  }
}

proc ::trumptruthrss::dlog {msg} {
  variable cfg
  if {$cfg(debug)} { putlog "trumptruthrss: $msg" }
}

proc ::trumptruthrss::chan_enabled {chan} {
  if {![catch {set v [channel get $chan enabletruth]}]} { return $v }
  if {![catch {set v [channel get $chan enableTruth]}]} { return $v }
  putlog "trumptruthrss: channel flag enabletruth/enableTruth not defined"
  return 0
}

proc ::trumptruthrss::enabled_channels {} {
  set out {}
  foreach c [channels] {
    if {[::trumptruthrss::chan_enabled $c]} { lappend out $c }
  }
  return $out
}

proc ::trumptruthrss::load_state {} {
  variable cfg; variable last_guid
  if {![file exists $cfg(state_file)]} { set last_guid ""; return }
  catch {
    set f [open $cfg(state_file) r]
    set last_guid [string trim [read $f]]
    close $f
  }
}

proc ::trumptruthrss::save_state {} {
  variable cfg; variable last_guid
  catch {
    set f [open $cfg(state_file) w]
    puts $f $last_guid
    close $f
  }
}

proc ::trumptruthrss::is_retruth {item} {
  set raw [string tolower [dict get $item text]]
  if {[string first "retruth" $raw] >= 0} { return 1 }
  set clean [string tolower [::trumptruthrss::strip_html [dict get $item text]]]
  if {[string first "rt @" $clean] == 0} { return 1 }
  return 0
}

proc ::trumptruthrss::curl_fetch {url} {
  variable cfg
  set cmd [list $cfg(curl) -s -L --compressed -m $cfg(curl_timeout) \
    -H "Accept: application/rss+xml, application/xml;q=0.9, */*;q=0.8" \
    -H "User-Agent: $cfg(user_agent)" \
    -w "\n__CURLMETA__:%{http_code}:%{content_type}\n" \
    $url]
  dlog "Fetching: $url"
  if {[catch {set out [eval exec $cmd]} err]} {
    putlog "trumptruthrss: curl failed: $err"
    return [list 0 "" ""]
  }
  set code 0; set ctype ""
  if {[regexp {__CURLMETA__:(\d+):([^\r\n]+)} $out -> code ctype]} {
    regsub {(\r?\n)?__CURLMETA__:[0-9]+:[^\r\n]+(\r?\n)?$} $out "" body
  } else { set body $out }
  dlog "HTTP $code (ctype=$ctype) bytes=[string length $body]"
  return [list $code $ctype $body]
}

proc ::trumptruthrss::html_decode {s} {
  set s [string map {
    "&amp;" "&" "&lt;" "<" "&gt;" ">"
    "&quot;" "\"" "&#34;" "\"" "&#39;" "'"
    "&apos;" "'" "&nbsp;" " "
  } $s]
  return $s
}

proc ::trumptruthrss::strip_html {html} {
  set s $html
  regsub -all -nocase {<br\s*/?>} $s "\n" s
  regsub -all -nocase {</p>\s*<p>} $s "\n" s
  regsub -all {<[^>]+>} $s "" s
  set s [::trumptruthrss::html_decode $s]
  regsub -all {[[:space:]]+} $s " " s
  return [string trim $s]
}

proc ::trumptruthrss::rss_gettag {block tag} {
  set open "<$tag"; set close "</$tag>"
  set i [string first $open $block]; if {$i < 0} { return "" }
  set gt [string first ">" $block $i]; if {$gt < 0} { return "" }
  set j [string first $close $block $gt]; if {$j < 0} { return "" }
  set val [string trim [string range $block [expr {$gt+1}] [expr {$j-1}]]]
  if {[string first {<![CDATA[} $val] == 0} {
    set end [string last {]]>} $val]
    if {$end > 9} { set val [string trim [string range $val 9 [expr {$end-1}]]] }
  }
  return $val
}

proc ::trumptruthrss::parse_feed {xml} {
  set head [string tolower [string range $xml 0 200]]
  if {[string first "<!doctype" $head] >= 0 || [string first "<html" $head] >= 0} {
    putlog "trumptruthrss: Got HTML instead of RSS/XML."; return {}
  }
  if {[string first "<?xml" $head] < 0 && [string first "<rss" $head] < 0 && \
      [string first "<feed" $head] < 0} {
    putlog "trumptruthrss: Response doesn't look like RSS/XML."; return {}
  }
  set items {}; set pos 0
  while {1} {
    set s [string first "<item" $xml $pos]; if {$s < 0} break
    set e [string first "</item>" $xml $s]; if {$e < 0} break
    lappend items [string range $xml $s [expr {$e+6}]]
    set pos [expr {$e+7}]
  }
  if {[llength $items] == 0} { putlog "trumptruthrss: No <item> elements found."; return {} }
  set out {}
  foreach it $items {
    set guid [rss_gettag $it "guid"]; set link [rss_gettag $it "link"]
    set title [rss_gettag $it "title"]; set desc [rss_gettag $it "description"]
    set enc [rss_gettag $it "content:encoded"]; set pub [rss_gettag $it "pubDate"]
    set text [expr {$enc ne "" ? $enc : ($desc ne "" ? $desc : $title)}]
    if {$guid eq ""} { set guid [expr {$link ne "" ? $link : $title}] }
    lappend out [dict create guid $guid link $link text $text pubDate $pub]
  }
  return $out
}

# -----------------------------------------------------------------------
# THE RIDICULOUS-O-METER
# Each detector returns a short snarky string, or "" if not triggered.
# -----------------------------------------------------------------------

proc ::trumptruthrss::detect_caps {text} {
  # Count ALL-CAPS words (3+ letters, not abbreviations like USA/FBI we expect)
  set words [regexp -all -inline {[A-Z]{3,}} $text]
  # Filter out the common expected ones
  set noise {USA FBI CIA DOJ GOP DNC NBC ABC CBS CNN FOX GOP NATO GOP URL RSS}
  set shouted {}
  foreach w $words {
    if {[lsearch -exact $noise $w] < 0} { lappend shouted $w }
  }
  set n [llength $shouted]
  if {$n >= 4} { return "$n words needlessly screamed in caps" }
  if {$n >= 2} { return "randomly screaming: [join [lrange $shouted 0 2] {, }]" }
  return ""
}

proc ::trumptruthrss::detect_exclamations {text} {
  set n [regexp -all {!} $text]
  if {$n >= 5} { return "$n exclamation marks (calm down!!!)" }
  if {$n >= 3} { return "$n exclamation marks used" }
  return ""
}

proc ::trumptruthrss::detect_self_obsession {text} {
  set lower [string tolower $text]
  # Count standalone first-person words using word boundaries
  set count [regexp -all {\m(i|me|my|myself|mine)\M} $lower]
  if {$count >= 8} { return "refers to himself $count times in one post" }
  if {$count >= 5} { return "$count first-person references (it's always about him)" }
  return ""
}

proc ::trumptruthrss::detect_superlatives {text} {
  set lower [string tolower $text]
  set found {}
  foreach pattern {
    {the greatest}  {the best ever}  {the worst ever}  {the biggest}
    {the most beautiful}  {the most powerful}  {nobody has ever}
    {the most successful}  {better than anyone}  {like nobody has seen}
    {the best in history}  {the greatest ever}  {the most incredible}
    {the most popular}  {number one}  {like never before}
  } {
    if {[string first $pattern $lower] >= 0} { lappend found $pattern }
  }
  if {[llength $found] >= 2} { return "stacked [llength $found] superlatives in one post" }
  if {[llength $found] == 1} { return "claims to be [lindex $found 0]" }
  return ""
}

proc ::trumptruthrss::detect_conspiracy_words {text} {
  set lower [string tolower $text]
  set hits {}
  foreach phrase {
    {witch hunt}        {fake news}         {rigged}
    {hoax}              {deep state}        {enemy of the people}
    {corrupt}           {disgrace}          {it was stolen}
    {radical left}      {they are destroying} {no other president}
    {russia russia russia}  {pedo}          {human scum}
    {very unfair}       {many people are saying}  {everybody knows}
    {total disaster}    {completely made up} {mainstream media}
    {lamestream}        {do nothing}        {should be ashamed}
  } {
    if {[string first $phrase $lower] >= 0} { lappend hits $phrase }
  }
  if {[llength $hits] >= 3} { return "packed with [llength $hits] grievance buzzwords" }
  if {[llength $hits] == 2} { return "invokes: [join $hits { and }]" }
  if {[llength $hits] == 1} { return "playing the '[lindex $hits 0]' card again" }
  return ""
}

proc ::trumptruthrss::detect_nicknames {text} {
  set lower [string tolower $text]
  set names {}
  foreach n {
    {crooked}   {sleepy}   {crazy}    {radical}   {wacky}
    {failing}   {nasty}    {slippery} {liddle}    {pencil neck}
    {low iq}    {dumb}     {dummy}    {clown}     {loser}
    {weak}      {corrupt}  {cryin}    {mini mike} {pocahontas}
    {lyin}      {shifty}   {slimeball}
  } {
    if {[string first $n $lower] >= 0} { lappend names $n }
  }
  if {[llength $names] >= 2} { return "name-calls [llength $names] people/things" }
  if {[llength $names] == 1} { return "uses nickname: '[lindex $names 0]'" }
  return ""
}

proc ::trumptruthrss::detect_believe_me {text} {
  set lower [string tolower $text]
  set phrases {}
  foreach p {
    {believe me}      {trust me}        {everybody knows}
    {many people are saying} {people are saying} {a lot of people think}
    {everyone agrees} {nobody knows more} {i know more about}
    {i alone can}     {only i can}      {nobody could have}
  } {
    if {[string first $p $lower] >= 0} { lappend phrases $p }
  }
  if {[llength $phrases] >= 2} { return "asks you to just trust him [llength $phrases] times" }
  if {[llength $phrases] == 1} { return "\"[lindex $phrases 0]\" (citation needed)" }
  return ""
}

proc ::trumptruthrss::detect_random_caps_nouns {text} {
  # Look for Title Case words mid-sentence that aren't after a period/! or a known proper noun
  # Simple heuristic: capitalised word NOT at start of sentence and not all-caps
  set words [regexp -all -inline {\s[A-Z][a-z]{2,}} $text]
  set noise {Trump Donald America American United States January Congress President Senate House}
  set odd {}
  foreach w $words {
    set w [string trim $w]
    if {[lsearch -exact $noise $w] < 0} { lappend odd $w }
  }
  # Deduplicate
  set odd [lsort -unique $odd]
  set n [llength $odd]
  if {$n >= 5} { return "randomly capitalises $n nouns like a German textbook" }
  if {$n >= 3} { return "mystery caps: [join [lrange $odd 0 2] {, }]..." }
  return ""
}

proc ::trumptruthrss::detect_numbers {text} {
  set lower [string tolower $text]
  set hits {}
  # Suspiciously round or large numbers
  foreach pattern {
    {\d+ million people}  {\d+ billion}  {100 percent}
    {100%}                {millions and millions}  {\d{2,} points}
    {number one in history}  {record setting}  {all time record}
    {best numbers ever}   {highest ever}  {lowest ever}
  } {
    if {[regexp $pattern $lower]} { lappend hits $pattern }
  }
  if {[llength $hits] >= 2} { return "throws out [llength $hits] suspiciously round statistics" }
  if {[llength $hits] == 1} { return "cites a very specific but unverifiable statistic" }
  return ""
}

proc ::trumptruthrss::detect_threats {text} {
  set lower [string tolower $text]
  set found {}
  foreach p {
    {will be prosecuted}  {should be in jail}  {lock}
    {will pay a big price} {i will}   {very unfair}
    {will be held accountable} {consequences}  {price to pay}
    {come after}  {never forget}  {be careful}
  } {
    if {[string first $p $lower] >= 0} { lappend found $p }
  }
  if {[llength $found] >= 2} { return "vaguely threatens people [llength $found] times" }
  if {[llength $found] == 1} { return "issues ominous warning: '[lindex $found 0]'" }
  return ""
}

# -----------------------------------------------------------------------
# Run all detectors, return list of findings (max 3 most interesting)
# -----------------------------------------------------------------------
proc ::trumptruthrss::analyse {text} {
  set findings {}
  foreach detector {
    detect_conspiracy_words
    detect_caps
    detect_self_obsession
    detect_nicknames
    detect_superlatives
    detect_believe_me
    detect_exclamations
    detect_random_caps_nouns
    detect_numbers
    detect_threats
  } {
    set result [::trumptruthrss::$detector $text]
    if {$result ne ""} { lappend findings $result }
    if {[llength $findings] >= 3} { break }
  }
  return $findings
}

# -----------------------------------------------------------------------
# Convert an RFC 822 pubDate to Europe/London time (GMT or BST as appropriate).
# Falls back to the original string if Tcl can't parse it.
# -----------------------------------------------------------------------
proc ::trumptruthrss::is_bst {epoch} {
  # Returns 1 if the UTC epoch falls inside British Summer Time.
  # BST runs from the last Sunday of March 01:00 UTC
  #         to the last Sunday of October 01:00 UTC.
  set year [clock format $epoch -format "%Y" -gmt 1]
  # Last Sunday of March at 01:00 UTC
  set mar31 [clock scan "$year-03-31 01:00:00" -format "%Y-%m-%d %H:%M:%S" -gmt 1]
  set dow   [clock format $mar31 -format "%w" -gmt 1]
  set bst_start [expr {$mar31 - $dow * 86400}]
  # Last Sunday of October at 01:00 UTC
  set oct31 [clock scan "$year-10-31 01:00:00" -format "%Y-%m-%d %H:%M:%S" -gmt 1]
  set dow   [clock format $oct31 -format "%w" -gmt 1]
  set bst_end [expr {$oct31 - $dow * 86400}]
  return [expr {$epoch >= $bst_start && $epoch < $bst_end}]
}

proc ::trumptruthrss::localise_date {pub} {
  if {$pub eq ""} { return "" }
  if {[catch {
    # Strip the trailing timezone offset (+0000 etc.) and parse as UTC.
    # Uses -gmt 1 instead of -timezone for compatibility with older Tcl builds.
    regsub {\s+[+-]\d{4}\s*$} $pub "" dateonly
    set epoch [clock scan $dateonly -gmt 1]
    if {[::trumptruthrss::is_bst $epoch]} {
      set local [clock format [expr {$epoch + 3600}] -format "%a %d %b %Y %H:%M BST" -gmt 1]
    } else {
      set local [clock format $epoch -format "%a %d %b %Y %H:%M GMT" -gmt 1]
    }
  } err]} {
    putlog "trumptruthrss: localise_date failed for '$pub': $err"
    return $pub
  }
  return $local
}

# -----------------------------------------------------------------------
# Random eye-catching prefix for ridiculous posts
# -----------------------------------------------------------------------
proc ::trumptruthrss::random_prefix {} {
  set prefixes {
    "Praise Allah!"
    "Allahu Akbar!"
    "Bismillah!"
    "As the Quran foretold:"
    "From the Mar-a-Lago mosque:"
    "BREAKING: The orange one has spoken:"
    "ALERT: Tiny hands on keyboard:"
    "Oh no, he's at his phone again:"
    "Covfefe alert:"
    "Stand by for tremendous words:"
    "The stable genius writes:"
    "Fox News is on in the background:"
    "3am Truth Social dispatch:"
    "The golf cart has stopped:"
    "Mar-a-Lago WiFi password: MAGA2024:"
    "Someone take his phone:"
    "The hamberder has been digested:"
    "His lawyer is crying somewhere:"
    "Historians will study this:"
    "Hold onto your toupee:"
    "The greatest post in history:"
    "Unprompted and unhinged:"
    "Nobody asked but here it is:"
    "The world waits with bated breath:"
    "Science cannot explain this:"
  }
  return [lindex $prefixes [expr {int(rand() * [llength $prefixes])}]]
}

# -----------------------------------------------------------------------
# Format item. Returns "" if not ridiculous enough (skip it).
# force=1 bypasses the threshold (used by !truth command).
# -----------------------------------------------------------------------
proc ::trumptruthrss::format_item {item {force 0}} {
  variable cfg

  set text [::trumptruthrss::strip_html [dict get $item text]]
  regsub -all {[[:space:]]+} $text " " text
  set text [string trim $text]
  if {$cfg(strip_non_ascii)} { regsub -all {[^\x00-\x7F]} $text "" text }

  set pub  [::trumptruthrss::localise_date [dict get $item pubDate]]
  set link [dict get $item link]

  # Skip posts with no readable text or that are just a URL
  if {!$force} {
    if {$text eq ""} { return "" }
    # Strip all URLs out and see if anything real is left
    set textonly $text
    regsub -all {https?://[^[:space:]]+} $textonly "" textonly
    set textonly [string trim $textonly]
    if {$textonly eq ""} { return "" }
  }

  set findings [::trumptruthrss::analyse $text]
  dlog "Findings for post: $findings"

  if {!$force && [llength $findings] < $cfg(min_findings)} {
    dlog "Skipping post - only [llength $findings] findings"
    return ""
  }

  # Build suffix: findings | date | link
  set suffix ""
  if {[llength $findings] > 0} {
    append suffix " \["
    set n 1
    foreach f $findings {
      if {$n > 1} { append suffix " |" }
      append suffix " ($n) $f"
      incr n
    }
    append suffix " \]"
  }
  if {$pub  ne ""} { append suffix " | $pub" }
  if {$link ne ""} { append suffix " | $link" }

  # Keep the post snippet short and punchy (120 chars)
  set snippet_limit 120
  if {[string length $text] > $snippet_limit} {
    set text "[string range $text 0 [expr {$snippet_limit - 4}]]..."
  }

  set prefix "[::trumptruthrss::random_prefix] "
  # Final safety trim to IRC limit
  set available [expr {440 - [string length $prefix] - [string length $suffix]}]
  if {[string length $text] > $available} {
    set text "[string range $text 0 [expr {$available - 4}]]..."
  }

  return "${prefix}$text$suffix"
}

proc ::trumptruthrss::announce_items {items} {
  set chans [::trumptruthrss::enabled_channels]
  if {[llength $chans] == 0} { return }
  foreach it $items {
    set msg [::trumptruthrss::format_item $it]
    if {$msg eq ""} { continue }
    foreach c $chans { putserv "PRIVMSG $c :$msg" }
  }
}

proc ::trumptruthrss::schedule {} {
  variable cfg; variable timer_id
  if {$timer_id ne ""} { catch {killutimer $timer_id} }
  set timer_id [utimer $cfg(poll_seconds) ::trumptruthrss::poll]
}

proc ::trumptruthrss::poll {} {
  variable cfg; variable last_guid; variable in_progress
  ::trumptruthrss::schedule
  if {$in_progress} { return }
  set in_progress 1

  if {[llength [::trumptruthrss::enabled_channels]] == 0} { set in_progress 0; return }

  lassign [::trumptruthrss::curl_fetch $cfg(feed_url)] code ctype body
  if {$code != 200 || $body eq ""} {
    putlog "trumptruthrss: fetch failed (HTTP=$code)"
    set in_progress 0; return
  }

  set items [::trumptruthrss::parse_feed $body]
  if {[info exists cfg(exclude_retruths)] && $cfg(exclude_retruths)} {
    set filtered {}
    foreach it $items { if {![::trumptruthrss::is_retruth $it]} { lappend filtered $it } }
    set items $filtered
  }
  if {[llength $items] == 0} { set in_progress 0; return }

  if {$last_guid eq ""} {
    set last_guid [dict get [lindex $items 0] guid]
    ::trumptruthrss::save_state
    set in_progress 0; return
  }

  set new {}
  foreach it $items {
    if {[dict get $it guid] eq $last_guid} break
    lappend new $it
  }
  if {[llength $new] == 0} { set in_progress 0; return }
  if {[llength $new] > $cfg(max_new_announce)} {
    set new [lrange $new 0 [expr {$cfg(max_new_announce)-1}]]
  }

  ::trumptruthrss::announce_items [lreverse $new]

  set last_guid [dict get [lindex $items 0] guid]
  ::trumptruthrss::save_state
  set in_progress 0
}

proc ::trumptruthrss::cmd_latest {nick host hand chan text} {
  if {![::trumptruthrss::chan_enabled $chan]} { return }
  lassign [::trumptruthrss::curl_fetch $::trumptruthrss::cfg(feed_url)] code ctype body
  if {$code != 200 || $body eq ""} {
    putserv "PRIVMSG $chan :Orange Truth: (error) couldn't fetch feed (HTTP=$code)."
    return
  }
  set items [::trumptruthrss::parse_feed $body]
  if {[llength $items] == 0} {
    putserv "PRIVMSG $chan :Orange Truth: (error) couldn't parse feed."
    return
  }
  set msg [::trumptruthrss::format_item [lindex $items 0] 1]
  if {$msg eq ""} { set msg "Orange Truth: surprisingly restrained post, nothing to report." }
  putserv "PRIVMSG $chan :$msg"
}

proc ::trumptruthrss::cmd_sync {nick host hand chan text} {
  variable last_guid
  if {![::trumptruthrss::chan_enabled $chan]} { return }
  lassign [::trumptruthrss::curl_fetch $::trumptruthrss::cfg(feed_url)] code ctype body
  if {$code != 200 || $body eq ""} {
    putserv "PRIVMSG $chan :Orange Truth: (error) couldn't sync (HTTP=$code)."
    return
  }
  set items [::trumptruthrss::parse_feed $body]
  if {[llength $items] == 0} {
    putserv "PRIVMSG $chan :Orange Truth: (error) couldn't parse feed."
    return
  }
  set new {}
  if {$last_guid ne ""} {
    foreach it $items {
      if {[dict get $it guid] eq $last_guid} break
      lappend new $it
    }
  } else { set new $items }

  # Update state pointer without announcing anything
  set last_guid [dict get [lindex $items 0] guid]
  ::trumptruthrss::save_state

  set n [llength $new]
  if {$n == 0} {
    putserv "PRIVMSG $chan :Orange Truth: already up to date."
  } else {
    putserv "PRIVMSG $chan :Orange Truth: synced, skipped $n post[expr {$n == 1 ? {} : {s}}]. Use !truth to see the latest."
  }
}

catch {unbind pub - "!truth"     ::trumptruthrss::cmd_latest}
catch {unbind pub - "!truthsync" ::trumptruthrss::cmd_sync}
bind pub - "!truth"     ::trumptruthrss::cmd_latest
bind pub - "!truthsync" ::trumptruthrss::cmd_sync

::trumptruthrss::load_state
::trumptruthrss::schedule
putlog "truthtrump.tcl loaded - Enable with: .chanset #chan +enabletruth"