view feeds.tcl @ 549:c6f389bef58e

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 7512889f7b72
children 85fe3bc36307
line wrap: on
line source

##########################################################################
#
# 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
# 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.0 by ccr/TNSP"



# ------------------------------------------------------------------------
proc feeds_log {umsg} {
  global feeds_logmsg feeds_name
  if {$feeds_logmsg != 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
  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_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]} {
    gets $ufile oldtime
    close $ufile
  } else {
    feeds_log "Could not open timefile: $uerrmsg"
    set oldtime [clock seconds]
  }

  # 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]]
    }

    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 {$nresult > 0} {
    if {![catch {set ufile [open "${feeds_dbfile}.time" w 0600]} uerrmsg]} {
      puts $ufile [clock seconds]
      close $ufile
    }
  }
}


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_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 {
  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."