Trumpstruths.tcl

Text Detected Guest 3 Views Size: 21.48 KB Posted on: Aug 24, 26 @ 11:49 PM
  1. # Announces new Trump posts via trumpstruth.org RSS
  2. # Feed: https://www.trumpstruth.org/feed
  3. # Detects ridiculous Trump-isms using pattern matching
  4.  
  5. catch {setudef flag enabletruth}
  6. catch {setudef flag enableTruth}
  7.  
  8. namespace eval ::trumptruthrss {
  9.   variable cfg
  10.   array set cfg {
  11.     feed_url          "https://www.trumpstruth.org/feed"
  12.     poll_seconds      3600
  13.     curl              "/usr/bin/curl"
  14.     curl_timeout      15
  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"
  16.     state_file        "trumptruthrss.state"
  17.     max_chars         420
  18.     strip_non_ascii   1
  19.     exclude_retruths  1
  20.     max_new_announce  5
  21.     debug             0
  22.     min_findings      1
  23.   }
  24.  
  25.   variable last_guid ""
  26.   variable in_progress 0
  27.   variable timer_id ""
  28. }
  29.  
  30. if {[info commands lreverse] eq ""} {
  31.   proc lreverse {lst} {
  32.     set out {}
  33.     foreach x $lst { set out [linsert $out 0 $x] }
  34.     return $out
  35.   }
  36. }
  37.  
  38. proc ::trumptruthrss::dlog {msg} {
  39.   variable cfg
  40.   if {$cfg(debug)} { putlog "trumptruthrss: $msg" }
  41. }
  42.  
  43. proc ::trumptruthrss::chan_enabled {chan} {
  44.   if {![catch {set v [channel get $chan enabletruth]}]} { return $v }
  45.   if {![catch {set v [channel get $chan enableTruth]}]} { return $v }
  46.   putlog "trumptruthrss: channel flag enabletruth/enableTruth not defined"
  47.   return 0
  48. }
  49.  
  50. proc ::trumptruthrss::enabled_channels {} {
  51.   set out {}
  52.   foreach c [channels] {
  53.     if {[::trumptruthrss::chan_enabled $c]} { lappend out $c }
  54.   }
  55.   return $out
  56. }
  57.  
  58. proc ::trumptruthrss::load_state {} {
  59.   variable cfg; variable last_guid
  60.   if {![file exists $cfg(state_file)]} { set last_guid ""; return }
  61.   catch {
  62.     set f [open $cfg(state_file) r]
  63.     set last_guid [string trim [read $f]]
  64.     close $f
  65.   }
  66. }
  67.  
  68. proc ::trumptruthrss::save_state {} {
  69.   variable cfg; variable last_guid
  70.   catch {
  71.     set f [open $cfg(state_file) w]
  72.     puts $f $last_guid
  73.     close $f
  74.   }
  75. }
  76.  
  77. proc ::trumptruthrss::is_retruth {item} {
  78.   set raw [string tolower [dict get $item text]]
  79.   if {[string first "retruth" $raw] >= 0} { return 1 }
  80.   set clean [string tolower [::trumptruthrss::strip_html [dict get $item text]]]
  81.   if {[string first "rt @" $clean] == 0} { return 1 }
  82.   return 0
  83. }
  84.  
  85. proc ::trumptruthrss::curl_fetch {url} {
  86.   variable cfg
  87.   set cmd [list $cfg(curl) -s -L --compressed -m $cfg(curl_timeout) \
  88.     -H "Accept: application/rss+xml, application/xml;q=0.9, */*;q=0.8" \
  89.     -H "User-Agent: $cfg(user_agent)" \
  90.     -w "\n__CURLMETA__:%{http_code}:%{content_type}\n" \
  91.     $url]
  92.   dlog "Fetching: $url"
  93.   if {[catch {set out [eval exec $cmd]} err]} {
  94.     putlog "trumptruthrss: curl failed: $err"
  95.     return [list 0 "" ""]
  96.   }
  97.   set code 0; set ctype ""
  98.   if {[regexp {__CURLMETA__:(\d+):([^\r\n]+)} $out -> code ctype]} {
  99.     regsub {(\r?\n)?__CURLMETA__:[0-9]+:[^\r\n]+(\r?\n)?$} $out "" body
  100.   } else { set body $out }
  101.   dlog "HTTP $code (ctype=$ctype) bytes=[string length $body]"
  102.   return [list $code $ctype $body]
  103. }
  104.  
  105. proc ::trumptruthrss::html_decode {s} {
  106.   set s [string map {
  107.     "&amp;" "&" "&lt;" "<" "&gt;" ">"
  108.     "&quot;" "\"" "&#34;" "\"" "&#39;" "'"
  109.     "&apos;" "'" "&nbsp;" " "
  110.   } $s]
  111.   return $s
  112. }
  113.  
  114. proc ::trumptruthrss::strip_html {html} {
  115.   set s $html
  116.   regsub -all -nocase {<br\s*/?>} $s "\n" s
  117.   regsub -all -nocase {</p>\s*<p>} $s "\n" s
  118.   regsub -all {<[^>]+>} $s "" s
  119.   set s [::trumptruthrss::html_decode $s]
  120.   regsub -all {[[:space:]]+} $s " " s
  121.   return [string trim $s]
  122. }
  123.  
  124. proc ::trumptruthrss::rss_gettag {block tag} {
  125.   set open "<$tag"; set close "</$tag>"
  126.   set i [string first $open $block]; if {$i < 0} { return "" }
  127.   set gt [string first ">" $block $i]; if {$gt < 0} { return "" }
  128.   set j [string first $close $block $gt]; if {$j < 0} { return "" }
  129.   set val [string trim [string range $block [expr {$gt+1}] [expr {$j-1}]]]
  130.   if {[string first {<![CDATA[} $val] == 0} {
  131.     set end [string last {]]>} $val]
  132.     if {$end > 9} { set val [string trim [string range $val 9 [expr {$end-1}]]] }
  133.   }
  134.   return $val
  135. }
  136.  
  137. proc ::trumptruthrss::parse_feed {xml} {
  138.   set head [string tolower [string range $xml 0 200]]
  139.   if {[string first "<!doctype" $head] >= 0 || [string first "<html" $head] >= 0} {
  140.     putlog "trumptruthrss: Got HTML instead of RSS/XML."; return {}
  141.   }
  142.   if {[string first "<?xml" $head] < 0 && [string first "<rss" $head] < 0 && \
  143.       [string first "<feed" $head] < 0} {
  144.     putlog "trumptruthrss: Response doesn't look like RSS/XML."; return {}
  145.   }
  146.   set items {}; set pos 0
  147.   while {1} {
  148.     set s [string first "<item" $xml $pos]; if {$s < 0} break
  149.     set e [string first "</item>" $xml $s]; if {$e < 0} break
  150.     lappend items [string range $xml $s [expr {$e+6}]]
  151.     set pos [expr {$e+7}]
  152.   }
  153.   if {[llength $items] == 0} { putlog "trumptruthrss: No <item> elements found."; return {} }
  154.   set out {}
  155.   foreach it $items {
  156.     set guid [rss_gettag $it "guid"]; set link [rss_gettag $it "link"]
  157.     set title [rss_gettag $it "title"]; set desc [rss_gettag $it "description"]
  158.     set enc [rss_gettag $it "content:encoded"]; set pub [rss_gettag $it "pubDate"]
  159.     set text [expr {$enc ne "" ? $enc : ($desc ne "" ? $desc : $title)}]
  160.     if {$guid eq ""} { set guid [expr {$link ne "" ? $link : $title}] }
  161.     lappend out [dict create guid $guid link $link text $text pubDate $pub]
  162.   }
  163.   return $out
  164. }
  165.  
  166. # -----------------------------------------------------------------------
  167. # THE RIDICULOUS-O-METER
  168. # Each detector returns a short snarky string, or "" if not triggered.
  169. # -----------------------------------------------------------------------
  170.  
  171. proc ::trumptruthrss::detect_caps {text} {
  172.   # Count ALL-CAPS words (3+ letters, not abbreviations like USA/FBI we expect)
  173.   set words [regexp -all -inline {[A-Z]{3,}} $text]
  174.   # Filter out the common expected ones
  175.   set noise {USA FBI CIA DOJ GOP DNC NBC ABC CBS CNN FOX GOP NATO GOP URL RSS}
  176.   set shouted {}
  177.   foreach w $words {
  178.     if {[lsearch -exact $noise $w] < 0} { lappend shouted $w }
  179.   }
  180.   set n [llength $shouted]
  181.   if {$n >= 4} { return "$n words needlessly screamed in caps" }
  182.   if {$n >= 2} { return "randomly screaming: [join [lrange $shouted 0 2] {, }]" }
  183.   return ""
  184. }
  185.  
  186. proc ::trumptruthrss::detect_exclamations {text} {
  187.   set n [regexp -all {!} $text]
  188.   if {$n >= 5} { return "$n exclamation marks (calm down!!!)" }
  189.   if {$n >= 3} { return "$n exclamation marks used" }
  190.   return ""
  191. }
  192.  
  193. proc ::trumptruthrss::detect_self_obsession {text} {
  194.   set lower [string tolower $text]
  195.   # Count standalone first-person words using word boundaries
  196.   set count [regexp -all {\m(i|me|my|myself|mine)\M} $lower]
  197.   if {$count >= 8} { return "refers to himself $count times in one post" }
  198.   if {$count >= 5} { return "$count first-person references (it's always about him)" }
  199.   return ""
  200. }
  201.  
  202. proc ::trumptruthrss::detect_superlatives {text} {
  203.   set lower [string tolower $text]
  204.   set found {}
  205.   foreach pattern {
  206.     {the greatest}  {the best ever}  {the worst ever}  {the biggest}
  207.     {the most beautiful}  {the most powerful}  {nobody has ever}
  208.     {the most successful}  {better than anyone}  {like nobody has seen}
  209.     {the best in history}  {the greatest ever}  {the most incredible}
  210.     {the most popular}  {number one}  {like never before}
  211.   } {
  212.     if {[string first $pattern $lower] >= 0} { lappend found $pattern }
  213.   }
  214.   if {[llength $found] >= 2} { return "stacked [llength $found] superlatives in one post" }
  215.   if {[llength $found] == 1} { return "claims to be [lindex $found 0]" }
  216.   return ""
  217. }
  218.  
  219. proc ::trumptruthrss::detect_conspiracy_words {text} {
  220.   set lower [string tolower $text]
  221.   set hits {}
  222.   foreach phrase {
  223.     {witch hunt}        {fake news}         {rigged}
  224.     {hoax}              {deep state}        {enemy of the people}
  225.     {corrupt}           {disgrace}          {it was stolen}
  226.     {radical left}      {they are destroying} {no other president}
  227.     {russia russia russia}  {pedo}          {human scum}
  228.     {very unfair}       {many people are saying}  {everybody knows}
  229.     {total disaster}    {completely made up} {mainstream media}
  230.     {lamestream}        {do nothing}        {should be ashamed}
  231.   } {
  232.     if {[string first $phrase $lower] >= 0} { lappend hits $phrase }
  233.   }
  234.   if {[llength $hits] >= 3} { return "packed with [llength $hits] grievance buzzwords" }
  235.   if {[llength $hits] == 2} { return "invokes: [join $hits { and }]" }
  236.   if {[llength $hits] == 1} { return "playing the '[lindex $hits 0]' card again" }
  237.   return ""
  238. }
  239.  
  240. proc ::trumptruthrss::detect_nicknames {text} {
  241.   set lower [string tolower $text]
  242.   set names {}
  243.   foreach n {
  244.     {crooked}   {sleepy}   {crazy}    {radical}   {wacky}
  245.     {failing}   {nasty}    {slippery} {liddle}    {pencil neck}
  246.     {low iq}    {dumb}     {dummy}    {clown}     {loser}
  247.     {weak}      {corrupt}  {cryin}    {mini mike} {pocahontas}
  248.     {lyin}      {shifty}   {slimeball}
  249.   } {
  250.     if {[string first $n $lower] >= 0} { lappend names $n }
  251.   }
  252.   if {[llength $names] >= 2} { return "name-calls [llength $names] people/things" }
  253.   if {[llength $names] == 1} { return "uses nickname: '[lindex $names 0]'" }
  254.   return ""
  255. }
  256.  
  257. proc ::trumptruthrss::detect_believe_me {text} {
  258.   set lower [string tolower $text]
  259.   set phrases {}
  260.   foreach p {
  261.     {believe me}      {trust me}        {everybody knows}
  262.     {many people are saying} {people are saying} {a lot of people think}
  263.     {everyone agrees} {nobody knows more} {i know more about}
  264.     {i alone can}     {only i can}      {nobody could have}
  265.   } {
  266.     if {[string first $p $lower] >= 0} { lappend phrases $p }
  267.   }
  268.   if {[llength $phrases] >= 2} { return "asks you to just trust him [llength $phrases] times" }
  269.   if {[llength $phrases] == 1} { return "\"[lindex $phrases 0]\" (citation needed)" }
  270.   return ""
  271. }
  272.  
  273. proc ::trumptruthrss::detect_random_caps_nouns {text} {
  274.   # Look for Title Case words mid-sentence that aren't after a period/! or a known proper noun
  275.   # Simple heuristic: capitalised word NOT at start of sentence and not all-caps
  276.   set words [regexp -all -inline {\s[A-Z][a-z]{2,}} $text]
  277.   set noise {Trump Donald America American United States January Congress President Senate House}
  278.   set odd {}
  279.   foreach w $words {
  280.     set w [string trim $w]
  281.     if {[lsearch -exact $noise $w] < 0} { lappend odd $w }
  282.   }
  283.   # Deduplicate
  284.   set odd [lsort -unique $odd]
  285.   set n [llength $odd]
  286.   if {$n >= 5} { return "randomly capitalises $n nouns like a German textbook" }
  287.   if {$n >= 3} { return "mystery caps: [join [lrange $odd 0 2] {, }]..." }
  288.   return ""
  289. }
  290.  
  291. proc ::trumptruthrss::detect_numbers {text} {
  292.   set lower [string tolower $text]
  293.   set hits {}
  294.   # Suspiciously round or large numbers
  295.   foreach pattern {
  296.     {\d+ million people}  {\d+ billion}  {100 percent}
  297.     {100%}                {millions and millions}  {\d{2,} points}
  298.     {number one in history}  {record setting}  {all time record}
  299.     {best numbers ever}   {highest ever}  {lowest ever}
  300.   } {
  301.     if {[regexp $pattern $lower]} { lappend hits $pattern }
  302.   }
  303.   if {[llength $hits] >= 2} { return "throws out [llength $hits] suspiciously round statistics" }
  304.   if {[llength $hits] == 1} { return "cites a very specific but unverifiable statistic" }
  305.   return ""
  306. }
  307.  
  308. proc ::trumptruthrss::detect_threats {text} {
  309.   set lower [string tolower $text]
  310.   set found {}
  311.   foreach p {
  312.     {will be prosecuted}  {should be in jail}  {lock}
  313.     {will pay a big price} {i will}   {very unfair}
  314.     {will be held accountable} {consequences}  {price to pay}
  315.     {come after}  {never forget}  {be careful}
  316.   } {
  317.     if {[string first $p $lower] >= 0} { lappend found $p }
  318.   }
  319.   if {[llength $found] >= 2} { return "vaguely threatens people [llength $found] times" }
  320.   if {[llength $found] == 1} { return "issues ominous warning: '[lindex $found 0]'" }
  321.   return ""
  322. }
  323.  
  324. # -----------------------------------------------------------------------
  325. # Run all detectors, return list of findings (max 3 most interesting)
  326. # -----------------------------------------------------------------------
  327. proc ::trumptruthrss::analyse {text} {
  328.   set findings {}
  329.   foreach detector {
  330.     detect_conspiracy_words
  331.     detect_caps
  332.     detect_self_obsession
  333.     detect_nicknames
  334.     detect_superlatives
  335.     detect_believe_me
  336.     detect_exclamations
  337.     detect_random_caps_nouns
  338.     detect_numbers
  339.     detect_threats
  340.   } {
  341.     set result [::trumptruthrss::$detector $text]
  342.     if {$result ne ""} { lappend findings $result }
  343.     if {[llength $findings] >= 3} { break }
  344.   }
  345.   return $findings
  346. }
  347.  
  348. # -----------------------------------------------------------------------
  349. # Convert an RFC 822 pubDate to Europe/London time (GMT or BST as appropriate).
  350. # Falls back to the original string if Tcl can't parse it.
  351. # -----------------------------------------------------------------------
  352. proc ::trumptruthrss::is_bst {epoch} {
  353.   # Returns 1 if the UTC epoch falls inside British Summer Time.
  354.   # BST runs from the last Sunday of March 01:00 UTC
  355.   #         to the last Sunday of October 01:00 UTC.
  356.   set year [clock format $epoch -format "%Y" -gmt 1]
  357.   # Last Sunday of March at 01:00 UTC
  358.   set mar31 [clock scan "$year-03-31 01:00:00" -format "%Y-%m-%d %H:%M:%S" -gmt 1]
  359.   set dow   [clock format $mar31 -format "%w" -gmt 1]
  360.   set bst_start [expr {$mar31 - $dow * 86400}]
  361.   # Last Sunday of October at 01:00 UTC
  362.   set oct31 [clock scan "$year-10-31 01:00:00" -format "%Y-%m-%d %H:%M:%S" -gmt 1]
  363.   set dow   [clock format $oct31 -format "%w" -gmt 1]
  364.   set bst_end [expr {$oct31 - $dow * 86400}]
  365.   return [expr {$epoch >= $bst_start && $epoch < $bst_end}]
  366. }
  367.  
  368. proc ::trumptruthrss::localise_date {pub} {
  369.   if {$pub eq ""} { return "" }
  370.   if {[catch {
  371.     # Strip the trailing timezone offset (+0000 etc.) and parse as UTC.
  372.     # Uses -gmt 1 instead of -timezone for compatibility with older Tcl builds.
  373.     regsub {\s+[+-]\d{4}\s*$} $pub "" dateonly
  374.     set epoch [clock scan $dateonly -gmt 1]
  375.     if {[::trumptruthrss::is_bst $epoch]} {
  376.       set local [clock format [expr {$epoch + 3600}] -format "%a %d %b %Y %H:%M BST" -gmt 1]
  377.     } else {
  378.       set local [clock format $epoch -format "%a %d %b %Y %H:%M GMT" -gmt 1]
  379.     }
  380.   } err]} {
  381.     putlog "trumptruthrss: localise_date failed for '$pub': $err"
  382.     return $pub
  383.   }
  384.   return $local
  385. }
  386.  
  387. # -----------------------------------------------------------------------
  388. # Random eye-catching prefix for ridiculous posts
  389. # -----------------------------------------------------------------------
  390. proc ::trumptruthrss::random_prefix {} {
  391.   set prefixes {
  392.     "Praise Allah!"
  393.     "Allahu Akbar!"
  394.     "Bismillah!"
  395.     "As the Quran foretold:"
  396.     "From the Mar-a-Lago mosque:"
  397.     "BREAKING: The orange one has spoken:"
  398.     "ALERT: Tiny hands on keyboard:"
  399.     "Oh no, he's at his phone again:"
  400.     "Covfefe alert:"
  401.     "Stand by for tremendous words:"
  402.     "The stable genius writes:"
  403.     "Fox News is on in the background:"
  404.     "3am Truth Social dispatch:"
  405.     "The golf cart has stopped:"
  406.     "Mar-a-Lago WiFi password: MAGA2024:"
  407.     "Someone take his phone:"
  408.     "The hamberder has been digested:"
  409.     "His lawyer is crying somewhere:"
  410.     "Historians will study this:"
  411.     "Hold onto your toupee:"
  412.     "The greatest post in history:"
  413.     "Unprompted and unhinged:"
  414.     "Nobody asked but here it is:"
  415.     "The world waits with bated breath:"
  416.     "Science cannot explain this:"
  417.   }
  418.   return [lindex $prefixes [expr {int(rand() * [llength $prefixes])}]]
  419. }
  420.  
  421. # -----------------------------------------------------------------------
  422. # Format item. Returns "" if not ridiculous enough (skip it).
  423. # force=1 bypasses the threshold (used by !truth command).
  424. # -----------------------------------------------------------------------
  425. proc ::trumptruthrss::format_item {item {force 0}} {
  426.   variable cfg
  427.  
  428.   set text [::trumptruthrss::strip_html [dict get $item text]]
  429.   regsub -all {[[:space:]]+} $text " " text
  430.   set text [string trim $text]
  431.   if {$cfg(strip_non_ascii)} { regsub -all {[^\x00-\x7F]} $text "" text }
  432.  
  433.   set pub  [::trumptruthrss::localise_date [dict get $item pubDate]]
  434.   set link [dict get $item link]
  435.  
  436.   # Skip posts with no readable text or that are just a URL
  437.   if {!$force} {
  438.     if {$text eq ""} { return "" }
  439.     # Strip all URLs out and see if anything real is left
  440.     set textonly $text
  441.     regsub -all {https?://[^[:space:]]+} $textonly "" textonly
  442.     set textonly [string trim $textonly]
  443.     if {$textonly eq ""} { return "" }
  444.   }
  445.  
  446.   set findings [::trumptruthrss::analyse $text]
  447.   dlog "Findings for post: $findings"
  448.  
  449.   if {!$force && [llength $findings] < $cfg(min_findings)} {
  450.     dlog "Skipping post - only [llength $findings] findings"
  451.     return ""
  452.   }
  453.  
  454.   # Build suffix: findings | date | link
  455.   set suffix ""
  456.   if {[llength $findings] > 0} {
  457.     append suffix " \["
  458.     set n 1
  459.     foreach f $findings {
  460.       if {$n > 1} { append suffix " |" }
  461.       append suffix " ($n) $f"
  462.       incr n
  463.     }
  464.     append suffix " \]"
  465.   }
  466.   if {$pub  ne ""} { append suffix " | $pub" }
  467.   if {$link ne ""} { append suffix " | $link" }
  468.  
  469.   # Keep the post snippet short and punchy (120 chars)
  470.   set snippet_limit 120
  471.   if {[string length $text] > $snippet_limit} {
  472.     set text "[string range $text 0 [expr {$snippet_limit - 4}]]..."
  473.   }
  474.  
  475.   set prefix "[::trumptruthrss::random_prefix] "
  476.   # Final safety trim to IRC limit
  477.   set available [expr {440 - [string length $prefix] - [string length $suffix]}]
  478.   if {[string length $text] > $available} {
  479.     set text "[string range $text 0 [expr {$available - 4}]]..."
  480.   }
  481.  
  482.   return "${prefix}$text$suffix"
  483. }
  484.  
  485. proc ::trumptruthrss::announce_items {items} {
  486.   set chans [::trumptruthrss::enabled_channels]
  487.   if {[llength $chans] == 0} { return }
  488.   foreach it $items {
  489.     set msg [::trumptruthrss::format_item $it]
  490.     if {$msg eq ""} { continue }
  491.     foreach c $chans { putserv "PRIVMSG $c :$msg" }
  492.   }
  493. }
  494.  
  495. proc ::trumptruthrss::schedule {} {
  496.   variable cfg; variable timer_id
  497.   if {$timer_id ne ""} { catch {killutimer $timer_id} }
  498.   set timer_id [utimer $cfg(poll_seconds) ::trumptruthrss::poll]
  499. }
  500.  
  501. proc ::trumptruthrss::poll {} {
  502.   variable cfg; variable last_guid; variable in_progress
  503.   ::trumptruthrss::schedule
  504.   if {$in_progress} { return }
  505.   set in_progress 1
  506.  
  507.   if {[llength [::trumptruthrss::enabled_channels]] == 0} { set in_progress 0; return }
  508.  
  509.   lassign [::trumptruthrss::curl_fetch $cfg(feed_url)] code ctype body
  510.   if {$code != 200 || $body eq ""} {
  511.     putlog "trumptruthrss: fetch failed (HTTP=$code)"
  512.     set in_progress 0; return
  513.   }
  514.  
  515.   set items [::trumptruthrss::parse_feed $body]
  516.   if {[info exists cfg(exclude_retruths)] && $cfg(exclude_retruths)} {
  517.     set filtered {}
  518.     foreach it $items { if {![::trumptruthrss::is_retruth $it]} { lappend filtered $it } }
  519.     set items $filtered
  520.   }
  521.   if {[llength $items] == 0} { set in_progress 0; return }
  522.  
  523.   if {$last_guid eq ""} {
  524.     set last_guid [dict get [lindex $items 0] guid]
  525.     ::trumptruthrss::save_state
  526.     set in_progress 0; return
  527.   }
  528.  
  529.   set new {}
  530.   foreach it $items {
  531.     if {[dict get $it guid] eq $last_guid} break
  532.     lappend new $it
  533.   }
  534.   if {[llength $new] == 0} { set in_progress 0; return }
  535.   if {[llength $new] > $cfg(max_new_announce)} {
  536.     set new [lrange $new 0 [expr {$cfg(max_new_announce)-1}]]
  537.   }
  538.  
  539.   ::trumptruthrss::announce_items [lreverse $new]
  540.  
  541.   set last_guid [dict get [lindex $items 0] guid]
  542.   ::trumptruthrss::save_state
  543.   set in_progress 0
  544. }
  545.  
  546. proc ::trumptruthrss::cmd_latest {nick host hand chan text} {
  547.   if {![::trumptruthrss::chan_enabled $chan]} { return }
  548.   lassign [::trumptruthrss::curl_fetch $::trumptruthrss::cfg(feed_url)] code ctype body
  549.   if {$code != 200 || $body eq ""} {
  550.     putserv "PRIVMSG $chan :Orange Truth: (error) couldn't fetch feed (HTTP=$code)."
  551.     return
  552.   }
  553.   set items [::trumptruthrss::parse_feed $body]
  554.   if {[llength $items] == 0} {
  555.     putserv "PRIVMSG $chan :Orange Truth: (error) couldn't parse feed."
  556.     return
  557.   }
  558.   set msg [::trumptruthrss::format_item [lindex $items 0] 1]
  559.   if {$msg eq ""} { set msg "Orange Truth: surprisingly restrained post, nothing to report." }
  560.   putserv "PRIVMSG $chan :$msg"
  561. }
  562.  
  563. proc ::trumptruthrss::cmd_sync {nick host hand chan text} {
  564.   variable last_guid
  565.   if {![::trumptruthrss::chan_enabled $chan]} { return }
  566.   lassign [::trumptruthrss::curl_fetch $::trumptruthrss::cfg(feed_url)] code ctype body
  567.   if {$code != 200 || $body eq ""} {
  568.     putserv "PRIVMSG $chan :Orange Truth: (error) couldn't sync (HTTP=$code)."
  569.     return
  570.   }
  571.   set items [::trumptruthrss::parse_feed $body]
  572.   if {[llength $items] == 0} {
  573.     putserv "PRIVMSG $chan :Orange Truth: (error) couldn't parse feed."
  574.     return
  575.   }
  576.   set new {}
  577.   if {$last_guid ne ""} {
  578.     foreach it $items {
  579.       if {[dict get $it guid] eq $last_guid} break
  580.       lappend new $it
  581.     }
  582.   } else { set new $items }
  583.  
  584.   # Update state pointer without announcing anything
  585.   set last_guid [dict get [lindex $items 0] guid]
  586.   ::trumptruthrss::save_state
  587.  
  588.   set n [llength $new]
  589.   if {$n == 0} {
  590.     putserv "PRIVMSG $chan :Orange Truth: already up to date."
  591.   } else {
  592.     putserv "PRIVMSG $chan :Orange Truth: synced, skipped $n post[expr {$n == 1 ? {} : {s}}]. Use !truth to see the latest."
  593.   }
  594. }
  595.  
  596. catch {unbind pub - "!truth"     ::trumptruthrss::cmd_latest}
  597. catch {unbind pub - "!truthsync" ::trumptruthrss::cmd_sync}
  598. bind pub - "!truth"     ::trumptruthrss::cmd_latest
  599. bind pub - "!truthsync" ::trumptruthrss::cmd_sync
  600.  
  601. ::trumptruthrss::load_state
  602. ::trumptruthrss::schedule
  603. putlog "truthtrump.tcl loaded - Enable with: .chanset #chan +enabletruth"

Raw Paste

Fork Edit
Comments 0
Login to post a comment.
  • No comments yet. Be the first.
Login to post a comment. Login or Register
Hello Guest! Paste is for source code and general debugging text.

Login or Register to edit, delete and keep track of your pastes and more.

Recent Pastes
[...]
[...]
Ircart.tcl
Untitled
Untitled
Untitled
Untitled
Untitled
Untitled
Untitled
We use cookies. To comply with GDPR in the EU and the UK we have to show you these.

We use cookies and similar technologies to keep this website functional (including spam protection via Google reCAPTCHA or Cloudflare Turnstile), and — with your consent — to measure usage and show ads. See Privacy.