Mercurial > hg > amuse

changeset 211:e2839225f6fb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
integrate db-admin into geerdes Ignore-this: 442285f4febbcd5d390a49d8c8b69e00 darcs-hash:20090522211215-16a00-0e6571178e720d2cf648e09486ec2bb160950355.gz committer: Jamie Forth <j.forth@gold.ac.uk>
author j.forth <j.forth@gold.ac.uk>
date Thu, 24 Feb 2011 11:23:17 +0000
parents be3d63b78054
children 619194befdd4
files amuse-geerdes.asd implementations/geerdes/connect.lisp implementations/geerdes/methods.lisp implementations/geerdes/package.lisp
diffstat 4 files changed, 19 insertions(+), 19 deletions(-) [+]
line wrap: on
line diff
--- a/amuse-geerdes.asd	Thu Feb 24 11:23:17 2011 +0000
+++ b/amuse-geerdes.asd	Thu Feb 24 11:23:17 2011 +0000
@@ -7,7 +7,6 @@
             ((:module geerdes
                       :components 
 		      ((:file "package")
-                       (:file "connect" :depends-on ("package"))
 	               (:file "classes" :depends-on ("package"))
 	               (:file "constructors" :depends-on ("package" "classes"))
 	               (:file "methods" :depends-on ("package" "classes" "constructors"))))))))
--- a/implementations/geerdes/connect.lisp	Thu Feb 24 11:23:17 2011 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,11 +0,0 @@
-(in-package #:amuse-geerdes)
-
-;; N.B. This file contains an access password for the database in
-;; plain text...
-
-(defun get-amuse-connection ()
-  (warn "This function should be removed, use connect-to-database instead.")
-  (clsql:connect '("vaughan-williams.doc.gold.ac.uk" "amuse" "LispMidi" "clsql")
-		 :if-exists :old :database-type :mysql))
-
-
--- a/implementations/geerdes/methods.lisp	Thu Feb 24 11:23:17 2011 +0000
+++ b/implementations/geerdes/methods.lisp	Thu Feb 24 11:23:17 2011 +0000
@@ -36,6 +36,12 @@
 (defmethod (setf file-id) (value (object geerdes-identifier-file-id))
   (setf (slot-value object 'file-id) value))
 
+;; Specialised constructors
+
+(defmethod make-composition-identifier ((package (eql *package*))
+					composition-id)
+  (g-id-file-id composition-id))
+
 ;; Composition 
 
 (defmethod get-composition ((identifier geerdes-identifier))
@@ -51,7 +57,8 @@
 				       :from [midi_file]
 				       :where [= [cat_id] cat-id]
 				       :flatp t
-				       :result-types :auto)))
+				       :result-types :auto
+				       :database *amuse-database*)))
 	 (timebase (second file-info))
 	 (file-id (first file-info))
 	 (composition (make-instance 'geerdes-composition
@@ -63,6 +70,7 @@
 	  (%midi-constituents composition) (get-db-constituents file-id))
   #.(clsql:restore-sql-reader-syntax-state)
   composition))
+
 (defmethod get-geerdes-composition ((identifier geerdes-identifier-file-id))
   #.(clsql:locally-enable-sql-reader-syntax)
   (let* ((file-id (file-id identifier))
@@ -70,7 +78,8 @@
 				       :from [midi_file]
 				       :where [= [id] file-id]
 				       :flatp t
-				       :result-types :auto)))
+				       :result-types :auto
+				       :database *amuse-database*)))
 	 (timebase (second file-info))
 	 (cat-id (first file-info))
 	 (composition (make-instance 'geerdes-composition
@@ -89,7 +98,9 @@
     SELECT track, channel, start, duration, patch, pitch, velocity, id, event_id, mel_duration
     FROM midi_event LEFT JOIN derived_midi_monody ON (id=event_id)
     WHERE file_id=" (princ-to-string file-id)
-    " ORDER BY start")))
+    " ORDER BY start")
+   :database *amuse-database*))
+
 (defun get-db-constituents (file-id)
   (clsql:query (concatenate 'string "
     SELECT track, channel, start, duration,
@@ -100,7 +111,8 @@
       LEFT JOIN midi_timesig ts ON (id=ts.constituent_id)
       LEFT JOIN midi_param param ON (id=param.constituent_id)
     WHERE c.file_id=" (princ-to-string file-id)
-    " ORDER BY start")))
+    " ORDER BY start")
+	       :database *amuse-database*))
 
 (defmethod monody ((composition geerdes-composition))
   (unless (amuse-geerdes::%monody composition)
@@ -149,4 +161,3 @@
 
 (defmethod crotchet ((object geerdes-object))
   (make-standard-period 1))
-
--- a/implementations/geerdes/package.lisp	Thu Feb 24 11:23:17 2011 +0000
+++ b/implementations/geerdes/package.lisp	Thu Feb 24 11:23:17 2011 +0000
@@ -1,5 +1,6 @@
 (cl:defpackage #:amuse-geerdes
-  (:use #:common-lisp #:amuse #:amuse-utils #:amuse-midi #:amuse-segmentation)
+  (:use #:common-lisp #:amuse #:amuse-utils #:amuse-midi
+  #:amuse-segmentation #:amuse-database-admin)
   (:export 
    ;; classes
    #:geerdes-composition
@@ -15,4 +16,4 @@
    ;; other (caching)
    #:properties)
   (:documentation "Package for MIDI pop-song database, originating
-  from Geerdes, a commercial supplier."))
\ No newline at end of file
+  from Geerdes, a commercial supplier."))