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

ECOLM functionality for tabcode implementation

darcs-hash:20080708152414-40ec0-be5878c3d42affaf70ad7d08e987ba2223f5fa59.gz

--- /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