comparison implementations/tabcode/ecolm.lisp @ 180:1a2b876b5587

ECOLM functionality for tabcode implementation darcs-hash:20080708152414-40ec0-be5878c3d42affaf70ad7d08e987ba2223f5fa59.gz
author d.lewis <d.lewis@gold.ac.uk>
date Tue, 08 Jul 2008 16:24:14 +0100
parents
children 5b2d0e5a99f1
comparison
equal deleted inserted replaced
179:88089258e08d 180:1a2b876b5587
1 (in-package #:amuse-tabcode)
2
3 (defun get-ecolm-connection ()
4 (clsql:connect (list "127.0.0.1" "ecolm" "basicuser" "basicuser" "29183")
5 :if-exists :old :database-type :mysql))
6
7 (defclass ecolm-identifier (identifier tabcode-object)
8 ((edition-id :initarg :ed-id :accessor edition-id)
9 (edition-text-id :initarg :ed-id :accessor %edition-text-id)
10 (piece-id :initarg :p-id :accessor piece-id)
11 (tabcode :initarg :code :accessor %tabcode)))
12
13 (defclass ecolm-search ()
14 ((piece-title :initarg :p-title :reader piece-title)
15 (source-title :initarg :s-title :reader source-title)))
16
17 (defun edition-text-id (ecolm-id)
18 (unless (or (slot-boundp ecolm-id 'edition-text-id)
19 (slot-boundp ecolm-id 'edition-id))
20 (get-best-edition ecolm-id))
21 (unless (slot-boundp ecolm-id 'edition-text-id)
22 (get-best-edition-text ecolm-id))
23 (%edition-text-id ecolm-id))
24
25 (defun get-best-edition (ecolm-id)
26 (let ((edition (clsql:query (format nil "SELECT et.`Edition ID`,
27 `EditionText ID`, `EditionText Text`
28 FROM Piece_Editions pe NATURAL JOIN Edition_Texts et
29 WHERE `Piece ID`=~D
30 ORDER BY `EditionText Stage` DESC,
31 `EditionText Date` DESC
32 LIMIT 0,1" (piece-id ecolm-id)))))
33 (setf (edition-id ecolm-id) (caar edition)
34 (%edition-text-id ecolm-id) (second (car edition))
35 (%tabcode ecolm-id) (third (car edition)))))
36
37 (defun get-best-edition-text (ecolm-id)
38 (let ((edition (clsql:query (format nil "SELECT et.`EditionText ID`,
39 `EditionText Text`
40 FROM Edition_Texts et
41 WHERE `Edition ID`=~D
42 ORDER BY `EditionText Stage` DESC, `EditionText Date` DESC
43 LIMIT 0,1" (edition-id ecolm-id)))))
44 (setf (%edition-text-id ecolm-id) (caar edition)
45 (%tabcode ecolm-id) (second (car edition)))))
46
47 (defun tabcode (identifier)
48 (if (slot-boundp identifier 'tabcode)
49 (%tabcode identifier)
50 (when (edition-text-id identifier)
51 (%tabcode identifier))))
52
53 (defmethod get-composition ((identifier ecolm-identifier))
54 (get-composition-from-tabwords
55 (tabcode::parse-tabcode-string (tabcode identifier))))