aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2022-03-13 11:40:49 +0000
committerChristopher Baines <mail@cbaines.net>2022-03-13 11:40:49 +0000
commit3a9964701b0520fec1efb2d58c4f5a9891deacd2 (patch)
treee118cbdb0ba2630cba86851a3d10134752bb6b5b
parentf69da3686583d53974e720a9e66103126631cb69 (diff)
downloadnar-herder-3a9964701b0520fec1efb2d58c4f5a9891deacd2.tar
nar-herder-3a9964701b0520fec1efb2d58c4f5a9891deacd2.tar.gz
Support inserting tags when inserting narinfos
This is the beginning of implementing support for tagging. The communicating of tags through changes still needs implementing.
-rw-r--r--nar-herder/database.scm65
-rw-r--r--scripts/nar-herder.in24
2 files changed, 85 insertions, 4 deletions
diff --git a/nar-herder/database.scm b/nar-herder/database.scm
index e8c8b8d..a1670ed 100644
--- a/nar-herder/database.scm
+++ b/nar-herder/database.scm
@@ -324,8 +324,48 @@ PRAGMA optimize;")))
id)))
+(define (tag->tag-id db key value)
+ (define (insert-tag)
+ (let ((statement
+ (sqlite-prepare
+ db
+ "
+INSERT INTO tags (key, value) VALUES (:key, :value)"
+ #:cache? #t)))
+
+ (sqlite-bind-arguments
+ statement
+ #:key key
+ #:value value)
+
+ (sqlite-step statement)
+ (sqlite-reset statement)
+
+ (last-insert-rowid db)))
+
+ (let ((statement
+ (sqlite-prepare
+ db
+ "
+SELECT id FROM tags WHERE key = :key AND value = :value"
+ #:cache? #t)))
+
+ (sqlite-bind-arguments
+ statement
+ #:key key
+ #:value value)
+
+ (match (let ((result (sqlite-step statement)))
+ (sqlite-reset statement)
+ result)
+ (#f
+ (insert-tag))
+ (#(id)
+ id))))
+
(define* (database-insert-narinfo database narinfo
- #:key change-datetime)
+ #:key change-datetime
+ (tags '()))
(define (insert-narinfo-record db)
(let ((statement
(sqlite-prepare
@@ -428,6 +468,26 @@ INSERT INTO recent_changes (
(sqlite-step statement)
(sqlite-reset statement)))
+ (define (insert-tags db narinfo-id tags)
+ (let ((statement
+ (sqlite-prepare
+ db
+ "
+INSERT INTO narinfo_tags (narinfo_id, tag_id) VALUES (:narinfo_id, :tag_id)"
+ #:cache? #t)))
+
+ (map (match-lambda
+ ((key . value)
+ (let ((tag-id (tag->tag-id db key value)))
+ (sqlite-bind-arguments
+ statement
+ #:narinfo_id narinfo-id
+ #:tag_id tag-id)
+
+ (sqlite-step statement)
+ (sqlite-reset statement))))
+ tags)))
+
(database-call-with-transaction
database
(lambda (db)
@@ -451,6 +511,9 @@ INSERT INTO recent_changes (
change-datetime)
(insert-change db (narinfo-contents narinfo)))
+ (unless (null? tags)
+ (insert-tags db narinfo-id tags))
+
narinfo-id))))
(define (database-select-narinfo-contents-by-hash database hash)
diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in
index 1cc5a67..0f4f7f2 100644
--- a/scripts/nar-herder.in
+++ b/scripts/nar-herder.in
@@ -77,6 +77,20 @@
`((database . ,(string-append (getcwd) "/nar_herder.db"))
(database-dump . ,(string-append (getcwd) "/nar_herder_dump.db"))))
+(define %import-options
+ (list (option '("tag") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'tags
+ (cons (match (string-split arg #\=)
+ ((key value)
+ (cons key value)))
+ (or (assq-ref result 'tags)
+ '()))
+ (alist-delete 'tags result))))))
+
+(define %import-options-defaults
+ '())
+
(define %server-options
(list (option '("port") #t #f
(lambda (opt name arg result)
@@ -172,8 +186,10 @@
(match (cdr (program-arguments))
(("import" rest ...)
- (let* ((opts (parse-options %base-options
- %base-option-defaults
+ (let* ((opts (parse-options (append %base-options
+ %import-options)
+ (append %base-option-defaults
+ %import-options-defaults)
rest))
(database (setup-database
(assq-ref opts 'database))))
@@ -212,7 +228,9 @@
(lambda (port)
;; Set url to a dummy value as this doesn't
;; matter
- (read-narinfo port "https://narherderdummyvalue"))))
+ (read-narinfo port "https://narherderdummyvalue")))
+ #:tags (or (assq-ref opts 'tags)
+ '()))
(report))
narinfos))))))