3 files changed, 53 insertions(+), 2 deletions(-)

A bin/addpost.tcl
M bin/updatelists.tcl
M src/algos/tclposting.tcl

@@ 0,0 1,43 @@
+#!/bin/env tclsh
+
+if {$argc < 4 || $argc % 2} { return -code error "Usage: bin/rmpost.tcl DB FEED URI ORD ?URI ORD ...?" }
+set uris [lassign $argv db feed]
+
+cd [file dirname [file dirname [dict get [info frame [info frame]] file]]]
+
+package require sqlite3
+package require json
+package require http
+package require tls
+::http::register https 443 ::tls::socket
+
+sqlite3 db $db
+
+foreach {uri ord} $uris {
+  switch -regexp -matchvar matches -- $uri {
+    {^at://.+} {
+      if {$ord == "-ts"} {
+        set endpoint {https://public.api.bsky.app/xrpc/app.bsky.feed.getPostThread}
+        set http_state [http::geturl "$endpoint?uri=$uri&depth=0&parentHeight=0"]
+        set ord [dict get [::json::json2dict [::http::data $http_state]] thread post record createdAt]
+      }
+    }
+    {^(?:(?:(?:(?:(?:https://)?bsky.app)?/)?profile)?/)?([^/]+)/post/(.+)$} {
+      lassign $matches _ pub rkey
+
+      set endpoint {https://public.api.bsky.app/xrpc/com.atproto.repo.getRecord}
+
+      set http_state [http::geturl "$endpoint?repo=$pub&collection=app.bsky.feed.post&rkey=$rkey"]
+      if {[::http::ncode $http_state] != 200} { return -code error "couldn't resolve bsky.app URI!\n[::http::data $http_state]" }
+      set data [::json::json2dict [::http::data $http_state]]
+      set uri [dict get $data uri]
+
+      if {$ord == "-ts"} {
+        set ord [dict get $data value createdAt]
+      }
+    }
+    default { return -code error "unknown URI format!" }
+  }
+
+  db eval "INSERT OR IGNORE INTO $feed (uri, ord) VALUES (:uri, :ord);"
+}

@@ 16,3 16,8 @@ exec bin/importlist.tcl $db \
   https://bsky.app/profile/rahaeli.bsky.social/lists/3l42hebnldp2w \
   https://bsky.app/profile/rahaeli.bsky.social/lists/3l42gs6pmns22
 puts "imported!"
+
+puts "importing aleteoryx's lists..."
+exec bin/importlist.tcl $db \
+  https://bsky.app/profile/aleteoryx.me/lists/3lbnogsl36d2y
+puts "imported!"

@@ 16,14 16,17 @@ namespace eval ::algos::tclposting {
       {tcllib}
       {tklib}
       {tcl\.tk}
-      {#tcllang}} | ] $text]} \
+      {#tcllang}
+      {[Tt]kinter}} | ] $text]} \
     {
       return {}
     }
 
     if {[regexp -nocase -- [join {
       {Title Tk}
-      {Comic-Con Tk}} | ] $text]} \
+      {Comic-Con Tk}
+      {[Tt][Vv][Ss]?}
+      {[Tt]elevision}} | ] $text]} \
     {
       return {}
     }