d@183: (in-package #:amuse-ecolm)
d@180: 
d@180: (defun get-ecolm-connection ()
d@180:   (clsql:connect (list "127.0.0.1" "ecolm" "basicuser" "basicuser" "29183")
d@180: 		 :if-exists :old :database-type :mysql))
d@180: 
d@180: (defclass ecolm-identifier (identifier tabcode-object)
d@180:   ((edition-id :initarg :ed-id :accessor edition-id)
d@180:    (edition-text-id :initarg :ed-id :accessor %edition-text-id)
d@180:    (piece-id :initarg :p-id :accessor piece-id)
d@180:    (tabcode :initarg :code :accessor %tabcode)))
d@180: 
d@180: (defclass ecolm-search ()
d@183:   ((piece-title :initarg :piece :reader piece-title)
d@183:    (source-title :initarg :source :reader source-title)
d@183:    (cluster-name :initarg :cluster :reader cluster-name)))
d@180: 
d@180: (defun edition-text-id (ecolm-id)
d@180:   (unless (or (slot-boundp ecolm-id 'edition-text-id)
d@180: 	      (slot-boundp ecolm-id 'edition-id))
d@180:     (get-best-edition ecolm-id))
d@180:   (unless (slot-boundp ecolm-id 'edition-text-id)
d@180:     (get-best-edition-text ecolm-id))
d@180:   (%edition-text-id ecolm-id))
d@180: 
d@180: (defun get-best-edition (ecolm-id)
d@180:   (let ((edition (clsql:query (format nil "SELECT et.`Edition ID`, 
d@180:        `EditionText ID`, `EditionText Text`
d@180:     FROM Piece_Editions pe NATURAL JOIN Edition_Texts et 
d@180:     WHERE `Piece ID`=~D
d@180:     ORDER BY `EditionText Stage` DESC,
d@180:              `EditionText Date` DESC
d@180:     LIMIT 0,1" (piece-id ecolm-id)))))
d@180:     (setf (edition-id ecolm-id) (caar edition)
d@180: 	  (%edition-text-id ecolm-id) (second (car edition))
d@180: 	  (%tabcode ecolm-id) (third (car edition)))))
d@180: 
d@180: (defun get-best-edition-text (ecolm-id)
d@180:   (let ((edition (clsql:query (format nil "SELECT et.`EditionText ID`,
d@180:         `EditionText Text`
d@180:     FROM Edition_Texts et 
d@180:     WHERE `Edition ID`=~D
d@180:     ORDER BY `EditionText Stage` DESC, `EditionText Date` DESC
d@180:     LIMIT 0,1" (edition-id ecolm-id)))))
d@180:     (setf (%edition-text-id ecolm-id) (caar edition)
d@180: 	  (%tabcode ecolm-id) (second (car edition)))))
d@180: 
d@180: (defun tabcode (identifier)
d@180:   (if (slot-boundp identifier 'tabcode)
d@180:       (%tabcode identifier)
d@180:       (when (edition-text-id identifier)
d@180: 	(%tabcode identifier))))
d@180: 
d@180: (defmethod get-composition ((identifier ecolm-identifier))
d@183:   (amuse-tabcode::get-composition-from-tabwords
d@183:    (tabcode::parse-tabcode-string (tabcode identifier))))
d@183: 
d@183: (defun make-ecolm-search (&key (piece-title nil) (source-title nil) (cluster-name nil))
d@183:   (make-instance 'ecolm-search
d@183: 		 :piece piece-title
d@183: 		 :source source-title
d@183: 		 :cluster cluster-name))
d@183: 
d@183: (defun ecolm-search (&key (piece-title nil) (source-title nil) (cluster-name nil))
d@183:   (get-ecolm-search-results (make-ecolm-search :piece-title piece-title
d@183: 					       :source-title source-title
d@183: 					       :cluster-name cluster-name)))
d@183: 
d@183: (defun get-ecolm-search-results (ecolm-search)
d@183:   (let ((prefixes '("SELECT DISTINCT p.`Piece ID` FROM Pieces p"))
d@183: 	(where-clauses '("WHERE 1"))
d@183: 	(results)
d@183: 	(query-string "") (sourcep))
d@183:     (when (and (slot-boundp ecolm-search 'piece-title)
d@183: 	       (piece-title ecolm-search))
d@183:       (push " LEFT JOIN Piece_Names pn USING (`Piece ID`) "
d@183: 	    prefixes)
d@183:       (push (format nil " AND (`Piece Title` LIKE '~D' OR `PieceName Alias` LIKE '~D') "
d@183: 		    (piece-title ecolm-search) (piece-title ecolm-search))
d@183: 	    where-clauses))
d@183:     (when (and (slot-boundp ecolm-search 'source-title)
d@183: 	       (source-title ecolm-search))
d@183:       (setf sourcep t)
d@183:       (push " LEFT JOIN Sources s ON p.`Source ID`=s.`Source ID`
d@183:               LEFT JOIN Source_Names sn ON s.`Source ID`=sn.`Source ID` "
d@183: 	    prefixes)
d@183:       (push (format nil " AND (`Source Title` LIKE '~D' OR `SourceName Alias` LIKE '~D') "
d@183: 		    (source-title ecolm-search) (source-title ecolm-search))
d@183: 	    where-clauses))
d@183:     (when (and (slot-boundp ecolm-search 'cluster-name)
d@183: 	       (cluster-name ecolm-search))
d@183:       (push (if sourcep
d@183: 		" LEFT JOIN Cluster_Pieces cp ON p.`Piece ID`=cp.`Piece ID`
d@183:                   LEFT JOIN Clusters c1 ON cp.`Cluster ID`=c1.`Cluster ID`
d@183:                   LEFT JOIN Cluster_Sources cs on s.`Source ID`=cs.`Source ID`
d@183:                   LEFT JOIN Clusters c2 ON cs.`Cluster ID`=c2.`Cluster ID` "
d@183: 		" LEFT JOIN Cluster_Pieces cp ON p.`Piece ID`=cp.`Piece ID`
d@183:                   LEFT JOIN Clusters c1 ON cp.`Cluster ID`=c1.`Cluster ID` ")
d@183: 	    prefixes)
d@183:       (push (format nil " AND (c1.`Cluster Name` LIKE '~D'~D)"
d@183: 		    (cluster-name ecolm-search)
d@183: 		    (if sourcep
d@183: 			(format nil "OR c2.`Cluster Name` LIKE '~D'"
d@183: 				(cluster-name ecolm-search))
d@183: 			""))
d@183: 		    
d@183: 	    where-clauses))
d@183:     (setf query-string (concatenate 'string
d@183: 				    (apply #'concatenate
d@183: 					   'string (reverse prefixes))
d@183: 				    (apply #'concatenate
d@183: 					   'string (reverse where-clauses)))
d@183: 	  results (clsql:query query-string))
d@183:     (remove-if-not #'edition-text-id (mapcar #'(lambda (x) (make-instance 'ecolm-identifier :p-id x)) results))))
d@183: