diff options
| -rw-r--r-- | nar-herder/database.scm | 65 | ||||
| -rw-r--r-- | scripts/nar-herder.in | 24 |
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)))))) |