changed key handling.

This commit is contained in:
2026-06-30 10:33:57 +02:00
parent dde77071c2
commit 3f468504a6
+29 -17
View File
@@ -56,24 +56,24 @@
(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)))
(ks-set!* (keystore-dbh ksh) (key->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)))
(ks-exists?* (keystore-dbh ksh) (key->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))
(ks-get* (keystore-dbh ksh) (key->string key) default-value))
(define/contract (ks-drop! ksh key)
(-> keystore? any/c boolean?)
(ks-drop!* (keystore-dbh ksh) (value->string key)))
(ks-drop!* (keystore-dbh ksh) (key->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))))
(cons (string->key (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))))
@@ -87,7 +87,7 @@
(define/contract (ks-keys-glob ksh sqlite-like)
(-> keystore? string? list?)
(map (λ (row)
(string->value (vector-ref row 0)))
(string->key (vector-ref row 0)))
(query-rows (keystore-dbh ksh)
"SELECT key FROM keystore WHERE str_key GLOB $1"
(string-downcase sqlite-like))))
@@ -171,12 +171,12 @@
(define (ks-keys* dbh)
(map (λ (row)
(string->value (vector-ref row 0)))
(string->key (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))
(cons (string->key (vector-ref row 0))
(string->value (vector-ref row 1))))
(query-rows dbh "SELECT key, value FROM keystore")))
@@ -185,14 +185,26 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (value->string v)
(if (string? v)
v
(call-with-output-string
(λ (out) (write (serialize v) out)))))
(call-with-output-string
(λ (out) (write (serialize v) out))))
(define (string->value v)
(if (and (string-prefix? v "((") (string-suffix? v ")"))
(deserialize
(call-with-input-string v (λ (in) (read in))))
v))
(deserialize
(call-with-input-string v (λ (in) (read in)))))
(define (key->string v)
(cond
((string? v) v)
((symbol? v) (string-append "@S:" (symbol->string v)))
((number? v) (string-append "@N:" (number->string v)))
(else (string-append "@SER:" (call-with-output-string
(λ (out) (write (serialize v) out))))))
)
(define (string->key v)
(cond
((string-prefix? v "@S:") (string->symbol (substring v 3)))
((string-prefix? v "@N:") (string->number (substring v 3)))
((string-prefix? v "@SER:") (string->value (substring v 5)))
(else v)))