view implementations/tabcode/ecolm.lisp @ 181:a397dfe432f6

TabCode Packaging

darcs-hash:20080709073509-40ec0-33b68a60705a58bedaab5ec071c16501a21a9ad2.gz

(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))))