commit 7e571d26dac4c733063b9c91c783975ccefda686
parent 000825fda10c31480e2751c793fd0c56fee095df
Author: Natasha Kerensikova <natgh@instinctive.eu>
Date: Tue, 2 Jan 2024 15:12:46 +0000
SQL statements are inlined near their use
Diffstat:
| M | src/iens.scm | | | 191 | ++++++++++++++++++++++++++++++++++++++----------------------------------------- |
1 file changed, 91 insertions(+), 100 deletions(-)
diff --git a/src/iens.scm b/src/iens.scm
@@ -201,30 +201,20 @@
;; Tag Management
-(define add-tag-stmt
- (sql db "INSERT INTO tag(name) VALUES (?);"))
-(define list-tags-stmt
- (sql db "SELECT name,auto,COUNT(tagrel.url_id) FROM tag OUTER LEFT JOIN tagrel ON id = tagrel.tag_id GROUP BY id ORDER BY name;"))
-(define remove-tag-stmt
- (sql db "DELETE FROM tag WHERE name = ?;"))
-(define rename-tag-stmt
- (sql db "UPDATE tag SET name = ? WHERE name = ?;"))
-(define reset-auto-tag-stmt
- (sql db "UPDATE tag SET auto = 0;"))
-(define set-auto-tag-stmt
- (sql db "UPDATE tag SET auto = ? WHERE name = ?;"))
+(define (set-tag-auto name auto)
+ (exec (sql db "UPDATE tag SET auto=? WHERE name=?;") auto name))
(defcmd (add-auto-tag name . rest)
"tag-name [tag-name ...]" "Set tags as automatic"
(trace `(add-auto-tag ,name))
- (exec set-auto-tag-stmt 1 name)
+ (set-tag-auto name 1)
(unless (null? rest)
(apply add-auto-tag rest)))
(defcmd (add-tag name . rest)
"tag-name [tag-name ...]" "Create a new tag"
(trace `(add-tag ,name))
- (exec add-tag-stmt name)
+ (exec (sql db "INSERT INTO tag(name) VALUES (?);") name)
(unless (null? rest)
(apply add-tag rest)))
@@ -233,10 +223,10 @@
(trace `(auto-tags . ,tag-list))
(with-transaction db
(lambda ()
- (exec reset-auto-tag-stmt)
+ (exec (sql db "UPDATE tag SET auto=0;"))
(let loop ((todo tag-list))
(unless (null? todo)
- (exec set-auto-tag-stmt 1 (car todo))
+ (set-tag-auto name 1)
(loop (cdr todo)))))))
(defcmd (list-tags)
@@ -245,40 +235,36 @@
(for-each-row*
(lambda (name auto count)
(write-line (conc " " name (if (= 0 auto) " (" "* (") count ")"))))
- list-tags-stmt))
+ (sql db "SELECT name,auto,COUNT(tagrel.url_id)
+ FROM tag OUTER LEFT JOIN tagrel ON id=tagrel.tag_id
+ GROUP BY id ORDER BY name;")))
(defcmd (remove-auto-tag name . rest)
"[tag-name ...]" "Set tags as not automatic"
(trace `(remove-auto-tag ,name))
- (exec set-auto-tag-stmt 0 name)
+ (set-tag-auto name 0)
(unless (null? rest)
(apply remove-auto-tag rest)))
(defcmd (remove-tag name . rest)
"tag-name [tag-name ...]" "Remove tags"
(trace `(remove-tag ,name))
- (exec remove-tag-stmt name)
+ (exec (sql db "DELETE FROM tag WHERE name=?;") name)
(unless (null? rest)
(apply remove-tag rest)))
(defcmd (rename-tag old-name new-name)
"old-tag-name new-tag-name" "Rename a tag, preserving associations"
(trace `(rename-tag ,old-name ,new-name))
- (exec rename-tag-stmt new-name old-name))
+ (exec (sql db "UPDATE tag SET name=? WHERE name=?;") new-name old-name))
;; Entry Protection
-(define get-protected-stmt
- (sql db "SELECT protected FROM entry WHERE id=?;"))
-(define set-protected-stmt
- (sql db "UPDATE entry SET protected=1,ptime=? WHERE id=?;"))
-(define tmp-protected-stmt
- (sql db "UPDATE entry SET protected=? WHERE id=?;"))
-(define unset-protected-stmt
- (sql db "UPDATE entry SET protected=0,ptime=NULL,mtime=? WHERE id=?;"))
-
(define (is-protected? entry-id)
- (not (= 0 (query fetch-value get-protected-stmt entry-id))))
+ (not (= 0
+ (query fetch-value
+ (sql db "SELECT protected FROM entry WHERE id=?;")
+ entry-id))))
(define-syntax unless-protected
(syntax-rules ()
@@ -289,12 +275,13 @@
(define (protect! time entry-id)
(trace `(protect! ,time ,entry-id))
- (exec tmp-protected-stmt 1 entry-id))
+ (exec (sql db "UPDATE entry SET protected=? WHERE id=?;") 1 entry-id))
(define (protect* ptime entry-id)
(trace `(protect ,ptime ,entry-id))
(unless-protected entry-id
- (exec set-protected-stmt ptime entry-id)))
+ (exec (sql db "UPDATE entry SET protected=1,ptime=? WHERE id=?;")
+ ptime entry-id)))
(defcmd (protect . args)
"[timestamp] [entry-id]" "Protect entries from modification"
@@ -307,11 +294,12 @@
(define (unprotect! time entry-id)
(trace `(unprotect! ,time ,entry-id))
- (exec tmp-protected-stmt 0 entry-id))
+ (exec (sql db "UPDATE entry SET protected=? WHERE id=?;") 0 entry-id))
(define (unprotect* mtime entry-id)
(trace `(unprotect ,mtime ,entry-id))
- (exec unset-protected-stmt mtime entry-id))
+ (exec (sql db "UPDATE entry SET protected=0,ptime=NULL,mtime=? WHERE id=?;")
+ mtime entry-id))
(defcmd (unprotect . args)
"[timestamp] [entry-id]" "Unprotect entries from modification"
@@ -342,29 +330,6 @@
;; Entry Management
-(define add-entry-stmt
- (sql db "INSERT INTO entry(url, notes, ctime, mtime) VALUES (?, ?, ?, ?);"))
-(define auto-tag-stmt
- (sql db "INSERT INTO tagrel SELECT ?,id FROM tag WHERE auto = 1;"))
-(define find-entry-stmt
- (sql db "SELECT id FROM entry WHERE url=?;"))
-(define random-tagged-stmt
- (sql db "SELECT url_id FROM tagrel WHERE tag_id IN (SELECT id FROM tag WHERE name=?) ORDER BY RANDOM() LIMIT 1;"))
-(define random-untagged-stmt
- (sql db "SELECT id FROM entry WHERE id NOT IN (SELECT url_id FROM tagrel) ORDER BY RANDOM() LIMIT 1;"))
-(define list-tagged-stmt
- (sql db "SELECT * FROM (SELECT id,url,notes FROM entry WHERE id IN (SELECT url_id FROM tagrel WHERE tag_id IN (SELECT id FROM tag WHERE name=?)) ORDER BY id DESC LIMIT ?) ORDER BY id ASC;"))
-(define list-untagged-stmt
- (sql db "SELECT id,url,notes FROM entry WHERE id NOT IN (SELECT url_id FROM tagrel);"))
-(define select-entry-stmt
- (sql db "SELECT id,url,type,description,notes,protected,ptime,ctime,mtime FROM entry WHERE id=?;"))
-(define set-descr-stmt
- (sql db "UPDATE entry SET type=?,description=?,mtime=? WHERE id=?;"))
-(define set-notes-stmt
- (sql db "UPDATE entry SET notes=?,mtime=? WHERE id=?;"))
-(define touch-entry-stmt
- (sql db "UPDATE entry SET mtime=? WHERE id=?;"))
-
(define cur-entry
(query fetch-value
(sql/transient db "SELECT id FROM entry ORDER BY id DESC LIMIT 1;")))
@@ -385,9 +350,11 @@
(let ((new-id
(with-transaction db
(lambda ()
- (exec add-entry-stmt url notes ctime ctime)
+ (exec (sql db "INSERT INTO entry(url,notes,ctime,mtime) VALUES (?,?,?,?);")
+ url notes ctime ctime)
(let ((new-id (last-insert-rowid db)))
- (exec auto-tag-stmt new-id)
+ (exec (sql db "INSERT INTO tagrel SELECT ?,id FROM tag WHERE auto=1;")
+ new-id)
new-id)))))
(set! cur-entry new-id)
(write-line (conc "Added " new-id))))
@@ -407,9 +374,11 @@
(trace `(add-notes ,mtime ,entry-id . ,lines))
(with-transaction db
(lambda ()
- (let ((prev-notes (list-ref (query fetch-row select-entry-stmt entry-id) 4)))
+ (let ((prev-notes (query fetch-value
+ (sql db "SELECT notes FROM entry WHERE id=?;")
+ entry-id)))
(unless-protected entry-id
- (exec set-notes-stmt
+ (exec (sql db "UPDATE entry SET notes=?,mtime=? WHERE id=?;")
(apply string-append prev-notes
(map terminate-line lines))
mtime
@@ -420,19 +389,10 @@
"Append new lines of notes"
(apply add-notes* (time-id-strings args)))
-(define (print-entry-row row)
- (let ((id (list-ref row 0))
- (url (list-ref row 1))
- (type (list-ref row 2))
- (descr (list-ref row 3))
- (notes (list-ref row 4))
- (protected? (not (= 0 (list-ref row 5))))
- (ptime (list-ref row 6))
- (ctime (list-ref row 7))
- (mtime (list-ref row 8)))
- (write-line (conc vt100-entry-header
- "#" id (if protected? "*" "") " - " url
- vt100-reset))
+(define (print-entry-row id url type descr notes protected ptime ctime mtime)
+ (write-line (conc vt100-entry-header
+ "#" id (if (zero? protected) "" "*") " - " url
+ vt100-reset))
(unless (null? ctime) (write-line (conc "Created " (rfc-3339 ctime))))
(unless (null? ptime) (write-line (conc "Protected " (rfc-3339 ptime))))
(unless (null? mtime) (write-line (conc "Modified " (rfc-3339 mtime))))
@@ -443,7 +403,7 @@
(write-string descr))
(unless (null? notes)
(write-line (conc "Notes:"))
- (write-string notes))))
+ (write-string notes)))
(define (print-listed-entry-row row)
(write-line (conc vt100-entry-header
@@ -452,20 +412,39 @@
(write-string (caddr row)))
(define (print-entry* entry-id)
- (query (for-each-row print-entry-row)
- select-entry-stmt
- entry-id))
+ (query (for-each-row* print-entry-row)
+ (sql db "SELECT id,url,type,description,notes,
+ protected,ptime,ctime,mtime
+ FROM entry WHERE id=?;")
+ entry-id)
+ (write-line
+ (string-intersperse
+ (cons "Tags:"
+ (query (map-rows car)
+ (sql db "SELECT tag.name FROM tagrel
+ OUTER LEFT JOIN tag ON tagrel.tag_id=tag.id
+ WHERE url_id=? ORDER BY tag.name;")
+ entry-id))
+ " ")))
(defcmd (list-tagged tag-name . args)
"tag-name [limit]" "Display entries with the given tag"
(query (for-each-row print-listed-entry-row)
- list-tagged-stmt
+ (sql db "SELECT * FROM
+ (SELECT id,url,notes FROM entry
+ WHERE id IN (SELECT url_id FROM tagrel
+ WHERE tag_id IN (SELECT id FROM tag
+ WHERE name=?))
+ ORDER BY id DESC LIMIT ?)
+ ORDER BY id ASC;")
tag-name
(if (null? args) 10 (car args))))
(defcmd (list-untagged)
"" "Display entries without any tag"
- (query (for-each-row print-listed-entry-row) list-untagged-stmt))
+ (query (for-each-row print-listed-entry-row)
+ (sql db "SELECT id,url,notes FROM entry
+ WHERE id NOT IN (SELECT url_id FROM tagrel);")))
(defcmd (print-entry . args)
"[entry-id]" "Display an entry"
@@ -478,7 +457,11 @@
(defcmd (random-tagged tag-name)
"tag" "Select a random entry with the given tag"
- (let ((entry-id (query fetch-value random-tagged-stmt tag-name)))
+ (let ((entry-id (query fetch-value
+ (sql db "SELECT url_id FROM tagrel WHERE tag_id IN
+ (SELECT id FROM tag WHERE name=?)
+ ORDER BY RANDOM() LIMIT 1;")
+ tag-name)))
(if entry-id
(begin
(set! cur-entry entry-id)
@@ -487,7 +470,10 @@
(defcmd (random-untagged)
"" "Select a random entry without tag"
- (let ((entry-id (query fetch-value random-untagged-stmt)))
+ (let ((entry-id (query fetch-value
+ (sql db "SELECT id FROM entry WHERE id NOT IN
+ (SELECT url_id FROM tagrel)
+ ORDER BY RANDOM() LIMIT 1;"))))
(if entry-id
(begin
(set! cur-entry entry-id)
@@ -503,7 +489,8 @@
(define (set-descr* mtime entry-id type text)
(trace `(set-descr ,mtime ,entry-id ,type ,text))
- (exec set-descr-stmt type text mtime entry-id))
+ (exec (sql db "UPDATE entry SET type=?,description=?,mtime=? WHERE id=?;")
+ type text mtime entry-id))
(defcmd (set-descr first . args)
"[[[mtime] entry-id] type] description" "Sets an entry description"
@@ -520,7 +507,9 @@
(set! cur-entry arg)
(when config-verbose (print-entry)))
((string? arg)
- (let ((id (query fetch-value find-entry-stmt arg)))
+ (let ((id (query fetch-value
+ (sql db "SELECT id FROM entry WHERE url=?;")
+ arg)))
(if id
(begin
(set! cur-entry id)
@@ -531,7 +520,7 @@
(define (touch* mtime entry-id)
(trace `(touch ,mtime ,entry-id))
(unless-protected entry-id
- (exec touch-entry-stmt mtime entry-id)))
+ (exec (sql db "UPDATE entry SET mtime=? WHERE id=?;") mtime entry-id)))
(define (touch . args)
(cond ((null? args)
@@ -547,19 +536,13 @@
;; Entry Tagging
-(define exclude-tag-stmt
- (sql db "DELETE FROM tagrel WHERE url_id=? AND tag_id=?;"))
-(define include-tag-stmt
- (sql db "INSERT OR IGNORE INTO tagrel VALUES (?, ?);"))
-(define select-tags-stmt
- (sql db "SELECT tag.name FROM tagrel OUTER LEFT JOIN tag ON tagrel.tag_id = tag.id WHERE url_id=? ORDER BY tag.name;"))
-(define get-tag-id-stmt
- (sql db "SELECT id FROM tag WHERE name = ?;"))
-
(define (print-tags* entry-id)
(write-line (apply conc (append (list "Tags for " entry-id ":")
(query (map-rows (lambda (x) (string-append " " (car x))))
- select-tags-stmt entry-id)))))
+ (sql db "SELECT tag.name FROM tagrel
+ OUTER LEFT JOIN tag ON tagrel.tag_id=tag.id
+ WHERE url_id=? ORDER BY tag.name;")
+ entry-id)))))
(defcmd (print-tags . args)
"[entry-id ...]" "Print tags associated with an entry"
@@ -575,8 +558,11 @@
(lambda ()
(let loop ((todo tag-list))
(if (null? todo)
- (exec touch-entry-stmt mtime entry-id)
- (let ((tag-id (query fetch-value get-tag-id-stmt (car todo))))
+ (exec (sql db "UPDATE entry SET mtime=? WHERE id=?;")
+ mtime entry-id)
+ (let ((tag-id (query fetch-value
+ (sql db "SELECT id FROM tag WHERE name=?;")
+ (car todo))))
(if tag-id
(unless-protected entry-id
(exec stmt entry-id tag-id))
@@ -587,7 +573,8 @@
(define (tag* mtime entry-id tag-list)
(unless (null? tag-list)
(trace `(tag ,mtime ,entry-id . ,tag-list))
- (exec-on-tags include-tag-stmt mtime entry-id tag-list)))
+ (exec-on-tags (sql db "INSERT OR IGNORE INTO tagrel VALUES (?,?);")
+ mtime entry-id tag-list)))
(defcmd (tag . args)
"[[timestamp] entry-id] tag-name [tag-name ...]"
@@ -597,7 +584,8 @@
(define (untag* mtime entry-id tag-list)
(unless (null? tag-list)
(trace `(untag ,mtime ,entry-id . ,tag-list))
- (exec-on-tags exclude-tag-stmt mtime entry-id tag-list)))
+ (exec-on-tags (sql db "DELETE FROM tagrel WHERE url_id=? AND tag_id=?;")
+ mtime entry-id tag-list)))
(defcmd (untag . args)
"[[timestamp] entry-id] tag-name [tag-name ...]"
@@ -659,7 +647,10 @@
(atom:link (@ (rel "related") (href ,url)))
,(atom-content type descr notes)
,@(query (map-rows (lambda (x) `(atom:category (@ (term ,(car x))))))
- select-tags-stmt id)))
+ (sql db "SELECT tag.name FROM tagrel
+ OUTER LEFT JOIN tag ON tagrel.tag_id=tag.id
+ WHERE url_id=? ORDER BY tag.name;")
+ id)))
(define (write-feed stmt mtime title self)
(write-string
