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

KindCoveredAll%
expression183750 24.4
branch840 20.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
 ;;;  This file contains the SPARQL parser interface for 'org.datagraph.spocq'
6
 ;;;
7
 ;;;  Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved
8
 
9
 
10
 
11
 (:documentation (receive-message send-error-message send-request-message send-response-message)
12
   "The content-type application/sparql-query indicates the message is to be coded
13
  as sparql.
14
 
15
  The grammar is specified by a rspective sparql-*-*-*.lisp file, each of which may be included
16
  in the system definition. Each yields a parsestate machine in its own package with an interface
17
  operator named respective the root production in the grammar. Various grammars are available
18
  alternative to the w3c standards:
19
 
20
  - virtuoso : http://docs.openlinksw.com/virtuoso/rdfsparql.html
21
  -
22
  ")
23
 
24
 ;;; set the default parser value - from among those known
25
 
26
 (setq *query-parser* (or (find-symbol "Sparql-Parser" (some #'find-package '(:sparql-1-0-5 :sparql-1-0-4)))
27
                          (find-symbol "Query-Parser" (some #'find-package '(:sparql-1-0-3 :sparql-1-0-2 :sparql-1-0)))))
28
 (assert (fboundp *query-parser*) ()
29
         "No query parser found.")
30
 
31
 (defparameter *literal-string-tokens* (make-hash-table :test 'eq :weakness :key :synchronized t)
32
   "Cache indicators for strings which designate string literals.
33
   As an eq hash table, it records specific strings which distinguishes lexical
34
   equivalents between and within parses.")
35
 
36
 
37
 ;;;
38
 ;;; interning sparql (sse) expressions:
39
 ;;; the initial results from parsing a query expression is an sse (symbolic sparql expression) which
40
 ;;; comprises operators and rdf terms. the terms are either
41
 ;;; - term structures which encapsulate the literal value and datatype uri or language tag
42
 ;;; - symbols, for uri in a defined vocabulary.
43
 ;;; in order to evaluate the query, the term must be replaced with the store's term identifiers in order
44
 ;;; to match against its content and to facilitate reduction operations. all terms in defined vocabularies
45
 ;;; are interned once the repository is attached and bound to there term identifier. other terms are interned
46
 ;;; on the fly. as the first step to compile the expression, the function intern-sse walks the expression tree
47
 ;;; interns any new terms and returns two values
48
 ;;; - the rewritten expression with the terms replaced by their term identifiers
49
 ;;; - a vector of new terms which have been replaced by the additive inverse of their ordinal number.
50
 ;;; the vector of transient term objects is transformed into one of external rdfcache terms and cached in the query.
51
 ;;; this is required for insertion/update operations.
52
 ;;;
53
 ;;; interning operates on three domains
54
 ;;; lexical-term :    (string x (uri + string))        : the parsed literal attributes from a sparql document
55
 ;;; spocq.e:term :    (number + string + spocq.e:term) : interned lisp object which represent terms
56
 ;;; rdfcache-term-id : integer                         : rdfcache term identifiers
57
 ;;;   zero designates no-value or unbound
58
 ;;;   positive designates a persistent term
59
 ;;;   negative designates a transient term
60
 ;;;
61
 ;;; a sparql document is first parsed to yield an sse. an sse is a combination of s-expressions, each of which
62
 ;;; expresses either an algebra operation, or an triple literal or pattern operation argument. an expression
63
 ;;; begins with a function name or a triple tag. the arguments are either further expressions or a
64
 ;;; spocq.e:term. this intermediate for preserves a readable query form at the cost of requiring a second
65
 ;;; translation to incorporate the rdfcache term identifiers for requests to the store.
66
 ;;; the translation happens during compilation rather than as a blanket re-write. this for three reasons:
67
 ;;; - constant arguments to sparql expression operators should stay in the spocq.e:term domain
68
 ;;; - ideomatic rewrites are easier to express for symbolic terms rather than term identifiers
69
 ;;; - ?
70
 ;;;
71
 ;;; noting that time to copy the global lexical->spocq term registry (@ a bit ovr 100 entries) is about thirty microseconds,
72
 ;;; the global registry is duplicated for independent use in each query. this eliminates simultaneous
73
 ;;; reader/writer access as the writing happens only when parsing. the spocq->store and store->spocq term
74
 ;;; registries must be multithreaded as the match compilation and streaming can involve more than one thread.
75
 ;;; this give a registry complement:
76
 ;;; *lexical->spocq-term-registry*  : a global binding with vocabulary terms
77
 ;;; *query-lexical->spocq-term-registry*  : a query-local version
78
 ;;; *task-spocq->store-term-registry* : a query-local map from spocq term to refcache term identifier
79
 ;;; *task-store->spocq-term-registry* : a query-local map from rdfcache term identifier to spocq term
80
 ;;; in addition, vocabulary terms cache their term identifier and their rdfcache term structure
81
 
82
 (defgeneric parse-sparql (input &key parser version base-iri namespace-bindings)
83
   (:documentation 
84
   "Parse the INPUT as a SPARQL document returning the sse, input token sequence and various options.
85
 
86
  INPUT : (or stream string pathname vector) : the sparql document or location
87
  :PARSER : symbol : the parser bnf identifier, eg. sparql-1-0-4:|Sparql-Parser|
88
  :BASE-IRI : string : the default base iri for relative iri in the document : default NIL
89
  :NAMESPACE-BINDINGS : (list (cons string . iri)) : the initial namespace bindings
90
 
91
  VALUES : query : list
92
           options : list
93
           tokens : vector
94
           token-index : integer
95
 
96
  Establish the initial dynamic bindings for the sparql parser and apply it to the given INPUT
97
  token sequence. Return the parsed query as an SSE form, a property list of the optional parameters,
98
  the document tokens, and the index of the last token in the complete parse or the last token examined for a failure.
99
  Iff the parse fails, the sse for is null. The option property list comprises
100
    :indices the counts for various generated terms
101
    :metadata the modified query metadata instance")
102
 
103
   (:method ((input vector) &rest options &key
104
             (version *query-parser*) (parser version)
105
             ;; permit all configuration parameters
106
             ((:dataset-graphs *dataset-graphs*) *dataset-graphs*)
107
             &allow-other-keys)
108
     (declare (dynamic-extent options))
109
     ;; ensure new configuration binding to capture parsed configuration and
110
     ;; for the use as a top-level operator, that is w/o bound *metadata*
111
     (with-instance-metadata (*metadata* :allow-other-keys t options)
112
       (let ((*max-input-index* 0)
113
             (atnp:*atn-term* nil)
114
             (*variables* ())
115
             (*task-indices* (make-task-indices)))
116
         (multiple-value-bind (result index success) (funcall parser input)
117
           (values result (list :indices *task-indices*
118
                                ;; return the new metadata
119
                                :dataset-graphs *dataset-graphs*
120
                                :metadata *metadata*)
121
                   input
122
                   (if success index *max-input-index*))))))
123
 
124
   (:method ((source string) &rest options)
125
     (declare (dynamic-extent options))
126
     (let ((*literal-string-tokens* *literal-string-tokens*) ;; (make-hash-table :test 'eq)) ;; should be a global hashtable with weak keys
127
           (lock (load-time-value (bt:make-lock "parse-sparql"))))
128
       (bt:with-lock-held (lock)
129
         (multiple-value-bind (input byte-offsets line-offsets) (tokenize-sparql source :start 0 :end (length source))
130
           (multiple-value-bind (sse-expression options query-input index)
131
                                (bt:with-timeout (*parse-sparql.timeout*) (apply #'parse-sparql input options))
132
             (if sse-expression
133
                 (values sse-expression options query-input index)
134
                 (flet ((_aref (array index)
135
                          (when (and (integerp index) (< index (length array))) (aref array index))))
136
                   (spocq.e::message-syntax-error :expression source
137
                                                  :token (_aref input index)
138
                                                  :byte-offset (_aref byte-offsets index)
139
                                                  :line-offset (_aref line-offsets index)))))))))
140
 
141
   (:method ((source pathname) &rest options)
142
     (declare (dynamic-extent options))
143
     (apply #'parse-sparql (read-file source) options))
144
 
145
   (:method ((source stream) &rest options)
146
     (declare (dynamic-extent options))
147
     (apply #'parse-sparql (read-stream source) options)))
148
 
149
 (defgeneric task-parse-sparql (task query-string &rest args &key
150
                                task-id
151
                                user-id
152
                                repository-id
153
                                dynamic-bindings
154
                                dataset-graphs
155
                                &allow-other-keys)
156
   (:documentation "Parse a sparql query string using an existing task as the
157
  context for defaults and error reporting.
158
  TASK : task : the context task
159
  QUERY-STRING : string : a sparql query
160
  VALUES :  QUERY-PROPERTIES : property-list : the results which from parsing the query text merging
161
            values from the context task as defaults.")
162
 
163
   (:method (task (source pathname) &rest options)
164
     (declare (dynamic-extent options))
165
     (apply #'task-parse-sparql task (read-file source) options))
166
 
167
   (:method (task (source stream) &rest options)
168
     (declare (dynamic-extent options))
169
     (apply #'task-parse-sparql task (read-stream source) options))
170
 
171
   (:method ((task task) (query-string string) &rest args &key
172
             (task-id (task-id task))
173
             (user-id (task-user-id task))
174
             (repository-id (task-repository-id task))
175
             (dynamic-bindings (query-dynamic-bindings task))
176
             (dataset-graphs (task-dataset-graphs task) dg-s)
177
             &allow-other-keys)
178
   (declare (dynamic-extent args))
179
   (with-configuration ()
180
     (labels ((tokenize-message (buffer)
181
                ;; read the query string - for sparql this should fit in to a single message, then
182
                ;; tokenize it an return the tokens with the position maps.
183
                (let ((length (length buffer)))
184
                  (when (and *query-maximum-length* (> length *query-maximum-length*))
185
                    (log-warn "Query length, ~d, exceeds ~d maximum: ~s"
186
                              length *query-maximum-length* (string-truncate buffer 32))
187
                    (spocq.e::message-length-error buffer))
188
                  (tokenize-sparql buffer :start 0 :end length)))
189
              (guarded-op (function)
190
                (let ((lock (load-time-value (bt:make-lock "task-parse-sparql"))))
191
                  (bt:with-lock-held (lock)
192
                    (handler-case (funcall function)
193
                      (error (condition)
194
                             (log-error "invalid sparql message body: ~s~%~a"
195
                                        query-string condition)
196
                             (syntax-error :condition condition))))))
197
              (syntax-error (&key (expression query-string) &allow-other-keys)
198
                (spocq.e:message-syntax-error :task (make-instance 'query-error-task
199
                                                      :id task-id
200
                                                      :user-id user-id
201
                                                      :repository-id repository-id
202
                                                      :request-routing-key nil
203
                                                      :request-exchange nil
204
                                                      :response-content-type nil)
205
                                              :operation nil
206
                                              :expression expression))
207
              (_aref (array index)
208
                (when (and (integerp index) (< index (length array))) (aref array index))))
209
       (let ((*literal-string-tokens* *literal-string-tokens*)) ;; (make-hash-table :test 'eq))
210
         (multiple-value-bind (input byte-offsets line-offsets)
211
                              (guarded-op #'(lambda () (tokenize-message query-string)))
212
           (log-info "task ~s~@[/~s~], repository ~s, query[~d]: '~a'"
213
                     task-id user-id repository-id (length query-string) (substitute #\space #.(code-char #o012) query-string))
214
           (multiple-value-bind (sse-expression options query-tokens index)
215
                                (guarded-op #'(lambda ()
216
                                                (with-metadata-bound (task :allow-other-keys t args)
217
                                                  (apply #'parse-sparql input args))))
218
             (cond (sse-expression
219
                    (list* :repository-id repository-id
220
                           :task-id task-id
221
                           :user-id user-id
222
                           :query-expression query-string
223
                           :sse-expression sse-expression
224
                           :dynamic-bindings dynamic-bindings
225
                           :graphs (if dg-s dataset-graphs *dataset-graphs*)
226
                           options))
227
                   (t
228
                    (log-notice "query parse failure for tokens: ~s" query-tokens)
229
                    (syntax-error :condition nil
230
                                  :token (_aref input index)
231
                                  :byte-offset (_aref byte-offsets index)
232
                                  :line-offset (_aref line-offsets index)))))))))))
233
 
234
 
235
 ;;;
236
 ;;; various data source interfaces
237
 ;;;  general streams
238
 ;;;  amqp streams : allow for out-of-band header information
239
 
240
 (defmethod receive-message ((stream amqp:channel) (content-type mime:application/sparql) &rest args)
241
   "Given an AMQP channel with application/sparql-query or -update CONTENT-TYPE, decode as a SPARQL query.
242
  Returns a property list which specifies the respository, task id ,and query sse expression and
243
  additional query properties as given in the message's basic headers:
244
  - graphs : a two-element list of the default and named graphs. These are taken from the
245
    FROM and FROM-NAMED clauses, or the default-graph-uri and named-graph-uri headers. The latter
246
    take precedence as per the rdf query [protocol (2.2.1.8)](http://www.w3.org/TR/rdf-sparql-protocol/#query-bindings-http)
247
  - routing key to route the response through the query exchange
248
  - trace routing key, to request and reoute trace message with compiled query content
249
  - an accept mime type
250
  - limit and offset constraints
251
 
252
  If the query string fails to parse, signal a message syntax error which captures the string and the position
253
  to which the parse had progressed.
254
 
255
  In some cases - named/default graphs, api-key, repository-id, a value can appear in both the document
256
  and the request header. In those cases, the header specification should override the other.
257
  "
258
 
259
   (with-header-configuration ((amqp:basic-headers (amqp:channel.basic stream)) args)
260
     (let* ((input "")
261
            (byte-offsets #())
262
            (line-offsets #())
263
            (query-prototype nil)
264
            (length (amqp.i::device-body-length stream))         ; sparql fits in a single message
265
            (buffer (make-array length :element-type 'character)))
266
 
267
       (labels ((tokenize-message (buffer)
268
                  ;; read the query string - for sparql this should fit in to a single message, then
269
                  ;; tokenize it an return the tokens with the position maps.
270
                  (let ((decoded-length (read-sequence buffer stream :start 0 :end (length buffer))))
271
                    (log-debug "receive-message: length from channel, ~d~@[/~d~]." decoded-length *query-maximum-length*)
272
                    (when (and *query-maximum-length* (> decoded-length *query-maximum-length*))
273
                      (log-warn "Query length, ~d, exceeds ~d maximum: ~s"
274
                                decoded-length *query-maximum-length* (string-truncate buffer 32))
275
                      (spocq.e::message-length-error buffer))
276
                    (tokenize-sparql buffer :start 0 :end decoded-length)))
277
                (guarded-op (function)
278
                  (let ((lock (load-time-value (bt:make-lock "receive-message"))))
279
                    (bt:with-lock-held (lock)
280
                      (handler-case (funcall function)
281
                        (error (condition)
282
                               (log-error "invalid sparql message body: ~s~%~a"
283
                                          buffer condition)
284
                               (syntax-error :condition condition))))))
285
                (syntax-error (&rest args &key (expression buffer) &allow-other-keys)
286
                  (apply #'spocq.e::message-syntax-error :task (make-instance 'query-error-task
287
                                                                 :repository-id *repository-id*
288
                                                                 :operation *operation*
289
                                                                 :request-exchange *request-exchange*
290
                                                                 :request-routing-key *request-routing-key*
291
                                                                 :response-content-type *response-content-type*
292
                                                                 :task-id *task-id*
293
                                                                 :user-id *user-id*)
294
                         :operation *operation*
295
                         :expression expression
296
                         args))
297
                (_aref (array index)
298
                  (when (and (integerp index) (< index (length array))) (aref array index))))
299
           
300
           (log-debug "task ~s: headers: ~{  ~a: ~s~}" *task-id* *request-headers*)
301
           (log-info "task ~s~@[/~s~], repository ~s, query[~d]: '~a'"
302
                     *task-id* *user-id* *repository-id* (length buffer) (substitute #\space #.(code-char #o012) buffer))
303
           ;; once the message has been read, first check if the repository is on-limits
304
           (when (find *repository-id* *disabled-repositories* :test #'string-equal)
305
             (syntax-error :expression "The repository has been disabled."))
306
           (unless *query-signature*
307
             (setf *query-signature* (make-sha1-digest (string-trim #(#\space #\return #\newline #\tab) buffer))))
308
 
309
           (setf query-prototype (find-query-prototype *repository-id* *query-signature* (first *dynamic-bindings*)))
310
           (cond (query-prototype
311
                  ;; give a prototype, clone it with any superseded values
312
                  (assert-prototype-metadata (instance-metadata query-prototype))
313
                  (values query-prototype
314
                          ;; copy indices from the clone
315
                          (list :dynamic-bindings *dynamic-bindings*
316
                                :end-time *end-time*
317
                                :dataset-graphs (case *dataset-source*   ; if not asserted by the request, then whatever came before
318
                                                  (:request *dataset-graphs*)
319
                                                  (t (task-dataset-graphs query-prototype)))
320
                                :metadata *metadata*
321
                                :repository-id *repository-id*
322
                                :request-exchange *request-exchange*
323
                                :request-routing-key *request-routing-key*
324
                                :response-content-type *response-content-type*
325
                                :revision-id *revision-id*
326
                                :signature *query-signature*
327
                                :task-id *task-id*
328
                                :user-id *user-id*
329
                                :time-interval *time-interval*
330
                                :trace-routing-key *trace-routing-key*
331
                                :agent-id *agent-id*
332
                                :agent-location *agent-location*)))
333
                 (t
334
                  (let ((*literal-string-tokens* *literal-string-tokens*)) ;; (make-hash-table :test 'eq)))
335
                    (guarded-op #'(lambda () 
336
                                    (multiple-value-setq (input byte-offsets line-offsets)
337
                                      (tokenize-message buffer))))
338
                    (multiple-value-bind (sse-expression options query-tokens index)
339
                                         (guarded-op #'(lambda () (parse-sparql input)))
340
                      (cond (sse-expression ; operation)
341
                             (values (first sse-expression) ; operation
342
                                     (list* :dynamic-bindings *dynamic-bindings*
343
                                            :end-time *end-time*
344
                                            :dataset-graphs *dataset-graphs*      ; as parsed when not asserted by the request
345
                                            :repository-id *repository-id*
346
                                            :request-exchange *request-exchange*
347
                                            :request-routing-key *request-routing-key*
348
                                            :response-content-type *response-content-type*
349
                                            :revision-id *revision-id*
350
                                            :signature *query-signature*
351
                                            :sse-expression sse-expression
352
                                            :task-id *task-id*
353
                                            :user-id *user-id*
354
                                            :time-interval *time-interval*
355
                                            :trace-routing-key *trace-routing-key*
356
                                            :query-expression buffer
357
                                            :agent-id *agent-id*
358
                                            :agent-location *agent-location*
359
                                            options
360
                                            )))
361
                            (t
362
                             (log-notice "query parse failure for tokens: ~s" query-tokens)
363
                             (syntax-error :condition nil
364
                                           :token (_aref input index)
365
                                           :byte-offset (_aref byte-offsets index)
366
                                           :line-offset (_aref line-offsets index))))))))))))
367
 
368
 
369
 (defmethod  receive-message ((stream stream) (content-type mime:application/sparql) &rest args)
370
   "Given a STREAM for any SPARQL content type, transform the stream into a string and delegate.
371
    if the stream is empty, cause an eof to be signaled"
372
   (apply #'receive-message (read-stream stream :eof-p t) content-type args))
373
 
374
 (defmethod receive-message ((message string) (content-type mime:application/sparql) &rest args)
375
   "Given a STRING with application/sparql-query CONTENT-TYPE, decode as a SPARQL query
376
  Returns an abbreviated property list which specifies just the query sse expression and the original text.
377
 
378
  As this input form permits neither default/named graphs nor namespace bindings, those are handled
379
  by the client.
380
 
381
  If the query string fails to parse, signal a message syntax error which captures the string and the position
382
  to which the parse had progressed.
383
  "
384
 
385
   (flet ((tokenize-message (message-buffer)
386
            ;; read the query string - for sparql this should fit in to a single message, then
387
            ;; tokenize it and return the tokens with the position maps.
388
            (let ((decoded-length (length message-buffer)))
389
              (log-debug "receive-message: length from stream, ~d~@[/~d~]." decoded-length *query-maximum-length*)
390
              (when (and *query-maximum-length* (> decoded-length *query-maximum-length*))
391
                (log-warn "Query length, ~d, exceeds ~d maximum: ~s"
392
                          decoded-length *query-maximum-length* (string-truncate message-buffer 32))
393
                (spocq.e::message-length-error message-buffer))
394
              (tokenize-sparql message-buffer :start 0 :end decoded-length)))
395
          (coerce-to-iri (value)
396
            (when (stringp value) (intern-iri value)))
397
          (when-integer (value)
398
            (when value (ignore-errors (parse-integer value)))))
399
     (let* ((buffer "")
400
            (input #())
401
            (byte-offsets #())
402
            (line-offsets #())
403
            ;; (operation :query)
404
            )
405
       (labels ((guarded-op (function)
406
                  (handler-case (funcall function)
407
                    ;; intercept errors which can be correlated to a query text location"
408
                    (invalid-token-error (condition)
409
                      (let* ((prefix (error-expression condition))
410
                             (position (position prefix input :test #'equalp))
411
                             (byte-offset (when position (_aref byte-offsets position)))
412
                             (line-offset (when position (_aref line-offsets position))))
413
                        (syntax-error :condition condition
414
                                      :token prefix
415
                                      :byte-offset byte-offset
416
                                      :line-offset line-offset)))
417
                    (error (condition)
418
                           (log-error "invalid sparql message body: ~s~%~a"
419
                                      buffer condition)
420
                           (syntax-error :condition condition))))
421
                (syntax-error (&rest args)
422
                  (apply #'spocq.e::message-syntax-error :task (make-instance 'query-error-task
423
                                                                 :id *task-id*
424
                                                                 :user-id *user-id*
425
                                                                 :repository-id *repository-id*
426
                                                                 :revision-id *revision-id*
427
                                                                 ;; :operation operation
428
                                                                 :request-routing-key nil
429
                                                                 :request-exchange nil
430
                                                                 :accept nil)
431
                         ;; :operation operation
432
                         :expression buffer
433
                         args))
434
              (_aref (array index)
435
                (when (and (integerp index) (< index (length array))) (aref array index))))
436
         (let ((*literal-string-tokens* *literal-string-tokens*)) ;; (make-hash-table :test 'eq)))
437
           (multiple-value-setq (input byte-offsets line-offsets buffer)
438
             (guarded-op #'(lambda () (tokenize-message message))))
439
           (log-info "task ~s~@[/~s~], repository ~s, query[~d]: '~a'"
440
                     *task-id* *user-id* *repository-id* (length buffer) (substitute #\space #.(code-char #o012) buffer))
441
           (multiple-value-bind (sse-expression options query-input index)
442
                                (guarded-op #'(lambda () (apply #'parse-sparql input args)))
443
             (declare (ignore query-input))
444
             (if sse-expression
445
                 (values (first sse-expression) ; operation
446
                         (list* :query-expression buffer
447
                                :sse-expression sse-expression
448
                                options))
449
                 (syntax-error :condition nil
450
                               :token (_aref input index)
451
                               :byte-offset (_aref byte-offsets index)
452
                               :line-offset (_aref line-offsets index)))))))))
453
 
454
 
455
 ;;;
456
 ;;; grammar-specific parsers
457
 
458
 ;;; once a lock was added here, 400's in parse term were less.
459
 ;;; that had started with parallel short queries by the dozen.
460
 ;;; this, although the isolated test, below did not repeat the issue, so there must be
461
 ;;; something in the lexer or parser which is not thread-safe.
462
 ;;; perhaps, no error which all strings were the same?
463
 ;;; until the issue is isolated, repeat the parse if it fails
464
 
465
 (defparameter *parse-term.retries* 3)
466
 
467
 (defgeneric parse-term (input &key parser version production default)
468
   (:documentation 
469
   "Parse the INPUT as a single sparql term the interned term object and the input token.
470
 
471
  INPUT : (or stream string pathname vector) : the encoded term 
472
  :PARSER : symbol : the parser bnf identifier, eg. sparql-1-0-4:|GraphTerm|
473
  :DEFAULT : t : return value if the parse fails; if not supplied a failues signals and error
474
 
475
  the maximum length is limited to *query-maximum-length*.
476
  an oversize string signals a message-syntax-error. ng. the token vector length is not limited
477
 
478
  VALUES : query : list
479
           tokens : vector
480
           token-index : integer")
481
 
482
   (:method ((input vector) &key (version *query-parser*) (parser version) ((:base-iri *base-iri*) (base-iri))
483
             (production 'sparql-1-0-4::|GraphTerm|)
484
             default)
485
     (declare (ignore default))
486
     (let ((*task-indices* (make-task-indices))
487
           (*max-input-index* 0)
488
           (atnp:*atn-term* nil)
489
           (*variables* ()))
490
       (loop for retry from 1
491
         do (multiple-value-bind (result index success) (funcall parser input :start-name production)
492
           (if (or result (>= retry *parse-term.retries*))
493
               (return-from parse-term
494
                 (values result
495
                         input
496
                         (if success index *max-input-index*))))))))             
497
 
498
   (:method ((source string) &rest options &key (default nil d-s) &allow-other-keys)
499
     (declare (dynamic-extent options))
500
     (cond ((equal source "\"\"")
501
            ; avoid triple-quote parse error
502
            "")
503
           ((and *query-maximum-length* (> (length source) *query-maximum-length*))
504
            (log-warn "Term length, ~d, exceeds ~d maximum: ~s"
505
                      (length source) *query-maximum-length* (string-truncate source 32))
506
            (spocq.e::message-length-error source))
507
           (t
508
            (let ((lock (load-time-value (bt:make-lock "parse-term")))
509
                  (*literal-string-tokens* *literal-string-tokens*)) ;; (make-hash-table :test 'eq)))
510
              (bt:with-lock-held (lock)
511
                (multiple-value-bind (input byte-offsets line-offsets)
512
                                     (tokenize-sparql source :start 0 :end (length source))
513
                  (multiple-value-bind (sse-expression query-input index)
514
                                       (apply #'parse-term input options)
515
                    (cond (sse-expression
516
                           (values sse-expression query-input index))
517
                          (d-s
518
                           (values default query-input index))
519
                          (t
520
                           (log-warn "parse-term failed: ~s" (list :input input :query-input query-input :index index))
521
                           (flet ((_aref (array index)
522
                                    (when (and (integerp index) (< index (length array))) (aref array index))))
523
                             (spocq.e::message-syntax-error :expression source
524
                                                            :token (_aref input index)
525
                                                            :byte-offset (_aref byte-offsets index)
526
                                                            :line-offset (_aref line-offsets index))))))))))))
527
 
528
   (:method ((source pathname) &rest options)
529
     (declare (dynamic-extent options))
530
     (apply #'parse-term (read-file source) options))
531
 
532
   (:method ((source stream) &rest options)
533
     (declare (dynamic-extent options))
534
     (apply #'parse-term (read-file source) options)))
535
 
536
 ;;; this showed no failure
537
 ;;; (loop for i below 1000 do (let ((i i)) (bt:make-thread (lambda () (sleep (random 2)) (if (parse-term "\"1496401700684\"") (format t "~a " i) (print :failed))))))
538
 
539
 (defun parse-sparql-profile (input &rest options &key production)
540
   (declare (dynamic-extent options))
541
   (setf production (or (etypecase production
542
                          (null 'sparql-1-0-4::|Sparql|)
543
                          (string (find-symbol production :sparql-1-0-4))
544
                          (symbol (or (find-symbol (string production) :sparql-1-0-4)
545
                                      (get production :atn-start-name)
546
                                      (setf (get production :atn-start-name)
547
                                            (loop for symbol being each symbol in (find-package :sparql-1-0-4)
548
                                              when (string-equal production symbol)
549
                                              return symbol)))))
550
                        (error "invalid sparql profile ~s." production)))
551
   (apply #'parse-term input :production production options))
552
 
553
 (defun parse-quads (input &rest args)
554
   "Parse the INPUT as a quad list as per the SPARQL BNF.
555
 
556
  INPUT : (or stream string pathname vector) : the encoded term 
557
  :DEFAULT : t : return value if the parse fails; if not supplied a failues signals and error
558
 
559
  VALUES : query : list
560
           tokens : vector
561
           token-index : integer"
562
   (declare (dynamic-extent args))
563
   (apply #'parse-term input :production 'sparql-1-0-4::|Quads| args))
564
 
565
 
566
 (defun parse-values (input &rest args)
567
   "Parse the INPUT as a values clause as per the SPARQL BNF.
568
 
569
  INPUT : (or stream string pathname vector) : the encoded term
570
  :DEFAULT : t : return value if the parse fails; if not supplied a failues signals and error
571
 
572
  VALUES : query : list
573
           tokens : vector
574
           token-index : integer"
575
   (declare (dynamic-extent args))
576
   (apply #'parse-term input :production 'sparql-1-0-4::|ValuesClause| args))
577
 
578
 
579
 (defgeneric parse-values-data (input &rest args)
580
   (:documentation
581
    "Parse the INPUT as a values data clause as per the SPARQL BNF.
582
 
583
  INPUT : (or stream string pathname vector) : the encoded term
584
  :DEFAULT : t : return value if the parse fails; if not supplied a failures signals an error
585
 
586
  VALUES : binding : (cons list list)")
587
 
588
   (:method ((input t) &rest args)
589
     (declare (dynamic-extent args))
590
     (destructuring-bind (values dimensions)
591
                         (apply #'parse-term input :production 'sparql-1-0-4::|ValuesData| args)
592
       (multiple-value-bind (dimensions values)
593
                            (alphabetize-bindings dimensions values)
594
         (cons dimensions values))))
595
   (:method ((input string) &rest args)
596
     ;; a null string is no values
597
     (declare (dynamic-extent args) (ignore args))
598
     (when (plusp (length input)) (call-next-method)))
599
   (:method ((input null)  &rest args)
600
     (declare (dynamic-extent args) (ignore args))
601
     nil))
602
 
603
 ;;;
604
 ;;; encoding operators
605
 
606
 (defmethod send-error-message ((body t) (stream t) (content-type mime:application/sparql))
607
   "Given a MESSAGE, and a STREAM with text/ssf CONTENT-TYPE, encode as SSF/utf8"
608
   (write-ssf (vector :|error| body) stream))
609
 
610
 
611
 (defmethod send-request-message (operation (message-body t) (stream amqp:channel) (content-type mime:application/sparql))
612
   "Given a MESSAGE, and a STREAM with text/ssf CONTENT-TYPE, encode as SPARQL/utf8"
613
   (destructuring-bind (repository task-id query options) message-body
614
     (declare (ignore repository task-id options))
615
     (write-sequence query stream :start 0 :end (length query))))
616
 
617
 
618
 (defmethod send-response-message (operation (message-body t) (stream amqp:channel) (content-type mime:application/sparql))
619
   "delegate to json columns"
620
   (setf (amqp.u:channel-content-type stream) mime:application/sparql-results+json-columns)
621
   (call-next-method))
622
 
623
 #+(or) ;; testing only
624
 (defmethod send-response-message (operation (message-body t) (stream stream) (content-type mime:application/sparql))
625
   "delegate to json columns"
626
   (send-response-message operation message-body stream mime:application/sparql-results+json-columns))
627
 
628
 ;;; (parse-sparql-profile "graph <http://dydra.com/> {<http://dydra.com/> a ?a}" :production "Quads")
629
 ;;; (parse-sparql-profile "{<http://dydra.com/> a ?a}"  :production "GroupGraphPattern")
630
 ;;; (parse-sparql-profile "graph <http://dydra.com/> {<http://dydra.com/> a ?a}" :production "GraphGraphPattern")