diff implementations/tabcode/ecolm.lisp @ 183:5b2d0e5a99f1

More tabcode, plus fixes for gsharp key-sigs and some new restart symbols in amuse

darcs-hash:20080721130227-40ec0-858017ddbc42513731d0119e704926768906dbc6.gz

--- a/implementations/tabcode/ecolm.lisp	Thu Jul 10 12:48:05 2008 +0100
+++ b/implementations/tabcode/ecolm.lisp	Mon Jul 21 14:02:27 2008 +0100
@@ -1,4 +1,4 @@
-(in-package #:amuse-tabcode)
+(in-package #:amuse-ecolm)
 
 (defun get-ecolm-connection ()
   (clsql:connect (list "127.0.0.1" "ecolm" "basicuser" "basicuser" "29183")
@@ -11,8 +11,9 @@
    (tabcode :initarg :code :accessor %tabcode)))
 
 (defclass ecolm-search ()
-  ((piece-title :initarg :p-title :reader piece-title)
-   (source-title :initarg :s-title :reader source-title)))
+  ((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)
@@ -51,5 +52,64 @@
 	(%tabcode identifier))))
 
 (defmethod get-composition ((identifier ecolm-identifier))
-  (get-composition-from-tabwords
-   (tabcode::parse-tabcode-string (tabcode identifier))))
\ No newline at end of file
+  (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))))
+