Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/redis.lisp

KindCoveredAll%
expression078 0.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 ;;; minimal redis support
6
 
7
 (defpackage :de.setf.redis (:use) (:nicknames :redis))
8
 
9
 (defmacro with-redis-connection ((&optional (uri *redis-host*)) &body body)
10
   `(flet ((.redis-op. (*redis-host*) ,@body))
11
      (declare (dynamic-extent #'.redis-op.))
12
      (call-with-redis-connection #'.redis-op. ,uri)))
13
 
14
 (defgeneric call-with-redis-connection (function host)
15
   (:method (function (host string))
16
     (call-with-redis-connection function (puri:uri host)))
17
   (:method (function (host puri:uri))
18
     (usocket:with-client-socket (socket stream (puri:uri-host host) (or (puri:uri-port host) *redis-port*))
19
       (call-with-redis-connection function stream)))
20
   (:method (function (stream stream))
21
     (funcall function stream)))
22
 
23
 
24
 (defmacro def-redis-op (name arguments &body body)
25
   (let ((host-op-name (cons-symbol :redis :host- name)))
26
     `(progn (defgeneric ,host-op-name (host ,@arguments)
27
               (:method ((host puri:uri) ,@arguments)
28
                 (usocket:with-client-socket (socket stream (puri:uri-host host) (or (puri:uri-port host) *redis-port*))
29
                   (let ((pw (puri:uri-password host)))
30
                     (when (plusp (length pw))
31
                       (format stream "AUTH ~a~%" pw)))
32
                   (,host-op-name stream ,@arguments)))
33
               (:method ((*redis-host* stream) ,@arguments)
34
                 ,@body))
35
             (defun ,name ,arguments
36
               (,host-op-name *redis-host* ,@arguments)))))
37
             
38
 
39
 (defun make-redis-key (string)
40
   (let* ((length (length string))
41
          (buffer-length (* length 4))
42
          (buffer (make-array buffer-length :element-type '(unsigned-byte 8)))
43
          (count 0)
44
          (encoder (load-time-value (content-encoding-byte-encoder (content-encoding :utf-8)))))
45
     (flet ((buffer-insert-byte (buffer byte)
46
              (declare (type (array (unsigned-byte 8) (*)) buffer))
47
              (declare (type (unsigned-byte 8) byte))
48
              ;; check bounds here as it's finally the encoded positioning
49
              (assert (< count buffer-length) () "redis key overrun.")
50
              (setf (aref buffer count) byte)
51
              (incf count)))
52
       (declare (dynamic-extent #'buffer-insert-byte))    ; just in case
53
       (dotimes (i length) 
54
         (funcall encoder (char string i) #'buffer-insert-byte buffer))
55
       (with-output-to-string (stream)
56
         (map nil #'(lambda (x) (format stream "~(~2,'0x~)" x))
57
              (ironclad:digest-sequence 'ironclad:sha1 buffer :end count))))))
58
 ;; (make-redis-key "asdf") (make-redis-key "")
59
 ;; (make-redis-key (de.setf.utility.codecs:buffer-get-string-utf8-8 (make-array 14 :element-type '(unsigned-byte 8) :initial-contents #(13 #o351 #o243 #o237 #o072 #o351 #o243 #o237 #o343 #o201 #o271 #o343 #o202 #o213)) 0))
60
     
61
 
62
 (defgeneric redis-key (object)
63
   (:method ((object null))
64
     *redis-default-graph-id*)
65
   (:method ((object t))
66
     (or (get-registry object *redis-keys*)
67
         (let ((rdf-string (with-output-to-string (stream) (write-ssf object stream))))
68
           (setf (get-registry object *redis-keys*) (make-redis-key rdf-string))))))
69
 
70
 
71
 #+(or)
72
 (def-redis-op redis::scard (repository set)
73
   (format *redis-host* "scard ~a:~a:~a~%"
74
           *redis-store-name* (repository-id repository) set)
75
   (finish-output *redis-host*)
76
   (peek-char #\: *redis-host*)
77
   (read-char *redis-host*)
78
   (read *redis-host*))
79
 
80
 (defun redis::scard (repository set)
81
   (declare (ignore repository set))
82
   1)
83
 
84
 ;; (redis::scard "jhacker/sp2b-250k" *redis-default-graph-id*)
85
 
86
 #+(or)
87
 (def-redis-op redis::term-count (repository term)
88
   (let ((temp-id (uuid:make-v1-uuid ))
89
         (term-key (redis-key term)))
90
     (format *redis-host* "sinterstore ~a ~a:~a:~a datagraph:term:~a~%"
91
             temp-id *redis-store-name* (repository-id repository) *redis-default-graph-id* term-key)
92
     (prog1 (redis::host-scard *redis-host* repository temp-id)
93
       (format *redis-host* "del ~a~%" temp-id))))
94
 
95
 (defun redis::term-count (repository set)
96
   (declare (ignore repository set))
97
   1)
98
 
99
 ;;; (setq *redis-host* (puri:uri "redis://guest:guest@ec2-174-129-66-148.compute-1.amazonaws.com:6379"))
100
 ;;; (redis::term-count "jhacker/sp2b-250k" "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>")
101
 ;;; (redis::term-count "jhacker/sp2b-250k" "\"110\"^^<http://www.w3.org/2001/XMLSchema#integer>")
102
 ;;; (redis::term-count "jhacker/sp2b-250k" "\"Journal 1 (1940)\"^^<http://www.w3.org/2001/XMLSchema#string>")
103
 ;;; (redis::scard (repository "jhacker/type-promotion-type-promotion-30") *redis-default-graph-id*)