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

KindCoveredAll%
expression0153 0.0
branch08 0.0
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
 ;;; application/link-format
6
 ;;; encodes time maps as http link headers
7
 
8
 #|
9
 the xample from http://www.mementoweb.org/guide/quick-intro/
10
 
11
 <http://a.example.org>;rel="original",
12
 <http://arxiv.example.net/timemap/http://a.example.org>; rel="timemap";type="application/link-format",
13
 <http://arxiv.example.net/timegate/http://a.example.org>; rel="timegate",
14
 <http://arxiv.example.net/web/20000620180259/http://a.example.org>; rel="first memento";datetime="Tue, 20 Jun 2000 18:02:59 GMT", 
15
 <http://arxiv.example.net/web/20091027204954/http://a.example.org>; rel="last memento";datetime="Tue, 27 Oct 2009 20:49:54 GMT",
16
 <http://arxiv.example.net/web/20000621011731/http://a.example.org>; rel="memento";datetime="Wed, 21 Jun 2000 01:17:31 GMT",
17
 <http://arxiv.example.net/web/20000621044156/http://a.example.org>; rel="memento";datetime="Wed, 21 Jun 2000 04:41:56 GMT"
18
          
19
 |#
20
 
21
 ;;; no reading
22
 
23
 (defgeneric write-rdf-link-format (results stream)
24
   (:documentation "Encode the timemap as link-format")
25
   
26
   (:method ((results cons) (stream t))
27
     ;; extract and encode
28
     ;; - the original resource,
29
     ;; - the timegate (which should be the same),
30
     ;; - the timemap (which is a dependent urn), and
31
     ;; -the uri's for all revisions.
32
     (let ((count 0))
33
       (labels ((find-subject (&key p o)
34
                  (first (find-statement :p p :o o)))
35
                (find-object (&key s p)
36
                  (third (find-statement :s s :p p)))
37
                (find-statement (&key s p o)
38
                  (loop for statement in results
39
                        for (map-s map-p map-o) = statement
40
                        when (and (term= s map-s) (term= p map-p) (term= o map-o))
41
                        do (return statement)
42
                        finally (error "no timemap statement found for :s ~s :p ~s :o ~s:~%~:w" s p o results)))
43
                (term= (test value)
44
                  (or (null test) (equalp test value)))
45
                (encode-link (subject &key datetime rel type)
46
                  (format stream "~:[~;,~]~&~a~@[;rel=~s~]~@[;datetime=~s~]~@[;type=~s~]"
47
                          (plusp (shiftf count (1+ count)))
48
                          subject rel datetime type))
49
                (collect-revision-information ()
50
                  (let* ((memento-uris (loop for (map-s map-p map-o) in results
51
                                             when (and (equalp map-p |rdf|:|type|)
52
                                                       (equalp map-o <http://www.mementoweb.org/terms/tb/Memento>))
53
                                             collect map-s))
54
                         (period-nodes (loop for uri in memento-uris
55
                                             collect (find-object :s uri :p <http://www.mementoweb.org/terms/tb/validOver>)))
56
                         (period-ends (loop for node in period-nodes
57
                                            collect (find-object :s node :p <http://www.mementoweb.org/terms/tb/start>))))
58
                    (loop for uri in memento-uris
59
                          for end in period-ends
60
                          collect (list uri end)))))
61
         (let ((repository-uri (find-subject :p |rdf|:|type| :o <http://www.mementoweb.org/terms/tb/OriginalResource>))
62
               (timegate-uri (find-subject :p |rdf|:|type| :o <http://www.mementoweb.org/terms/tb/TimeGate>))
63
               (timemap-uri (find-subject :p |rdf|:|type| :o <http://www.mementoweb.org/terms/tb/TimeMap>)))
64
           (encode-link repository-uri :rel "original")
65
           (encode-link timemap-uri :rel "timemap" :type "application/link-format")
66
           (encode-link timegate-uri :rel "timegate")
67
           (loop for (revision-uri end-time) in (collect-revision-information)
68
                 do (encode-link revision-uri :rel "memento" :datetime (encode-rfc1123 end-time))))
69
         (terpri stream)
70
         (incf-stat *solutions-constructed* (length results))
71
         (incf-stat *statements-returned* count))))
72
 
73
   (:method ((field list-solution-field) (stream t))
74
     (write-rdf-link-format (solution-field-solutions field) stream))
75
   )
76
 
77
 
78
 
79
 ;;;
80
 
81
 (defmethod send-response-message ((operation (eql :|timemap|)) (message t) (stream t) (content-type mime:application/link-format))
82
   "Given a TIMEMAP, and a STREAM with the application/link-format CONTENT-TYPE, encode HTTP link headers"
83
   (when *encoding-trace-output*
84
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
85
   (let ((*package* *spocq-reader-package*))
86
     (write-rdf-link-format message stream)))
87
 
88
 (defmethod send-response-message ((operation t) (message t) (stream t) (content-type mime:application/link-format))
89
   "Given a TIMEMAP, and a STREAM with the application/link-format CONTENT-TYPE, encode HTTP link headers"
90
   (when *encoding-trace-output*
91
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
92
   (let ((*package* *spocq-reader-package*))
93
     (write-rdf-link-format message stream)))
94
 
95
 (defmethod send-response-message ((operation (eql :|timemap|)) (message t) (stream t) (content-type mime:*/*))
96
   (send-response-message operation message stream mime:text/plain))