Mercurial > hg > amuse
changeset 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 | 88089258e08d |
| children | a397dfe432f6 |
| files | implementations/tabcode/ecolm.lisp |
| diffstat | 1 files changed, 55 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/implementations/tabcode/ecolm.lisp Tue Jul 08 16:24:14 2008 +0100 @@ -0,0 +1,55 @@ +(in-package #:amuse-tabcode) + +(defun get-ecolm-connection () + (clsql:connect (list "127.0.0.1" "ecolm" "basicuser" "basicuser" "29183") + :if-exists :old :database-type :mysql)) + +(defclass ecolm-identifier (identifier tabcode-object) + ((edition-id :initarg :ed-id :accessor edition-id) + (edition-text-id :initarg :ed-id :accessor %edition-text-id) + (piece-id :initarg :p-id :accessor piece-id) + (tabcode :initarg :code :accessor %tabcode))) + +(defclass ecolm-search () + ((piece-title :initarg :p-title :reader piece-title) + (source-title :initarg :s-title :reader source-title))) + +(defun edition-text-id (ecolm-id) + (unless (or (slot-boundp ecolm-id 'edition-text-id) + (slot-boundp ecolm-id 'edition-id)) + (get-best-edition ecolm-id)) + (unless (slot-boundp ecolm-id 'edition-text-id) + (get-best-edition-text ecolm-id)) + (%edition-text-id ecolm-id)) + +(defun get-best-edition (ecolm-id) + (let ((edition (clsql:query (format nil "SELECT et.`Edition ID`, + `EditionText ID`, `EditionText Text` + FROM Piece_Editions pe NATURAL JOIN Edition_Texts et + WHERE `Piece ID`=~D + ORDER BY `EditionText Stage` DESC, + `EditionText Date` DESC + LIMIT 0,1" (piece-id ecolm-id))))) + (setf (edition-id ecolm-id) (caar edition) + (%edition-text-id ecolm-id) (second (car edition)) + (%tabcode ecolm-id) (third (car edition))))) + +(defun get-best-edition-text (ecolm-id) + (let ((edition (clsql:query (format nil "SELECT et.`EditionText ID`, + `EditionText Text` + FROM Edition_Texts et + WHERE `Edition ID`=~D + ORDER BY `EditionText Stage` DESC, `EditionText Date` DESC + LIMIT 0,1" (edition-id ecolm-id))))) + (setf (%edition-text-id ecolm-id) (caar edition) + (%tabcode ecolm-id) (second (car edition))))) + +(defun tabcode (identifier) + (if (slot-boundp identifier 'tabcode) + (%tabcode identifier) + (when (edition-text-id identifier) + (%tabcode identifier)))) + +(defmethod get-composition ((identifier ecolm-identifier)) + (get-composition-from-tabwords + (tabcode::parse-tabcode-string (tabcode identifier)))) \ No newline at end of file