X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fsql.lisp;h=8107bd96c1a0fe21b97a97b8d26cf6ed1bf185a1;hp=4ed2e81e72cd725fe1849811667ed7f478e90bb6;hb=9bbed78051e80e6ab76ae47834136035602bbbf1;hpb=a4449b6f1b9fb2471da255fc506bcad6f8feb220 diff --git a/sql/sql.lisp b/sql/sql.lisp index 4ed2e81..8107bd9 100644 --- a/sql/sql.lisp +++ b/sql/sql.lisp @@ -1,26 +1,26 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ====================================================================== -;;;; File: sql.lisp -;;;; Updated: <04/04/2004 12:05:32 marcusp> -;;;; ====================================================================== +;;;; ************************************************************************* ;;;; -;;;; Description ========================================================== -;;;; ====================================================================== +;;;; $Id$ ;;;; -;;;; The CLSQL-USQL Functional Data Manipulation Language (FDML). +;;;; The CLSQL Functional Data Manipulation Language (FDML). ;;;; -;;;; ====================================================================== +;;;; This file is part of CLSQL. +;;;; +;;;; CLSQL users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. +;;;; ************************************************************************* (in-package #:clsql-sys) - ;;; Basic operations on databases (defmethod database-query-result-set ((expr %sql-expression) database - &key full-set types) + &key full-set result-types) (database-query-result-set (sql-output expr database) database - :full-set full-set :types types)) + :full-set full-set :result-types result-types)) (defmethod execute-command ((expr %sql-expression) &key (database *default-database*)) @@ -28,12 +28,26 @@ (values)) - (defmethod query ((expr %sql-expression) &key (database *default-database*) (result-types nil) (flatp nil)) (query (sql-output expr database) :database database :flatp flatp :result-types result-types)) +(defun truncate-database (&key (database *default-database*)) + (unless (typep database 'database) + (clsql-base::signal-no-database-error database)) + (unless (is-database-open database) + (database-reconnect database)) + (when (db-type-has-views? (database-underlying-type database)) + (dolist (view (list-views :database database)) + (drop-view view :database database))) + (dolist (table (list-tables :database database)) + (drop-table table :database database)) + (dolist (index (list-indexes :database database)) + (drop-index index :database database)) + (dolist (seq (list-sequences :database database)) + (drop-sequence seq :database database))) + (defun print-query (query-exp &key titles (formats t) (sizes t) (stream t) (database *default-database*)) "The PRINT-QUERY function takes a symbolic SQL query expression and @@ -55,7 +69,7 @@ value of T. This specifies that *STANDARD-OUTPUT* is used." (mapcan #'(lambda (s f) (list s f)) sizes record))))) (let* ((query-exp (etypecase query-exp (string query-exp) - (sql-query (sql-output query-exp)))) + (sql-query (sql-output query-exp database)))) (data (query query-exp :database database)) (sizes (if (or (null sizes) (listp sizes)) sizes (compute-sizes (if titles (cons titles data) data)))) @@ -91,11 +105,11 @@ table INTO. The default value of DATABASE is *DEFAULT-DATABASE*." (vals nil) (av-pairs nil) (subquery nil)) - (if (null into) + (unless into (error 'clsql-sql-syntax-error :reason ":into keyword not supplied")) - (let ((ins (make-instance 'sql-insert :into into))) + (let ((insert (make-instance 'sql-insert :into into))) (with-slots (attributes values query) - ins + insert (cond ((and vals (not attrs) (not query) (not av-pairs)) (setf values vals)) ((and vals attrs (not subquery) (not av-pairs)) @@ -112,7 +126,7 @@ table INTO. The default value of DATABASE is *DEFAULT-DATABASE*." (t (error 'clsql-sql-syntax-error :reason "bad or ambiguous keyword combination."))) - ins))) + insert))) (defun delete-records (&key (from nil) (where nil) @@ -124,12 +138,11 @@ from which the records are to be removed, and defaults to (let ((stmt (make-instance 'sql-delete :from from :where where))) (execute-command stmt :database database))) -(defun update-records (table &key - (attributes nil) - (values nil) - (av-pairs nil) - (where nil) - (database *default-database*)) +(defun update-records (table &key (attributes nil) + (values nil) + (av-pairs nil) + (where nil) + (database *default-database*)) "Changes the values of existing fields in TABLE with columns specified by ATTRIBUTES and VALUES (or AV-PAIRS) where the WHERE condition is true." @@ -178,10 +191,11 @@ condition is true." (let ((keyword-package (symbol-package :foo))) (defmethod database-output-sql ((sym symbol) database) - (declare (ignore database)) - (if (equal (symbol-package sym) keyword-package) - (concatenate 'string "'" (string sym) "'") - (symbol-name sym)))) + (convert-to-db-default-case + (if (equal (symbol-package sym) keyword-package) + (concatenate 'string "'" (string sym) "'") + (symbol-name sym)) + database))) (defmethod database-output-sql ((tee (eql t)) database) (declare (ignore database)) @@ -207,6 +221,10 @@ condition is true." (declare (ignore database)) (db-timestring self)) +(defmethod database-output-sql ((self duration) database) + (declare (ignore database)) + (format nil "'~a'" (duration-timestring self))) + (defmethod database-output-sql (thing database) (if (or (null thing) (eq 'null thing)) @@ -216,17 +234,18 @@ condition is true." "No type conversion to SQL for ~A is defined for DB ~A." :format-arguments (list (type-of thing) (type-of database))))) -(defmethod output-sql-hash-key ((arg vector) &optional database) + +(defmethod output-sql-hash-key ((arg vector) database) (list 'vector (map 'list (lambda (arg) (or (output-sql-hash-key arg database) (return-from output-sql-hash-key nil))) arg))) -(defmethod output-sql (expr &optional (database *default-database*)) +(defmethod output-sql (expr database) (write-string (database-output-sql expr database) *sql-stream*) - t) + (values)) -(defmethod output-sql ((expr list) &optional (database *default-database*)) +(defmethod output-sql ((expr list) database) (if (null expr) (write-string +null-string+ *sql-stream*) (progn @@ -239,4 +258,18 @@ condition is true." (write-char #\) *sql-stream*))) t) +(defmethod describe-table ((table sql-create-table) + &key (database *default-database*)) + (database-describe-table + database + (convert-to-db-default-case + (symbol-name (slot-value table 'name)) database))) +#+nil +(defmethod add-storage-class ((self database) (class symbol) &key (sequence t)) + (let ((tablename (view-table (find-class class)))) + (unless (tablep tablename) + (create-view-from-class class) + (when sequence + (create-sequence-from-class class))))) +