136 lines
4.2 KiB
Racket
136 lines
4.2 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/contract
|
|
racket/serialize
|
|
racket/port
|
|
db
|
|
)
|
|
|
|
(provide ks-open
|
|
ks-set!
|
|
ks-get
|
|
ks-drop!
|
|
ks-exists?
|
|
ks-keys
|
|
ks-keys-glob
|
|
ks-key-values-glob
|
|
ks-key-values
|
|
ks-key-values-raw
|
|
ks-keys-raw
|
|
)
|
|
|
|
(define-struct keystore
|
|
(file path dbh)
|
|
#:transparent
|
|
)
|
|
|
|
(define/contract (ks-open file)
|
|
(-> (or/c path? string? symbol?) keystore?)
|
|
(let ((path (if (symbol? file)
|
|
(build-path (find-system-path 'cache-dir) (format "ks-~a.db" file))
|
|
(build-path file))))
|
|
(let ((dbh (sqlite3-connect #:database path #:mode 'create)))
|
|
(query-exec dbh "CREATE TABLE IF NOT EXISTS keystore(key varchar primary key, value varchar, str_key varchar);")
|
|
(query-exec dbh "CREATE INDEX IF NOT EXISTS keystore_idx on keystore(str_key);")
|
|
(make-keystore file path dbh))))
|
|
|
|
(define/contract (ks-set! ksh key value)
|
|
(-> keystore? any/c any/c boolean?)
|
|
(ks-set!* (keystore-dbh ksh) (value->string key) (format "~a" key) (value->string value)))
|
|
|
|
(define/contract (ks-exists? ksh key)
|
|
(-> keystore? any/c boolean?)
|
|
(ks-exists?* (keystore-dbh ksh) (value->string key)))
|
|
|
|
(define/contract (ks-get ksh key . default-value)
|
|
(-> keystore? any/c ... any/c any/c)
|
|
(ks-get* (keystore-dbh ksh) (value->string key) default-value))
|
|
|
|
(define/contract (ks-drop! ksh key)
|
|
(-> keystore? any/c boolean?)
|
|
(ks-drop!* (keystore-dbh ksh) (value->string key)))
|
|
|
|
(define/contract (ks-key-values-glob ksh gl)
|
|
(-> keystore? string? list?)
|
|
(map (λ (row)
|
|
(cons (string->value (vector-ref row 0)) (string->value (vector-ref row 1))))
|
|
(query-rows (keystore-dbh ksh)
|
|
"SELECT key, value FROM keystore WHERE str_key GLOB $1"
|
|
(string-downcase gl))))
|
|
|
|
(define/contract (ks-keys-glob ksh sqlite-like)
|
|
(-> keystore? string? list?)
|
|
(map (λ (row)
|
|
(string->value (vector-ref row 0)))
|
|
(query-rows (keystore-dbh ksh)
|
|
"SELECT key FROM keystore WHERE str_key GLOB $1"
|
|
(string-downcase sqlite-like))))
|
|
|
|
(define/contract (ks-keys ksh)
|
|
(-> keystore? list?)
|
|
(ks-keys* (keystore-dbh ksh)))
|
|
|
|
(define/contract (ks-key-values ksh)
|
|
(-> keystore? list?)
|
|
(ks-key-values* (keystore-dbh ksh)))
|
|
|
|
(define/contract (ks-keys-raw ksh)
|
|
(-> keystore? list?)
|
|
(map vector->list
|
|
(query-rows (keystore-dbh ksh) "SELECT key, str_key FROM keystore")))
|
|
|
|
(define/contract (ks-key-values-raw ksh)
|
|
(-> keystore? list?)
|
|
(map vector->list
|
|
(query-rows (keystore-dbh ksh) "SELECT key, str_key, value FROM keystore")))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Internal working
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(define (ks-set!* dbh key str-key value)
|
|
(query-exec dbh "INSERT OR REPLACE INTO keystore VALUES($1, $2, $3)"
|
|
key value (string-downcase str-key))
|
|
#t)
|
|
|
|
(define (ks-exists?* dbh key)
|
|
(> (query-value dbh "SELECT COUNT(*) FROM keystore WHERE key = $1" key) 0))
|
|
|
|
(define (ks-get* dbh key default-value)
|
|
(if (ks-exists?* dbh key)
|
|
(string->value (query-value dbh "SELECT value FROM keystore WHERE key = $1" key))
|
|
(if (null? default-value)
|
|
'ks-nil
|
|
(car default-value))
|
|
)
|
|
)
|
|
|
|
(define (ks-drop!* dbh key)
|
|
(query-exec dbh "DELETE FROM keystore WHERE key = $1" key)
|
|
#t)
|
|
|
|
(define (ks-keys* dbh)
|
|
(map (λ (row)
|
|
(string->value (vector-ref row 0)))
|
|
(query-rows dbh "SELECT key FROM keystore")))
|
|
|
|
(define (ks-key-values* dbh)
|
|
(map (λ (row)
|
|
(cons (string->value (vector-ref row 0))
|
|
(string->value (vector-ref row 1))))
|
|
(query-rows dbh "SELECT key, value FROM keystore")))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; serialization
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (value->string v)
|
|
(call-with-output-string
|
|
(λ (out) (write (serialize v) out))))
|
|
|
|
(define (string->value v)
|
|
(deserialize
|
|
(call-with-input-string v (λ (in) (read in)))))
|
|
|