commit 64d6bc5f0e6d948c3e66ac332be9164bb701d88c
parent c45f1db71410c5aa17d45624417128dedbb138c2
Author: Natasha Kerensikova <natgh@instinctive.eu>
Date: Wed, 30 Sep 2026 18:43:56 +0000
Import gruiks form IRC log in get-gruiks
Diffstat:
| M | src/get-gruiks.scm | | | 145 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 145 insertions(+), 0 deletions(-)
diff --git a/src/get-gruiks.scm b/src/get-gruiks.scm
@@ -14,6 +14,8 @@
(import
(chicken condition)
+ (chicken file)
+ (chicken file posix)
(chicken io)
(chicken port)
(chicken process signal)
@@ -22,6 +24,7 @@
(chicken time)
(chicken time posix)
atom
+ comparse
openssl ; must be above http-client
http-client
intarweb
@@ -277,6 +280,144 @@
(exn () (write-line (conc "Error while checking " name))
(print-error-message exn))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Gruik build from IRC log
+
+(define irc-digit (in #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+(define irc-hex (in #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7
+ #\8 #\9 #\a #\b #\c #\d #\e #\f))
+(define (irc-digits n) (repeated irc-digit n))
+(define irc-date
+ (as-string
+ (sequence (irc-digits 4) (is #\.)
+ (irc-digits 2) (is #\.)
+ (irc-digits 2) (is #\ )
+ (irc-digits 2) (is #\:)
+ (irc-digits 2) (is #\:)
+ (irc-digits 2))))
+(define irc-nick
+ (as-string
+ (enclosed-by (is #\<)
+ (repeated item until: (is #\>))
+ (is #\>))))
+(define irc-source
+ (as-string
+ (enclosed-by (char-seq " [")
+ (repeated item until: (is #\]))
+ (char-seq "] "))))
+(define irc-url
+ (as-string
+ (enclosed-by (char-seq " ")
+ (sequence (char-seq "http")
+ (repeated item until: (is #\space)))
+ (char-seq " "))))
+(define irc-hash
+ (as-string
+ (enclosed-by (char-seq "#")
+ (repeated irc-hex 8)
+ end-of-input)))
+(define irc-suffix (sequence irc-url irc-hash))
+(define irc-line
+ (sequence irc-date
+ irc-nick
+ irc-source
+ (as-string (repeated item until: irc-suffix))
+ irc-url
+ irc-hash))
+
+(define (read-line-pos fd)
+ (let loop ((acc ""))
+ (let ((c (file-read fd 1)))
+ (if (and (= 1 (cadr c))
+ (not (string=? (car c) "\n")))
+ (loop (string-append acc (car c)))
+ (list acc (file-position fd))))))
+
+(define (line->notes line max-width)
+ (let loop ((rest (string-split line " " #t))
+ (lines '())
+ (words ""))
+ (cond
+ ((null? rest)
+ (reverse-string-append (cons words lines)))
+ ((<= (+ (string-length words) 1 (string-length (car rest))) max-width)
+ (loop (cdr rest)
+ lines
+ (string-append words
+ (if (string=? words "") "" " ")
+ (car rest))))
+ (else
+ (loop (cdr rest)
+ (cons (string-append words "\n") lines)
+ (car rest))))))
+
+(define (insert-line line offset)
+ (set! gruik-processed (add1 gruik-processed))
+ (secosleep (time->seconds (min-sleep)))
+ (and-let* ((parsed (parse irc-line line))
+ (now (current-seconds))
+ (section (list-ref parsed 2))
+ (title (list-ref parsed 3))
+ (url (list-ref parsed 4))
+ (_ (= 0 (exec (sql db
+ "UPDATE gruik
+ SET mtime=CAST(strftime('%s', 'now') as INT),
+ notes=(CASE WHEN title=?3
+ THEN notes
+ ELSE trim(notes||char(10)
+ ||'Also “'||?3||'”',
+ char(10))
+ END)
+ WHERE section=?1 AND url=?2;")
+ section url title)
+ (query fetch-value
+ (sql db "SELECT COUNT(id) FROM entry
+ WHERE source=? AND url=? AND title=?;")
+ section url title))))
+ (set! gruik-inserted (add1 gruik-inserted))
+ (exec
+ (sql db
+ "INSERT INTO gruik(position, notes, ptime,
+ section, title, url, mark, ctime, mtime)
+ VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?);")
+ offset
+ (line->notes line 79)
+ (car parsed)
+ section
+ title
+ url
+ (+ (query fetch-value
+ (sql db "SELECT -2*COUNT(*) FROM gruik WHERE url=?;")
+ url)
+ (query fetch-value
+ (sql db "SELECT -2*COUNT(*) FROM entry WHERE url=?;")
+ url))
+ now
+ now)))
+
+(define (import-gruiks)
+ (let ((src-path (get-config "gruik-source")))
+ (when src-path
+ (let* ((fd (file-open src-path open/rdonly))
+ (so (get-config/default "gruik-seen" 0))
+ (_ (set-file-position! fd so seek/set)))
+ (zero-gruik-counters)
+ (write-log 1 "Importing gruiks from " so)
+ (let loop ((offset so))
+ (let ((rp (read-line-pos fd)))
+ (if (= (cadr rp) offset)
+ (begin
+ (write-log 1 "Imported " gruik-inserted "/" gruik-processed
+ " gruiks until " offset)
+ (reset-gruik-counters)
+ (exec
+ (sql db "INSERT OR REPLACE INTO config VALUES (?,?);")
+ "gruik-seen"
+ offset))
+ (begin
+ (apply insert-line rp)
+ (loop (cadr rp))))))))))
+
;;;;;;;;;;;;;;;
;; Actual Run
@@ -289,6 +430,8 @@
(define usr1-queue (make-signal-handler signal/usr1))
+(import-gruiks)
+
(if total-period
(let loop ((index (query fetch-value
(sql/transient db
@@ -304,6 +447,8 @@
index)))
(apply process-source (cons deadline (cdr arg)))
(sleep-until deadline)
+ (when (<= (car arg) index)
+ (import-gruiks))
(unless (and (<= (car arg) index) (usr1-queue))
(loop (car arg)))))
(query
