Mercurial > hg > egg-tcls

changeset 549:c6f389bef58e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
feeds: Largely refactor feeds.tcl, bump version to 2.0.
author Matti Hamalainen <ccr@tnsp.org>
date Wed, 08 Jul 2020 17:09:07 +0300
parents 028ee7efd4ff
children 85fe3bc36307
files config.feeds.example feeds.tcl
diffstat 2 files changed, 217 insertions(+), 99 deletions(-) [+]
line wrap: on
line diff
--- a/config.feeds.example	Wed Jul 08 13:23:48 2020 +0300
+++ b/config.feeds.example	Wed Jul 08 17:09:07 2020 +0300
@@ -8,6 +8,37 @@
 set feeds_dbfile "/home/niinuska/bot/feeds.sqlite"
 
 
+proc feeds_cmd_pub_last {unick uhost uhand uchan utext} {
+  return [feeds_cmd $unick $uhost $uhand $uchan "last $utext" 1]
+}
+
+proc feeds_cmd_msg_last {unick uhost uhand utext} {
+  return [feeds_cmd $unick $uhost $uhand "PRIV" "last $utext" 0]
+}
+
+
+proc feeds_cmd_pubm_last {unick uhost uhand uchan utext} {
+  return [feeds_cmd $unick $uhost $uhand $uchan "last [feeds_cmdm_split $utext]" 1]
+}
+
+proc feeds_cmd_msgm_last {unick uhost uhand utext} {
+  return [feeds_cmd_msg $unick $uhost $uhand "PRIV" "last [feeds_cmdm_split $utext]" 0]
+}
+
+
+# Initialization proc called only by feeds.tcl
+proc feeds_init { } {
+  # Bind commands
+  bind pubm - !feed* feeds_cmd_pubm
+  bind pub - !last feeds_cmd_pub_last
+  bind pubm - !lates* feeds_cmd_pubm_last
+
+  bind msgm - !feed* feeds_cmd_msgm
+  bind msg - !last feeds_cmd_msg_last
+  bind msgm - !lates* feeds_cmd_msgm_last
+}
+
+
 # Proc for fetching the feeds data, called by fetch_feeds.tcl
 proc feeds_fetch { } {
   #fetch_poliisi "http://www.poliisi.fi/oulu/tiedotteet/1/0?all1/0" "Poliisi/Oulu" "http://www.poliisi.fi"
@@ -39,9 +70,8 @@
 # "#channel" "feedname|feedname2"
 # feednames can use matching, e.g. "mtv3*" would match all beginning with "mtv3"
 array set feeds_channels {
-  "#mazmlame" "the adventurers|oots|mestari|blastwave"
-  "#fireball" "mestari"
-  "#tnsp" "the adventurers|oots|mestari"
+  "#mazmlame" "the adventurers|oots|mestari|effi"
+  "#fireball" "mestari|effi"
 }
 
 
@@ -72,3 +102,25 @@
 
 # Set 'user agent' string for HTTP. If empty or not set, default will be used.
 #set http_user_agent "Mozilla"
+
+
+###
+### Messages
+###
+
+array set feeds_messages {
+
+  "usage_full" {"usage_help"}
+  "usage_help" "@cmd@ \[latest \[<feed>\]|list|history\]"
+
+  "chk_unsync_entries" "Epäsynkki."
+  "chk_new_entries" "@1@ uutta."
+  "chk_entry" "@1@: @4@ \002@2@\002 -- @3@"
+
+  "search_latest_feed" "Uusin '@1@' / @2@: @3@ -- @4@"
+  "search_no_matches"  "Ei osumia haulla '@1@'."
+
+  "history_list" "Feedien historia: @1@"
+  "history_list_item" "@1@ (@2@)"
+  "history_list_sep" ", "
+}
--- a/feeds.tcl	Wed Jul 08 13:23:48 2020 +0300
+++ b/feeds.tcl	Wed Jul 08 17:09:07 2020 +0300
@@ -1,6 +1,6 @@
 ##########################################################################
 #
-# FeedCheck v1.1 by Matti 'ccr' Hamalainen <ccr@tnsp.org>
+# FeedCheck v2.0 by Matti 'ccr' Hamalainen <ccr@tnsp.org>
 # (C) Copyright 2008-2020 Tecnic Software productions (TNSP)
 #
 # Requires fetch_feeds.tcl to be run as a cronjob, for example
@@ -29,21 +29,11 @@
 package require sqlite3
 
 set feeds_name "FeedCheck"
-set feeds_message "$feeds_name v1.1 by ccr/TNSP"
+set feeds_message "$feeds_name v2.0 by ccr/TNSP"
 
-putlog "$feeds_message"
-bind pub - !feeds feeds_pubfetch
-bind pub - !last feeds_publast
-bind pub - !latest feeds_publast
 
 
 # ------------------------------------------------------------------------
-proc feeds_smsg {uchan umsg} {
-  global feeds_preferredmsg
-  putserv "$feeds_preferredmsg $uchan :$umsg"
-}
-
-
 proc feeds_log {umsg} {
   global feeds_logmsg feeds_name
   if {$feeds_logmsg != 0} {
@@ -52,31 +42,37 @@
 }
 
 
-proc feeds_msg {utime ufeed uurl utitle} {
-  global feeds_channels
-  foreach {uchan ufilter} [array get feeds_channels] {
-    foreach umatch [split $ufilter "|"] {
-      if {[string match -nocase $umatch $ufeed]} {
-        feeds_smsg "$uchan" "$ufeed: \002$utitle\002 -- $uurl"
-      }
-    }
+proc feeds_qm {uid} {
+  global feeds_messages
+
+  if {[info exists feeds_messages($uid)]} {
+    return $feeds_messages($uid)
+  } else {
+    return $uid
   }
 }
 
 
-### Open database, etc
-if {[catch {sqlite3 feeds_dbh $feeds_dbfile} uerrmsg]} {
-  puts "Could not open SQLite3 database '$feeds_dbfile': $uerrmsg."
-  exit 2
+proc feeds_smsg {apublic anick achan amsg {aargs {}}} {
+  global feeds_preferredmsg
+  set amsg [string map [list "@cmd@" "!feeds"] $amsg]
+  utl_msg_args $feeds_preferredmsg $apublic $anick $achan $amsg $aargs
+}
+
+
+proc feeds_msg {apublic anick achan aid {aargs {}}} {
+  feeds_smsg $apublic $anick $achan [feeds_qm $aid] $aargs
 }
 
 
 # ------------------------------------------------------------------------
-proc feeds_check_start {} {
-  global feeds_dbfile
+
+proc feeds_check_do {uforce upublic unick uchan} {
+  global feeds_dbfile feeds_dbh feeds_sync_limit feeds_channels
 
+  # Get old time, if it exists
   set oldtime 0
-  if {![catch {set ufile [open "$feeds_dbfile.time" r 0600]} uerrmsg]} {
+  if {![catch {set ufile [open "${feeds_dbfile}.time" r 0600]} uerrmsg]} {
     gets $ufile oldtime
     close $ufile
   } else {
@@ -84,47 +80,156 @@
     set oldtime [clock seconds]
   }
 
-  return $oldtime
-}
+  # Check for new items
+  set usql "SELECT feed AS ufeed, title AS utitle, url AS uurl, utime AS utime FROM feeds WHERE utime > $oldtime ORDER BY utime ASC"
+  set nresult [feeds_dbh onecolumn "SELECT COUNT(*) FROM feeds WHERE utime > $oldtime"]
 
+  if {$nresult > $feeds_sync_limit} {
+    # Too many items, don't spam the channels
+    feeds_log "${nresult} new entries since [utl_ctime $oldtime], probably unsynchronized. Ignoring."
+    if {$uforce} {
+      feeds_msg $upublic $unick $uchan "chk_unsync_entries" [list $nresult $oldtime [utl_ctime $oldtime]]
+    }
+  } else {
+    # Spam the channels with new items
+    feeds_log "${nresult} new entries since [utl_ctime $oldtime] .."
+    if {$uforce} {
+      feeds_msg $upublic $unick $uchan "chk_new_entries" [list $nresult [utl_ctime $oldtime]]
+    }
 
-proc feeds_check_end {} {
-  global feeds_dbfile
+    feeds_dbh eval $usql {
+      # Message all relevant channels
+      foreach {qchan ufilter} [array get feeds_channels] {
+        foreach umatch [split $ufilter "|"] {
+          if {[string match -nocase $umatch $ufeed]} {
+            feeds_msg 1 "NULL" $qchan "chk_entry" [list $ufeed $utitle $uurl [utl_ctime $utime]]
+          }
+        }
+      }
+    }
+  }
 
-  if {![catch {set ufile [open "$feeds_dbfile.time" w 0600]} uerrmsg]} {
-    puts $ufile [clock seconds]
-    close $ufile
+  if {$nresult > 0} {
+    if {![catch {set ufile [open "${feeds_dbfile}.time" w 0600]} uerrmsg]} {
+      puts $ufile [clock seconds]
+      close $ufile
+    }
   }
 }
 
 
-# ------------------------------------------------------------------------
 proc feeds_exec {} {
-  global feeds_dbh feeds_check_period feeds_running feeds_sync_limit
-
-#  feeds_log "Timed feed check."
-  set oldtime [feeds_check_start]
-  set usql "SELECT feed AS ufeed, title AS utitle, url AS uurl, utime AS utime FROM feeds WHERE utime > $oldtime ORDER BY utime ASC"
-  set nresult [feeds_dbh onecolumn "SELECT COUNT(*) FROM feeds WHERE utime > $oldtime"]
+  global feeds_check_period feeds_running
 
-  if {$nresult > $feeds_sync_limit} {
-    feeds_log "${nresult} new entries, probably unsynchronized. Ignoring."
-  } else {
-    feeds_log "${nresult} new entries since ${oldtime} ( [utl_ctime $oldtime] ) .."
-    feeds_dbh eval $usql {
-      feeds_msg $utime $ufeed $uurl $utitle
-    }
-  }
-
-  if {$nresult > 0} {
-    feeds_check_end
-  }
+  feeds_check_do 0 0 "NULL" "NULL"
 
   set feeds_running [clock seconds]
   timer $feeds_check_period feeds_exec
 }
 
 
+# ------------------------------------------------------------------------
+proc feeds_cmd {unick uhost uhand uchan uargs upublic} {
+  global feeds_dbh feeds_messages
+
+  # Check and handle arguments
+  set rarglist [::textutil::split::splitx $uargs {\s+}]
+  set rcmd [lindex $rarglist 0]
+  set rargs [lrange $rarglist 1 end]
+
+  if {$rcmd == "?" || $rcmd == "help" || $rcmd == "apua"} {
+    foreach ukey $feeds_messages(usage_full) {
+      feeds_msg $upublic $unick $uchan $ukey
+    }
+    return 0
+  }
+
+  if {$rcmd == "last" || $rcmd == "latest" || $rcmd == "uusin"} {
+    # Show latest entry or latest entry of specified feed
+    set ufound 0
+    set utext [string tolower [join $rargs " "]]
+    set usql "SELECT url AS uurl, feed AS ufeed, title AS utitle, utime AS utime FROM feeds WHERE feed LIKE '%[utl_escape $utext]%' ORDER BY utime DESC LIMIT 1"
+    feeds_dbh eval $usql {
+      feeds_msg $upublic $unick $uchan "search_latest_feed" [list $ufeed [utl_ctime $utime] $utitle $uurl]
+      set ufound 1
+    }
+
+    if {$ufound == 0} {
+      feeds_msg $upublic $unick $uchan "search_no_matches" [list $utext]
+    }
+  } elseif {[string match "forc*" $rcmd] || [string match "fet*" $rcmd]} {
+    # Force check for new entries
+    if {![matchattr $uhand n]} {
+      feeds_msg $upublic $unick $uchan "no_access"
+    }
+    feeds_check_do 1 $upublic $unick $uchan
+  } elseif {[string match "list*" $rcmd]} {
+    # List ...
+    feeds_smsg $upublic $unick $uchan "usage_help"
+
+  } elseif {[string match "hist*" $rcmd]} {
+    # Show history of feeds
+    set ulistitem [feeds_qm "history_list_item"]
+    set ulistsep [feeds_qm "history_list_sep"]
+    set usql "SELECT feed AS ufeed, utime FROM feeds GROUP BY feed ORDER BY utime DESC,feed DESC"
+    set ulist {}
+
+    feeds_dbh eval $usql {
+      lappend ulist [utl_str_map_values $ulistitem [list $ufeed [utl_ctime $utime]]]
+    }
+
+    feeds_msg $upublic $unick $uchan "history_list" [list [join $ulist $ulistsep]]
+  } else {
+    feeds_msg $upublic $unick $uchan "usage_help"
+  }
+}
+
+
+#-------------------------------------------------------------------------
+proc feeds_cmd_pub {unick uhost uhand uchan uargs} {
+  global feeds_channels
+
+  foreach {ukey uvalue} [array get feeds_channels] {
+    if {[string match $ukey $uchan]} {
+      return [feeds_cmd $unick $uhost $uhand $uchan $uargs 1]
+    }
+  }
+
+  return 1
+}
+
+proc feeds_cmd_msg {unick uhost uhand uargs} {
+  feeds_cmd $unick $uhost $uhand "PRIV" $uargs 0
+  return 1
+}
+
+
+#-------------------------------------------------------------------------
+proc feeds_cmdm_split {uargs} {
+  set rarglist [::textutil::split::splitx $uargs {\s+}]
+  return [join [lrange $rarglist 1 end] " "]
+}
+
+proc feeds_cmd_pubm {unick uhost uhand uchan uargs} {
+  return [feeds_cmd_pub $unick $uhost $uhand $uchan [feeds_cmdm_split $uargs]]
+}
+
+proc feeds_cmd_msgm {unick uhost uhand uargs} {
+  return [feeds_cmd_msg $unick $uhost $uhand [feeds_cmdm_split $uargs]]
+}
+
+
+# ------------------------------------------------------------------------
+###
+### Initializing ..
+###
+putlog "$feeds_message"
+
+if {[catch {sqlite3 feeds_dbh $feeds_dbfile} uerrmsg]} {
+  puts "Could not open SQLite3 database '$feeds_dbfile': $uerrmsg."
+  exit 2
+}
+
 if {[info exists feeds_running]} {
   set feeds_last [expr [clock seconds] - $feeds_running]
 } else {
@@ -132,49 +237,10 @@
 }
 
 if {$feeds_last < 0 || $feeds_last > [expr $feeds_check_period * 60]} {
-  feeds_log "Starting timed feed check."
+  putlog " - Starting timed feed check."
   feeds_exec
 }
 
-
-# ------------------------------------------------------------------------
-proc feeds_pubfetch {unick uhost uhand uchan utext} {
-  global feeds_dbh feeds_sync_limit
-#  feeds_log "Manual check invoked on $uchan."
-
-  set oldtime [feeds_check_start]
-  set nresult [feeds_dbh onecolumn "SELECT COUNT(*) FROM feeds WHERE utime > $oldtime"]
-
-  if {$nresult > 0} {
-    feeds_check_end
-    if {$nresult > $feeds_sync_limit} {
-      feeds_smsg $uchan "$nresult uutta, tod. näk. epäsynkissä. Ignoorataan."
-    } else {
-      set usql "SELECT feed AS ufeed, title AS utitle, url AS uurl, utime AS utime FROM feeds WHERE utime > $oldtime ORDER BY utime ASC"
-      feeds_dbh eval $usql {
-        feeds_msg $utime $ufeed $uurl $utitle
-        set found 1
-      }
-      feeds_smsg $uchan "$nresult uutta."
-    }
-  } else {
-    feeds_smsg $uchan "Ei uusia."
-  }
-}
-
-
-# ------------------------------------------------------------------------
-proc feeds_publast {unick uhost uhand uchan utext} {
-  global feeds_dbh
-  set ufound 0
-
-  set usql "SELECT url AS uurl, feed AS ufeed, title AS utitle, utime AS utime FROM feeds WHERE feed LIKE '%[string tolower [utl_escape $utext]]%' ORDER BY utime DESC LIMIT 1"
-  feeds_dbh eval $usql {
-    feeds_smsg $uchan "Uusin '$ufeed' / [utl_ctime $utime]: $utitle -- $uurl"
-    set ufound 1
-  }
-
-  if {$ufound == 0} {
-    feeds_smsg $uchan "Ei osumia haulla '${utext}'."
-  }
-}
+putlog " - Executing feeds_init()"
+feeds_init
+putlog " - feeds_init() done."