Mercurial > hg > amuse
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)))) |