luxferre/tii
1
0
Fork 0
Code Actions Activity

Migration to sqlite3 started

Browse Source
This commit is contained in:
Luxferre
2024-10-23 20:27:03 +03:00
parent 5c1b6570df
commit a86bb5a0e6
3 changed files with 96 additions and 141 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tiifetch.tcl
+39 -25
View File
@@ -1,7 +1,7 @@
#!/usr/bin/env tclsh
# tiifetch: fetch all data from an ii/idec station into the local text db
# (see https://github.com/idec-net/new-docs/blob/master/protocol-en.md)
# Usage: tiifetch.tcl [station_url] [echos] [db_dir]
# Usage: tiifetch.tcl [station_url] [echos] [db_file]
# The echo list should be delimited with slash (/), comma (,) or semicolon (;)
# if no echos are specified (or "" is passed), then list.txt will be fetched
# and then all missing echo content from it will be downloaded
@@ -9,11 +9,12 @@
# tiidb directory in the program root with echoconfs and messages respectively
# This component only fetches the messages, doesn't parse or display them
# Supported protocols: HTTP, HTTPS, Gemini, Spartan, Gopher/Finger/Nex
# Depends on Tcllib for URI parsing
# Depends on Tcllib for URI parsing and SQLite3 for data storage
# Created by Luxferre in 2024, released into public domain
package require http
package require uri
package require sqlite3
# autodetect TclTLS support and enable HTTPS request support if detected
set tls_support 0
@@ -188,15 +189,18 @@ proc listcomp {a b} {
}
# main logic proc
proc fetchiidb {url echos dbdir dolog} {
proc fetchiidb {url echos dbfile dolog} {
# trim the parameters
set url [string trim $url]
set echos [string trim $echos]
set dbdir [file normalize [string trim $dbdir]]
set echodir [file join $dbdir "echo"]
set msgdir [file join $dbdir "msg"]
# ensure that the necessary dirs exist
file mkdir $dbdir $echodir $msgdir
set dbfile [file normalize [string trim $dbfile]]
# prepare starting script
sqlite3 msgdb $dbfile
msgdb eval {
CREATE TABLE IF NOT EXISTS `msg` (`id` INTEGER PRIMARY KEY AUTOINCREMENT, `msgid` VARCHAR(20), `timestamp` INT, `echoname` VARCHAR(120),
`repto` TEXT, `msgfrom` TEXT, `msgfromaddr` TEXT, `msgto` TEXT, `subj` TEXT, `body` TEXT);
}
# attempt to fetch the echolist if echos are empty
if {$echos eq {}} {
if {$dolog eq 1} {puts "Fetching echolist..."}
@@ -237,23 +241,18 @@ proc fetchiidb {url echos dbdir dolog} {
# now, process the map we've built
dict for {echoname msgids} $echomap {
if {![string match *.* $echoname]} {continue}
if {[llength msgids] eq 0} {continue}
# get the existing message IDs in the echo
set echofile [file join $echodir $echoname]
set oldmsgids ""
if [file exists $echofile] {
set oldmsgids [lmap s [split [readfile $echofile] "\n"] {string trim $s}]
}
set oldmsgids [msgdb eval {SELECT `msgid` FROM `msg` WHERE `echoname` = $echoname ORDER BY `id` ASC;}]
# pre-filter the new message IDs to fetch
set newmsgids [listcomp $msgids $oldmsgids]
# save the echo index file with all message IDs
set msgids [list {*}$oldmsgids {*}$newmsgids]
writefileln $echofile [string cat [string trimright [join $msgids "\n"]] "\n"]
if {$dolog eq 1} {puts "Fetching [llength $newmsgids] new messages from $echoname..."}
set idgroups ""
set grcount 0
set localcount 0
foreach nmid $newmsgids { # iterate over new messages to group them
if {$nmid ne ""} {
# insert new message ID to the echo mapping
dict lappend idgroups $grcount $nmid
incr localcount
if {$localcount > $maxids} {
@@ -270,15 +269,30 @@ proc fetchiidb {url echos dbdir dolog} {
set parts [split $bline ":"]
if {[llength $parts] > 1} { # valid message
set mid [lindex $parts 0]
set mdata [binary decode base64 [lindex $parts 1]]
writefileln [file join $msgdir $mid] [encoding convertfrom utf-8 $mdata]
set mdata [encoding convertfrom utf-8 [binary decode base64 [lindex $parts 1]]]
set msglines [split $mdata "\n"]
set replyto ""
set tags [split [lindex $msglines 0] "/"]
if {[dict exists $tags repto]} {
set replyto [dict get $tags repto]
} else {set replyto ""}
set echoarea [string trim [lindex $msglines 1]]
set timestamp [string trim [lindex $msglines 2]]
set msgfrom [string trim [lindex $msglines 3]]
set msgfromaddr [string trim [lindex $msglines 4]]
set msgto [string trim [lindex $msglines 5]]
set subj [string trim [lindex $msglines 6]]
set msgbody [string trimright [lrange $msglines 8 end]]
msgdb eval {INSERT INTO `msg` (`msgid`, `timestamp`, `echoname`, `repto`, `msgfrom`, `msgfromaddr`, `msgto`, `subj`, `body`)
VALUES ($mid, $timestamp, $echoarea, $replyto, $msgfrom, $msgfromaddr, $msgto, $subj, $msgbody);}
}
}
}
}
msgdb close
}
proc massfetch {echos dbdir dolog} {
proc massfetch {echos db dolog} {
global appdir
if {$dolog eq 1} {puts "No ii/idec station URL specified, using stations.txt"}
set stfile [file join $appdir "stations.txt"]
@@ -288,7 +302,7 @@ proc massfetch {echos dbdir dolog} {
set station [string trim $station]
if {$station ne "" && ![string match "#*" $station]} {
if {$dolog eq 1} {puts "Fetching from $station"}
fetchiidb $station $echos $dbdir $dolog
fetchiidb $station $echos $db $dolog
}
}
} else {
@@ -305,7 +319,7 @@ set appdir [file dirname $scriptpath]
if [string match *app-tiifetch $appdir] {
set appdir [file normalize [file join $appdir ".." ".." ".." ]]
}
set localdbdir [file join $appdir "tiidb"]
set localdb [file join $appdir "tii.db"]
# populate general HTTP configuration
set cfgfile [file join $appdir "config.txt"]
@@ -324,19 +338,19 @@ if {[file exists $cfgfile]} {
if {$argc > 0} {
if {$argc > 2} {
set localdbdir [lindex $argv 2]
set localdb [lindex $argv 2]
}
puts "Fetching messages, please wait..."
set sturl [string trim [lindex $argv 0]]
if {$sturl eq ""} {
massfetch [lindex $argv 1] $localdbdir 1
massfetch [lindex $argv 1] $localdb 1
} else {
fetchiidb $sturl [lindex $argv 1] $localdbdir 1
fetchiidb $sturl [lindex $argv 1] $localdb 1
}
puts "Messages fetched"
} else {
puts "Fetching messages, please wait..."
massfetch "" $localdbdir 1
massfetch "" $localdb 1
puts "Messages fetched"
}