view feeds.tcl @ 698:6ba9f961e463 default tip

quotedb: Bump version and copyright.
author Matti Hamalainen <ccr@tnsp.org>
date Mon, 18 Sep 2023 11:38:41 +0300
parents 2737e90aad83
children
line wrap: on
line source

##########################################################################
#
# FeedCheck v2.1 by Matti 'ccr' Hamalainen <ccr@tnsp.org>
# (C) Copyright 2008-2021 Tecnic Software productions (TNSP)
#
# Requires fetch_feeds.tcl to be run as a cronjob, for example
# 15 * * * *     /absolute/path/to/fetch_feeds.tcl
#
# See also create_feeds_db.tcl OR convert_feeds_db.tcl, as you will
# need to either create a SQLite3 database or convert old text flat
# file to SQLite3.
#
# This script is freely distributable under GNU GPL (version 2) license.
#
##########################################################################

### The configuration should be in config.feeds in same directory
### as this script. Or change the line below to point where ever
### you wish. See "config.feeds.example" for an example config file.
source [file dirname [info script]]/config.feeds

### Required utillib.tcl
source [file dirname [info script]]/utillib.tcl


##########################################################################
# No need to look below this line
##########################################################################
package require sqlite3

set feeds_name "FeedCheck"
set feeds_message "$feeds_name v2.1 by ccr/TNSP"


# ------------------------------------------------------------------------
### Utility functions
proc feeds_log {umsg} {
  global feeds_log_enable feeds_name
  if {$feeds_log_enable != 0} {
    putlog "${feeds_name}: $umsg"
  }
}


proc feeds_qm {uid} {
  global feeds_messages

  if {[info exists feeds_messages($uid)]} {
    return $feeds_messages($uid)
  } else {
    return $uid
  }
}


proc feeds_smsg {apublic anick achan amsg {aargs {}}} {
  global feeds_preferredmsg feeds_cmd_name
  set amsg [string map [list "@cmd@" $feeds_cmd_name] $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_cmd_match { uid ustr } {
  global feeds_commands
  return [utl_cmd_match feeds_commands $uid $ustr]
}


# ------------------------------------------------------------------------
proc feeds_check_do {uforce upublic unick uchan} {
  global feeds_db_file feeds_dbh feeds_sync_limit feeds_channels

  # Get old time, if it exists
  set oldtime 0
  if {![catch {set ufile [open "${feeds_db_file}.time" r 0600]} uerrmsg]} {
    gets $ufile oldtime
    close $ufile
  } else {
    feeds_log "Could not open timefile for reading: ${uerrmsg}"
    set oldtime [clock seconds]
  }

  # Check for new items
  set nresults [feeds_dbh onecolumn "SELECT COUNT(*) FROM feeds WHERE utime > $oldtime"]

  if {$nresults > $feeds_sync_limit} {
    # Too many items, don't spam the channels
    feeds_log "${nresults} new entries since [utl_ctime $oldtime], probably unsynchronized. Ignoring."
    if {$uforce} {
      feeds_msg $upublic $unick $uchan "chk_unsync_entries" [list $nresults [utl_ctime $oldtime]]
    }
  } elseif {$nresults > 0 || $uforce} {
    # Spam the channels with new items
    feeds_log "${nresults} new entries since [utl_ctime $oldtime] .."

    if {$uforce} {
      feeds_msg $upublic $unick $uchan "chk_new_entries" [list $nresults [utl_ctime $oldtime] $oldtime]
    }

    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 {
      # 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 {$nresults > 0} {
    if {![catch {set ufile [open "${feeds_db_file}.time" w 0600]} uerrmsg]} {
      puts $ufile [clock seconds]
      close $ufile
    } else {
      feeds_log "Could not write timefile: ${uerrmsg}"
    }
  }
}


proc feeds_exec {} {
  global feeds_check_period feeds_running

  feeds_check_do 0 0 "NULL" "NULL"

  set feeds_running [clock seconds]
  timer $feeds_check_period feeds_exec
}


proc feeds_validate_name {upublic unick uchan upattern ufname} {
  global feeds_dbh
  upvar $ufname afname

  # Check value
  if {$upattern == ""} {
    set afname ""
    return 1
  }

  # Check if there are multiple matches
  set usql "SELECT COUNT(DISTINCT(feed)) AS nfeeds,feed AS afname FROM feeds WHERE feed LIKE '%[utl_escape $upattern]%'"
  feeds_dbh eval $usql {}

  if {$nfeeds > 1} {
    feeds_msg $upublic $unick $uchan "multiple_matches" [list $upattern]
    return 0
  } elseif {$nfeeds == 0} {
    feeds_msg $upublic $unick $uchan "no_matches" [list $upattern]
    return 0
  } else {
    return 1
  }
}


# ------------------------------------------------------------------------
proc feeds_cmd {unick uhost uhand uchan uargs upublic} {
  global feeds_dbh feeds_messages feeds_history_limit

  # Check and handle arguments
  set rarglist [::textutil::split::splitx $uargs {\s+}]
  set rcmd [lindex $rarglist 0]
  set rargs [lrange $rarglist 1 end]
  set qadmin [matchattr $uhand n]
#  set qadmin 0

  if {[feeds_cmd_match "help" $rcmd]} {
    # Show help
    foreach ukey $feeds_messages(help_full) {
      feeds_msg $upublic $unick $uchan $ukey
    }
  } elseif {[feeds_cmd_match "latest" $rcmd]} {
    # Show latest entry or latest entry of specified feed
    set ufound 0
    set utext [string tolower [join $rargs " "]]

    # Validate feed name
    if {![feeds_validate_name $upublic $unick $uchan $utext fname]} {
      return 0
    }

    set usql "SELECT url AS uurl, feed AS ufeed, title AS utitle, utime AS utime FROM feeds WHERE feed LIKE '%[utl_escape $fname]%' 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 {[feeds_cmd_match "force" $rcmd]} {
    # Force check for new entries
    if {!$qadmin} {
      feeds_msg $upublic $unick $uchan "no_access"
      return 0
    }

    feeds_check_do 1 $upublic $unick $uchan
  } elseif {[feeds_cmd_match "list" $rcmd]} {
    # List feeds
    set uarg [lindex $rargs 0]

    if {[feeds_cmd_match "all" $uarg]} {
      # Long list
      set utext [string tolower [join [lrange $rargs 1 end] " "]]

      if {$upublic && !$qadmin} {
        feeds_msg $upublic $unick $uchan "feed_list_long_denied" [list $rcmd $utext]
        return 0
      }

      set ulistitem [feeds_qm "feed_list_item_long"]
      set ulistsep [feeds_qm "feed_list_sep_long"]

      set usql "SELECT feed AS ufeed, MAX(utime) AS ulatest, MIN(utime) AS uoldest, COUNT(feed) AS nitems FROM feeds WHERE feed LIKE '%[utl_escape $utext]%' GROUP BY feed"
      set ulist {}

      feeds_dbh eval $usql {
        lappend ulist [utl_str_map_values $ulistitem [list $ufeed [utl_ctime $ulatest] [utl_ctime $uoldest] $nitems]]
      }

      if {$utext != ""} {
        feeds_msg $upublic $unick $uchan "feed_list_filter" [list $utext [join $ulist $ulistsep]]
      } else {
        feeds_msg $upublic $unick $uchan "feed_list_all" [list [join $ulist $ulistsep]]
      }

    } elseif {$uarg != ""} {
      # List feeds with a name filter
      set utext [string tolower [join $rargs " "]]

      set ulistitem [feeds_qm "feed_list_item_short"]
      set ulistsep [feeds_qm "feed_list_sep_short"]

      set usql "SELECT feed AS ufeed, MAX(utime) AS ulatest, MIN(utime) AS uoldest, COUNT(feed) AS nitems FROM feeds WHERE feed LIKE '%[utl_escape $utext]%' GROUP BY feed"
      set ulist {}

      feeds_dbh eval $usql {
        lappend ulist [utl_str_map_values $ulistitem [list $ufeed [utl_ctime $ulatest] [utl_ctime $uoldest] $nitems]]
      }

      feeds_msg $upublic $unick $uchan "feed_list_filter" [list $utext [join $ulist $ulistsep]]
    } else {
      # List any active feeds
      set uold [expr [clock seconds] - 60*60*24*365]

      set ulistitem [feeds_qm "feed_list_item_short"]
      set ulistsep [feeds_qm "feed_list_sep_short"]

      set usql "SELECT feed AS ufeed, MAX(utime) AS ulatest, MIN(utime) AS uoldest, COUNT(feed) AS nitems FROM feeds GROUP BY feed HAVING ulatest >= $uold"
      set ulist {}

      feeds_dbh eval $usql {
        lappend ulist [utl_str_map_values $ulistitem [list $ufeed [utl_ctime $ulatest] [utl_ctime $uoldest] $nitems]]
      }

      feeds_msg $upublic $unick $uchan "feed_list_active" [list [utl_ctime $uold] [join $ulist $ulistsep]]
    }

  } elseif {[feeds_cmd_match "history" $rcmd]} {
    # Show history of a feed
    if {[llength $rarglist] < 2} {
      feeds_msg $upublic $unick $uchan "help_history"
      return 0
    }

    set utext [string tolower [join $rargs " "]]
    if {$upublic && !$qadmin} {
      feeds_msg $upublic $unick $uchan "feed_list_long_denied" [list $rcmd $utext]
      return 0
    }

    # Validate feed name
    if {![feeds_validate_name $upublic $unick $uchan $utext fname]} {
      return 0
    }

    set ulistitem [feeds_qm "history_list_item"]
    set ulistsep [feeds_qm "history_list_sep"]
    set usql "SELECT url AS uurl, title AS utitle, utime FROM feeds WHERE feed='[utl_escape $fname]' ORDER BY utime DESC LIMIT ${feeds_history_limit}"
    set ulist {}

    feeds_dbh eval $usql {
      lappend ulist [utl_str_map_values $ulistitem [list $uurl $utitle [utl_ctime $utime]]]
    }

    feeds_msg $upublic $unick $uchan "history_list" [list $fname [join $ulist $ulistsep]]
  } else {
    # Help/usage
    feeds_msg $upublic $unick $uchan "help_short"
  }

  return 0
}


#-------------------------------------------------------------------------
proc feeds_cmd_pub {unick uhost uhand uchan uargs} {
  global feeds_channels

  foreach {ukey uvalue} [array get feeds_channels] {
    if {[string match $ukey $uchan]} {
      feeds_cmd $unick $uhost $uhand $uchan $uargs 1
      return 1
    }
  }

  return 1
}

proc feeds_cmd_msg {unick uhost uhand uargs} {
  feeds_cmd $unick $uhost $uhand "PRIV" $uargs 0
  return 1
}


#-------------------------------------------------------------------------
# Script initialization
#-------------------------------------------------------------------------
putlog "$feeds_message"

if {[catch {sqlite3 feeds_dbh $feeds_db_file} uerrmsg]} {
  putlog "Could not open SQLite3 database '${feeds_db_file}': ${uerrmsg}"
  exit 2
}

if {[info exists feeds_running]} {
  set feeds_last [expr [clock seconds] - $feeds_running]
} else {
  set feeds_last -1
}

if {$feeds_last < 0 || $feeds_last > [expr $feeds_check_period * 60]} {
  putlog " - Starting timed feed check."
  feeds_exec
}

putlog " - Executing feeds_init()"
feeds_init
putlog " - feeds_init() done."

# end of script