comparison implementations/mtp/methods.lisp @ 149:a45da9b93b37

implementations/mtp/methods.lisp: fix some bugs in dataset retrieval. darcs-hash:20071025122256-c0ce4-dc50f52a16aaa6d3d78d961e6a934a5af77b7542.gz
author Marcus Pearce <m.pearce@gold.ac.uk>
date Thu, 25 Oct 2007 13:22:56 +0100
parents fd85f52d9f9d
children 03be243f9003
comparison
equal deleted inserted replaced
148:c8db9d1bd191 149:a45da9b93b37
12 (defgeneric get-dataset (identifer)) 12 (defgeneric get-dataset (identifer))
13 13
14 (defmethod get-dataset ((identifier mtp-dataset-identifier)) 14 (defmethod get-dataset ((identifier mtp-dataset-identifier))
15 (let* ((dataset-id (dataset-id identifier)) 15 (let* ((dataset-id (dataset-id identifier))
16 (where-clause [= [dataset-id] dataset-id]) 16 (where-clause [= [dataset-id] dataset-id])
17 (db-dataset (clsql:select [*] :from [mtp-dataset] :where where-clause)) 17 (db-dataset (car (clsql:select [*] :from [mtp-dataset] :where where-clause)))
18 (db-compositions (clsql:select [composition-id][description] 18 (db-compositions (clsql:select [composition-id][description]
19 :from [mtp-composition] 19 :from [mtp-composition]
20 :order-by '(([composition-id] :asc)) 20 :order-by '(([composition-id] :asc))
21 :where where-clause)) 21 :where where-clause))
22 (db-events (apply #'clsql:select 22 (db-events (apply #'clsql:select
31 :midc (fourth db-dataset))) 31 :midc (fourth db-dataset)))
32 (compositions nil) 32 (compositions nil)
33 (events nil)) 33 (events nil))
34 ;; for each db-composition 34 ;; for each db-composition
35 (dolist (dbc db-compositions) 35 (dolist (dbc db-compositions)
36 (let ((composition-id (first dbc)) 36 (let ((composition-id (car dbc))
37 (description (second dbc))) 37 (description (car dbc)))
38 ;; for each db-event 38 ;; for each db-event
39 (do* ((dbes db-events (cdr dbes)) 39 (do* ((dbes db-events (cdr dbes))
40 (dbe (car dbes) (car dbes)) 40 (dbe (car dbes) (car dbes))
41 (cid (second dbe) (second dbe))) 41 (cid (second dbe) (second dbe)))
42 ((or (null dbes) (not (= cid composition-id))) 42 ((or (null dbes) (not (= cid composition-id)))
43 (setf db-events dbes)) 43 (setf db-events dbes))
44 (when dbe 44 (when dbe
45 (push (db-event->mtp-event dbe) events))) 45 (push (db-event->mtp-event dbe) events)))
46 (let* ((interval (+ (timepoint (car events)) (duration (car events)))) 46 (when events
47 (composition 47 (let* ((interval (+ (timepoint (car events)) (duration (car events))))
48 (make-mtp-composition :dataset-id dataset-id 48 (composition
49 :composition-id composition-id 49 (make-mtp-composition :dataset-id dataset-id
50 :description description 50 :composition-id composition-id
51 :time 0 51 :description description
52 :interval interval))) 52 :time 0
53 (sequence:adjust-sequence composition (length events) 53 :interval interval)))
54 :initial-contents (nreverse events)) 54 (sequence:adjust-sequence composition (length events)
55 (setf events nil) 55 :initial-contents (nreverse events))
56 (push composition compositions)))) 56 (setf events nil)
57 (push composition compositions)))))
57 (sequence:adjust-sequence dataset (length compositions) 58 (sequence:adjust-sequence dataset (length compositions)
58 :initial-contents (nreverse compositions)) 59 :initial-contents (nreverse compositions))
59 dataset)) 60 dataset))
60 61
61 (defmethod get-composition ((identifier mtp-composition-identifier)) 62 (defmethod get-composition ((identifier mtp-composition-identifier))