Mercurial > hg > amuse
changeset 216:e1842efb1dd4
amuse-database-admin add implementation and dataset functionality
Ignore-this: 787cc01acf2d6a58640fec017de16c17
darcs-hash:20090716145807-16a00-6fe5ad4a2b6252b2c1f3d109a16455bb32243965.gz
committer: Jamie Forth <j.forth@gold.ac.uk>
| author | j.forth <j.forth@gold.ac.uk> |
|---|---|
| date | Thu, 24 Feb 2011 11:23:18 +0000 |
| parents | 4eceac78e7c6 |
| children | d8f650e3796e |
| files | amuse-database-admin.asd base/database/classes.lisp base/database/database-connect.lisp base/database/datasets-functions.lisp base/database/datasets-setup.lisp base/database/generics.lisp base/database/implementations-functions.lisp base/database/implementations-setup.lisp base/database/package.lisp base/generics.lisp |
| diffstat | 10 files changed, 277 insertions(+), 1 deletions(-) [+] |
line wrap: on
line diff
--- a/amuse-database-admin.asd Thu Feb 24 11:23:18 2011 +0000 +++ b/amuse-database-admin.asd Thu Feb 24 11:23:18 2011 +0000 @@ -8,5 +8,11 @@ ((:module database :components ((:file "package") + (:file "classes" :depends-on ("package")) (:file "database-connect" :depends-on ("package")) + (:file "datasets-functions" :depends-on ("datasets-setup")) + (:file "datasets-setup" :depends-on ("database-connect")) + (:file "generics" :depends-on ("package")) + (:file "implementations-functions" :depends-on ("implementations-setup")) + (:file "implementations-setup" :depends-on ("package")) ))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/database/classes.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -0,0 +1,18 @@ +(cl:in-package #:amuse-database-admin) + +(defclass amuse-dataset-identifier (identifier) + ((dataset-id :reader dataset-id + :initarg :dataset-id)) + (:documentation "A dataset is a set of pieces used for a particualar +analytical task. A dataset is not necessarily the same thing as a +corpus or collection (are these things different?). Corpus indicates +that a set of pieces have been curated in some way and in that sense +`belong together'. A dataset is just simply a set of pieces gathered +together to analyse, and the pieces can be from any corpus or +backend (hence the amuse- prefix")) + +(defclass amuse-dataset (list-slot-sequence) + ((identifier :initarg :identifier + :reader identifier) + (description :initarg :description + :reader description)))
--- a/base/database/database-connect.lisp Thu Feb 24 11:23:18 2011 +0000 +++ b/base/database/database-connect.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -1,6 +1,16 @@ (cl:in-package #:amuse-database-admin) -(defparameter *amuse-database* nil) +(defvar *amuse-database* nil + "The default AMuSE-wide database connection is assigned to this + variable. If for any reason, such as testing database interaction, + you do not wish to use the default database, this variable can be + shadowed locally within a particular backend package. For this to + actually work consistantly, all clsql database functions should + specify *amuse-database* explicitally as the :database argument. Not + doing this relies on the value of clsql:*default-database* being the + connection to the correct database, which in most cases will + actually be fine so long as you are not connecting to different + databases.") (defun connect-to-database (&key (database-name "amuse") username use-tunnel (make-default t))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/database/datasets-functions.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -0,0 +1,85 @@ +(cl:in-package #:amuse-database-admin) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Constructors + +(defun make-amuse-dataset-identifier (dataset-id) + (make-instance 'amuse-dataset-identifier + :dataset-id dataset-id)) + +(defun %make-amuse-dataset (dataset-identifier description + composition-identifiers) + (make-instance 'amuse-dataset + :%data composition-identifiers + :identifier dataset-identifier + :description description)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Database functions + +(defun make-new-dataset (description &optional (database + *amuse-database*)) + "A dataset is a set of pieces used for a particualar analytical +task. A dataset is not necessarily the same thing as a corpus or +collection (are these things different?). Corpus indicates that a set +of pieces have been curated in some way and in that sense `belong +together'. A dataset is just simply a set of pieces gathered together +to analyse, and the pieces can be from any corpus or backend." + (let (dataset-id) + #.(clsql:locally-enable-sql-reader-syntax) + (clsql:insert-records :into "amuse_datasets" + :attributes '([description]) + :values (list description) + :database database) + #.(clsql:locally-disable-sql-reader-syntax) + (setf dataset-id (clsql-mysql::mysql-insert-id + (clsql-mysql::database-mysql-ptr + database))) + (make-amuse-dataset-identifier dataset-id))) + +(defun assign-composition-to-dataset (composition-identifier + dataset-identifier + &optional (database + *amuse-database*)) + (clsql:execute-command (format nil " +INSERT INTO amuse_datasets_join +SET dataset_id := ~S, +implementation_id := (SELECT get_impl_id('~A')), +composition_id := ~S;" + (dataset-id dataset-identifier) + (implementation-namestring + composition-identifier) + (composition-id + composition-identifier))) + :database database) + +(defun get-dataset (dataset-identifier &optional (database + *amuse-database*)) + (let ((dataset-header (clsql:query (format nil " +SELECT description +FROM amuse_datasets +WHERE dataset_id = ~S" (dataset-id dataset-identifier)) + :database database + :flatp t + :field-names nil)) + (dataset-rows (clsql:query (format nil " +SELECT implementation_name, composition_id +FROM amuse_datasets_join +LEFT JOIN amuse_implementations +USING (implementation_id) +WHERE dataset_id = ~S" + (dataset-id + dataset-identifier)) + :flatp t + :field-names nil + :database database))) + (%make-amuse-dataset dataset-identifier (car dataset-header) + (%init-dataset-rows dataset-rows)))) + +(defun %init-dataset-rows (dataset-rows) + (loop for row in dataset-rows + collect (make-composition-identifier (find-package + (first row)) (second row)) + into composition-identifiers + finally (return composition-identifiers)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/database/datasets-setup.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -0,0 +1,46 @@ +(cl:in-package #:amuse-database-admin) + +(defun create-datasets-table (&optional (database *amuse-database*)) + (%create-datasets-table database) + (%create-datasets-join-table database)) + +(defun drop-datasets-table (&optional (database *amuse-database*)) + (%drop-datasets-table database) + (%drop-datasets-join-table database)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Helper functions + +(defun %create-datasets-table (database) + #.(clsql:locally-enable-sql-reader-syntax) + (clsql:create-table "amuse_datasets" + '(([|dataset-id|] clsql:smallint :unsigned + :not-null :auto-increment :primary-key) + ([|description|] (clsql:varchar 255) + :not-null)) + :database database + :transactions t) + #.(clsql:locally-disable-sql-reader-syntax)) + +(defun %create-datasets-join-table (database) + #.(clsql:locally-enable-sql-reader-syntax) + (clsql:create-table "amuse_datasets_join" + '(([|dataset-id|] clsql:smallint :unsigned + :not-null) + ([|implementation-id|] clsql:smallint + :unsigned :not-null) + ([|composition-id|] clsql:smallint :not-null)) + :constraints '("KEY (dataset_id)") + :database database + :transactions t) + #.(clsql:locally-disable-sql-reader-syntax)) + +(defun %drop-datasets-table (database) + (clsql:drop-table "amuse_datasets" + :database database + :if-does-not-exist :ignore)) + +(defun %drop-datasets-join-table (database) + (clsql:drop-table "amuse_datasets_join" + :database database + :if-does-not-exist :ignore))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/database/generics.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -0,0 +1,3 @@ +(cl:in-package #:amuse-database-admin) + +(defgeneric make-composition-identifier (package composition-id))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/database/implementations-functions.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -0,0 +1,21 @@ +(cl:in-package #:amuse-database-admin) + +(defun register-new-implementation (package-object &optional + (database *amuse-database*)) + #.(clsql:locally-enable-sql-reader-syntax) + (clsql:insert-records :into "amuse_implementations" + :attributes '([implementation-name]) + :values (list (package-name package-object)) + :database database) + (clsql-mysql::mysql-insert-id + (clsql-mysql::database-mysql-ptr database)) + #.(clsql:locally-disable-sql-reader-syntax)) + +(defun implementation-package (object) + (symbol-package + (class-name + (class-of + object)))) + +(defun implementation-namestring (object) + (package-name (implementation-package object)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/database/implementations-setup.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -0,0 +1,68 @@ +(cl:in-package #:amuse-database-admin) + +(defun create-implementations-table (&optional + (database *amuse-database*)) + (%create-implementations-table database) + (%create-implementation-stored-routines database)) + +(defun drop-implementations-table (&optional + (database *amuse-database*)) + (%drop-implementations-table database) + (%drop-implementation-stored-routines database)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Helper functions + +(defun %create-implementations-table (database) + #.(clsql:locally-enable-sql-reader-syntax) + (clsql:create-table "amuse_implementations" + '(([|implementation-id|] clsql:smallint :unsigned + :not-null :auto-increment :primary-key) + ([|implementation-name|] (varchar 255) + :not-null :unique)) + :database database + :transactions t) + #.(clsql:locally-disable-sql-reader-syntax)) + +(defun %drop-implementations-table (database) + (clsql:drop-table "amuse_implementations" + :if-does-not-exist :ignore + :database database)) + +(defun %create-implementation-stored-routines (database) + (%create-db-fun-get-impl-id database) + (%create-db-fun-get-impl-name database)) + +(defun %drop-implementation-stored-routines (database) + (%drop-db-fun-get-impl-id database) + (%drop-db-fun-get-impl-name database)) + +(defun %create-db-fun-get-impl-id (database) + (clsql:execute-command " +CREATE FUNCTION get_impl_id ( +impl_name VARCHAR(255)) +RETURNS SMALLINT +RETURN (SELECT implementation_id +FROM amuse_implementations +WHERE implementation_name = impl_name);" + :database database)) + +(defun %drop-db-fun-get-impl-id (database) + (clsql:execute-command " +DROP FUNCTION get_impl_id" + :database database)) + +(defun %create-db-fun-get-impl-name (database) + (clsql:execute-command " +CREATE FUNCTION get_impl_name ( +impl_id SMALLINT) +RETURNS VARCHAR(255) +RETURN (SELECT implementation_name +FROM amuse_implementations +WHERE implementation_id = impl_id);" + :database database)) + +(defun %drop-db-fun-get-impl-name (database) + (clsql:execute-command " +DROP FUNCTION get_impl_name" + :database database))
--- a/base/database/package.lisp Thu Feb 24 11:23:18 2011 +0000 +++ b/base/database/package.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -4,4 +4,15 @@ #:disconnect-from-database #:*amuse-database* #:make-db-option-file + + #:make-new-dataset ; datasets-functions + #:assign-composition-to-dataset + #:get-dataset + #:make-amuse-dataset-identifier + + #:make-composition-identifier ; generics + + #:register-new-implementation ; implementation functions + #:implementation-package + #:implementation-namestring ))
--- a/base/generics.lisp Thu Feb 24 11:23:18 2011 +0000 +++ b/base/generics.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -1,5 +1,13 @@ (cl:in-package #:amuse) +;;; Identifiers + +(defgeneric identifier (object)) + +(defgeneric event-id (object)) + +(defgeneric composition-id (object)) + ;;; Pulling compositions from the database (defgeneric get-composition (identifier)