view implementations/tabcode/ecolm.lisp @ 190:725ce7ce77ba

remove DOS line endings in base/classes.lisp

darcs-hash:20090105150355-16a00-972232fbb3eb8030c3e0c6d3788ba6f389183d8c.gz

(in-package #:amuse-ecolm)

(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 :piece :reader piece-title)
   (source-title :initarg :source :reader source-title)
   (cluster-name :initarg :cluster :reader cluster-name)))

(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))
  (amuse-tabcode::get-composition-from-tabwords
   (tabcode::parse-tabcode-string (tabcode identifier))))

(defun make-ecolm-search (&key (piece-title nil) (source-title nil) (cluster-name nil))
  (make-instance 'ecolm-search
		 :piece piece-title
		 :source source-title
		 :cluster cluster-name))

(defun ecolm-search (&key (piece-title nil) (source-title nil) (cluster-name nil))
  (get-ecolm-search-results (make-ecolm-search :piece-title piece-title
					       :source-title source-title
					       :cluster-name cluster-name)))

(defun get-ecolm-search-results (ecolm-search)
  (let ((prefixes '("SELECT DISTINCT p.`Piece ID` FROM Pieces p"))
	(where-clauses '("WHERE 1"))
	(results)
	(query-string "") (sourcep))
    (when (and (slot-boundp ecolm-search 'piece-title)
	       (piece-title ecolm-search))
      (push " LEFT JOIN Piece_Names pn USING (`Piece ID`) "
	    prefixes)
      (push (format nil " AND (`Piece Title` LIKE '~D' OR `PieceName Alias` LIKE '~D') "
		    (piece-title ecolm-search) (piece-title ecolm-search))
	    where-clauses))
    (when (and (slot-boundp ecolm-search 'source-title)
	       (source-title ecolm-search))
      (setf sourcep t)
      (push " LEFT JOIN Sources s ON p.`Source ID`=s.`Source ID`
              LEFT JOIN Source_Names sn ON s.`Source ID`=sn.`Source ID` "
	    prefixes)
      (push (format nil " AND (`Source Title` LIKE '~D' OR `SourceName Alias` LIKE '~D') "
		    (source-title ecolm-search) (source-title ecolm-search))
	    where-clauses))
    (when (and (slot-boundp ecolm-search 'cluster-name)
	       (cluster-name ecolm-search))
      (push (if sourcep
		" LEFT JOIN Cluster_Pieces cp ON p.`Piece ID`=cp.`Piece ID`
                  LEFT JOIN Clusters c1 ON cp.`Cluster ID`=c1.`Cluster ID`
                  LEFT JOIN Cluster_Sources cs on s.`Source ID`=cs.`Source ID`
                  LEFT JOIN Clusters c2 ON cs.`Cluster ID`=c2.`Cluster ID` "
		" LEFT JOIN Cluster_Pieces cp ON p.`Piece ID`=cp.`Piece ID`
                  LEFT JOIN Clusters c1 ON cp.`Cluster ID`=c1.`Cluster ID` ")
	    prefixes)
      (push (format nil " AND (c1.`Cluster Name` LIKE '~D'~D)"
		    (cluster-name ecolm-search)
		    (if sourcep
			(format nil "OR c2.`Cluster Name` LIKE '~D'"
				(cluster-name ecolm-search))
			""))
		    
	    where-clauses))
    (setf query-string (concatenate 'string
				    (apply #'concatenate
					   'string (reverse prefixes))
				    (apply #'concatenate
					   'string (reverse where-clauses)))
	  results (clsql:query query-string))
    (remove-if-not #'edition-text-id (mapcar #'(lambda (x) (make-instance 'ecolm-identifier :p-id x)) results))))