--- /dev/null
+CLSQL is written and Copyright (c) 2002 by Kevin M. Rosenberg and is
+based on the MaiSQL package written and Copyright (c) 1999-2001 by
+Pierre R. Mai.
+
+CLSQL is licensed under the terms of the Lisp Lesser GNU
+Public License (http://opensource.franz.com/preamble.html), known as
+the LLGPL. The LLGPL consists of a preamble (see above URL) and the
+LGPL. Where these conflict, the preamble takes precedence.
+CLSQL is referenced in the preamble as the "LIBRARY."
+
+CLSQL is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+
+
--- /dev/null
+ Copyright (C) 1999-2001 Pierre R. Mai
+
+ Permission is hereby granted, free of charge, to any person obtaining
+ a copy of this software and associated documentation files (the
+ "Software"), to deal in the Software without restriction, including
+ without limitation the rights to use, copy, modify, merge, publish,
+ distribute, sublicense, and/or sell copies of the Software, and to
+ permit persons to whom the Software is furnished to do so, subject to
+ the following conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR
+ OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+ ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+ OTHER DEALINGS IN THE SOFTWARE.
+
+ Except as contained in this notice, the name of the author shall
+ not be used in advertising or otherwise to promote the sale, use or
+ other dealings in this Software without prior written authorization
+ from the author.
--- /dev/null
+23 Mar 2002 Kevin Rosenberg (kevin@rosenberg.net)
+ * Initial Release
+
+
--- /dev/null
+Refer to the main documentation file for installation instructions.
+
+Documentation is availabe as a PDF file in doc/clsql.pdf and
+as HTML files in doc/html/.
+
--- /dev/null
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for the CLSQL package
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile,v 1.1 2002/03/23 14:04:49 kevin Exp $
+#
+# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+#
+# 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.
+
+PACKAGE=clsql
+
+all: nothing
+
+nothing:
+
+clean:
+ @rm -f $(PACKAGE)-*.tar.gz $(PACKAGE)-*.zip
+ @find . -type d -name .bin |xargs rm -rf
+
+realclean: clean
+ @find . -type f -name \*~ -exec rm {} \;
+ @find . -type f -name "#*#" -exec rm {} \;
+
+docs:
+ @(cd doc; make dist-doc)
+
+VERSION=$(shell cat VERSION)
+DISTDIR=$(PACKAGE)-$(VERSION)
+DIST_TARBALL=$(DISTDIR).tar.gz
+DIST_ZIP=$(DISTDIR).zip
+SOURCE_FILES=interfaces sql cmucl-compat doc Makefile VERSION \
+ COPYING.CLSQL COPYING.MaiSQL README INSTALL ChangeLog NEWS TODO \
+ set-logical.cl test-clsql.cl \
+ clsql.system clsql-aodbc.system clsql-mysql.system \
+ clsql-postgresql.system clsql-postgresql-socket.system
+
+dist: realclean docs
+ @rm -fr $(DISTDIR) $(DIST_TARBALL) $(DIST_ZIP)
+ @mkdir $(DISTDIR)
+ @cp -a $(SOURCE_FILES) $(DISTDIR)
+ @find $(DISTDIR) -type d -name CVS | xargs rm -r
+ @find $(DISTDIR) -type f -name .cvsignore -exec rm {} \;
+ @find $(DISTDIR)/doc -type f -name \*.tex -or -name \*.aux -or \
+ -name \*.log -or -name \*.out -or -name \*.dvi -or \
+ -name \*~ -or -name \*.ps -exec rm {} \;
+ @tar czf $(DIST_TARBALL) $(DISTDIR)
+ @find $(DISTDIR) -type f -exec unix2dos -q {} \;
+ @zip -rq $(DIST_ZIP) $(DISTDIR)
+ @rm -r $(DISTDIR)
--- /dev/null
+Initial release of CLSQL
--- /dev/null
+CLSQL is a Common Lisp to SQL engine interface written by Kevin M.
+Rosenberg. It is based Pierre R. Mai's excellent MaiSQL package. It
+uses the UFFI (http://uffi.med-info.com) library for compatibility
+with Allegro CL, Lispworks, and CMUCL.
+
+CLSQL's home is http://clsql.med-info.com.
+
+Documentation is availabe as a PDF file in doc/clsql.pdf and
+as HTML files in doc/html/.
+
+
--- /dev/null
+Fix postgresql-socket on Lispworks and CMUCL so that the
+socket stream uses a consistent element-type.
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: clsql-aodbc.system
+;;;; Purpose: Defsystem-3/4 definition file for CLSQL AODBC backend
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: clsql-aodbc.system,v 1.1 2002/03/23 14:04:49 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :make)
+
+(defsystem :clsql-aodbc
+ :source-pathname "CLSQL:interfaces;aodbc;"
+ :source-extension "cl"
+ :binary-pathname "CLSQL:interfaces;aodbc;bin;"
+ :components ((:file "aodbc-package")
+ (:file "aodbc-sql" :depends-on ("aodbc-package")))
+ :depends-on (:clsql)
+ :finally-do
+ (clsql-sys:initialize-database-type :database-type :aodbc))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: clsql-mysql.system
+;;;; Purpose: Defsystem-3/4 definition file for CLSQL MySQL backend
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: clsql-mysql.system,v 1.1 2002/03/23 14:04:49 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+
+(in-package :make)
+
+;;; System definition
+
+(defsystem :clsql-mysql
+ :source-pathname "CLSQL:interfaces;mysql;"
+ :source-extension "cl"
+ :binary-pathname "CLSQL:interfaces;mysql;bin;"
+ :components ((:file "mysql-package")
+ (:file "mysql-loader" :depends-on ("mysql-package"))
+ (:file "mysql-uffi" :depends-on ("mysql-loader"))
+ (:file "mysql-sql" :depends-on ("mysql-uffi")))
+ :depends-on (:uffi :clsql)
+ :finally-do
+ (progn
+ (clsql-sys:initialize-database-type :database-type :mysql)
+ (setq clsql:*default-database-type* :mysql)
+ (pushnew :mysql cl:*features*)))
+
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: clsql-postgresql.system
+;;;; Purpose: Defsystem-3/4 file for CLSQL PostgresSQL socket backend
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: clsql-postgresql-socket.system,v 1.1 2002/03/23 14:04:49 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :make)
+
+;;; System definition
+
+(defsystem :clsql-postgresql-socket
+ :source-pathname "CLSQL:interfaces;postgresql-socket;"
+ :source-extension "cl"
+ :binary-pathname "CLSQL:interfaces;postgresql-socket;bin;"
+ :components ((:file "postgresql-socket-package")
+ (:file "postgresql-socket-uffi"
+ :depends-on ("postgresql-socket-package"))
+ (:file "postgresql-socket-sql"
+ :depends-on ("postgresql-socket-uffi")))
+ :depends-on (:clsql))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: clsql-postgresql.system
+;;;; Purpose: Defsystem-3/4 file for CLSQL PostgresSQL backend
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: clsql-postgresql.system,v 1.1 2002/03/23 14:04:49 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :make)
+
+(defsystem :clsql-postgresql
+ :source-pathname "CLSQL:interfaces;postgresql;"
+ :source-extension "cl"
+ :binary-pathname "CLSQL:interfaces;postgresql;bin;"
+ :source-extension "cl"
+ :components ((:file "postgresql-package")
+ (:file "postgresql-loader" :depends-on ("postgresql-package"))
+ (:file "postgresql-uffi" :depends-on ("postgresql-loader"))
+ (:file "postgresql-sql" :depends-on ("postgresql-uffi")))
+ :depends-on (:uffi :clsql))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: clsql.system
+;;;; Purpose: Defsystem-3/4 for CLSQL
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: clsql.system,v 1.1 2002/03/23 14:04:49 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+(load (make-pathname :name "set-logical" :type "cl"
+ :defaults *load-truename*))
+(set-logical-host-for-pathname "CLSQL" *load-truename*)
+
+;;; System definitions
+
+(mk:defsystem :cmucl-compat
+ :source-pathname "CLSQL:cmucl-compat;"
+ :source-extension "cl"
+ :binary-pathname "CLSQL:cmucl-compat;bin;"
+ :components ((:file "cmucl-compat")
+ (:file "loop-extension")))
+
+(mk:defsystem :clsql
+ :source-pathname "CLSQL:sql;"
+ :source-extension "cl"
+ :binary-pathname "CLSQL:sql;bin;"
+ :components ((:file "package")
+ (:file "sql" :depends-on ("package"))
+ (:file "functional" :depends-on ("sql")))
+ :depends-on (:cmucl-compat)
+ :finally-do
+ (pushnew :clsql cl:*features*)
+ )
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: cmucl-compat.sql
+;;;; Purpose: Compatiblity library for CMUCL functions
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: cmucl-compat.cl,v 1.1 2002/03/23 14:04:49 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+(defpackage :cmucl-compat
+ (:export
+ #:shrink-vector
+ #:make-sequence-of-type
+ #:result-type-or-lose
+ #:required-argument
+ ))
+(in-package :cmucl-compat)
+
+#+cmu
+(defmacro required-argument ()
+ `(ext:required-argument))
+
+#-cmu
+(defun required-argument ()
+ (error "~&A required keyword argument was not supplied"))
+
+#+cmu
+(defmacro shrink-vector (vec len)
+ `(lisp::shrink-vector ,vec ,len))
+
+#-cmu
+(defmacro shrink-vector (vec len)
+ "Shrinks a vector. Optimized if vector has a fill pointer.
+Needs to be a macro to overwrite value of VEC."
+ (let ((new-vec (gensym)))
+ `(cond
+ ((adjustable-array-p ,vec)
+ (adjust-array ,vec ,len))
+ ((typep ,vec 'simple-array)
+ (let ((,new-vec (make-array ,len :element-type
+ (array-element-type ,vec))))
+ (dotimes (i ,len)
+ (declare (fixnum i))
+ (setf (aref ,new-vec i) (aref ,vec i)))
+ (setq ,vec ,new-vec)))
+ ((typep ,vec 'vector)
+ (setf (fill-pointer ,vec) ,len)
+ ,vec)
+ (t
+ (error "Unable to shrink vector ~S which is type-of ~S" ,vec (type-of ,vec)))
+ )))
+
+
+
+#-cmu
+(defun make-sequence-of-type (type length)
+ "Returns a sequence of the given TYPE and LENGTH."
+ (declare (fixnum length))
+ (case type
+ (list
+ (make-list length))
+ ((bit-vector simple-bit-vector)
+ (make-array length :element-type '(mod 2)))
+ ((string simple-string base-string simple-base-string)
+ (make-string length))
+ (simple-vector
+ (make-array length))
+ ((array simple-array vector)
+ (if (listp type)
+ (make-array length :element-type (cadr type))
+ (make-array length)))
+ (t
+ (make-sequence-of-type (result-type-or-lose type t) length))))
+
+
+#+cmu
+(if (fboundp 'lisp::make-sequence-of-type)
+ (defun make-sequence-of-type (type len)
+ (lisp::make-sequence-of-type type len))
+ (defun make-sequence-of-type (type len)
+ (system::make-sequence-of-type type len)))
+
+
+#-cmu
+(defun result-type-or-lose (type nil-ok)
+ (unless (or type nil-ok)
+ (error "NIL output type invalid for this sequence function"))
+ (case type
+ ((list cons)
+ 'list)
+ ((string simple-string base-string simple-base-string)
+ 'string)
+ (simple-vector
+ 'simple-vector)
+ (vector
+ 'vector)
+ (t
+ (error "~S is a bad type specifier for sequence functions." type))
+ ))
+
+#+cmu
+(defun result-type-or-lose (type nil-ok)
+ (lisp::result-type-or-lose type nil-ok))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: loop-extension.cl
+;;;; Purpose: Extensions to the Loop macro for CMUCL
+;;;; Programmer: Pierre R. Mai
+;;;;
+;;;; Copyright (c) 1999-2001 Pierre R. Mai
+;;;;
+;;;; $Id: loop-extension.cl,v 1.1 2002/03/23 14:04:49 kevin Exp $
+;;;;
+;;;; The functions in this file were orignally distributed in the
+;;;; MaiSQL package in the file sql/sql.cl
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+;;;; MIT-LOOP extension
+
+#+cmu
+(defun loop-record-iteration-path (variable data-type prep-phrases)
+ (let ((in-phrase nil)
+ (from-phrase nil))
+ (loop for (prep . rest) in prep-phrases
+ do
+ (case prep
+ ((:in :of)
+ (when in-phrase
+ (ansi-loop::loop-error
+ "Duplicate OF or IN iteration path: ~S." (cons prep rest)))
+ (setq in-phrase rest))
+ ((:from)
+ (when from-phrase
+ (ansi-loop::loop-error
+ "Duplicate FROM iteration path: ~S." (cons prep rest)))
+ (setq from-phrase rest))
+ (t
+ (ansi-loop::loop-error
+ "Unknown preposition: ~S." prep))))
+ (unless in-phrase
+ (ansi-loop::loop-error "Missing OF or IN iteration path."))
+ (unless from-phrase
+ (setq from-phrase '(*default-database*)))
+ (cond
+ ((consp variable)
+ (let ((query-var (ansi-loop::loop-gentemp 'loop-record-))
+ (db-var (ansi-loop::loop-gentemp 'loop-record-database-))
+ (result-set-var (ansi-loop::loop-gentemp
+ 'loop-record-result-set-))
+ (step-var (ansi-loop::loop-gentemp 'loop-record-step-)))
+ (push `(when ,result-set-var
+ (database-dump-result-set ,result-set-var ,db-var))
+ ansi-loop::*loop-epilogue*)
+ `(((,variable nil ,data-type) (,query-var ,(first in-phrase))
+ (,db-var ,(first from-phrase))
+ (,result-set-var nil)
+ (,step-var nil))
+ ((multiple-value-bind (%rs %cols)
+ (database-query-result-set ,query-var ,db-var)
+ (setq ,result-set-var %rs ,step-var (make-list %cols))))
+ ()
+ ()
+ (not (database-store-next-row ,result-set-var ,db-var ,step-var))
+ (,variable ,step-var)
+ (not ,result-set-var)
+ ()
+ (not (database-store-next-row ,result-set-var ,db-var ,step-var))
+ (,variable ,step-var))))
+ (t
+ (let ((query-var (ansi-loop::loop-gentemp 'loop-record-))
+ (db-var (ansi-loop::loop-gentemp 'loop-record-database-))
+ (result-set-var (ansi-loop::loop-gentemp
+ 'loop-record-result-set-)))
+ (push `(when ,result-set-var
+ (database-dump-result-set ,result-set-var ,db-var))
+ ansi-loop::*loop-epilogue*)
+ `(((,variable nil ,data-type) (,query-var ,(first in-phrase))
+ (,db-var ,(first from-phrase))
+ (,result-set-var nil))
+ ((multiple-value-bind (%rs %cols)
+ (database-query-result-set ,query-var ,db-var)
+ (setq ,result-set-var %rs ,variable (make-list %cols))))
+ ()
+ ()
+ (not (database-store-next-row ,result-set-var ,db-var ,variable))
+ ()
+ (not ,result-set-var)
+ ()
+ (not (database-store-next-row ,result-set-var ,db-var ,variable))
+ ()))))))
+
+#+cmu
+(ansi-loop::add-loop-path '(record records tuple tuples)
+ 'loop-record-iteration-path
+ ansi-loop::*loop-ansi-universe*
+ :preposition-groups '((:of :in) (:from))
+ :inclusive-permitted nil)
--- /dev/null
+clsql.pdf
+clsql.ps
+clsql.tex
+clsql.dvi
+clsql.aux
+clsql.log
+clsql.out
+html
--- /dev/null
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for the clsql documentation
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile,v 1.1 2002/03/23 14:04:49 kevin Exp $
+#
+# This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+#
+# UFFI 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.
+
+
+
+# Set to DSSSL
+# For RedHat 6.x
+#DSSSL_HTML=/usr/lib/sgml/stylesheets/nwalsh-modular/html/docbook.dsl
+#DSSL_PRINT=/usr/lib/sgml/stylesheets/nwalsh-modular/print/docbook.dsl
+
+# For RedHat 7.2
+DSSSL_HTML=/usr/share/sgml/docbook/dsssl-stylesheets-1.64/html/docbook.dsl
+DSSSL_PRINT=/usr/share/sgml/docbook/dsssl-stylesheets-1.64/print/docbook.dsl
+
+# Latest version
+DSSSL_HTML=/usr/share/sgml/docbook/dsssl-stylesheets-1.76/html/docbook.dsl
+DSSSL_PRINT=/usr/share/sgml/docbook/dsssl-stylesheets-1.76/print/docbook.dsl
+
+# Custom version
+DSSSL_HTML=dsssl/html/docbook.dsl
+DSSSL_PRINT=dsssl/print/docbook.dsl
+
+# Nothing to configure beyond this point
+
+DOCFILE_BASE_DEFAULT=clsql
+DOCFILE_EXT_DEFAULT=sgml
+
+# Standard docfile processing
+
+ifndef DOCFILE_BASE
+DOCFILE_BASE=${DOCFILE_BASE_DEFAULT}
+endif
+
+ifndef DOCFILE_EXT
+DOCFILE_EXT=${DOCFILE_EXT_DEFAULT}
+endif
+
+DOCFILE=${DOCFILE_BASE}.${DOCFILE_EXT}
+TEXFILE=${DOCFILE_BASE}.tex
+PDFFILE=${DOCFILE_BASE}.pdf
+PSFILE=${DOCFILE_BASE}.ps
+DVIFILE=${DOCFILE_BASE}.dvi
+TMPFILES=${DOCFILE_BASE}.aux ${DOCFILE_BASE}.out ${DOCFILE_BASE}.log
+DOCFILES=$(shell echo *.sgml)
+
+all: html pdf ps dvi
+
+dist-doc: html pdf
+
+CHECK=nsgmls -s -C catalog || exit 1
+
+check:
+ $(CHECK)
+
+html: html/manual.htm
+
+html/manual.htm: ${DOCFILES}
+ $(CHECK)
+ ( rm -rf html ; mkdir html; cd html ; jade -t sgml -c ../catalog -d ${DSSSL_HTML} ../${DOCFILE}; mv book1.htm manual.htm; cd ..)
+
+tex: ${TEXFILE}
+
+${TEXFILE}: ${DOCFILES}
+ $(CHECK)
+ @jade -t tex -c catalog -d ${DSSSL_PRINT} ${DOCFILE}
+
+pdf: ${PDFFILE}
+
+${PDFFILE}: ${TEXFILE}
+ @pdfjadetex '\pdfcompresslevel=9' '\input ${TEXFILE}'
+ @pdfjadetex '\pdfcompresslevel=9' '\input ${TEXFILE}'
+ @pdfjadetex '\pdfcompresslevel=9' '\input ${TEXFILE}'
+ @pdfjadetex '\pdfcompresslevel=9' '\input ${TEXFILE}'
+
+dvi: ${DVIFILE}
+
+${DVIFILE}: ${TEXFILE}
+ jadetex ${TEXFILE}
+ jadetex ${TEXFILE}
+ jadetex ${TEXFILE}
+ jadetex ${TEXFILE}
+
+ps: ${PSFILE}
+
+${PSFILE}: ${DVIFILE}
+ dvips -o ${PSFILE} ${DVIFILE}
+
+clean:
+ @rm -rf html
+ @rm -f ${PSFILE} ${PDFFILE} ${DVIFILE} ${TEXFILE}
+ @rm -f ${TMPFILES}
+
+realclean: clean
+ @rm -f *~
+
+
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+ <appendix>
+ <title>Database Back-ends</title>
+
+ <sect1>
+ <title>MySQL</title>
+ <sect2>
+ <title>Libraries</title>
+ <para>The MySQL back-end needs access to the MySQL C
+ client library (<filename>libmysqlclient.so</filename>).
+ The location of this library is specified via
+ <symbol>*mysql-so-load-path*</symbol>, which defaults
+ to <filename>/usr/lib/libmysqlclient.so</filename>.
+ Additional flags to <application>ld</application> needed for
+ linking are specified via
+ <symbol>*mysql-so-libraries*</symbol>,
+ which defaults to <symbol>("-lc")</symbol>.</para>
+ </sect2>
+ <sect2>
+ <title>Initialization</title>
+ <para>Use
+ <programlisting>(mk:load-system :clsql-mysql)</programlisting>
+ to load the MySQL back-end. The database type for the MySQL
+ back-end is <symbol>:mysql</symbol>.</para>
+ </sect2>
+ <sect2>
+ <title>Connection Specification</title>
+ <sect3>
+ <title>Syntax of connection-spec</title>
+ <synopsis>(<replaceable>host</replaceable> <replaceable>db</replaceable> <replaceable>user</replaceable> <replaceable>password</replaceable>)</synopsis>
+ </sect3>
+ <sect3>
+ <title>Description of connection-spec</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>host</parameter></term>
+ <listitem>
+ <para>String representing the hostname or IP address
+ the MySQL server resides on, or <symbol>nil</symbol>
+ to indicate the localhost.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>db</parameter></term>
+ <listitem>
+ <para>String representing the name of the database on
+ the server to connect to.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>user</parameter></term>
+ <listitem>
+ <para>String representing the user name to use for
+ authentication, or <symbol>nil</symbol> to use the
+ current Unix user ID.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>password</parameter></term>
+ <listitem>
+ <para>String representing the unencrypted password to
+ use for authentication, or <symbol>nil</symbol> if
+ the authentication record has an empty password
+ field.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </sect3>
+ </sect2>
+ </sect1>
+
+ <sect1>
+ <title>AODBC</title>
+ <sect2>
+ <title>Libraries</title>
+ <para>The AODBC back-end requires access to the ODBC interface
+ of &acl;.</para>
+ </sect2>
+ <sect2>
+ <title>Initialization</title>
+ <para>Use
+ <programlisting>(mk:load-system :clsql-aodbc)</programlisting>
+ to load the MySQL back-end. The database type for the AODBC
+ back-end is <symbol>:aodbc</symbol>.</para>
+ </sect2>
+ <sect2>
+ <title>Connection Specification</title>
+ <sect3>
+ <title>Syntax of connection-spec</title>
+ <synopsis>(<replaceable>dsn</replaceable> <replaceable>user</replaceable> <replaceable>password</replaceable>)</synopsis>
+ </sect3>
+ <sect3>
+ <title>Description of connection-spec</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>dsn</parameter></term>
+ <listitem>
+ <para>String representing the ODBC data source name.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>user</parameter></term>
+ <listitem>
+ <para>String representing the user name to use for
+ authentication.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>password</parameter></term>
+ <listitem>
+ <para>String representing the unencrypted password to
+ use for authentication.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </sect3>
+ </sect2>
+ </sect1>
+
+ <sect1>
+ <title>PostgreSQL</title>
+ <sect2>
+ <title>Libraries</title>
+ <para>The PostgreSQL back-end needs access to the PostgreSQL C
+ client library (<filename>libpq.so</filename>). The
+ location of this library is specified via
+ <symbol>*postgresql-so-load-path*</symbol>, which defaults
+ to <filename>/usr/lib/libpq.so</filename>. Additional flags
+ to <application>ld</application> needed for linking are
+ specified via <symbol>*postgresql-so-libraries*</symbol>,
+ which defaults to <symbol>("-lcrypt" "-lc")</symbol>.</para>
+ </sect2>
+ <sect2>
+ <title>Initialization</title>
+ <para>Use
+ <programlisting>(mk:load-system :clsql-postgresql)</programlisting>
+ to load the PostgreSQL back-end. The database type for the
+ PostgreSQL back-end is <symbol>:postgresql</symbol>.</para>
+ </sect2>
+ <sect2>
+ <title>Connection Specification</title>
+ <sect3>
+ <title>Syntax of connection-spec</title>
+ <synopsis>(<replaceable>host</replaceable> <replaceable>db</replaceable> <replaceable>user</replaceable> <replaceable>password</replaceable> &optional <replaceable>port</replaceable> <replaceable>options</replaceable> <replaceable>tty</replaceable>)</synopsis>
+ </sect3>
+ <sect3>
+ <title>Description of connection-spec</title>
+ <para>For every parameter in the connection-spec,
+ <symbol>nil</symbol> indicates that the PostgreSQL default
+ environment variables (see PostgreSQL documentation) will
+ be used, or if those are unset, the compiled-in defaults
+ of the C client library are used.</para>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>host</parameter></term>
+ <listitem>
+ <para>String representing the hostname or IP address
+ the PostgreSQL server resides on. Use the empty
+ string to indicate a connection to localhost via
+ Unix-Domain sockets instead of TCP/IP.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>db</parameter></term>
+ <listitem>
+ <para>String representing the name of the database on
+ the server to connect to.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>user</parameter></term>
+ <listitem>
+ <para>String representing the user name to use for
+ authentication.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>password</parameter></term>
+ <listitem>
+ <para>String representing the unencrypted password to
+ use for authentication.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>port</parameter></term>
+ <listitem>
+ <para>String representing the port to use for
+ communication with the PostgreSQL server.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>options</parameter></term>
+ <listitem>
+ <para>String representing further runtime options for
+ the PostgreSQL server.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>tty</parameter></term>
+ <listitem>
+ <para>String representing the tty or file to use for
+ debugging messages from the PostgreSQL server.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </sect3>
+ </sect2>
+ </sect1>
+
+ <sect1>
+ <title>PostgreSQL Socket</title>
+ <sect2>
+ <title>Libraries</title>
+ <para>The PostgreSQL Socket back-end needs
+ <emphasis>no</emphasis> access to the PostgreSQL C
+ client library, since it communicates directly with the
+ PostgreSQL server using the published frontend/backend
+ protocol, version 2.0. This eases installation and makes it
+ possible to dump CMU CL images containing CLSQL and this
+ backend, contrary to backends which require FFI code.</para>
+ </sect2>
+ <sect2>
+ <title>Initialization</title>
+ <para>Use
+ <programlisting>(mk:load-system :clsql-postgresql-socket)</programlisting>
+ to load the PostgreSQL Socket back-end. The database type for the
+ PostgreSQL Socket back-end is
+ <symbol>:postgresql-socket</symbol>.</para>
+ </sect2>
+ <sect2>
+ <title>Connection Specification</title>
+ <sect3>
+ <title>Syntax of connection-spec</title>
+ <synopsis>(<replaceable>host</replaceable> <replaceable>db</replaceable> <replaceable>user</replaceable> <replaceable>password</replaceable> &optional <replaceable>port</replaceable> <replaceable>options</replaceable> <replaceable>tty</replaceable>)</synopsis>
+ </sect3>
+ <sect3>
+ <title>Description of connection-spec</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>host</parameter></term>
+ <listitem>
+ <para>If this is a string, it represents the hostname or
+ IP address the PostgreSQL server resides on. In
+ this case communication with the server proceeds via
+ a TCP connection to the given host and port.</para>
+ <para>
+ If this is a pathname, then it is assumed to name the
+ directory that contains the server's Unix-Domain
+ sockets. The full name to the socket is then
+ constructed from this and the port number passed,
+ and communication will proceed via a connection to
+ this unix-domain socket.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>db</parameter></term>
+ <listitem>
+ <para>String representing the name of the database on
+ the server to connect to.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>user</parameter></term>
+ <listitem>
+ <para>String representing the user name to use for
+ authentication.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>password</parameter></term>
+ <listitem>
+ <para>String representing the unencrypted password to
+ use for authentication. This can be the empty
+ string if no password is required for
+ authentication.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>port</parameter></term>
+ <listitem>
+ <para>Integer representing the port to use for
+ communication with the PostgreSQL server. This
+ defaults to 5432.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>options</parameter></term>
+ <listitem>
+ <para>String representing further runtime options for
+ the PostgreSQL server.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>tty</parameter></term>
+ <listitem>
+ <para>String representing the tty or file to use for
+ debugging messages from the PostgreSQL server.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </sect3>
+ </sect2>
+ </sect1>
+ </appendix>
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+<bookinfo>
+ <title>&clsql; Users' Guide</title>
+ <author>
+ <firstname>Pierre</firstname>
+ <othername>R.</othername>
+ <surname>Mai</surname>
+ </author>
+ <author>
+ <firstname>Kevin</firstname>
+ <othername>M.</othername>
+ <surname>Rosenberg</surname>
+ </author>
+ <printhistory>
+ <simpara>Release $Name: $</simpara>
+ <simpara>File $Date: 2002/03/23 14:04:50 $</simpara>
+ <simpara>$Id: bookinfo.sgml,v 1.1 2002/03/23 14:04:50 kevin Exp $</simpara>
+ </printhistory>
+ <copyright>
+ <year>1999</year>
+ <year>2001</year>
+ <year>2002</year>
+ <holder>Pierre R. Mai and Kevin M. Rosenberg</holder>
+ </copyright>
+ <legalnotice>
+ <itemizedlist>
+ <listitem>
+ <para>&clsql; is Copyright ©
+ 1999-2001 by Pierre R. Mai and Copyright © 2002 by
+ Kevin M. Rosenberg.</para>
+ </listitem>
+ <listitem>
+ <para><application>Allegro CL</application>® is a registered
+ trademark of Franz Inc.</para>
+ </listitem>
+ <listitem>
+ <para><application>Common SQL</application>,
+ <application>LispWorks</application> and
+ <application>Xanalys</application> are trademarks or
+ registered trademarks of Xanalys Inc.</para>
+ </listitem>
+ <listitem>
+ <para><application>Microsoft
+ Windows</application>® is a registered trademark of
+ Microsoft Inc.</para>
+ </listitem>
+ <listitem>
+ <para>Other brand or
+ product names are the registered trademarks or trademarks of
+ their respective holders.</para>
+ </listitem>
+ </itemizedlist>
+ </legalnotice>
+</bookinfo>
--- /dev/null
+CATALOG sgml-docbook-4.1.cat
+DOCUMENT clsql.sgml
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+<!DOCTYPE BOOK PUBLIC "-//OASIS//DTD DocBook V4.1//EN" [
+<!ENTITY defsystem "<application><emphasis>Defsystem</emphasis></application>">
+<!ENTITY clocc "<application><emphasis>CLOCC</emphasis></application>">
+<!ENTITY uffi "<application><emphasis>UFFI</emphasis></application>">
+<!ENTITY ffi "<emphasis>FFI</emphasis>">
+<!ENTITY clsql "<application><emphasis>CLSQL</emphasis></application>">
+<!ENTITY maisql "<application><emphasis>MaiSQL</emphasis></application>">
+<!ENTITY sql "<application>SQL</application>">
+<!ENTITY mysql "<application>MySQL</application>">
+<!ENTITY postgresql "<application>PostgreSQL</application>">
+<!ENTITY aodbc "<application>AODBC</application>">
+<!ENTITY cmucl "<application>CMUCL</application>">
+<!ENTITY lw "<application>Lispworks</application>">
+<!ENTITY acl "<application>AllegroCL</application>">
+<!ENTITY cl "<application>ANSI Common Lisp</application>">
+<!ENTITY t "<constant>T</constant>">
+<!ENTITY nil "<constant>NIL</constant>">
+<!ENTITY null "<constant>NULL</constant>">
+<!ENTITY c "<computeroutput>C</computeroutput>">
+<!ENTITY defsystem "<application>defsystem</application>">
+<!ENTITY bookinfo SYSTEM "bookinfo.sgml">
+<!ENTITY preface SYSTEM "preface.sgml">
+<!ENTITY intro SYSTEM "intro.sgml">
+<!ENTITY ref SYSTEM "ref.sgml">
+<!ENTITY appendix SYSTEM "appendix.sgml">
+<!ENTITY glossary SYSTEM "glossary.sgml">
+]>
+
+<book>
+&bookinfo;
+&preface;
+&intro;
+&ref;
+&appendix;
+&glossary;
+</book>
--- /dev/null
+<!DOCTYPE style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN" [
+<!ENTITY dbstyle PUBLIC "-//Norman Walsh//DOCUMENT DocBook HTML Stylesheet/EN" CDATA DSSSL>
+]>
+
+ <style-sheet>
+ <style-specification use="docbook">
+ <style-specification-body>
+(element envar ($mono-seq$))
+(element symbol ($mono-seq$))
+(element type ($mono-seq$))
+(element errortype ($mono-seq$))
+(element returnvalue ($italic-mono-seq$))
+(define (book-titlepage-recto-elements)
+ (list (normalize "title")
+ (normalize "subtitle")
+ (normalize "graphic")
+ (normalize "corpauthor")
+ (normalize "authorgroup")
+ (normalize "author")
+ (normalize "editor")
+ (normalize "printhistory")
+ (normalize "copyright")
+ (normalize "abstract")
+ (normalize "legalnotice")))
+(define %use-id-as-filename% #t)
+(define use-output-dir #t)
+ --> </style-specification-body>
+ --> </style-specification>
+<external-specification id="docbook" document="dbstyle">
+ --> </style-sheet>
--- /dev/null
+<!DOCTYPE style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN" [
+<!ENTITY docbook PUBLIC "-//Norman Walsh//DOCUMENT DocBook HTML Stylesheet//EN" CDATA DSSSL>
+]>
+
+ <style-sheet>
+ <style-specification use="docbook">
+ <style-specification-body>
+(element envar ($mono-seq$))
+(element symbol ($mono-seq$))
+(element type ($mono-seq$))
+(element errortype ($mono-seq$))
+(element returnvalue ($italic-mono-seq$))
+(define (book-titlepage-recto-elements)
+ (list (normalize "title")
+ (normalize "subtitle")
+ (normalize "graphic")
+ (normalize "corpauthor")
+ (normalize "authorgroup")
+ (normalize "author")
+ (normalize "editor")
+ (normalize "printhistory")
+ (normalize "copyright")
+ (normalize "abstract")
+ (normalize "legalnotice")))
+(define %use-id-as-filename% #t)
+(define use-output-dir #t)
+</style-specification-body>
+</style-specification>
+<external-specification id="docbook" document="docbook">
+</style-sheet>
--- /dev/null
+<!DOCTYPE style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN" [
+<!ENTITY dbstyle PUBLIC "-//Norman Walsh//DOCUMENT DocBook Print Stylesheet/EN" CDATA DSSSL>
+]>
+
+ <style-sheet>
+ <style-specification use="docbook">
+ <style-specification-body>
+(element envar ($mono-seq$))
+(element symbol ($mono-seq$))
+(element type ($mono-seq$))
+(element errortype ($mono-seq$))
+(element returnvalue ($italic-mono-seq$))
+(define (book-titlepage-verso-elements)
+ (list (normalize "title")
+ (normalize "subtitle")
+ (normalize "corpauthor")
+ (normalize "authorgroup")
+ (normalize "author")
+ (normalize "editor")
+ (normalize "edition")
+ (normalize "pubdate")
+ (normalize "printhistory")
+ (normalize "copyright")
+ (normalize "abstract")
+ (normalize "legalnotice")
+ (normalize "revhistory")))
+ --> </style-specification-body>
+ --> </style-specification>
+<external-specification id="docbook" document="dbstyle">
+ --> </style-sheet>
--- /dev/null
+<!DOCTYPE style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN" [
+<!ENTITY docbook PUBLIC "-//Norman Walsh//DOCUMENT DocBook Print Stylesheet//EN" CDATA DSSSL>
+]>
+
+<style-sheet>
+<style-specification use="docbook">
+<style-specification-body>
+(element envar ($mono-seq$))
+(element symbol ($mono-seq$))
+(element type ($mono-seq$))
+(element errortype ($mono-seq$))
+(element returnvalue ($italic-mono-seq$))
+(define (book-titlepage-verso-elements)
+ (list (normalize "title")
+ (normalize "subtitle")
+ (normalize "corpauthor")
+ (normalize "authorgroup")
+ (normalize "author")
+ (normalize "editor")
+ (normalize "edition")
+ (normalize "pubdate")
+ (normalize "printhistory")
+ (normalize "copyright")
+ (normalize "abstract")
+ (normalize "legalnotice")
+ (normalize "revhistory")))
+</style-specification-body>
+</style-specification>
+<external-specification id="docbook" document="docbook">
+</style-sheet>
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+<glossary>
+ <note>
+ <para>This glossary is still very thinly populated, and not all
+ references in the main text have been properly linked and
+ coordinated with this glossary. This will hopefully change in
+ future revisions.
+ </para>
+ </note>
+ <glossentry>
+ <glossterm>Active database</glossterm>
+ <glosssee otherterm="gloss-database-object">
+ </glossentry>
+ <glossentry>
+ <glossterm>Connection</glossterm>
+ <glosssee otherterm="gloss-database-object">
+ </glossentry>
+ <glossentry>
+ <glossterm>Closed Database</glossterm>
+ <glossdef>
+ <para>
+ An object of type <type>closed-database</type>. This is
+ in contrast to the terms connection, database, active
+ database or <glossterm
+ linkend="gloss-database-object">database object</glossterm>
+ which don't include objects which are closed database.
+ </para>
+ </glossdef>
+ </glossentry>
+ <glossentry>
+ <glossterm>database</glossterm>
+ <glosssee otherterm="gloss-database-object">
+ </glossentry>
+ <glossentry id="gloss-ffi">
+ <glossterm>Foreign Function Interface
+ (<acronym>FFI</acronym>)
+ </glossterm>
+ <glossdef>
+ <para>
+ An interface from Common Lisp to a external library which
+ contains compiled functions written in other programming
+ languages, typically C.
+ </para>
+ </glossdef>
+ </glossentry>
+ <glossentry id="gloss-database-object">
+ <glossterm>Database Object</glossterm>
+ <glossdef>
+ <para>An object of type <type>database</type>.</para>
+ </glossdef>
+ </glossentry>
+ <glossentry id="gloss-sql">
+ <glossterm>Structured Query Language
+ (<acronym>SQL</acronym>)
+ </glossterm>
+ <glossdef>
+ <para>
+ An ANSI standard language for storing and retrieving data
+ in a relational database.
+ </para>
+ </glossdef>
+ </glossentry>
+ <glossentry id="gloss-sql-expression">
+ <glossterm>SQL Expression</glossterm>
+ <glossdef>
+ <para>Either a string containing a valid SQL statement, or
+ an object of type <type>sql-expression</type><note>
+ <para>This has not been implemented yet, so only strings
+ are valid SQL expressions for the moment.</para>
+ </note>
+ </para>
+ </glossdef>
+ </glossentry>
+</glossary>
+
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+<chapter>
+ <title>Introduction</title>
+
+ <sect1>
+ <title>Purpose</title>
+ <para>&clsql; is a Common Lisp interface to <glossterm
+linkend="gloss-sql">SQL</glossterm> databases. A number of Common
+Lisp implementations and SQL databases are supported.The general
+structure of &clsql; is based on the
+<application>CommonSQL</application> package by Xanalys.</para>
+ </sect1>
+
+ <sect1>
+ <title>History</title>
+ <para>
+ &clsql; is written by Kevin M. Rosenberg and based substantially
+on Pierre R. Mai's excellent &maisql; package. The main changes have
+been to port the &ffi; to &uffi;, add to Allegro's ODBC interface as a
+supported database, add a compatibility layer for &cmucl; specific
+code, and make the code more robust in terms of &mysql; support.
+ </para>
+ </sect1>
+
+ <sect1>
+ <title>Prerequisites</title>
+
+ <sect2>
+ <title>&defsystem;</title>
+ <para> &clsql; uses &defsystem to compile and load its
+components. &defsystem; is included in the <ulink
+url="http://clocc.sourceforge.net"><citetitle>&clocc;</citetitle></ulink>. The
+defsystem version in the pre-packaged distribution is rather old and
+may not function well. The version in CVS tree tree works quite
+well. For convenience, a copy of the latest defsystem at the FTP
+<ulink
+url="ftp://ftp.med-info.com/pub/defsystem/"><citetitle>site</citetitle></ulink>
+of &clsql;.
+ </para>
+ </sect2>
+
+ <sect2>
+ <title>&uffi;</title>
+ <para> &clsql; uses <ulink
+url="http://uffi.med-info.com/"><citetitle>&uffi;</citetitle></ulink>
+as a <emphasis>Foreign Function Interface</emphasis> (<glossterm
+linkend="gloss-ffi">FFI</glossterm>) to support multiple &cl;
+implementations.</para>
+
+<para>You can download &uffi; from its FTP <ulink
+url="ftp://ftp.med-info.com/pub/uffi/"><citetitle>site</citetitle></ulink>. There
+are zip files for Microsoft Windows systems and gzipped tar files for
+other systems.</para>
+ </sect2>
+
+ <sect2>
+ <title>Supported Common Lisp Implementation</title>
+ <para>
+The implementations that support &clsql; is governed by the supported
+implementations of &uffi;. At the time of the initial release of &clsql;,
+the following implementations are supported:
+ </para>
+ <itemizedlist mark="opencircle">
+ <listitem><para>&acl; v6.1 on Redhat Linux 7.2 and Microsoft Windows.</para></listitem>
+ <listitem><para>&lw; v4.2 on Redhat Linux 7.2 and Microsoft Windows.</para></listitem>
+ <listitem><para>&cmucl; 18d on Redhat Linux 7.2.</para></listitem>
+ </itemizedlist>
+ </sect2>
+
+ <sect2>
+ <title>Supported &sql; Implementation</title>
+ <para>
+ Currently, &clsql; supports the following databases:
+ </para>
+ <itemizedlist mark="opencircle">
+ <listitem><para>&mysql; v3.23.49 on Redhat Linux 7.2 and Microsoft Windows.</para></listitem>
+ <listitem><para>&postgresql; v7.1 on Redhat Linux 7.2. Support for both direct API connections and TCP socket connections.</para></listitem>
+ <listitem><para>Allegro's ODBC interface (&aodbc;) on Redhat Linux 7.2 and Microsoft Windows.</para></listitem>
+ </itemizedlist>
+ </sect2>
+
+ </sect1>
+
+ <sect1>
+ <title>Installation</title>
+
+ <sect2>
+ <title>Ensure &defsystem; is loaded</title>
+ <para>
+ Simply load the file <filename>defsystem.lisp</filename>.
+<computeroutput>
+(load "defsystem.lisp")
+</computeroutput>
+ </para>
+ </sect2>
+
+ <sect2>
+ <title>Build <filename>clsql-mysql</filename> helper library</title>
+ <para>&mysql; uses functions that require 64-bit integer
+parameters and return values. The &ffi; in most &clsql;
+implementations do not support 64-bit integers. Thus, a C helper
+library is required to break these 64-bit integers into two compatible
+32-bit integers.</para>
+
+<para><filename>Makefile</filename>'s for Microsoft Windows and GNU/Solaris systems
+are supplied to build this library. In addition, the <type>DLL</type> and <type>LIB</type>
+files for Microsoft Windows are supplied with the distribution.</para>
+
+<para>To build the library, first move to the directory
+<filename>interfaces/mysql</filename> directory. You may need to
+edit <filename>Makefile</filename> or <filename>Makefile.msvc</filename> to
+correctly specify the location of your &mysql; installation. On UNIX systems, use
+the command:
+<programlisting>make</programlisting>. On a Microsoft Windows system,
+use the command: <programlisting>nmake /f
+Makefile.msvc</programlisting>.</para>
+ </sect2>
+
+ <sect2>
+ <title>Load &uffi;</title>
+ <para>
+ Unpack the appropriate &uffi; version for your system which creates a directory
+for the &uffi; files. Add that directory to &defsystem; <varname>*central-registry*</varname>.
+You can do that by either pushing the pathname of the directory onto this variable, or
+use the new <function>add-registry-location</function> present in the newest versions of
+&defsystem;. The below example code assumes the &uffi; files reside in the
+<filename>/usr/local/src/lisp/uffi</filename> directory.
+ <computeroutput>
+ (mk:add-registry-location #P"/usr/local/src/lisp/uffi")
+ (mk:load-system :uffi)
+ </computeroutput>
+ </para>
+ </sect2>
+
+ </sect1>
+
+</chapter>
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+ <preface>
+ <title>Preface</title>
+ <para>This guide provides reference
+ to the features of &clsql;. The first
+ chapter provides an introduction to &clsql; and installation
+ instructions.
+ Following that chapter is the reference section for all user
+ accessible symbols of &clsql; with examples of usage,
+ followed by the reference section for all accessible symbols of
+ the database back-end interface. At the end there you will find
+ a glossary of commonly used terms with their
+ definitions.</para>
+ </preface>
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+ <reference>
+ <title><symbol>CLSQL</symbol></title>
+ <partintro>
+ <para>This part gives a reference to all the symbols exported
+ from the package <symbol>CLSQL-SYS</symbol>, which are also
+ re-exported from the package <symbol>CLSQL</symbol>. These
+ symbols constitute the normal user-interface of
+ &clsql;.</para>
+ </partintro>
+ <!-- Conditions -->
+ <refentry id="maisql-condition">
+ <refnamediv>
+ <refname>CLSQL-CONDITION</refname>
+ <refpurpose>the super-type of all
+ &clsql;-specific
+ conditions</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This is the super-type of all
+ &clsql;-specific conditions
+ defined by &clsql;, or any of it's
+ database-specific interfaces. There are no defined
+ initialization arguments nor any accessors.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="maisql-error">
+ <refnamediv>
+ <refname>CLSQL-ERROR</refname>
+ <refpurpose>the super-type of all
+ &clsql;-specific
+ errors</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-error</errortype></member>
+ <member><errortype>error</errortype></member>
+ <member><errortype>serious-condition</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This is the super-type of all
+ &clsql;-specific conditions that
+ represent errors, as defined by
+ &clsql;, or any of it's
+ database-specific interfaces. There are no defined
+ initialization arguments nor any accessors.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="maisql-simple-error">
+ <refnamediv>
+ <refname>CLSQL-SIMPLE-ERROR</refname>
+ <refpurpose>Unspecific simple
+ &clsql; errors</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-simple-error</errortype></member>
+ <member><errortype>simple-condition</errortype></member>
+ <member><errortype>maisql-error</errortype></member>
+ <member><errortype>error</errortype></member>
+ <member><errortype>serious-condition</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This condition is used in all instances of errors, where
+ there exists no &clsql;-specific
+ condition that is more specific. The valid initialization
+ arguments and accessors are the same as for
+ <errortype>simple-condition</errortype>.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="maisql-warning">
+ <refnamediv>
+ <refname>CLSQL-WARNING</refname>
+ <refpurpose>the super-type of all
+ &clsql;-specific
+ warnings</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-warning</errortype></member>
+ <member><errortype>warning</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This is the super-type of all
+ &clsql;-specific conditions that
+ represent warnings, as defined by
+ &clsql;, or any of it's
+ database-specific interfaces. There are no defined
+ initialization arguments nor any accessors.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="maisql-simple-warning">
+ <refnamediv>
+ <refname>CLSQL-SIMPLE-WARNING</refname>
+ <refpurpose>Unspecific simple
+ &clsql; warnings</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-simple-warning</errortype></member>
+ <member><errortype>simple-condition</errortype></member>
+ <member><errortype>maisql-warning</errortype></member>
+ <member><errortype>warning</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This condition is used in all instances of warnings,
+ where there exists no
+ &clsql;-specific condition that is
+ more specific. The valid initialization arguments and
+ accessors are the same as for
+ <errortype>simple-condition</errortype>.</para>
+ </refsect1>
+ </refentry>
+ <!-- Specifc Conditions -->
+ <refentry id="maisql-invalid-spec-error">
+ <refnamediv>
+ <refname>CLSQL-INVALID-SPEC-ERROR</refname>
+ <refpurpose>condition representing errors because of invalid
+ connection specifications</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-invalid-spec-error</errortype></member>
+ <member><errortype>maisql-error</errortype></member>
+ <member><errortype>error</errortype></member>
+ <member><errortype>serious-condition</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This condition represents errors that occur because the
+ user supplies an invalid connection specification to either
+ <function>database-name-from-spec</function> or
+ <function>connect</function>. The following initialization
+ arguments and accessors exist:</para>
+ <segmentedlist>
+ <segtitle>Initarg</segtitle>
+ <segtitle>Accessor</segtitle>
+ <segtitle>Description</segtitle>
+ <seglistitem>
+ <seg><symbol>:connection-spec</symbol></seg>
+ <seg><function>maisql-invalid-spec-error-connection-spec</function></seg>
+ <seg>The invalid connection specification used.</seg>
+ </seglistitem>
+ <seglistitem>
+ <seg><symbol>:database-type</symbol></seg>
+ <seg><function>maisql-invalid-spec-error-database-type</function></seg>
+ <seg>The Database type used in the attempt.</seg>
+ </seglistitem>
+ <seglistitem>
+ <seg><symbol>:template</symbol></seg>
+ <seg><function>maisql-invalid-spec-error-template</function></seg>
+ <seg>An argument describing the template that a valid
+ connection specification must match for this database type.</seg>
+ </seglistitem>
+ </segmentedlist>
+ </refsect1>
+ </refentry>
+ <refentry id="maisql-connect-error">
+ <refnamediv>
+ <refname>CLSQL-CONNECT-ERROR</refname>
+ <refpurpose>condition representing errors during
+ connection</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-connect-error</errortype></member>
+ <member><errortype>maisql-error</errortype></member>
+ <member><errortype>error</errortype></member>
+ <member><errortype>serious-condition</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This condition represents errors that occur while trying
+ to connect to a database. The following initialization
+ arguments and accessors exist:</para>
+ <segmentedlist>
+ <segtitle>Initarg</segtitle>
+ <segtitle>Accessor</segtitle>
+ <segtitle>Description</segtitle>
+ <seglistitem>
+ <seg><symbol>:database-type</symbol></seg>
+ <seg><function>maisql-connect-error-database-type</function></seg>
+ <seg>Database type for the connection attempt</seg>
+ </seglistitem>
+ <seglistitem>
+ <seg><symbol>:connection-spec</symbol></seg>
+ <seg><function>maisql-connect-error-connection-spec</function></seg>
+ <seg>The connection specification used in the
+ connection attempt.</seg>
+ </seglistitem>
+ <seglistitem>
+ <seg><symbol>:errno</symbol></seg>
+ <seg><function>maisql-connect-error-errno</function></seg>
+ <seg>The numeric or symbolic error specification
+ returned by the database back-end. The values and
+ semantics of this are interface specific.</seg>
+ </seglistitem>
+ <seglistitem>
+ <seg><symbol>:error</symbol></seg>
+ <seg><function>maisql-connect-error-error</function></seg>
+ <seg>A string describing the problem that occurred,
+ possibly one returned by the database back-end.</seg>
+ </seglistitem>
+ </segmentedlist>
+ </refsect1>
+ </refentry>
+ <refentry id="maisql-sql-error">
+ <refnamediv>
+ <refname>CLSQL-SQL-ERROR</refname>
+ <refpurpose>condition representing errors during query or
+ command execution</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-sql-error</errortype></member>
+ <member><errortype>maisql-error</errortype></member>
+ <member><errortype>error</errortype></member>
+ <member><errortype>serious-condition</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This condition represents errors that occur while
+ executing SQL statements, either as part of query operations
+ or command execution, either explicitly or implicitly, as
+ caused e.g. by <function>with-transaction</function>.
+ The following initialization arguments and accessors exist:</para>
+ <segmentedlist>
+ <segtitle>Initarg</segtitle>
+ <segtitle>Accessor</segtitle>
+ <segtitle>Description</segtitle>
+ <seglistitem>
+ <seg><symbol>:database</symbol></seg>
+ <seg><function>maisql-sql-error-database</function></seg>
+ <seg>The database object that was involved in the
+ incident.</seg>
+ </seglistitem>
+ <seglistitem>
+ <seg><symbol>:expression</symbol></seg>
+ <seg><function>maisql-sql-error-expression</function></seg>
+ <seg>The SQL expression whose execution caused the error.</seg>
+ </seglistitem>
+ <seglistitem>
+ <seg><symbol>:errno</symbol></seg>
+ <seg><function>maisql-sql-error-errno</function></seg>
+ <seg>The numeric or symbolic error specification
+ returned by the database back-end. The values and
+ semantics of this are interface specific.</seg>
+ </seglistitem>
+ <seglistitem>
+ <seg><symbol>:error</symbol></seg>
+ <seg><function>maisql-sql-error-error</function></seg>
+ <seg>A string describing the problem that occurred,
+ possibly one returned by the database back-end.</seg>
+ </seglistitem>
+ </segmentedlist>
+ </refsect1>
+ </refentry>
+ <refentry id="maisql-exists-condition">
+ <refnamediv>
+ <refname>CLSQL-EXISTS-CONDITION</refname>
+ <refpurpose>condition indicating situations arising because of
+ existing connections</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-exists-condition</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This condition is the super-type of all conditions which
+ represents problems that occur during calls to
+ <function>connect</function>, if a connection to the
+ database exists already. Depending on the value of
+ <parameter>if-exists</parameter> to the call of
+ <function>connect</function>, either a warning, an error or
+ no condition at all is signalled. If a warning or error is
+ signalled, either
+ <errortype>maisql-exists-warning</errortype> or
+ <errortype>maisql-exists-error</errortype> is signalled,
+ which are subtypes of
+ <errortype>maisql-exists-condition</errortype> and
+ <errortype>maisql-warning</errortype> or
+ <errortype>maisql-error</errortype>.
+ <errortype>maisql-exists-condition</errortype> is never
+ signalled itself.</para>
+ <para>
+ The following initialization arguments and accessors exist:</para>
+ <segmentedlist>
+ <segtitle>Initarg</segtitle>
+ <segtitle>Accessor</segtitle>
+ <segtitle>Description</segtitle>
+ <seglistitem>
+ <seg><symbol>:old-db</symbol></seg>
+ <seg><function>maisql-exists-condition-old-db</function></seg>
+ <seg>The database object that represents the existing
+ connection. This slot is always filled.</seg>
+ </seglistitem>
+ <seglistitem>
+ <seg><symbol>:new-db</symbol></seg>
+ <seg><function>maisql-exists-condition-new-db</function></seg>
+ <seg>The database object that will be used and returned by
+ this call to connect, if execution continues normally.
+ This can be either <symbol>nil</symbol>, indicating that
+ a new database object is to be created on continuation,
+ or a database object representing the newly created
+ continuation, or the same database object as
+ <symbol>old-db</symbol>, indicating that the existing
+ database object will be reused. This slot is always
+ filled and defaults to <symbol>nil</symbol>.</seg>
+ </seglistitem>
+ </segmentedlist>
+ </refsect1>
+ </refentry>
+ <refentry id="maisql-exists-warning">
+ <refnamediv>
+ <refname>CLSQL-EXISTS-WARNING</refname>
+ <refpurpose>condition representing warnings arising because of
+ existing connections</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-exists-warning</errortype></member>
+ <member><errortype>maisql-exists-condition</errortype></member>
+ <member><errortype>maisql-warning</errortype></member>
+ <member><errortype>warning</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This condition is a subtype of
+ <errortype>maisql-exists-condition</errortype>, and is
+ signalled during calls to <function>connect</function> when
+ there is an existing connection, and
+ <parameter>if-exists</parameter> is either
+ <symbol>:warn-new</symbol> or <symbol>:warn-old</symbol>.
+ In the former case, <symbol>new-db</symbol> will be the
+ newly created database object, in the latter case it will be
+ the existing old database object.</para>
+ <para>
+ The initialization arguments and accessors are the same as
+ for <errortype>maisql-exists-condition</errortype>.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="maisql-exists-error">
+ <refnamediv>
+ <refname>CLSQL-EXISTS-ERROR</refname>
+ <refpurpose>condition representing errors arising because of
+ existing connections</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-exists-error</errortype></member>
+ <member><errortype>maisql-exists-condition</errortype></member>
+ <member><errortype>maisql-error</errortype></member>
+ <member><errortype>error</errortype></member>
+ <member><errortype>serious-condition</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This condition is a subtype of
+ <errortype>maisql-exists-condition</errortype>, and is
+ signalled during calls to <function>connect</function> when
+ there is an existing connection, and
+ <parameter>if-exists</parameter> is <symbol>:error</symbol>.
+ In this case, <symbol>new-db</symbol> will be
+ <symbol>nil</symbol>, indicating that the database object to
+ be returned by <function>connect</function> depends on user
+ action in continuing from this correctable error.</para>
+ <para>
+ The initialization arguments and accessors are the same as
+ for <errortype>maisql-exists-condition</errortype>.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="maisql-closed-error">
+ <refnamediv>
+ <refname>CLSQL-CLOSED-ERROR</refname>
+ <refpurpose>condition representing errors because the database
+ has already been closed</refpurpose>
+ <refclass>Condition Type</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><errortype>maisql-closed-error</errortype></member>
+ <member><errortype>maisql-error</errortype></member>
+ <member><errortype>error</errortype></member>
+ <member><errortype>serious-condition</errortype></member>
+ <member><errortype>maisql-condition</errortype></member>
+ <member><errortype>condition</errortype></member>
+ <member><errortype>t</errortype></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This condition represents errors that occur because the
+ user invokes an operation on the given database object,
+ although the database is invalid because
+ <function>disconnect</function> has already been called on
+ this database object.</para>
+ <para>Functions which signal this error when called with a
+ closed database will usually provide a
+ <symbol>continue</symbol> restart, that will just return nil
+ from the function.</para>
+ <para>
+ The following initialization arguments and accessors exist:</para>
+ <segmentedlist>
+ <segtitle>Initarg</segtitle>
+ <segtitle>Accessor</segtitle>
+ <segtitle>Description</segtitle>
+ <seglistitem>
+ <seg><symbol>:database</symbol></seg>
+ <seg><function>maisql-closed-error-database</function></seg>
+ <seg>The database object that was involved in the
+ incident.</seg>
+ </seglistitem>
+ </segmentedlist>
+ </refsect1>
+ </refentry>
+
+ <!-- Database Types -->
+ <refentry id="default-database-type">
+ <refnamediv>
+ <refname>*DEFAULT-DATABASE-TYPE*</refname>
+ <refpurpose>The default database type to use</refpurpose>
+ <refclass>Variable</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Value Type</title>
+ <para>Any keyword representing a valid database back-end of
+ &clsql;, or
+ <symbol>nil</symbol>.</para>
+ </refsect1>
+ <refsect1>
+ <title>Initial Value</title>
+ <para><symbol>nil</symbol></para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>The value of this variable is used in calls to
+ <function>initialize-database-type</function> and
+ <function>connect</function> as the default
+ value of the <parameter>database-type</parameter>
+ parameter.</para>
+ <caution>
+ <para>If the value of this variable is <symbol>nil</symbol>,
+ then all calls to
+ <function>initialize-database-type</function> or
+ <function>connect</function> will have to specify the
+ <parameter>database-type</parameter> to use, or a
+ general-purpose error will be signalled.</para>
+ </caution>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(setf *default-database-type* :mysql)
+=> :mysql
+(initialize-database-type)
+=> t
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Affected By</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="initialized-database-types">
+ <refnamediv>
+ <refname>*INITIALIZED-DATABASE-TYPES*</refname>
+ <refpurpose>List of all initialized database types</refpurpose>
+ <refclass>Variable</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Value Type</title>
+ <para>A list of all initialized database types, each of which
+ represented by it's corresponding keyword.</para>
+ </refsect1>
+ <refsect1>
+ <title>Initial Value</title>
+ <para><symbol>nil</symbol></para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This variable is updated whenever
+ <function>initialize-database-type</function> is called for a
+ database type which hasn't already been initialized before,
+ as determined by this variable. In that case the keyword
+ representing the database type is pushed onto the list
+ stored in
+ <symbol>*INITIALIZED-DATABASE-TYPES*</symbol>.</para>
+ <caution>
+ <para>Attempts to modify the value of this variable will
+ result in undefined behaviour.</para>
+ </caution>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(setf *default-database-type* :mysql)
+=> :mysql
+(initialize-database-type)
+=> t
+*initialized-database-types*
+=> (:MYSQL)
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Affected By</title>
+ <para>
+ <simplelist>
+ <member><function>initialize-database-type</function></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>Direct access to this variable is primarily provided
+ because of compatibility with Harlequin's <application>Common
+ SQL</application>.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="initialize-database-type">
+ <refnamediv>
+ <refname>INITIALIZE-DATABASE-TYPE</refname>
+ <refpurpose>Initializes a database type</refpurpose>
+ <refclass>Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>initialize-database-type</function> &key <replaceable>database-type</replaceable> => <returnvalue>result</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>database-type</parameter></term>
+ <listitem>
+ <para>The database type to initialize, i.e. a keyword
+ symbol denoting a known database back-end. Defaults to
+ the value of
+ <symbol>*default-database-type*</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>result</returnvalue></term>
+ <listitem>
+ <para>Either <symbol>nil</symbol> if the initialization
+ attempt fails, or <symbol>t</symbol> otherwise.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>If the back-end specified by
+ <parameter>database-type</parameter> has not already been
+ initialized, as seen from
+ <symbol>*initialized-database-types*</symbol>, an attempt is
+ made to initialize the database. If this attempt succeeds,
+ or the back-end has already been initialized, the function
+ returns t, and places the keyword denoting the database type
+ onto the list stored in
+ <symbol>*initialized-database-types*</symbol>, if not
+ already present.</para>
+ <para>If initialization fails, the function returns
+ <symbol>nil</symbol>, and/or signals an error of type
+ <errortype>maisql-error</errortype>. The kind of action
+ taken depends on the back-end and the cause of the
+ problem.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+*initialized-database-types*
+=> NIL
+(setf *default-database-type* :mysql)
+=> :MYSQL
+(initialize-database-type)
+>> Compiling LAMBDA (#:G897 #:G898 #:G901 #:G902):
+>> Compiling Top-Level Form:
+>>
+=> T
+*initialized-database-types*
+=> (:MYSQL)
+(initialize-database-type)
+=> T
+*initialized-database-types*
+=> (:MYSQL)
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>The database back-end corresponding to the database type
+ specified is initialized, unless it has already been
+ initialized. This can involve any number of other side
+ effects, as determined by the back-end implementation (like
+ e.g. loading of foreign code, calling of foreign code,
+ networking operations, etc.). If initialization is
+ attempted and succeeds, the
+ <parameter>database-type</parameter> is pushed onto the list
+ stored in
+ <symbol>*initialized-database-types*</symbol>.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>
+ <simplelist>
+ <member><symbol>*default-database-type*</symbol></member>
+ <member><symbol>*initialized-database-types*</symbol></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>If an error is encountered during the initialization
+ attempt, the back-end may signal errors of kind
+ <errortype>maisql-error</errortype>.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <!-- Databases Connection and Disconnection -->
+ <refentry id="connect-if-exists">
+ <refnamediv>
+ <refname>*CONNECT-IF-EXISTS*</refname>
+ <refpurpose>Default value for the
+ <parameter>if-exists</parameter> parameter of
+ <function>connect</function>.</refpurpose>
+ <refclass>Variable</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Value Type</title>
+ <para>A valid argument to the <parameter>if-exists</parameter>
+ parameter of <function>connect</function>, i.e. one of
+ <simplelist type="inline">
+ <member><symbol>:new</symbol></member>
+ <member><symbol>:warn-new</symbol></member>
+ <member><symbol>:error</symbol></member>
+ <member><symbol>:warn-old</symbol></member>
+ <member><symbol>:old</symbol></member>
+ </simplelist>.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Initial Value</title>
+ <para><symbol>:error</symbol></para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>The value of this variable is used in calls to
+ <function>connect</function> as the default
+ value of the <parameter>if-exists</parameter>
+ parameter. See <link
+ linkend="connect"><function>connect</function></link> for
+ the semantics of the valid values for this variable.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected By</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link
+ linkend="connect"><function>connect</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="connected-databases">
+ <refnamediv>
+ <refname>CONNECTED-DATABASES</refname>
+ <refpurpose>Return the list of active database
+ objects.</refpurpose>
+ <refclass>Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>connected-databases</function> => <returnvalue>databases</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><returnvalue>databases</returnvalue></term>
+ <listitem>
+ <para>The list of active database objects.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This function returns the list of active database
+ objects, i.e. all those database objects created by calls to
+ <function>connect</function>, which have not been closed by
+ calling <function>disconnect</function> on them.</para>
+ <caution>
+ <para>The consequences of modifying the list returned by
+ <function>connected-databases</function> are
+ undefined.</para>
+ </caution>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(connected-databases)
+=> NIL
+(connect '(nil "template1" "dent" nil) :database-type :postgresql)
+=> #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {4830BC65}>
+(connect '("dent" "newesim" "dent" "dent") :database-type :mysql)
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {4830C5AD}>
+(connected-databases)
+=> (#<CLSQL-MYSQL:MYSQL-DATABASE {4830C5AD}>
+ #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {4830BC65}>)
+(disconnect)
+=> T
+(connected-databases)
+=> (#<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {4830BC65}>)
+(disconnect)
+=> T
+(connected-databases)
+=> NIL
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected By</title>
+ <para>
+ <simplelist>
+ <member><function>connect</function></member>
+ <member><function>disconnect</function></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="default-database">
+ <refnamediv>
+ <refname>*DEFAULT-DATABASE*</refname>
+ <refpurpose>The default database object to use</refpurpose>
+ <refclass>Variable</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Value Type</title>
+ <para>Any object of type <type>database</type>, or nil to
+ indicate no default database.</para>
+ </refsect1>
+ <refsect1>
+ <title>Initial Value</title>
+ <para><symbol>nil</symbol></para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>Any function or macro in
+ &clsql; that operates on a
+ database uses the value of this variable as the default
+ value for it's <parameter>database</parameter>
+ parameter.</para>
+ <para>The value of this parameter is changed by calls to
+ <function>connect</function>, which sets
+ <symbol>*default-database*</symbol> to the database object
+ it returns. It is also changed by calls to
+ <function>disconnect</function>, when the database object
+ being disconnected is the same as the value of
+ <symbol>*default-database*</symbol>. In this case
+ <function>disconnect</function> sets
+ <symbol>*default-database*</symbol> to the first database
+ that remains in the list of active databases as returned by
+ <function>connected-databases</function>, or
+ <symbol>nil</symbol> if no further active databases
+ exist.</para>
+ <para>The user may change <symbol>*default-database*</symbol>
+ at any time to a valid value of his choice.</para>
+ <caution>
+ <para>If the value of <symbol>*default-database*</symbol> is
+ <symbol>nil</symbol>, then all calls to
+ &clsql; functions on databases
+ must provide a suitable <parameter>database</parameter>
+ parameter, or an error will be signalled.</para>
+ </caution>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(connected-databases)
+=> NIL
+(connect '("dent" "newesim" "dent" "dent") :database-type :mysql)
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {48385F55}>
+(connect '(nil "template1" "dent" nil) :database-type :postgresql)
+=> #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {483868FD}>
+(connect '("dent" "newesim" "dent" "dent") :database-type :mysql :if-exists :new)
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {48387265}>
+*default-database*
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {48387265}>
+(disconnect)
+=> T
+*default-database*
+=> #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {483868FD}>
+(disconnect)
+=> T
+*default-database*
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {48385F55}>
+(disconnect)
+=> T
+*default-database*
+=> NIL
+(connected-databases)
+=> NIL
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Affected By</title>
+ <para>
+ <simplelist>
+ <member><link linkend="connect"><function>connect</function></link></member>
+ <member><link linkend="disconnect"><function>disconnect</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link linkend="connected-databases"><function>connected-databases</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <note>
+ <para>This variable is intended to facilitate working with
+ &clsql; in an interactive
+ fashion at the top-level loop, and because of this,
+ <function>connect</function> and
+ <function>disconnect</function> provide some fairly
+ complex behaviour to keep
+ <symbol>*default-database*</symbol> set to useful values.
+ Programmatic use of &clsql;
+ should never depend on the value of
+ <symbol>*default-database*</symbol> and should provide
+ correct database objects via the
+ <parameter>database</parameter> parameter to functions
+ called.</para>
+ </note>
+ </refsect1>
+ </refentry>
+ <!-- Classes -->
+ <refentry id="database">
+ <refnamediv>
+ <refname>DATABASE</refname>
+ <refpurpose>The super-type of all
+ &clsql; databases</refpurpose>
+ <refclass>Class</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><type>database</type></member>
+ <member><type>standard-object</type></member>
+ <member><type>t</type></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This class is the superclass of all
+ &clsql; databases. The different
+ database back-ends derive subclasses of this class to
+ implement their databases. No instances of this class are
+ ever created by &clsql;.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="closed-database">
+ <refnamediv>
+ <refname>CLOSED-DATABASE</refname>
+ <refpurpose>The class representing all closed
+ &clsql; databases</refpurpose>
+ <refclass>Class</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Class Precedence List</title>
+ <para>
+ <simplelist type="inline">
+ <member><type>closed-database</type></member>
+ <member><type>standard-object</type></member>
+ <member><type>t</type></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>&clsql; <type>database</type>
+ instances are changed to this class via
+ <function>change-class</function> after they are closed via
+ <function>disconnect</function>. All functions and generic
+ functions that take database objects as arguments will
+ signal errors of type
+ <errortype>maisql-closed-error</errortype> when they are
+ called on instances of <type>closed-database</type>, with
+ the exception of <function>database-name</function>, which
+ will continue to work as for instances of
+ <type>database</type>.</para>
+ </refsect1>
+ </refentry>
+ <!-- Functions -->
+ <refentry id="database-name">
+ <refnamediv>
+ <refname>DATABASE-NAME</refname>
+ <refpurpose>Get the name of a database object</refpurpose>
+ <refclass>Generic Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>database-name</function> <replaceable>database</replaceable> => <returnvalue>name</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>database</parameter></term>
+ <listitem>
+ <para>A database object, either of type
+ <type>database</type> or of type
+ <type>closed-database</type>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>name</returnvalue></term>
+ <listitem>
+ <para>A string describing the identity of the database
+ to which this database object is connected to.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This function returns the database name of the given
+ database. The database name is a string which somehow
+ describes the identity of the database to which this
+ database object is or has been connected. The database name
+ of a database object is determined at
+ <function>connect</function> time, when a call to
+ <function>database-name-from-spec</function> derives the
+ database name from the connection specification passed to
+ <function>connect</function> in the
+ <parameter>connection-spec</parameter> parameter.</para>
+ <para>The database name is used via
+ <function>find-database</function> in
+ <function>connect</function> to determine whether database
+ connections to the specified database exist already.</para>
+ <para>Usually the database name string will include
+ indications of the host, database name, user, or port that
+ where used during the connection attempt. The only
+ important thing is that this string shall try to identify
+ the database at the other end of the connection. Connection
+ specifications parts like passwords and credentials shall
+ not be used as part of the database name.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(database-name-from-spec '("dent" "newesim" "dent" "dent") :mysql)
+=> "dent/newesim/dent"
+(connect '("dent" "newesim" "dent" "dent") :database-type :mysql)
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {48391DCD}>
+(database-name *default-database*)
+=> "dent/newesim/dent"
+
+(database-name-from-spec '(nil "template1" "dent" nil) :postgresql)
+=> "/template1/dent"
+(connect '(nil "template1" "dent" nil) :database-type :postgresql)
+=> #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {48392D2D}>
+(database-name *default-database*)
+=> "/template1/dent"
+
+(database-name-from-spec '("www.pmsf.de" "template1" "dent" nil) :postgresql)
+=> "www.pmsf.de/template1/dent"
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected By</title>
+ <para>
+ <simplelist>
+ <member><link linkend="database-name-from-spec"><function>database-name-from-spec</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>Will signal an error if the object passed as the
+ <parameter>database</parameter> parameter is neither of type
+ <type>database</type> nor of type
+ <type>closed-database</type>.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link
+ linkend="connect"><function>connect</function></link></member>
+ <member><link
+ linkend="find-database"><function>find-database</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="find-database">
+ <refnamediv>
+ <refname>FIND-DATABASE</refname>
+ <refpurpose>Locate a database object through it's
+ name.</refpurpose>
+ <refclass>Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>find-database</function> <replaceable>database</replaceable> &optional <replaceable>errorp</replaceable> => <returnvalue>result</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>database</parameter></term>
+ <listitem>
+ <para>A database object or a string, denoting a database
+ name.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>errorp</parameter></term>
+ <listitem>
+ <para>A generalized boolean. Defaults to
+ <symbol>t</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>result</returnvalue></term>
+ <listitem>
+ <para>Either a database object, or, if
+ <parameter>errorp</parameter> is <symbol>nil</symbol>,
+ possibly <symbol>nil</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para><function>find-database</function> locates an active
+ database object given the specification in
+ <parameter>database</parameter>. If
+ <parameter>database</parameter> is an object of type
+ <type>database</type>, <function>find-database</function>
+ returns this. Otherwise it will search the active databases
+ as indicated by the list returned by
+ <function>connected-databases</function> for a database
+ whose name (as returned by
+ <function>database-name</function> is equal as per
+ <function>string=</function> to the string passed as
+ <parameter>database</parameter>. If it succeeds, it returns
+ the first database found.</para>
+ <para>If it fails to find a matching database, it will signal
+ an error of type <errortype>maisql-error</errortype> if
+ <parameter>errorp</parameter> is true. If
+ <parameter>errorp</parameter> is <symbol>nil</symbol>, it
+ will return <symbol>nil</symbol> instead.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(database-name-from-spec '("dent" "newesim" "dent" "dent") :mysql)
+=> "dent/newesim/dent"
+(connect '("dent" "newesim" "dent" "dent") :database-type :mysql)
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {48391DCD}>
+(database-name *default-database*)
+=> "dent/newesim/dent"
+
+(database-name-from-spec '(nil "template1" "dent" nil) :postgresql)
+=> "/template1/dent"
+(connect '(nil "template1" "dent" nil) :database-type :postgresql)
+=> #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {48392D2D}>
+(database-name *default-database*)
+=> "/template1/dent"
+
+(database-name-from-spec '("www.pmsf.de" "template1" "dent" nil) :postgresql)
+=> "www.pmsf.de/template1/dent"
+
+(find-database "dent/newesim/dent")
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {484E91C5}>
+(find-database "/template1/dent")
+=> #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {48392D2D}>
+(find-database "www.pmsf.de/template1/dent" nil)
+=> NIL
+(find-database **)
+=> #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {48392D2D}>
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected By</title>
+ <para>
+ <simplelist>
+ <member><link linkend="connected-databases"><function>connected-databases</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>Will signal an error of type
+ <errortype>maisql-error</errortype> if no matching database
+ can be found, and <parameter>errorp</parameter> is true.
+ Will signal an error if the value of
+ <parameter>database</parameter> is neither an object of type
+ <type>database</type> nor a string.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link
+ linkend="database-name"><function>database-name</function></link></member>
+ <member><link
+ linkend="database-name-from-spec"><function>database-name-from-spec</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="connect">
+ <refnamediv>
+ <refname>CONNECT</refname>
+ <refpurpose>create a connection to a database</refpurpose>
+ <refclass>Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>connect</function> <replaceable>connection-spec</replaceable> &key <replaceable>if-exists</replaceable> <replaceable>database-type</replaceable> => <returnvalue>database</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>connection-spec</parameter></term>
+ <listitem>
+ <para>A connection specification</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>if-exists</parameter></term>
+ <listitem>
+ <para>This indicates the action to take if a connection
+ to the same database exists already. See below for the
+ legal values and actions. It defaults to the value of
+ <symbol>*connect-if-exists*</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>database-type</parameter></term>
+ <listitem>
+ <para>A database type specifier, i.e. a keyword.
+ This defaults to the value of
+ <symbol>*default-database-type*</symbol></para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>database</returnvalue></term>
+ <listitem>
+ <para>The database object representing the connection.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This function takes a connection specification and
+ a database type and creates a connection to the database
+ specified by those. The type and structure of the
+ connection specification depend on the database type.</para>
+ <para>The parameter <parameter>if-exists</parameter> specifies
+ what to do if a connection to the database specified exists
+ already, which is checked by calling
+ <function>find-database</function> on the database name
+ returned by <function>database-name-from-spec</function>
+ when called with the <parameter>connection-spec</parameter>
+ and <parameter>database-type</parameter> parameters. The
+ possible values of <parameter>if-exists</parameter> are:
+ <variablelist>
+ <varlistentry>
+ <term><symbol>:new</symbol></term>
+ <listitem>
+ <para>Go ahead and create a new connection.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><symbol>:warn-new</symbol></term>
+ <listitem>
+ <para>This is just like <symbol>:new</symbol>, but
+ also signals a warning of type
+ <errortype>maisql-exists-warning</errortype>,
+ indicating the old and newly created
+ databases.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><symbol>:error</symbol></term>
+ <listitem>
+ <para>This will cause <function>connect</function> to
+ signal a correctable error of type
+ <errortype>maisql-exists-error</errortype>. The
+ user may choose to proceed, either by indicating
+ that a new connection shall be created, via the
+ restart <symbol>create-new</symbol>, or by
+ indicating that the existing connection shall be
+ used, via the restart
+ <symbol>use-old</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><symbol>:old</symbol></term>
+ <listitem>
+ <para>This will cause <function>connect</function> to
+ use an old connection if one exists.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><symbol>:warn-old</symbol></term>
+ <listitem>
+ <para>This is just like <symbol>:old</symbol>, but
+ also signals a warning of type
+ <errortype>maisql-exists-warning</errortype>,
+ indicating the old database used, via the slots
+ <symbol>old-db</symbol> and
+ <symbol>new-db</symbol></para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </para>
+ <para>The database name of the returned database object will
+ be the same under <function>string=</function> as that which
+ would be returned by a call to
+ <function>database-name-from-spec</function> with the given
+ <parameter>connection-spec</parameter> and
+ <parameter>database-type</parameter> parameters.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(database-name-from-spec '("dent" "newesim" "dent" "dent") :mysql)
+=> "dent/newesim/dent"
+(connect '("dent" "newesim" "dent" "dent") :database-type :mysql)
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {48036F6D}>
+(database-name *)
+=> "dent/newesim/dent"
+
+(connect '("dent" "newesim" "dent" "dent") :database-type :mysql)
+>> In call to CONNECT:
+>> There is an existing connection #<CLSQL-MYSQL:MYSQL-DATABASE {48036F6D}> to database dent/newesim/dent.
+>>
+>> Restarts:
+>> 0: [CREATE-NEW] Create a new connection.
+>> 1: [USE-OLD ] Use the existing connection.
+>> 2: [ABORT ] Return to Top-Level.
+>>
+>> Debug (type H for help)
+>>
+>> (CONNECT ("dent" "newesim" "dent" "dent") :IF-EXISTS NIL :DATABASE-TYPE ...)
+>> Source:
+>> ; File: /prj/CLSQL/sql/sql.cl
+>> (RESTART-CASE (ERROR 'CLSQL-EXISTS-ERROR :OLD-DB OLD-DB)
+>> (CREATE-NEW NIL :REPORT "Create a new connection."
+>> (SETQ RESULT #))
+>> (USE-OLD NIL :REPORT "Use the existing connection."
+>> (SETQ RESULT OLD-DB)))
+>> 0] 0
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {480451F5}>
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>A database connection is established, and the resultant
+ database object is registered, so as to appear in the list
+ returned by <function>connected-databases</function>.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>
+ <simplelist>
+ <member><symbol>*default-database-type*</symbol></member>
+ <member><symbol>*connect-if-exists*</symbol></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>If the connection specification is not syntactically or
+ semantically correct for the given database type, an error
+ of type <errortype>maisql-invalid-spec-error</errortype> is
+ signalled. If during the connection attempt an error is
+ detected (e.g. because of permission problems, network
+ trouble or any other cause), an error of type
+ <errortype>maisql-connect-error</errortype> is
+ signalled.</para>
+ <para>If a connection to the database specified by
+ <parameter>connection-spec</parameter> exists already,
+ conditions are signalled according to the
+ <parameter>if-exists</parameter> parameter, as described
+ above.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><function>connected-databases</function></member>
+ <member><link linkend="disconnect"><function>disconnect</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="disconnect">
+ <refnamediv>
+ <refname>DISCONNECT</refname>
+ <refpurpose>close a database connection</refpurpose>
+ <refclass>Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>disconnect</function> &key <replaceable>database</replaceable> => <returnvalue>t</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>database</parameter></term>
+ <listitem>
+ <para>The database to disconnect, which defaults to the
+ database indicated by
+ <symbol>*default-database*</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This function takes a <type>database</type> object as
+ returned by <function>connect</function>, and closes the
+ connection. The class of the object passed is changed to
+ <type>closed-database</type> after the disconnection
+ succeeds, thereby preventing further use of the object as
+ an argument to &clsql; functions,
+ with the exception of <function>database-name</function>.
+ If the user does pass a closed database object to any other
+ &clsql; function, an error of type
+ <errortype>maisql-closed-error</errortype> is
+ signalled.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(disconnect :database (find-database "dent/newesim/dent"))
+=> T
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>The database connection is closed, and the database
+ object is removed from the list of connected databases as
+ returned by <function>connected-databases</function>.</para>
+ <para>The class of the database object is changed to
+ <type>closed-database</type>.</para>
+ <para>If the database object passed is the same under
+ <function>eq</function> as the value of
+ <symbol>*default-database*</symbol>, then
+ <symbol>*default-database*</symbol> is set to the first
+ remaining database from
+ <function>connected-databases</function> or to nil if no
+ further active database exists.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>
+ <simplelist>
+ <member><symbol>*default-database*</symbol></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>If during the disconnection attempt an error is
+ detected (e.g. because of network trouble or any other
+ cause), an error of type <errortype>maisql-error</errortype>
+ might be signalled.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link linkend="connect"><function>connect</function></link></member>
+ <member><link linkend="connect"><function>closed-database</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="database-name-from-spec">
+ <refnamediv>
+ <refname>DATABASE-NAME-FROM-SPEC</refname>
+ <refpurpose>Return the database name string corresponding to
+ the given connection specification.</refpurpose>
+ <refclass>Generic Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis>
+ <function>database-name-from-spec</function> <replaceable>connection-spec</replaceable> <replaceable>database-type</replaceable> => <returnvalue>name</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>connection-spec</parameter></term>
+ <listitem>
+ <para>A connection specification, whose structure and
+ interpretation are dependent on the
+ <parameter>database-type</parameter>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>database-type</parameter></term>
+ <listitem>
+ <para>A database type specifier, i.e. a keyword.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>name</returnvalue></term>
+ <listitem>
+ <para>A string denoting a database name.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This generic function takes a connection specification
+ and a database type and returns the database name of the
+ database object that would be created had
+ <function>connect</function> been called with the given
+ connection specification and database types.</para>
+ <para>This function is useful in determining a database name
+ from the connection specification, since the way the
+ connection specification is converted into a database name
+ is dependent on the database type.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(database-name-from-spec '("dent" "newesim" "dent" "dent") :mysql)
+=> "dent/newesim/dent"
+(connect '("dent" "newesim" "dent" "dent") :database-type :mysql)
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {48391DCD}>
+(database-name *default-database*)
+=> "dent/newesim/dent"
+
+(database-name-from-spec '(nil "template1" "dent" nil) :postgresql)
+=> "/template1/dent"
+(connect '(nil "template1" "dent" nil) :database-type :postgresql)
+=> #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {48392D2D}>
+(database-name *default-database*)
+=> "/template1/dent"
+
+(database-name-from-spec '("www.pmsf.de" "template1" "dent" nil) :postgresql)
+=> "www.pmsf.de/template1/dent"
+
+(find-database "dent/newesim/dent")
+=> #<CLSQL-MYSQL:MYSQL-DATABASE {484E91C5}>
+(find-database "/template1/dent")
+=> #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {48392D2D}>
+(find-database "www.pmsf.de/template1/dent" nil)
+=> NIL
+(find-database **)
+=> #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {48392D2D}>
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>If the value of <parameter>connection-spec</parameter>
+ is not a valid connection specification for the given
+ database type, an error of type
+ <errortype>maisql-invalid-spec-error</errortype> might be
+ signalled.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link linkend="connect"><function>connect</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <!-- Querying Operations -->
+ <refentry id="execute-command">
+ <refnamediv>
+ <refname>EXECUTE-COMMAND</refname>
+ <refpurpose>Execute an SQL command which returns no
+ values.</refpurpose>
+ <refclass>Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>execute-command</function> <replaceable>sql-expression</replaceable> &key <replaceable>database</replaceable> => <returnvalue>t</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>sql-expression</parameter></term>
+ <listitem>
+ <para>An <glossterm linkend="gloss-sql-expression">sql
+ expression</glossterm> that represents an SQL
+ statement which will return no values.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>database</parameter></term>
+ <listitem>
+ <para>A
+ <glossterm linkend="gloss-database-object">database
+ object</glossterm>. This will default to the value
+ of <symbol>*default-database*</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This will execute the command given by
+ <parameter>sql-expression</parameter> in the
+ <parameter>database</parameter> specified. If the execution
+ succeeds it will return <symbol>t</symbol>, otherwise an
+ error of type <errortype>maisql-sql-error</errortype> will
+ be signalled.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(execute-command "create table eventlog (time char(30),event char(70))")
+=> T
+
+(execute-command "create table eventlog (time char(30),event char(70))")
+>>
+>> While accessing database #<CLSQL-POSTGRESQL:POSTGRESQL-DATABASE {480B2B6D}>
+>> with expression "create table eventlog (time char(30),event char(70))":
+>> Error NIL: ERROR: amcreate: eventlog relation already exists
+>> has occurred.
+>>
+>> Restarts:
+>> 0: [ABORT] Return to Top-Level.
+>>
+>> Debug (type H for help)
+>>
+>> (CLSQL-POSTGRESQL::|(PCL::FAST-METHOD DATABASE-EXECUTE-COMMAND (T POSTGRESQL-DATABASE))|
+>> #<unused-arg>
+>> #<unused-arg>
+>> #<unavailable-arg>
+>> #<unavailable-arg>)
+>> Source: (ERROR 'CLSQL-SQL-ERROR :DATABASE DATABASE :EXPRESSION ...)
+>> 0] 0
+
+(execute-command "drop table eventlog")
+=> T
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Whatever effects the execution of the SQL statement has
+ on the underlying database, if any.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>If the execution of the SQL statement leads to any
+ errors, an error of type
+ <errortype>maisql-sql-error</errortype> is signalled.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link linkend="query"><function>query</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="query">
+ <refnamediv>
+ <refname>QUERY</refname>
+ <refpurpose>Execute an SQL query and return the tuples as a
+ list</refpurpose>
+ <refclass>Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>query</function> <replaceable>query-expression</replaceable> &key <replaceable>database</replaceable> => <returnvalue>result</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>query-expression</parameter></term>
+ <listitem>
+ <para>An <glossterm linkend="gloss-sql-expression">sql
+ expression</glossterm> that represents an SQL
+ query which is expected to return a (possibly empty)
+ result set.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>database</parameter></term>
+ <listitem>
+ <para>A
+ <glossterm linkend="gloss-database-object">database
+ object</glossterm>. This will default to the value
+ of <symbol>*default-database*</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>result</returnvalue></term>
+ <listitem>
+ <para>A list representing the result set obtained. For
+ each tuple in the result set, there is an element in
+ this list, which is itself a list of all the attribute
+ values in the tuple.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This will execute the query given by
+ <parameter>query-expression</parameter> in the
+ <parameter>database</parameter> specified. If the execution
+ succeeds it will return the result set returned by the
+ database, otherwise an error of type
+ <errortype>maisql-sql-error</errortype> will
+ be signalled.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(execute-command "create table simple (name char(50), salary numeric(10,2))")
+=> T
+(execute-command "insert into simple values ('Mai, Pierre',10000)")
+=> T
+(execute-command "insert into simple values ('Hacker, Random J.',8000.50)")
+=> T
+(query "select * from simple")
+=> (("Mai, Pierre" "10000.00") ("Hacker, Random J." "8000.50"))
+(query "select salary from simple")
+=> (("10000.00") ("8000.50"))
+(query "select salary from simple where salary > 10000")
+=> NIL
+(query "select salary,name from simple where salary > 10000")
+=> NIL
+(query "select salary,name from simple where salary > 9000")
+=> (("10000.00" "Mai, Pierre"))
+(query "select salary,name from simple where salary > 8000")
+=> (("10000.00" "Mai, Pierre") ("8000.50" "Hacker, Random J."))
+
+;; MySQL-specific:
+(query "show tables")
+=> (("demo") ("log") ("newlog") ("simple") ("spacetrial"))
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Whatever effects the execution of the SQL query has
+ on the underlying database, if any.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>If the execution of the SQL query leads to any
+ errors, an error of type
+ <errortype>maisql-sql-error</errortype> is signalled.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link linkend="execute-command"><function>execute-command</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <!-- Iteration -->
+ <refentry id="map-query">
+ <refnamediv>
+ <refname>MAP-QUERY</refname>
+ <refpurpose>Map a function over all the tuples from a
+ query</refpurpose>
+ <refclass>Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>map-query</function> <replaceable>output-type-spec</replaceable> <replaceable>function</replaceable> <replaceable>query-expression</replaceable> &key <replaceable>database</replaceable> => <returnvalue>result</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>output-type-spec</parameter></term>
+ <listitem>
+ <para>A sequence type specifier or <symbol>nil</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>function</parameter></term>
+ <listitem>
+ <para>A function designator.
+ <parameter>function</parameter> must take as many
+ arguments as are attributes in the result set returned
+ by executing the SQL
+ <parameter>query-expression</parameter>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>query-expression</parameter></term>
+ <listitem>
+ <para>An <glossterm linkend="gloss-sql-expression">sql
+ expression</glossterm> that represents an SQL
+ query which is expected to return a (possibly empty)
+ result set, where each tuple has as many attributes as
+ <parameter>function</parameter> takes arguments.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>database</parameter></term>
+ <listitem>
+ <para>A
+ <glossterm linkend="gloss-database-object">database
+ object</glossterm>. This will default to the value
+ of <symbol>*default-database*</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>result</returnvalue></term>
+ <listitem>
+ <para>If <parameter>output-type-spec</parameter> is a
+ type specifier other than <symbol>nil</symbol>, then a
+ sequence of the type it denotes. Otherwise
+ <symbol>nil</symbol> is returned.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>Applies <parameter>function</parameter> to the
+ attributes of successive tuples in the result set returned
+ by executing the SQL
+ <parameter>query-expression</parameter>. If the
+ <parameter>output-type-spec</parameter> is
+ <symbol>nil</symbol>, then the result of each application
+ of <parameter>function</parameter> is discarded, and
+ <function>map-query</function> returns
+ <symbol>nil</symbol>. Otherwise the result of each
+ successive application of <parameter>function</parameter> is
+ collected in a sequence of type
+ <parameter>output-type-spec</parameter>, where the jths
+ element is the result of applying
+ <parameter>function</parameter> to the attributes of the
+ jths tuple in the result set. The collected sequence is the
+ result of the call to <function>map-query</function>.
+ </para>
+ <para>If the <parameter>output-type-spec</parameter> is a
+ subtype of <type>list</type>, the result will be a
+ <type>list</type>.</para>
+ <para>If the <parameter>result-type</parameter> is a subtype
+ of <type>vector</type>, then if the implementation can
+ determine the element type specified for the
+ <parameter>result-type</parameter>, the element type of the
+ resulting array is the result of
+ <emphasis>upgrading</emphasis> that element type; or, if the
+ implementation can determine that the element type is
+ unspecified (or <symbol>*</symbol>), the element type of the
+ resulting array is <type>t</type>; otherwise, an error is
+ signaled.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(map-query 'list #'(lambda (salary name)
+ (declare (ignorable name))
+ (read-from-string salary))
+ "select salary,name from simple where salary > 8000")
+=> (10000.0 8000.5)
+
+(map-query '(vector double-float)
+ #'(lambda (salary name)
+ (declare (ignorable name))
+ (coerce (read-from-string salary) 'double-float))
+ "select salary,name from simple where salary > 8000")
+=> #(10000.0d0 8000.5d0)
+(type-of *)
+=> (SIMPLE-ARRAY DOUBLE-FLOAT (2))
+
+(let (list)
+ (values (map-query nil #'(lambda (salary name)
+ (push (cons name (read-from-string salary)) list))
+ "select salary,name from simple where salary > 8000")
+ list))
+=> NIL
+=> (("Hacker, Random J." . 8000.5) ("Mai, Pierre" . 10000.0))
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Whatever effects the execution of the SQL query has
+ on the underlying database, if any.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>If the execution of the SQL query leads to any
+ errors, an error of type
+ <errortype>maisql-sql-error</errortype> is signalled.</para>
+ <para>An error of type <errortype>type-error</errortype> must
+ be signaled if the <parameter>output-type-spec</parameter> is
+ not a recognizable subtype of <type>list</type>, not a
+ recognizable subtype of <type>vector</type>, and not
+ <symbol>nil</symbol>.</para>
+ <para>An error of type <errortype>type-error</errortype>
+ should be signaled if
+ <parameter>output-type-spec</parameter> specifies the number
+ of elements and the size of the result set is different from
+ that number.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link linkend="query"><function>query</function></link></member>
+ <member><link linkend="do-query"><function>do-query</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="do-query">
+ <refnamediv>
+ <refname>DO-QUERY</refname>
+ <refpurpose>Iterate over all the tuples of a
+ query</refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>do-query</function> ((&rest <replaceable>args</replaceable>) <replaceable>query-expression</replaceable> &key <replaceable>database</replaceable>) &body <replaceable>body</replaceable> => <returnvalue>nil</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>args</parameter></term>
+ <listitem>
+ <para>A list of variable names.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>query-expression</parameter></term>
+ <listitem>
+ <para>An <glossterm linkend="gloss-sql-expression">sql
+ expression</glossterm> that represents an SQL
+ query which is expected to return a (possibly empty)
+ result set, where each tuple has as many attributes as
+ <parameter>function</parameter> takes arguments.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>database</parameter></term>
+ <listitem>
+ <para>A
+ <glossterm linkend="gloss-database-object">database
+ object</glossterm>. This will default to
+ <symbol>*default-database*</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>body</parameter></term>
+ <listitem>
+ <para>A body of Lisp code, like in a
+ <function>destructuring-bind</function> form.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>Executes the <parameter>body</parameter> of code
+ repeatedly with the variable names in
+ <parameter>args</parameter> bound to the attributes of each
+ tuple in the result set returned by executing the SQL
+ <parameter>query-expression</parameter> on the
+ <parameter>database</parameter> specified.</para>
+ <para>The body of code is executed in a block named
+ <symbol>nil</symbol> which may be returned from prematurely
+ via <function>return</function> or
+ <function>return-from</function>. In this case the result
+ of evaluating the <function>do-query</function> form will be
+ the one supplied to <function>return</function> or
+ <function>return-from</function>. Otherwise the result will
+ be <symbol>nil</symbol>.</para>
+ <para>The body of code appears also is if wrapped in a
+ <function>destructuring-bind</function> form, thus allowing
+ declarations at the start of the body, especially those
+ pertaining to the bindings of the variables named in
+ <parameter>args</parameter>.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(do-query ((salary name) "select salary,name from simple")
+ (format t "~30A gets $~2,5$~%" name (read-from-string salary)))
+>> Mai, Pierre gets $10000.00
+>> Hacker, Random J. gets $08000.50
+=> NIL
+
+(do-query ((salary name) "select salary,name from simple")
+ (return (cons salary name)))
+=> ("10000.00" . "Mai, Pierre")
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Whatever effects the execution of the SQL query has
+ on the underlying database, if any.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>If the execution of the SQL query leads to any
+ errors, an error of type
+ <errortype>maisql-sql-error</errortype> is signalled.</para>
+ <para>If the number of variable names in
+ <parameter>args</parameter> and the number of attributes in
+ the tuples in the result set don't match up, an error is
+ signalled.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link linkend="query"><function>query</function></link></member>
+ <member><link linkend="map-query"><function>map-query</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ <refentry id="loop-tuples">
+ <refnamediv>
+ <refname>LOOP-FOR-AS-TUPLES</refname>
+ <refpurpose>Iterate over all the tuples of a
+ query via a loop clause</refpurpose>
+ <refclass>Loop Clause</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><replaceable>var</replaceable> [<replaceable>type-spec</replaceable>] being {each | the} {record | records | tuple | tuples} {in | of} <replaceable>query</replaceable> [from <replaceable>database</replaceable>]</synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>var</parameter></term>
+ <listitem>
+ <para>A <literal>d-var-spec</literal>, as defined in the
+ grammar for <function>loop</function>-clauses in the
+ ANSI Standard for Common Lisp. This allows for the
+ usual loop-style destructuring.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type-spec</parameter></term>
+ <listitem>
+ <para>An optional <literal>type-spec</literal> either
+ simple or destructured, as defined in the grammar for
+ <function>loop</function>-clauses in the ANSI Standard
+ for Common Lisp.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>query</parameter></term>
+ <listitem>
+ <para>An <glossterm linkend="gloss-sql-expression">sql
+ expression</glossterm> that represents an SQL
+ query which is expected to return a (possibly empty)
+ result set, where each tuple has as many attributes as
+ <parameter>function</parameter> takes arguments.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>database</parameter></term>
+ <listitem>
+ <para>An optional
+ <glossterm linkend="gloss-database-object">database
+ object</glossterm>. This will default to the value
+ of <symbol>*default-database*</symbol>.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This clause is an iteration driver for
+ <function>loop</function>, that binds the given variable
+ (possibly destructured) to the consecutive tuples (which are
+ represented as lists of attribute values) in the result set
+ returned by executing the SQL <parameter>query</parameter>
+ expression on the <parameter>database</parameter>
+ specified.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <programlisting>
+(defvar *my-db* (connect '("dent" "newesim" "dent" "dent"))
+ "My database"
+=> *MY-DB*
+(loop with time-graph = (make-hash-table :test #'equal)
+ with event-graph = (make-hash-table :test #'equal)
+ for (time event) being the tuples of "select time,event from log"
+ from *my-db*
+ do
+ (incf (gethash time time-graph 0))
+ (incf (gethash event event-graph 0))
+ finally
+ (flet ((show-graph (k v) (format t "~40A => ~5D~%" k v)))
+ (format t "~&Time-Graph:~%===========~%")
+ (maphash #'show-graph time-graph)
+ (format t "~&~%Event-Graph:~%============~%")
+ (maphash #'show-graph event-graph))
+ (return (values time-graph event-graph)))
+>> Time-Graph:
+>> ===========
+>> D => 53000
+>> X => 3
+>> test-me => 3000
+>>
+>> Event-Graph:
+>> ============
+>> CLOS Benchmark entry. => 9000
+>> Demo Text... => 3
+>> doit-text => 3000
+>> C Benchmark entry. => 12000
+>> CLOS Benchmark entry => 32000
+=> #<EQUAL hash table, 3 entries {48350A1D}>
+=> #<EQUAL hash table, 5 entries {48350FCD}>
+ </programlisting>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Whatever effects the execution of the SQL query has
+ on the underlying database, if any.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>If the execution of the SQL query leads to any
+ errors, an error of type
+ <errortype>maisql-sql-error</errortype> is signalled.</para>
+ <para>Otherwise, any of the exceptional situations of
+ <function>loop</function> applies.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link linkend="query"><function>query</function></link></member>
+ <member><link linkend="map-query"><function>map-query</function></link></member>
+ <member><link linkend="do-query"><function>do-query</function></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ </reference>
+ <reference>
+ <title><symbol>CLSQL-SYS</symbol></title>
+ <partintro>
+ <para>This part gives a reference to all the symbols exported
+ from the package <symbol>CLSQL-SYS</symbol>, which are not also
+ exported from <symbol>CLSQL</symbol>. These symbols are part of
+ the interface for database back-ends, but not part of the normal
+ user-interface of &clsql;.</para>
+ <note>
+ <para>This part has only one demonstration entry, since the
+ rest still has to be written. In the meantime, use the
+ source to understand the database back-end interface.</para>
+ </note>
+ </partintro>
+ <refentry id="database-initialize-database-type">
+ <refnamediv>
+ <refname>DATABASE-INITIALIZE-DATABASE-TYPE</refname>
+ <refpurpose>Back-end part of <link
+ linkend="initialize-database-type"><function>initialize-database-type</function></link>.</refpurpose>
+ <refclass>Generic Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis><function>database-initialize-database-type</function> <replaceable>database-type</replaceable> => <returnvalue>result</returnvalue></synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>database-type</parameter></term>
+ <listitem>
+ <para>A keyword indicating the database type to
+ initialize.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>result</returnvalue></term>
+ <listitem>
+ <para>Either <symbol>t</symbol> if the initialization
+ succeeds or <symbol>nil</symbol> if it fails.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This generic function implements the main part of the
+ database type initialization performed by
+ <function>initialize-database-type</function>. After
+ <function>initialize-database-type</function> has checked
+ that the given database type has not been initialized
+ before, as indicated by
+ <symbol>*initialized-database-types*</symbol>, it will call
+ this function with the database type as it's sole
+ parameter. Database back-ends are required to define a
+ method on this generic function which is specialized via an
+ eql-specializer to the keyword representing their database
+ type.</para>
+ <para>Database back-ends shall indicate successful
+ initialization by returning <symbol>t</symbol> from their
+ method, and <symbol>nil</symbol> otherwise. Methods for
+ this generic function are allowed to signal errors of type
+ <errortype>maisql-error</errortype> or subtypes thereof.
+ They may also signal other types of conditions, if
+ appropriate, but have to document this.</para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <para></para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>All necessary side effects to initialize the database
+ instance.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected By</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>Conditions of type <errortype>maisql-error</errortype>
+ or other conditions may be signalled, depending on the
+ database back-end.</para>
+ </refsect1>
+ <refsect1>
+ <title>See Also</title>
+ <para>
+ <simplelist>
+ <member><link
+ linkend="initialize-database-type"><function>initialize-database-type</function></link></member>
+ <member><link linkend="initialized-database-types"><symbol>*initialized-database-types*</symbol></link></member>
+ </simplelist>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+ </reference>
--- /dev/null
+CATALOG /usr/share/sgml/sgml-iso-entities-8879.1986/catalog
+CATALOG /usr/share/sgml/docbook/sgml-dtd-4.1/catalog
+CATALOG /usr/share/sgml/openjade-1.3/catalog
+CATALOG /usr/share/sgml/docbook/dsssl-stylesheets-1.64/catalog
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: aodbc-package.cl
+;;;; Purpose: Package definition for CLSQL AODBC backend
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: aodbc-package.cl,v 1.1 2002/03/23 14:04:52 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+#+allegro
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require :aodbc-v2))
+#-allegro (warn "This system requires Allegro's AODBC library to operate")
+
+(defpackage :clsql-aodbc
+ (:nicknames :aodbc)
+ (:use :common-lisp :clsql-sys)
+ (:export #:aodbc-database)
+ (:documentation "This is the CLSQL interface to Allegro's AODBC"))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: aodbc-sql.cl
+;;;; Purpose: Low-level interface for CLSQL AODBC backend
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: aodbc-sql.cl,v 1.1 2002/03/23 14:04:52 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-aodbc)
+
+
+(defmethod database-initialize-database-type ((database-type (eql :aodbc)))
+ t)
+
+(defclass aodbc-database (database)
+ ((aodbc-conn :accessor database-aodbc-conn :initarg :aodbc-conn)))
+
+(defmethod database-name-from-spec (connection-spec
+ (database-type (eql :aodbc)))
+ (check-connection-spec connection-spec database-type (dsn user password))
+ (destructuring-bind (dsn user password) connection-spec
+ (declare (ignore password))
+ (concatenate 'string dsn "/" user)))
+
+(defmethod database-connect (connection-spec (database-type (eql :aodbc)))
+ (check-connection-spec connection-spec database-type (dsn user password))
+ (destructuring-bind (dsn user password) connection-spec
+ (handler-case
+ (make-instance 'aodbc-database
+ :name (database-name-from-spec connection-spec :aodbc)
+ :aodbc-conn
+ (dbi:connect :user user
+ :password password
+ :data-source-name dsn))
+ (error () ;; Init or Connect failed
+ (error 'clsql-connect-error
+ :database-type database-type
+ :connection-spec connection-spec
+ :errno nil
+ :error "Connection failed")))))
+
+(defmethod database-disconnect ((database aodbc-database))
+ (dbi:disconnect (database-aodbc-conn database))
+ (setf (database-aodbc-conn database) nil)
+ t)
+
+(defmethod database-query (query-expression (database aodbc-database))
+ (handler-case
+ (dbi:sql query-expression :db (database-aodbc-conn database))
+ (error ()
+ (error 'clsql-sql-error
+ :database database
+ :expression query-expression
+ :errno nil
+ :error "Query failed"))))
+
+(defmethod database-execute-command (sql-expression
+ (database aodbc-database))
+ (handler-case
+ (dbi:sql sql-expression :db (database-aodbc-conn database))
+ (error ()
+ (error 'clsql-sql-error
+ :database database
+ :expression sql-expression
+ :errno nil
+ :error "Execute command failed"))))
+
+(defstruct aodbc-result-set
+ (query nil)
+ (full-set nil))
+
+(defmethod database-query-result-set (query-expression
+ (database aodbc-database)
+ &optional full-set)
+ (handler-case
+ (multiple-value-bind (query column-names)
+ (dbi:sql query-expression
+ :db (database-aodbc-conn database)
+ :row-count nil
+ :column-names t
+ :query t
+ )
+ (values
+ (make-aodbc-result-set :query query :full-set full-set)
+ (length column-names)
+ nil ;; not able to return number of rows with aodbc
+ ))
+ (error ()
+ (error 'clsql-sql-error
+ :database database
+ :expression query-expression
+ :errno nil
+ :error "Query result set failed"))))
+
+(defmethod database-dump-result-set (result-set (database aodbc-database))
+ (dbi:close-query (aodbc-result-set-query result-set))
+ t)
+
+(defmethod database-store-next-row (result-set
+ (database aodbc-database)
+ list)
+ (let ((row (dbi:fetch-row (aodbc-result-set-query result-set) nil 'eof)))
+ (if (eq row 'eof)
+ nil
+ (progn
+ (loop for elem in row
+ for rest on list
+ do
+ (setf (car rest) elem))
+ list))))
+
+
--- /dev/null
+.bin
+clsql-mysql.o
+clsql-mysql.so
+
--- /dev/null
+# -*- Mode: Makefile -*-
+###########################################################################
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for the CLSQL UFFI helper package
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile,v 1.1 2002/03/23 14:04:52 kevin Exp $
+#
+# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+#
+# 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.
+###########################################################################
+
+
+# These variables are correct for GCC
+# you'll need to modify these for other compilers
+CC=gcc
+SHARED_CC_OPT=-fpic
+SHARED_LD_OPT=-shared
+
+# If you are using Solaris, these are the correct values
+# for creating a shared library
+#CC=cc
+#SHARED_CC_OPT=-KPIC
+#SHARED_LD_OPT=-G
+
+# Set to the directory where you have installed mysql's library
+#MYSQL_DIR=/usr
+MYSQL_DIR=/opt/mysql
+
+MYSQL_LIB=${MYSQL_DIR}/lib/mysql
+MYSQL_LIB_FILE=${MYSQL_LIB}/libmysqlclient.so
+MYSQL_INCLUDE=${MYSQL_DIR}/include/mysql
+
+# Nothing to configure beyond this point
+
+BASE=clsql-mysql
+SRC=${BASE}.c
+OBJECT=${BASE}.o
+LIB=${BASE}.so
+
+all: ${LIB}
+
+${LIB}: ${SRC} ${MYSQL_LIB_FILE}
+ ${CC} ${SHARED_CC_OPT} -I ${MYSQL_INCLUDE} -c ${SRC} -o ${OBJECT}
+ ld ${SHARED_LD_OPT} ${OBJECT} ${MYSQL_LIB_FILE} -o ${LIB}
+ @rm ${OBJECT}
+
+clean:
+ rm -f ${LIB}
+
+realclean: clean
+ rm -f *~
+
--- /dev/null
+# -*- Mode: Makefile -*-
+###########################################################################
+# FILE IDENTIFICATION
+#
+# Name: Makefile.msvc
+# Purpose: Makefile for the CLSQL UFFI helper package (MSVC)
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile.msvc,v 1.1 2002/03/23 14:04:52 kevin Exp $
+#
+# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+#
+# 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.
+###########################################################################
+
+
+BASE=clsql-mysql
+
+# Set to the directory where you have installed mysql's library
+MYSQL_DIR=c:/mysql
+
+MYSQL_LIB_DIR=$(MYSQL_DIR)/lib/opt
+MYSQL_LIB_FILE=$(MYSQL_LIB_DIR)/Libmysql.lib
+MYSQL_INCLUDE=$(MYSQL_DIR)/include
+
+# Nothing to configure beyond here
+
+SRC=$(BASE).c
+OBJ=$(BASE).obj
+DLL=$(BASE).dll
+
+$(DLL): $(SRC) $(MYSQL_LIB_FILE)
+ cl /MD /LD -D_MT /DWIN32=1 /D__LCC__=1 /I$(MYSQL_INCLUDE) $(SRC) $(MYSQL_LIB_FILE)
+ del $(OBJ) $(BASE).exp
+
+clean:
+ del /q $(DLL)
+
+
--- /dev/null
+/****************************************************************************
+ * FILE IDENTIFICATION
+ *
+ * Name: mysql-helper.cl
+ * Purpose: Helper functions for mysql.cl to handle 64-bit parts of API
+ * Programmer: Kevin M. Rosenberg
+ * Date Started: Mar 2002
+ *
+ * $Id: clsql-mysql.c,v 1.1 2002/03/23 14:04:52 kevin Exp $
+ *
+ * This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+ *
+ * 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.
+ ***************************************************************************/
+
+#ifdef WIN32
+#include <windows.h>
+
+BOOL WINAPI DllEntryPoint(HINSTANCE hinstdll, DWORD fdwReason,
+ LPVOID lpvReserved)
+{
+ return 1;
+}
+
+#define DLLEXPORT __declspec(dllexport)
+
+#else
+#define DLLEXPORT
+#endif
+
+
+#include <mysql.h>
+
+/* Need to assemble a 64-bit integer to send to MySQL */
+DLLEXPORT
+void
+clsql_mysql_data_seek (MYSQL_RES* res, unsigned int offset_high32,
+ unsigned int offset_low32)
+{
+ my_ulonglong offset;
+
+ offset = offset_high32;
+ offset = offset << 32;
+ offset += offset_low32;
+
+ mysql_data_seek (res, offset);
+}
+
+/* The following functions are used to return 64-bit integers to Lisp.
+ They return the 32-bit low part and store in upper 32-bits in a
+ located sent via a pointer */
+
+const unsigned int bitmask_32bits = 0xFFFFFFFF;
+
+#define lower_32bits(int64) ((unsigned int) int64 & bitmask_32bits)
+#define upper_32bits(int64) ((unsigned int) (int64 >> 32))
+
+DLLEXPORT
+unsigned int
+clsql_mysql_num_rows (MYSQL_RES* res, unsigned int* pHigh32)
+{
+ my_ulonglong nRows = mysql_num_rows (res);
+ *pHigh32 = upper_32bits(nRows);
+ return lower_32bits(nRows);
+}
+
+DLLEXPORT
+unsigned int
+clsql_mysql_affected_rows (MYSQL* res, unsigned int* pHigh32)
+{
+ my_ulonglong nAffected = mysql_affected_rows (res);
+ *pHigh32 = upper_32bits(nAffected);
+ return lower_32bits(nAffected);
+}
+
+DLLEXPORT
+unsigned int
+clsql_mysql_insert_id (MYSQL* mysql, unsigned int* pHigh32)
+{
+ my_ulonglong insert_id = mysql_insert_id (mysql);
+ *pHigh32 = upper_32bits(insert_id);
+ return lower_32bits(insert_id);
+}
+
+
+
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: mysql-loader.sql
+;;;; Purpose: MySQL library loader using UFFI
+;;;; Programmers: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: mysql-loader.cl,v 1.1 2002/03/23 14:04:52 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :mysql)
+
+;;;; Modified by Kevin Rosenberg
+;;;; - probe potential directories to find library
+;;;; - Changed from CMUCL functions to UFFI to
+;;;; -- prevent library from being loaded multiple times
+;;;; -- support Allegro CL and Lispworks
+
+(defvar *clsql-mysql-library-filename*
+ (translate-logical-pathname
+ #+(or linux unix) "CLSQL:interfaces;mysql;clsql-mysql.so"
+ #+(or mswindows win32) "CLSQL:interfaces;mysql;clsql-mysql.dll"
+ ))
+
+(defvar *mysql-library-filename*
+ (cond
+ ((probe-file "/opt/mysql/lib/mysql/libmysqlclient.so")
+ "/opt/mysql/lib/mysql/libmysqlclient.so")
+ ((probe-file "/usr/local/lib/libmysqlclient.so")
+ "/usr/local/lib/libmysqlclient.so")
+ ((probe-file "/usr/lib/libmysqlclient.so")
+ "/usr/lib/libmysqlclient.so")
+ #+(or win32 mswindows)
+ ((probe-file "c:/mysql/lib/opt/libmysql.dll")
+ "c:/mysql/lib/opt/libmysql.dll")
+ (t
+ (warn "Can't find MySQL client library to load.")))
+ "Location where the MySQL client library is to be found.")
+
+(defvar *mysql-supporting-libraries* '("c")
+ "Used only by CMU. List of library flags needed to be passed to ld to
+load the MySQL client library succesfully. If this differs at your site,
+set to the right path before compiling or loading the system.")
+
+
+
+(defmethod database-type-load-foreign ((database-type (eql :mysql)))
+ (uffi:load-foreign-library *mysql-library-filename*
+ :module "mysql"
+ :supporting-libraries
+ *mysql-supporting-libraries*)
+ (uffi:load-foreign-library *clsql-mysql-library-filename*
+ :module "clsql-mysql"
+ :supporting-libraries
+ (append *mysql-supporting-libraries*)))
+
+
+(database-type-load-foreign :mysql)
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: mysql-package.cl
+;;;; Purpose: Package definition for low-level MySQL interface
+;;;; Programmers: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: mysql-package.cl,v 1.1 2002/03/23 14:04:52 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+(defpackage :mysql
+ (:use :common-lisp)
+ (:export
+ #:mysql-socket
+ #:mysql-book
+ #:mysql-byte
+ #:mysql-net-type
+ #:mysql-net-type#tcp-ip
+ #:mysql-net-type#socket
+ #:mysql-net-type#named-pipe
+ #:mysql-net
+ #:mysql-used-mem
+ #:mysql-mem-root
+ #:mysql-field-types
+ #:mysql-field-types#decimal
+ #:mysql-field-types#tiny
+ #:mysql-field-types#short
+ #:mysql-field-types#long
+ #:mysql-field-types#float
+ #:mysql-field-types#double
+ #:mysql-field-types#null
+ #:mysql-field-types#timestamp
+ #:mysql-field-types#longlong
+ #:mysql-field-types#int24
+ #:mysql-field-types#date
+ #:mysql-field-types#time
+ #:mysql-field-types#datetime
+ #:mysql-field-types#year
+ #:mysql-field-types#newdate
+ #:mysql-field-types#enum
+ #:mysql-field-types#tiny-blob
+ #:mysql-field-types#medium-blob
+ #:mysql-field-types#long-blob
+ #:mysql-field-types#blob
+ #:mysql-field-types#var-string
+ #:mysql-field-types#string
+ #:mysql-field
+ #:mysql-row
+ #:mysql-field-offset
+ #:mysql-row-offset
+ #:mysql-data
+ #:mysql-options
+ #:mysql-mysql-option
+ #:mysql-mysql-option#connect-timeout
+ #:mysql-mysql-option#compress
+ #:mysql-mysql-option#named-pipe
+ #:mysql-mysql-option#init-command
+ #:mysql-mysql-option#read-default-file
+ #:mysql-mysql-option#read-default-group
+ #:mysql-status
+ #:mysql-status#ready
+ #:mysql-status#get-ready
+ #:mysql-status#use-result
+ #:mysql-mysql
+ #:mysql-mysql-res
+
+ ;; functions
+ #:mysql-init
+ #:mysql-connect
+ #:mysql-real-connect
+ #:mysql-close
+ #:mysql-select-db
+ #:mysql-query
+ #:mysql-real-query
+ #:mysql-create-db
+ #:mysql-drop-db
+ #:mysql-shutdown
+ #:mysql-dump-debug-info
+ #:mysql-refresh
+ #:mysql-kill
+ #:mysql-ping
+ #:mysql-stat
+ #:mysql-get-server-info
+ #:mysql-get-client-info
+ #:mysql-get-host-info
+ #:mysql-get-proto-info
+ #:mysql-list-dbs
+ #:mysql-list-tables
+ #:mysql-list-fields
+ #:mysql-list-processes
+ #:mysql-store-result
+ #:mysql-use-result
+ #:mysql-options
+ #:mysql-free-result
+ #:mysql-row-seek
+ #:mysql-field-seek
+ #:mysql-fetch-row
+ #:mysql-fetch-lengths
+ #:mysql-fetch-field
+ #:mysql-escape-string
+ #:mysql-debug
+ #:mysql-num-rows
+ #:mysql-num-fields
+ #:mysql-affected-rows
+ #:mysql-insert-id
+ #:mysql-eof
+ #:mysql-error
+ #:mysql-error-string
+ #:mysql-errno
+ #:mysql-info
+ #:mysql-info-string
+ #:mysql-data-seek
+ )
+ (:documentation "This is the low-level interface MySQL."))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: mysql-sql.cl
+;;;; Purpose: High-level MySQL interface using UFFI
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: mysql-sql.cl,v 1.1 2002/03/23 14:04:52 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+
+;;;; Modified by Kevin Rosenberg, Feb 20002
+;;;; -- Added support for Allegro CL and Lispworks using UFFI layer
+;;;; -- Changed database-connect to use mysql-real-connect. This way,
+;;;; can avoid using double (unwind-protect)
+;;;; -- Changed database-connect to have MySQL library allocate space
+;;;; for MYSQL structure. This will make the code more robust in
+;;;; the event that MySQL library changes the size of the mysql-mysql
+;;;; structure.
+
+(defpackage :clsql-mysql
+ (:use :common-lisp :clsql-sys :mysql)
+ (:documentation "This is the CLSQL interface to MySQL."))
+
+(in-package :clsql-mysql)
+
+(defmethod database-initialize-database-type ((database-type (eql :mysql)))
+ t)
+
+(uffi:def-type mysql-mysql-ptr-def (* mysql-mysql))
+(uffi:def-type mysql-row-def mysql-row)
+(uffi:def-type mysql-mysql-res-ptr-def (* mysql-mysql-res))
+
+(defclass mysql-database (database)
+ ((mysql-ptr :accessor database-mysql-ptr :initarg :mysql-ptr
+ :type mysql-mysql-ptr-def)))
+
+(defmethod database-name-from-spec (connection-spec (database-type (eql :mysql)))
+ (check-connection-spec connection-spec database-type (host db user password))
+ (destructuring-bind (host db user password) connection-spec
+ (declare (ignore password))
+ (concatenate 'string host "/" db "/" user)))
+
+(defmethod database-connect (connection-spec (database-type (eql :mysql)))
+ (check-connection-spec connection-spec database-type (host db user password))
+ (destructuring-bind (host db user password) connection-spec
+ (let ((mysql-ptr (mysql-init (uffi:make-null-pointer 'mysql-mysql)))
+ (socket nil))
+ (if (uffi:null-pointer-p mysql-ptr)
+ (error 'clsql-connect-error
+ :database-type database-type
+ :connection-spec connection-spec
+ :errno (mysql-errno mysql-ptr)
+ :error (mysql-error-string mysql-ptr))
+ (uffi:with-cstring (host-native host)
+ (uffi:with-cstring (user-native user)
+ (uffi:with-cstring (password-native password)
+ (uffi:with-cstring (db-native db)
+ (uffi:with-cstring (socket-native socket)
+ (let ((error-occurred nil))
+ (unwind-protect
+ (if (uffi:null-pointer-p
+ (mysql-real-connect
+ mysql-ptr host-native user-native password-native
+ db-native 0 socket-native 0))
+ (progn
+ (setq error-occurred t)
+ (error 'clsql-connect-error
+ :database-type database-type
+ :connection-spec connection-spec
+ :errno (mysql-errno mysql-ptr)
+ :error (mysql-error-string mysql-ptr)))
+ (make-instance 'mysql-database
+ :name (database-name-from-spec connection-spec
+ database-type)
+ :mysql-ptr mysql-ptr))
+ (when error-occurred (mysql-close mysql-ptr)))))))))))))
+
+
+(defmethod database-disconnect ((database mysql-database))
+ (mysql-close (database-mysql-ptr database))
+ (setf (database-mysql-ptr database) nil)
+ t)
+
+
+(defstruct mysql-result-set
+ (res-ptr (uffi:make-null-pointer 'mysql-mysql-res)
+ :type mysql-mysql-res-ptr-def)
+ (full-set nil))
+
+(defmethod database-dump-result-set (result-set (database mysql-database))
+ (mysql-free-result (mysql-result-set-res-ptr result-set))
+ t)
+
+
+(defmethod database-store-next-row (result-set (database mysql-database) list)
+ (let* ((res-ptr (mysql-result-set-res-ptr result-set))
+ (row (mysql-fetch-row res-ptr)))
+ (declare (type mysql-mysql-res-ptr-def res-ptr)
+ (type mysql-row-def row))
+ (unless (uffi:null-pointer-p row)
+ (loop for i from 0 below (mysql-num-fields res-ptr)
+ for rest on list
+ do
+ (setf (car rest)
+ (uffi:convert-from-foreign-string (uffi:deref-array row 'mysql-row i))))
+ list)))
+
+
+(defmethod database-execute-command (sql-expression (database mysql-database))
+ (uffi:with-cstring (sql-native sql-expression)
+ (let ((mysql-ptr (database-mysql-ptr database)))
+ (declare (type mysql-mysql-ptr-def mysql-ptr))
+ (if (zerop (mysql-query mysql-ptr sql-native))
+ t
+ (error 'clsql-sql-error
+ :database database
+ :expression sql-expression
+ :errno (mysql-errno mysql-ptr)
+ :error (mysql-error-string mysql-ptr))))))
+
+
+
+(defmethod database-query (query-expression (database mysql-database))
+ (with-slots (mysql-ptr) database
+ (uffi:with-cstring (query-native query-expression)
+ (if (zerop (mysql-query mysql-ptr query-native))
+ (let ((res-ptr (mysql-use-result mysql-ptr)))
+ (if res-ptr
+ (unwind-protect
+ (loop for row = (mysql-fetch-row res-ptr)
+ until (uffi:null-pointer-p row)
+ collect
+ (loop for i from 0 below (mysql-num-fields res-ptr)
+ collect
+ (uffi:convert-from-cstring
+ (uffi:deref-array row 'mysql-row i))))
+ (mysql-free-result res-ptr))
+ (error 'clsql-sql-error
+ :database database
+ :expression query-expression
+ :errno (mysql-errno mysql-ptr)
+ :error (mysql-error-string mysql-ptr))))
+ (error 'clsql-sql-error
+ :database database
+ :expression query-expression
+ :errno (mysql-errno mysql-ptr)
+ :error (mysql-error-string mysql-ptr))))))
+
+
+(defmethod database-query-result-set (query-expression
+ (database mysql-database)
+ &optional full-set)
+ (uffi:with-cstring (query-native query-expression)
+ (let ((mysql-ptr (database-mysql-ptr database)))
+ (declare (type mysql-mysql-ptr-def mysql-ptr))
+ (if (zerop (mysql-query mysql-ptr query-native))
+ (let ((res-ptr (if full-set
+ (mysql-store-result mysql-ptr)
+ (mysql-use-result mysql-ptr))))
+ (declare (type mysql-mysql-res-ptr-def res-ptr))
+ (if (not (uffi:null-pointer-p res-ptr))
+ (if full-set
+ (values (make-mysql-result-set :res-ptr res-ptr :full-set t)
+ (mysql-num-fields res-ptr)
+ (mysql-num-rows res-ptr))
+ (values (make-mysql-result-set :res-ptr res-ptr)
+ (mysql-num-fields res-ptr)))
+ (error 'clsql-sql-error
+ :database database
+ :expression query-expression
+ :errno (mysql-errno mysql-ptr)
+ :error (mysql-error-string mysql-ptr))))
+ (error 'clsql-sql-error
+ :database database
+ :expression query-expression
+ :errno (mysql-errno mysql-ptr)
+ :error (mysql-error-string mysql-ptr))))))
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: mysql.cl
+;;;; Purpose: Low-level MySQL interface using UFFI
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: mysql-uffi.cl,v 1.1 2002/03/23 14:04:53 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+
+(in-package :mysql)
+
+;;;; Modifications from original code
+;;;; - Updated C-structures to conform to structures in MySQL 3.23.46
+;;;; - Changed from CMUCL interface to UFFI
+;;;; - Added and call a C-helper file to support 64-bit integers
+;;;; that are used in a few routines.
+;;;; - Removed all references to interiors of C-structions, this will
+;;;; increase robustness when MySQL's internal structures change.
+
+;;;; Type definitions
+
+;;; Basic Types
+
+(uffi:def-foreign-type mysql-socket :int)
+(uffi:def-foreign-type mysql-bool :char)
+(uffi:def-foreign-type mysql-byte :unsigned-char)
+
+(uffi:def-enum mysql-net-type
+ (:tcp-ip
+ :socket
+ :named-pipe))
+
+(uffi:def-struct mysql-net
+ (vio :pointer-void)
+ (fd mysql-socket)
+ (fcntl :int)
+ (buff (* :unsigned-char))
+ (buff-end (* :unsigned-char))
+ (write-pos (* :unsigned-char))
+ (read-pos (* :unsigned-char))
+ (last-error (:array :char 200))
+ (last-errno :unsigned-int)
+ (max-packet :unsigned-int)
+ (timeout :unsigned-int)
+ (pkt-nr :unsigned-int)
+ (error mysql-bool)
+ (return-errno mysql-bool)
+ (compress mysql-bool)
+ (no-send-ok mysql-bool)
+ (remain-in-buf :unsigned-long)
+ (length :unsigned-long)
+ (buf-length :unsigned-long)
+ (where-b :unsigned-long)
+ (return-status (* :unsigned-int))
+ (reading-or-writing :unsigned-char)
+ (save-char :char))
+
+;;; Mem-Root
+(uffi:def-struct mysql-used-mem
+ (next :pointer-self)
+ (left :unsigned-int)
+ (size :unsigned-int))
+
+(uffi:def-struct mysql-mem-root
+ (free (* mysql-used-mem))
+ (used (* mysql-used-mem))
+ (pre-alloc (* mysql-used-mem))
+ (min-alloc :unsigned-int)
+ (block-size :unsigned-int)
+ (error-handler :pointer-void))
+
+;;; MYSQL-FIELD
+(uffi:def-enum mysql-field-types
+ (:decimal
+ :tiny
+ :short
+ :long
+ :float
+ :double
+ :null
+ :timestamp
+ :longlong
+ :int24
+ :date
+ :time
+ :datetime
+ :year
+ :newdate
+ (:enum 247)
+ (:set 248)
+ (:tiny-blob 249)
+ (:medium-blob 250)
+ (:long-blob 251)
+ (:blob 252)
+ (:var-string 253)
+ (:string 254)))
+
+(uffi:def-struct mysql-field
+ (name (* :char))
+ (table (* :char))
+ (def (* :char))
+ (type mysql-field-types)
+ (length :unsigned-int)
+ (max-length :unsigned-int)
+ (flags :unsigned-int)
+ (decimals :unsigned-int))
+
+;;; MYSQL-ROWS
+
+(uffi:def-array-pointer mysql-row (* :unsigned-char))
+
+(uffi:def-foreign-type mysql-field-offset :unsigned-int)
+
+(uffi:def-struct mysql-rows
+ (next :pointer-self)
+ (data mysql-row))
+
+(uffi:def-foreign-type mysql-row-offset (* mysql-rows))
+
+(uffi:def-struct mysql-data
+ (rows-high32 :unsigned-long)
+ (rows-low32 :unsigned-long)
+ (fields :unsigned-int)
+ (data (* mysql-rows))
+ (alloc mysql-mem-root))
+
+;;; MYSQL
+(uffi:def-struct mysql-options
+ (connect-timeout :unsigned-int)
+ (client-flag :unsigned-int)
+ (compress mysql-bool)
+ (named-pipe mysql-bool)
+ (port :unsigned-int)
+ (host (* :char))
+ (init-command (* :char))
+ (user (* :char))
+ (password (* :char))
+ (unix-socket (* :char))
+ (db (* :char))
+ (my-cnf-file (* :char))
+ (my-cnf-group (* :char))
+ (charset-dir (* :char))
+ (charset-name (* :char))
+ (use-ssl mysql-bool)
+ (ssl-key (* :char))
+ (ssl-cert (* :char))
+ (ssl-ca (* :char))
+ (ssl-capath (* :char)))
+
+(uffi:def-enum mysql-option
+ (:connect-timeout
+ :compress
+ :named-pipe
+ :init-command
+ :read-default-file
+ :read-default-group))
+
+(uffi:def-enum mysql-status
+ (:ready
+ :get-result
+ :use-result))
+
+(uffi:def-struct mysql-mysql
+ (net mysql-net)
+ (connected-fd (* :char))
+ (host (* :char))
+ (user (* :char))
+ (passwd (* :char))
+ (unix-socket (* :char))
+ (server-version (* :char))
+ (host-info (* :char))
+ (info (* :char))
+ (db (* :char))
+ (port :unsigned-int)
+ (client-flag :unsigned-int)
+ (server-capabilities :unsigned-int)
+ (protocol-version :unsigned-int)
+ (field-count :unsigned-int)
+ (server-status :unsigned-int)
+ (thread-id :unsigned-long)
+ (affected-rows-high32 :unsigned-long)
+ (affected-rows-low32 :unsigned-long)
+ (insert-id-high32 :unsigned-long)
+ (insert-id-low32 :unsigned-long)
+ (extra-info-high32 :unsigned-long)
+ (extra-info-low32 :unsigned-long)
+ (packet-length :unsigned-long)
+ (status mysql-status)
+ (fields (* mysql-field))
+ (field-alloc mysql-mem-root)
+ (free-me mysql-bool)
+ (reconnect mysql-bool)
+ (options mysql-options)
+ (scramble-buff (:array :char 9))
+ (charset :pointer-void)
+ (server-language :unsigned-int))
+
+
+;;; MYSQL-RES
+(uffi:def-struct mysql-mysql-res
+ (row-count-high32 :unsigned-long)
+ (row-count-low32 :unsigned-long)
+ (field-count :unsigned-int)
+ (current-field :unsigned-int)
+ (fields (* mysql-field))
+ (data (* mysql-data))
+ (data-cursor (* mysql-rows))
+ (field-alloc mysql-mem-root)
+ (row mysql-row)
+ (current-row mysql-row)
+ (lengths (* :unsigned-long))
+ (handle (* mysql-mysql))
+ (eof mysql-bool))
+
+;;;; The Foreign C routines
+(declaim (inline mysql-init))
+(uffi:def-function "mysql_init"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning (* mysql-mysql))
+
+(declaim (inline mysql-connect))
+(uffi:def-function "mysql_connect"
+ ((mysql (* mysql-mysql))
+ (host :cstring)
+ (user :cstring)
+ (passwd :cstring))
+ :module "mysql"
+ :returning (* mysql-mysql))
+
+(declaim (inline mysql-real-connect))
+(uffi:def-function "mysql_real_connect"
+ ((mysql (* mysql-mysql))
+ (host :cstring)
+ (user :cstring)
+ (passwd :cstring)
+ (db :cstring)
+ (port :unsigned-int)
+ (unix-socket :cstring)
+ (clientflag :unsigned-int))
+ :module "mysql"
+ :returning (* mysql-mysql))
+
+(declaim (inline mysql-close))
+(uffi:def-function "mysql_close"
+ ((sock (* mysql-mysql)))
+ :module "mysql"
+ :returning :void)
+
+(declaim (inline mysql-select-db))
+(uffi:def-function "mysql_select_db"
+ ((mysql (* mysql-mysql))
+ (db :cstring))
+ :module "mysql"
+ :returning :int)
+
+(declaim (inline mysql-query))
+(uffi:def-function "mysql_query"
+ ((mysql (* mysql-mysql))
+ (query :cstring))
+ :module "mysql"
+ :returning :int)
+
+ ;;; I doubt that this function is really useful for direct Lisp usage,
+;;; but it is here for completeness...
+
+(declaim (inline mysql-real-query))
+(uffi:def-function "mysql_real_query"
+ ((mysql (* mysql-mysql))
+ (query :cstring)
+ (length :unsigned-int))
+ :module "mysql"
+ :returning :int)
+
+(declaim (inline mysql-create-db))
+(uffi:def-function "mysql_create_db"
+ ((mysql (* mysql-mysql))
+ (db :cstring))
+ :module "mysql"
+ :returning :int)
+
+(declaim (inline mysql-drop-db))
+(uffi:def-function "mysql_drop_db"
+ ((mysql (* mysql-mysql))
+ (db :cstring))
+ :module "mysql"
+ :returning :int)
+
+(declaim (inline mysql-shutdown))
+(uffi:def-function "mysql_shutdown"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning :int)
+
+(declaim (inline mysql-dump-debug-info))
+(uffi:def-function "mysql_dump_debug_info"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning :int)
+
+(declaim (inline mysql-refresh))
+(uffi:def-function "mysql_refresh"
+ ((mysql (* mysql-mysql))
+ (refresh-options :unsigned-int))
+ :module "mysql"
+ :returning :int)
+
+(declaim (inline mysql-kill))
+(uffi:def-function "mysql_kill"
+ ((mysql (* mysql-mysql))
+ (pid :unsigned-long))
+ :module "mysql"
+ :returning :int)
+
+(declaim (inline mysql-ping))
+(uffi:def-function "mysql_ping"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning :int)
+
+(declaim (inline mysql-stat))
+(uffi:def-function "mysql_stat"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning :cstring)
+
+(declaim (inline mysql-get-server-info))
+(uffi:def-function "mysql_get_server_info"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning :cstring)
+
+(declaim (inline mysql-get-client-info))
+(uffi:def-function "mysql_get_client_info"
+ ()
+ :module "mysql"
+ :returning :cstring)
+
+(declaim (inline mysql-get-host-info))
+(uffi:def-function "mysql_get_host_info"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning :cstring)
+
+(declaim (inline mysql-get-proto-info))
+(uffi:def-function "mysql_get_proto_info"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning :unsigned-int)
+
+(declaim (inline mysql-list-dbs))
+(uffi:def-function "mysql_list_dbs"
+ ((mysql (* mysql-mysql))
+ (wild :cstring))
+ :module "mysql"
+ :returning (* mysql-mysql-res))
+
+(declaim (inline mysql-list-tables))
+(uffi:def-function "mysql_list_tables"
+ ((mysql (* mysql-mysql))
+ (wild :cstring))
+ :module "mysql"
+ :returning (* mysql-mysql-res))
+
+(declaim (inline mysql-list-fields))
+(uffi:def-function "mysql_list_fields"
+ ((mysql (* mysql-mysql))
+ (table :cstring)
+ (wild :cstring))
+ :module "mysql"
+ :returning (* mysql-mysql-res))
+
+(declaim (inline mysql-list-processes))
+(uffi:def-function "mysql_list_processes"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning (* mysql-mysql-res))
+
+(declaim (inline mysql-store-result))
+(uffi:def-function "mysql_store_result"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning (* mysql-mysql-res))
+
+(declaim (inline mysql-use-result))
+(uffi:def-function "mysql_use_result"
+ ((mysql (* mysql-mysql)))
+ :module "mysql"
+ :returning (* mysql-mysql-res))
+
+(declaim (inline mysql-options))
+(uffi:def-function "mysql_options"
+ ((mysql (* mysql-mysql))
+ (option mysql-option)
+ (arg :cstring))
+ :module "mysql"
+ :returning :int)
+
+(declaim (inline mysql-free-result))
+(uffi:def-function "mysql_free_result"
+ ((res (* mysql-mysql-res)))
+ :module "mysql"
+ :returning :void)
+
+(declaim (inline mysql-row-seek))
+(uffi:def-function "mysql_row_seek"
+ ((res (* mysql-mysql-res))
+ (offset mysql-row-offset))
+ :module "mysql"
+ :returning mysql-row-offset)
+
+(declaim (inline mysql-field-seek))
+(uffi:def-function "mysql_field_seek"
+ ((res (* mysql-mysql-res))
+ (offset mysql-field-offset))
+ :module "mysql"
+ :returning mysql-field-offset)
+
+(declaim (inline mysql-fetch-row))
+(uffi:def-function "mysql_fetch_row"
+ ((res (* mysql-mysql-res)))
+ :module "mysql"
+ :returning mysql-row)
+
+(declaim (inline mysql-fetch-lengths))
+(uffi:def-function "mysql_fetch_lengths"
+ ((res (* mysql-mysql-res)))
+ :module "mysql"
+ :returning (* :unsigned-long))
+
+(declaim (inline mysql-fetch-field))
+(uffi:def-function "mysql_fetch_field"
+ ((res (* mysql-mysql-res)))
+ :module "mysql"
+ :returning (* mysql-field))
+
+(declaim (inline mysql-escape-string))
+(uffi:def-function "mysql_escape_string"
+ ((to :cstring)
+ (from :cstring)
+ (length :unsigned-int))
+ :module "mysql"
+ :returning :unsigned-int)
+
+(declaim (inline mysql-debug))
+(uffi:def-function "mysql_debug"
+ ((debug :cstring))
+ :module "mysql"
+ :returning :void)
+
+(declaim (inline clsql-mysql-num-rows))
+(uffi:def-function "clsql_mysql_num_rows"
+ ((res (* mysql-mysql-res))
+ (p-high32 (* :unsigned-int)))
+ :module "clsql-mysql"
+ :returning :unsigned-int)
+
+
+;;;; Equivalents of C Macro definitions for accessing various fields
+;;;; in the internal MySQL Datastructures
+
+(uffi:def-constant +2^32+ 4294967296)
+(uffi:def-constant +2^32-1+ (1- +2^32+))
+
+(defmacro make-64-bit-integer (high32 low32)
+ `(+ ,low32 (* ,high32 +2^32+)))
+
+(declaim (inline mysql-num-rows))
+(defun mysql-num-rows (res)
+ (uffi:with-foreign-object (p-high32 :unsigned-int)
+ (let ((low32 (clsql-mysql-num-rows res p-high32))
+ (high32 (uffi:deref-pointer p-high32 :unsigned-int)))
+ (if (zerop high32)
+ low32
+ (make-64-bit-integer high32 low32)))))
+
+(uffi:def-function "clsql_mysql_affected_rows"
+ ((mysql (* mysql-mysql))
+ (p-high32 (* :unsigned-int)))
+ :returning :unsigned-int
+ :module "clsql-mysql")
+
+(defun mysql-affected-rows (mysql)
+ (uffi:with-foreign-object (p-high32 :unsigned-int)
+ (let ((low32 (clsql-mysql-affected-rows mysql p-high32))
+ (high32 (uffi:deref-pointer p-high32 :unsigned-int)))
+ (if (zerop high32)
+ low32
+ (make-64-bit-integer high32 low32)))))
+
+(uffi:def-function "clsql_mysql_insert_id"
+ ((res (* mysql-mysql))
+ (p-high32 (* :unsigned-int)))
+ :returning :unsigned-int
+ :module "clsql-mysql")
+
+(defun mysql-insert-id (mysql)
+ (uffi:with-foreign-object (p-high32 :unsigned-int)
+ (let ((low32 (clsql-mysql-insert-id mysql p-high32))
+ (high32 (uffi:deref-pointer p-high32 :unsigned-int)))
+ (if (zerop high32)
+ low32
+ (make-64-bit-integer high32 low32)))))
+
+
+(declaim (inline mysql-num-fields))
+(uffi:def-function "mysql_num_fields"
+ ((res (* mysql-mysql-res)))
+ :returning :unsigned-int
+ :module "mysql")
+
+(declaim (inline clsql-mysql-eof))
+(uffi:def-function ("mysql_eof" clsql-mysql-eof)
+ ((res (* mysql-mysql-res)))
+ :returning :char
+ :module "mysql")
+
+(declaim (inline mysql-eof))
+(defun mysql-eof (res)
+ (if (zerop (clsql-mysql-eof res))
+ nil
+ t))
+
+(declaim (inline mysql-error))
+(uffi:def-function ("mysql_error" mysql-error)
+ ((mysql (* mysql-mysql)))
+ :returning :cstring
+ :module "mysql")
+
+(declaim (inline mysql-error-string))
+(defun mysql-error-string (mysql)
+ (uffi:convert-from-cstring (mysql-error mysql)))
+
+(declaim (inline mysql-errno))
+(uffi:def-function "mysql_errno"
+ ((mysql (* mysql-mysql)))
+ :returning :unsigned-int
+ :module "mysql")
+
+(declaim (inline mysql-info))
+(uffi:def-function ("mysql_info" mysql-info)
+ ((mysql (* mysql-mysql)))
+ :returning :cstring
+ :module "mysql")
+
+(declaim (inline mysql-info-string))
+(defun mysql-info-string (mysql)
+ (uffi:convert-from-cstring (mysql-info mysql)))
+
+(declaim (inline clsql-mysql-data-seek))
+(uffi:def-function "clsql_mysql_data_seek"
+ ((res (* mysql-mysql-res))
+ (offset-high32 :unsigned-int)
+ (offset-low32 :unsigned-int))
+ :module "clsql-mysql"
+ :returning :void)
+
+
+(declaim (inline split-64bit-integer))
+(defun split-64bit-integer (int64)
+ (values (ash int64 -32) (logand int64 +2^32-1+)))
+
+(defun mysql-data-seek (res offset)
+ (multiple-value-bind (high32 low32) (split-64bit-integer offset)
+ (clsql-mysql-data-seek res high32 low32)))
+
--- /dev/null
+#include <stdio.h>
+#include "/opt/mysql/include/mysql/mysql.h"
+
+int main (int argc, char** argv)
+{
+ printf ("Size of MYSQL struct: %ld\n", sizeof (MYSQL));
+}
--- /dev/null
+(in-package :mysql)
+
+#+lispworks
+(progn
+ (setq c (fli:allocate-foreign-object :type 'mysql-mysql))
+ (format t "~&Size MYSQL structure: ~d" (fli:pointer-element-size c)))
+#+allegro
+(progn
+ (setq c (ff:allocate-fobject 'mysql-mysql :foreign))
+ (format t "~&Size MYSQL structure: ~A" c))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: postgresql-socket-package.cl
+;;;; Purpose: Package definition for PostgreSQL interface using sockets
+;;;; Programmers: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: postgresql-socket-package.cl,v 1.1 2002/03/23 14:04:53 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+(in-package :cl-user)
+
+(defpackage :postgresql-socket
+ (:use :common-lisp)
+ (:export #:+crypt-library+
+ #:postgresql-condition
+ #:postgresql-condition-connection
+ #:postgresql-condition-message
+ #:postgresql-error
+ #:postgresql-fatal-error
+ #:postgresql-login-error
+ #:postgresql-warning
+ #:postgresql-notification
+ #:postgresql-connection
+ #:postgresql-connection-p
+ #:postgresql-cursor
+ #:postgresql-cursor-p
+ #:postgresql-cursor-connection
+ #:postgresql-cursor-name
+ #:postgresql-cursor-fields
+ #:+postgresql-server-default-port+
+ #:open-postgresql-connection
+ #:reopen-postgresql-connection
+ #:close-postgresql-connection
+ #:postgresql-connection-open-p
+ #:ensure-open-postgresql-connection
+ #:start-query-execution
+ #:wait-for-query-results
+ #:read-cursor-row
+ #:copy-cursor-row
+ #:skip-cursor-row
+ ))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: postgresql-socket-sql.sql
+;;;; Purpose: High-level PostgreSQL interface using socket
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: postgresql-socket-sql.cl,v 1.1 2002/03/23 14:04:53 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+
+(defpackage :clsql-postgresql-socket
+ (:use :common-lisp :clsql-sys :postgresql-socket)
+ (:export #:postgresql-socket-database)
+ (:documentation "This is the CLSQL socket interface to PostgreSQL."))
+
+(in-package :clsql-postgresql-socket)
+
+(defun convert-to-clsql-warning (database condition)
+ (warn 'clsql-database-warning :database database
+ :message (postgresql-condition-message condition)))
+
+(defun convert-to-clsql-error (database expression condition)
+ (error 'clsql-sql-error :database database
+ :expression expression
+ :errno (type-of condition)
+ :error (postgresql-condition-message condition)))
+
+(defmacro with-postgresql-handlers
+ ((database &optional expression)
+ &body body)
+ (let ((database-var (gensym))
+ (expression-var (gensym)))
+ `(let ((,database-var ,database)
+ (,expression-var ,expression))
+ (handler-bind ((postgresql-warning
+ (lambda (c)
+ (convert-to-clsql-warning ,database-var c)))
+ (postgresql-error
+ (lambda (c)
+ (convert-to-clsql-error
+ ,database-var ,expression-var c))))
+ ;; KMR - removed double @@
+ ,@body))))
+
+(defmethod database-initialize-database-type
+ ((database-type (eql :postgresql-socket)))
+ t)
+
+(defclass postgresql-socket-database (database)
+ ((connection :accessor database-connection :initarg :connection
+ :type postgresql-connection)))
+
+(defmethod database-name-from-spec
+ (connection-spec (database-type (eql :postgresql-socket)))
+ (check-connection-spec connection-spec database-type
+ (host db user password &optional port options tty))
+ (destructuring-bind (host db user password &optional port options tty)
+ connection-spec
+ (declare (ignore password options tty))
+ (concatenate 'string host (if port ":") (if port port) "/" db "/" user)))
+
+(defmethod database-connect
+ (connection-spec (database-type (eql :postgresql-socket)))
+ (check-connection-spec connection-spec database-type
+ (host db user password &optional port options tty))
+ (destructuring-bind (host db user password &optional
+ (port +postgresql-server-default-port+)
+ (options "") (tty ""))
+ connection-spec
+ (handler-case
+ (handler-bind ((postgresql-warning
+ (lambda (c)
+ (warn 'clsql-simple-warning
+ :format-control "~A"
+ :format-arguments
+ (list (princ-to-string c))))))
+ (open-postgresql-connection :host host :port port
+ :options options :tty tty
+ :database db :user user
+ :password password))
+ (:no-error (connection)
+ ;; Success, make instance
+ (make-instance 'postgresql-socket-database
+ :name (database-name-from-spec connection-spec
+ database-type)
+ :connection connection))
+ (postgresql-error (c)
+ ;; Connect failed
+ (error 'clsql-connect-error
+ :database-type database-type
+ :connection-spec connection-spec
+ :errno (type-of c)
+ :error (postgresql-condition-message c))))))
+
+(defmethod database-disconnect ((database postgresql-socket-database))
+ (close-postgresql-connection (database-connection database))
+ t)
+
+(defmethod database-query (expression (database postgresql-socket-database))
+ (let ((connection (database-connection database)))
+ (with-postgresql-handlers (database expression)
+ (start-query-execution connection expression)
+ (multiple-value-bind (status cursor)
+ (wait-for-query-results connection)
+ (unless (eq status :cursor)
+ (close-postgresql-connection connection)
+ (error 'clsql-sql-error
+ :database database
+ :expression expression
+ :errno 'missing-result
+ :error "Didn't receive result cursor for query."))
+ (loop for row = (read-cursor-row cursor)
+ while row
+ collect row
+ finally
+ (unless (null (wait-for-query-results connection))
+ (close-postgresql-connection connection)
+ (error 'clsql-sql-error
+ :database database
+ :expression expression
+ :errno 'multiple-results
+ :error "Received multiple results for query.")))))))
+
+(defmethod database-execute-command
+ (expression (database postgresql-socket-database))
+ (let ((connection (database-connection database)))
+ (with-postgresql-handlers (database expression)
+ (start-query-execution connection expression)
+ (multiple-value-bind (status result)
+ (wait-for-query-results connection)
+ (when (eq status :cursor)
+ (loop
+ (multiple-value-bind (row stuff)
+ (skip-cursor-row result)
+ (unless row
+ (setq status :completed result stuff)
+ (return)))))
+ (cond
+ ((null status)
+ t)
+ ((eq status :completed)
+ (unless (null (wait-for-query-results connection))
+ (close-postgresql-connection connection)
+ (error 'clsql-sql-error
+ :database database
+ :expression expression
+ :errno 'multiple-results
+ :error "Received multiple results for command."))
+ result)
+ (t
+ (close-postgresql-connection connection)
+ (error 'clsql-sql-error
+ :database database
+ :expression expression
+ :errno 'missing-result
+ :error "Didn't receive completion for command.")))))))
+
+(defmethod database-query-result-set
+ (expression (database postgresql-socket-database) &optional full-set)
+ (declare (ignore full-set))
+ (let ((connection (database-connection database)))
+ (with-postgresql-handlers (database expression)
+ (start-query-execution connection expression)
+ (multiple-value-bind (status cursor)
+ (wait-for-query-results connection)
+ (unless (eq status :cursor)
+ (close-postgresql-connection connection)
+ (error 'clsql-sql-error
+ :database database
+ :expression expression
+ :errno 'missing-result
+ :error "Didn't receive result cursor for query."))
+ (values (cons nil cursor)
+ (length (postgresql-cursor-fields cursor)))))))
+
+(defmethod database-dump-result-set
+ (result-set (database postgresql-socket-database))
+ (if (car result-set)
+ t
+ (with-postgresql-handlers (database)
+ (loop while (skip-cursor-row (cdr result-set))
+ finally (setf (car result-set) t)))))
+
+(defmethod database-store-next-row
+ (result-set (database postgresql-socket-database) list)
+ (let ((cursor (cdr result-set)))
+ (with-postgresql-handlers (database)
+ (if (copy-cursor-row cursor list)
+ t
+ (prog1 nil
+ (setf (car result-set) t)
+ (wait-for-query-results (database-connection database)))))))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: postgresql-socket.cl
+;;;; Purpose: Low-level PostgreSQL interface using sockets
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
+;;;;
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: postgresql-socket-uffi.cl,v 1.1 2002/03/23 14:04:54 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+
+;;;; Changes by Kevin Rosenberg
+;;;; - Added socket open functions for Allegro and Lispworks
+;;;; - Changed CMUCL FFI to UFFI
+;;;; - Added necessary (force-output) for socket streams on
+;;;; Allegro and Lispworks
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :postgresql-socket)
+
+
+;;; Message I/O stuff
+
+(defmacro define-message-constants (description &rest clauses)
+ (assert (evenp (length clauses)))
+ (loop with seen-characters = nil
+ for (name char) on clauses by #'cddr
+ for char-code = (char-code char)
+ for doc-string = (format nil "~A (~:C): ~A" description char name)
+ if (member char seen-characters)
+ do (error "Duplicate message type ~@C for group ~A" char description)
+ else
+ collect
+ `(defconstant ,name ,char-code ,doc-string)
+ into result-clauses
+ and do (push char seen-characters)
+ finally
+ (return `(progn ,@result-clauses))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+(define-message-constants "Backend Message Constants"
+ +ascii-row-message+ #\D
+ +authentication-message+ #\R
+ +backend-key-message+ #\K
+ +binary-row-message+ #\B
+ +completed-response-message+ #\C
+ +copy-in-response-message+ #\G
+ +copy-out-response-message+ #\H
+ +cursor-response-message+ #\P
+ +empty-query-response-message+ #\I
+ +error-response-message+ #\E
+ +function-response-message+ #\V
+ +notice-response-message+ #\N
+ +notification-response-message+ #\A
+ +ready-for-query-message+ #\Z
+ +row-description-message+ #\T))
+
+(defgeneric send-socket-value (type socket value))
+
+(defmethod send-socket-value ((type (eql 'int32)) socket (value integer))
+ (write-byte (ldb (byte 8 24) value) socket)
+ (write-byte (ldb (byte 8 16) value) socket)
+ (write-byte (ldb (byte 8 8) value) socket)
+ (write-byte (ldb (byte 8 0) value) socket))
+
+(defmethod send-socket-value ((type (eql 'int16)) socket (value integer))
+ (write-byte (ldb (byte 8 8) value) socket)
+ (write-byte (ldb (byte 8 0) value) socket))
+
+(defmethod send-socket-value ((type (eql 'int8)) socket (value integer))
+ (write-byte (ldb (byte 8 0) value) socket))
+
+(defmethod send-socket-value ((type (eql 'string)) socket (value string))
+ (loop for char across value
+ for code = (char-code char)
+ do (write-byte code socket)
+ finally (write-byte 0 socket)))
+
+(defmethod send-socket-value ((type (eql 'limstring)) socket (value string))
+ (loop for char across value
+ for code = (char-code char)
+ do (write-byte code socket)))
+
+(defmethod send-socket-value ((type (eql 'byte)) socket (value integer))
+ (write-byte value socket))
+
+(defmethod send-socket-value ((type (eql 'byte)) socket (value character))
+ (write-byte (char-code value) socket))
+
+(defmethod send-socket-value ((type (eql 'byte)) socket value)
+ (write-sequence value socket))
+
+(defgeneric read-socket-value (type socket))
+
+(defmethod read-socket-value ((type (eql 'int32)) socket)
+ (let ((result 0))
+ (setf (ldb (byte 8 24) result) (read-byte socket))
+ (setf (ldb (byte 8 16) result) (read-byte socket))
+ (setf (ldb (byte 8 8) result) (read-byte socket))
+ (setf (ldb (byte 8 0) result) (read-byte socket))
+ result))
+
+(defmethod read-socket-value ((type (eql 'int16)) socket)
+ (let ((result 0))
+ (setf (ldb (byte 8 8) result) (read-byte socket))
+ (setf (ldb (byte 8 0) result) (read-byte socket))
+ result))
+
+(defmethod read-socket-value ((type (eql 'int8)) socket)
+ (read-byte socket))
+
+(defmethod read-socket-value ((type (eql 'string)) socket)
+ (with-output-to-string (out)
+ (loop for code = (read-byte socket)
+ until (zerop code)
+ do (write-char (code-char code) out))))
+
+(defgeneric skip-socket-value (type socket))
+
+(defmethod skip-socket-value ((type (eql 'int32)) socket)
+ (dotimes (i 4) (read-byte socket)))
+
+(defmethod skip-socket-value ((type (eql 'int16)) socket)
+ (dotimes (i 2) (read-byte socket)))
+
+(defmethod skip-socket-value ((type (eql 'int8)) socket)
+ (read-byte socket))
+
+(defmethod skip-socket-value ((type (eql 'string)) socket)
+ (loop until (zerop (read-byte socket))))
+
+(defmacro define-message-sender (name (&rest args) &rest clauses)
+ (loop with socket-var = (gensym)
+ for (type value) in clauses
+ collect
+ `(send-socket-value ',type ,socket-var ,value)
+ into body
+ finally
+ (return
+ `(defun ,name (,socket-var ,@args)
+ ,@body))))
+
+(defun pad-limstring (string limit)
+ (let ((result (make-string limit :initial-element #\NULL)))
+ (loop for char across string
+ for index from 0 below limit
+ do (setf (char result index) char))
+ result))
+
+(define-message-sender send-startup-message
+ (database user &optional (command-line "") (backend-tty ""))
+ (int32 296) ; Length
+ (int32 #x00020000) ; Version 2.0
+ (limstring (pad-limstring database 64))
+ (limstring (pad-limstring user 32))
+ (limstring (pad-limstring command-line 64))
+ (limstring (pad-limstring "" 64)) ; Unused
+ (limstring (pad-limstring backend-tty 64)))
+
+(define-message-sender send-terminate-message ()
+ (byte #\X))
+
+(define-message-sender send-unencrypted-password-message (password)
+ (int32 (+ 5 (length password)))
+ (string password))
+
+(define-message-sender send-query-message (query)
+ (byte #\Q)
+ (string query))
+
+(define-message-sender send-encrypted-password-message (crypted-password)
+ (int32 (+ 5 (length crypted-password)))
+ (string crypted-password))
+
+(define-message-sender send-cancel-request (pid key)
+ (int32 16) ; Length
+ (int32 80877102) ; Magic
+ (int32 pid)
+ (int32 key))
+
+;;; Support for encrypted password transmission
+
+(defconstant +crypt-library+ "/usr/lib/libcrypt.so"
+ "Name of the shared library to load in order to access the crypt
+function named by `*crypt-function-name*'.")
+
+(defvar *crypt-library-loaded* nil)
+
+(defun crypt-password (password salt)
+ "Encrypt a password for transmission to a PostgreSQL server."
+ (unless *crypt-library-loaded*
+ (uffi:load-foreign-library +crypt-library+ :supporting-libaries '("c"))
+ (eval (uffi:def-function "crypt"
+ ((key :cstring)
+ (salt :cstring))
+ :returning :cstring))
+ (setq *crypt-library-loaded* t))
+ (uffi:with-cstring (password-cstring password)
+ (uffi:with-cstring (salt-cstring salt)
+ (uffi:convert-from-cstring (crypt password-cstring salt-cstring)))))
+;;; Condition hierarchy
+
+(define-condition postgresql-condition (condition)
+ ((connection :initarg :connection :reader postgresql-condition-connection)
+ (message :initarg :message :reader postgresql-condition-message))
+ (:report
+ (lambda (c stream)
+ (format stream "~@<~A occurred on connection ~A. ~:@_Reason: ~A~:@>"
+ (type-of c)
+ (postgresql-condition-connection c)
+ (postgresql-condition-message c)))))
+
+(define-condition postgresql-error (error postgresql-condition)
+ ())
+
+(define-condition postgresql-fatal-error (postgresql-error)
+ ())
+
+(define-condition postgresql-login-error (postgresql-fatal-error)
+ ())
+
+(define-condition postgresql-warning (warning postgresql-condition)
+ ())
+
+(define-condition postgresql-notification (postgresql-condition)
+ ()
+ (:report
+ (lambda (c stream)
+ (format stream "~@<Asynchronous notification on connection ~A: ~:@_~A~:@>"
+ (postgresql-condition-connection c)
+ (postgresql-condition-message c)))))
+
+;;; Structures
+
+(defstruct postgresql-connection
+ host
+ port
+ database
+ user
+ password
+ options
+ tty
+ socket
+ pid
+ key)
+
+(defstruct postgresql-cursor
+ connection
+ name
+ fields)
+
+;;; Socket stuff
+
+(defconstant +postgresql-server-default-port+ 5432
+ "Default port of PostgreSQL server.")
+
+(defvar *postgresql-server-socket-timeout* 60
+ "Timeout in seconds for reads from the PostgreSQL server.")
+
+
+#+cmu
+(defun open-postgresql-socket (host port)
+ (etypecase host
+ (pathname
+ ;; Directory to unix-domain socket
+ (ext:connect-to-unix-socket
+ (namestring
+ (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
+ :defaults host))))
+ (string
+ (ext:connect-to-inet-socket host port))))
+
+#+cmu
+(defun open-postgresql-socket-stream (host port)
+ (system:make-fd-stream
+ (open-postgresql-socket host port)
+ :input t :output t :element-type '(unsigned-byte 8)
+ :buffering :none
+ :timeout *postgresql-server-socket-timeout*))
+
+#+allegro
+(defun open-postgresql-socket-stream (host port)
+ (etypecase host
+ (pathname
+ (let ((path (namestring
+ (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
+ :defaults host))))
+ (socket:make-socket :type :stream :address-family :file
+ :connect :active
+ :remote-filename path :local-filename path)))
+ (string
+ (socket:with-pending-connect
+ (mp:with-timeout (*postgresql-server-socket-timeout* (error "connect failed"))
+ (socket:make-socket :type :stream :address-family :internet
+ :remote-port port :remote-host host
+ :connect :active :nodelay t))))
+ ))
+
+#+lispworks
+(defun open-postgresql-socket-stream (host port)
+ (etypecase host
+ (pathname
+ (error "File sockets not supported on Lispworks."))
+ (string
+ (comm:open-tcp-stream host port :direction :io :element-type '(unsigned-byte 8)
+ :read-timeout *postgresql-server-socket-timeout*))
+ ))
+
+;;; Interface Functions
+
+(defun open-postgresql-connection (&key (host (cmucl-compat:required-argument))
+ (port +postgresql-server-default-port+)
+ (database (cmucl-compat:required-argument))
+ (user (cmucl-compat:required-argument))
+ options tty password)
+ "Open a connection to a PostgreSQL server with the given parameters.
+Note that host, database and user arguments must be supplied.
+
+If host is a pathname, it is assumed to name a directory containing
+the local unix-domain sockets of the server, with port selecting which
+of those sockets to open. If host is a string, it is assumed to be
+the name of the host running the PostgreSQL server. In that case a
+TCP connection to the given port on that host is opened in order to
+communicate with the server. In either case the port argument
+defaults to `+postgresql-server-default-port+'.
+
+Password is the clear-text password to be passed in the authentication
+phase to the server. Depending on the server set-up, it is either
+passed in the clear, or encrypted via crypt and a server-supplied
+salt. In that case the alien function specified by `*crypt-library*'
+and `*crypt-function-name*' is used for encryption.
+
+Note that all the arguments (including the clear-text password
+argument) are stored in the `postgresql-connection' structure, in
+order to facilitate automatic reconnection in case of communication
+troubles."
+ (reopen-postgresql-connection
+ (make-postgresql-connection :host host :port port
+ :options (or options "") :tty (or tty "")
+ :database database :user user
+ :password (or password ""))))
+
+(defun reopen-postgresql-connection (connection)
+ "Reopen the given PostgreSQL connection. Closes any existing
+connection, if it is still open."
+ (when (postgresql-connection-open-p connection)
+ (close-postgresql-connection connection))
+ (let ((socket (open-postgresql-socket-stream
+ (postgresql-connection-host connection)
+ (postgresql-connection-port connection))))
+ (unwind-protect
+ (progn
+ (setf (postgresql-connection-socket connection) socket)
+ (send-startup-message socket
+ (postgresql-connection-database connection)
+ (postgresql-connection-user connection)
+ (postgresql-connection-options connection)
+ (postgresql-connection-tty connection))
+ (force-output socket)
+ (loop
+ (case (read-socket-value 'int8 socket)
+ (#.+authentication-message+
+ (case (read-socket-value 'int32 socket)
+ (0 (return))
+ ((1 2)
+ (error 'postgresql-login-error
+ :connection connection
+ :message
+ "Postmaster expects unsupported Kerberos authentication."))
+ (3
+ (send-unencrypted-password-message
+ socket
+ (postgresql-connection-password connection)))
+ (4
+ (let ((salt (make-string 2)))
+ (read-sequence salt socket)
+ (send-encrypted-password-message
+ socket
+ (crypt-password
+ (postgresql-connection-password connection) salt))))
+ (t
+ (error 'postgresql-login-error
+ :connection connection
+ :message
+ "Postmaster expects unknown authentication method."))))
+ (#.+error-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (error 'postgresql-login-error
+ :connection connection :message message)))
+ (t
+ (error 'postgresql-login-error
+ :connection connection
+ :message
+ "Received garbled message from Postmaster"))))
+ ;; Start backend communication
+ (force-output socket)
+ (loop
+ (case (read-socket-value 'int8 socket)
+ (#.+backend-key-message+
+ (setf (postgresql-connection-pid connection)
+ (read-socket-value 'int32 socket)
+ (postgresql-connection-key connection)
+ (read-socket-value 'int32 socket)))
+ (#.+ready-for-query-message+
+ (setq socket nil)
+ (return connection))
+ (#.+error-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (error 'postgresql-login-error
+ :connection connection
+ :message message)))
+ (#.+notice-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (warn 'postgresql-warning :connection connection
+ :message message)))
+ (t
+ (error 'postgresql-login-error
+ :connection connection
+ :message
+ "Received garbled message from Postmaster")))))
+ (when socket
+ (close socket)))))
+
+(defun close-postgresql-connection (connection &optional abort)
+ (unless abort
+ (ignore-errors
+ (send-terminate-message (postgresql-connection-socket connection))))
+ (close (postgresql-connection-socket connection)))
+
+(defun postgresql-connection-open-p (connection)
+ (let ((socket (postgresql-connection-socket connection)))
+ (and socket (streamp socket) (open-stream-p socket))))
+
+(defun ensure-open-postgresql-connection (connection)
+ (unless (postgresql-connection-open-p connection)
+ (reopen-postgresql-connection connection)))
+
+(defun process-async-messages (connection)
+ (assert (postgresql-connection-open-p connection))
+ ;; Process any asnychronous messages
+ (loop with socket = (postgresql-connection-socket connection)
+ while (listen socket)
+ do
+ (case (read-socket-value 'int8 socket)
+ (#.+notice-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (warn 'postgresql-warning :connection connection
+ :message message)))
+ (#.+notification-response-message+
+ (let ((pid (read-socket-value 'int32 socket))
+ (message (read-socket-value 'string socket)))
+ (when (= pid (postgresql-connection-pid connection))
+ (signal 'postgresql-notification :connection connection
+ :message message))))
+ (t
+ (close-postgresql-connection connection)
+ (error 'postgresql-fatal-error :connection connection
+ :message "Received garbled message from backend")))))
+
+(defun start-query-execution (connection query)
+ (ensure-open-postgresql-connection connection)
+ (process-async-messages connection)
+ (send-query-message (postgresql-connection-socket connection) query)
+ (force-output (postgresql-connection-socket connection)))
+
+(defun wait-for-query-results (connection)
+ (assert (postgresql-connection-open-p connection))
+ (let ((socket (postgresql-connection-socket connection))
+ (cursor-name nil)
+ (error nil))
+ (loop
+ (case (read-socket-value 'int8 socket)
+ (#.+completed-response-message+
+ (return (values :completed (read-socket-value 'string socket))))
+ (#.+cursor-response-message+
+ (setq cursor-name (read-socket-value 'string socket)))
+ (#.+row-description-message+
+ (let* ((count (read-socket-value 'int16 socket))
+ (fields
+ (loop repeat count
+ collect
+ (list
+ (read-socket-value 'string socket)
+ (read-socket-value 'int32 socket)
+ (read-socket-value 'int16 socket)
+ (read-socket-value 'int32 socket)))))
+ (return
+ (values :cursor
+ (make-postgresql-cursor :connection connection
+ :name cursor-name
+ :fields fields)))))
+ (#.+copy-in-response-message+
+ (return :copy-in))
+ (#.+copy-out-response-message+
+ (return :copy-out))
+ (#.+ready-for-query-message+
+ (when error
+ (error error))
+ (return nil))
+ (#.+error-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (setq error
+ (make-condition 'postgresql-error
+ :connection connection :message message))))
+ (#.+notice-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (warn 'postgresql-warning
+ :connection connection :message message)))
+ (#.+notification-response-message+
+ (let ((pid (read-socket-value 'int32 socket))
+ (message (read-socket-value 'string socket)))
+ (when (= pid (postgresql-connection-pid connection))
+ (signal 'postgresql-notification :connection connection
+ :message message))))
+ (t
+ (close-postgresql-connection connection)
+ (error 'postgresql-fatal-error :connection connection
+ :message "Received garbled message from backend"))))))
+
+(defun read-null-bit-vector (socket count)
+ (let ((result (make-array count :element-type 'bit)))
+ (dotimes (offset (ceiling count 8))
+ (loop with byte = (read-byte socket)
+ for index from (* offset 8) below (min count (* (1+ offset) 8))
+ for weight downfrom 7
+ do (setf (aref result index) (ldb (byte 1 weight) byte))))
+ result))
+
+(defun read-cursor-row (cursor)
+ (let* ((connection (postgresql-cursor-connection cursor))
+ (socket (postgresql-connection-socket connection))
+ (fields (postgresql-cursor-fields cursor)))
+ (assert (postgresql-connection-open-p connection))
+ (loop
+ (let ((code (read-socket-value 'int8 socket)))
+ (case code
+ (#.+ascii-row-message+
+ (return
+ (loop with count = (length fields)
+ with null-vector = (read-null-bit-vector socket count)
+ repeat count
+ for null-bit across null-vector
+ for null-p = (zerop null-bit)
+ if null-p
+ collect nil
+ else
+ collect
+ (let* ((length (read-socket-value 'int32 socket))
+ (result (make-string (- length 4))))
+ (read-sequence result socket)
+ result))))
+ (#.+binary-row-message+
+ (error "NYI"))
+ (#.+completed-response-message+
+ (return (values nil (read-socket-value 'string socket))))
+ (#.+error-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (error 'postgresql-error
+ :connection connection :message message)))
+ (#.+notice-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (warn 'postgresql-warning
+ :connection connection :message message)))
+ (#.+notification-response-message+
+ (let ((pid (read-socket-value 'int32 socket))
+ (message (read-socket-value 'string socket)))
+ (when (= pid (postgresql-connection-pid connection))
+ (signal 'postgresql-notification :connection connection
+ :message message))))
+ (t
+ (close-postgresql-connection connection)
+ (error 'postgresql-fatal-error :connection connection
+ :message "Received garbled message from backend")))))))
+
+(defun copy-cursor-row (cursor sequence)
+ (let* ((connection (postgresql-cursor-connection cursor))
+ (socket (postgresql-connection-socket connection))
+ (fields (postgresql-cursor-fields cursor)))
+ (assert (= (length fields) (length sequence)))
+ (loop
+ (let ((code (read-socket-value 'int8 socket)))
+ (case code
+ (#.+ascii-row-message+
+ (return
+ (map-into
+ sequence
+ #'(lambda (null-bit)
+ (if (zerop null-bit)
+ nil
+ (let* ((length (read-socket-value 'int32 socket))
+ (result (make-string (- length 4))))
+ (read-sequence result socket)
+ result)))
+ (read-null-bit-vector socket (length sequence)))))
+ (#.+binary-row-message+
+ (error "NYI"))
+ (#.+completed-response-message+
+ (return (values nil (read-socket-value 'string socket))))
+ (#.+error-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (error 'postgresql-error
+ :connection connection :message message)))
+ (#.+notice-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (warn 'postgresql-warning
+ :connection connection :message message)))
+ (#.+notification-response-message+
+ (let ((pid (read-socket-value 'int32 socket))
+ (message (read-socket-value 'string socket)))
+ (when (= pid (postgresql-connection-pid connection))
+ (signal 'postgresql-notification :connection connection
+ :message message))))
+ (t
+ (close-postgresql-connection connection)
+ (error 'postgresql-fatal-error :connection connection
+ :message "Received garbled message from backend")))))))
+
+(defun skip-cursor-row (cursor)
+ (let* ((connection (postgresql-cursor-connection cursor))
+ (socket (postgresql-connection-socket connection))
+ (fields (postgresql-cursor-fields cursor)))
+ (loop
+ (let ((code (read-socket-value 'int8 socket)))
+ (case code
+ (#.+ascii-row-message+
+ (loop for null-bit across
+ (read-null-bit-vector socket (length fields))
+ do
+ (unless (zerop null-bit)
+ (let* ((length (read-socket-value 'int32 socket)))
+ (loop repeat (- length 4) do (read-byte socket)))))
+ (return t))
+ (#.+binary-row-message+
+ (error "NYI"))
+ (#.+completed-response-message+
+ (return (values nil (read-socket-value 'string socket))))
+ (#.+error-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (error 'postgresql-error
+ :connection connection :message message)))
+ (#.+notice-response-message+
+ (let ((message (read-socket-value 'string socket)))
+ (warn 'postgresql-warning
+ :connection connection :message message)))
+ (#.+notification-response-message+
+ (let ((pid (read-socket-value 'int32 socket))
+ (message (read-socket-value 'string socket)))
+ (when (= pid (postgresql-connection-pid connection))
+ (signal 'postgresql-notification :connection connection
+ :message message))))
+ (t
+ (close-postgresql-connection connection)
+ (error 'postgresql-fatal-error :connection connection
+ :message "Received garbled message from backend")))))))
+
+(defun run-query (connection query)
+ (start-query-execution connection query)
+ (multiple-value-bind (status cursor)
+ (wait-for-query-results connection)
+ (assert (eq status :cursor))
+ (loop for row = (read-cursor-row cursor)
+ while row
+ collect row
+ finally
+ (wait-for-query-results connection))))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: postgresql-loader.sql
+;;;; Purpose: PostgreSQL library loader using UFFI
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: postgresql-loader.cl,v 1.1 2002/03/23 14:04:53 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :postgresql)
+
+(defvar *postgresql-library-filename*
+ (cond
+ ((probe-file "/opt/postgresql/lib/libpq.so")
+ "/opt/postgresql/lib/libpq.so")
+ ((probe-file "/usr/local/lib/libpq.so")
+ "/usr/local/lib/libpq.so")
+ ((probe-file "/usr/lib/libpq.so")
+ "/usr/lib/libpq.so")
+ #+(or win32 mswindows)
+ ((probe-file "c:/postgresql/lib/libpq.dll")
+ "c:/postgresql/lib/libpq.dll")
+ (t
+ (warn "Can't find PostgresQL client library to load.")))
+ "Location where the PostgresSQL client library is to be found.")
+
+(defvar *postgresql-supporting-libraries* '("crypt" "c")
+ "Used only by CMU. List of library flags needed to be passed to ld to
+load the PostgresSQL client library succesfully. If this differs at your site,
+set to the right path before compiling or loading the system.")
+
+(defmethod database-type-load-foreign ((database-type (eql :postgresql)))
+ (uffi:load-foreign-library *postgresql-library-filename*
+ :module "postgresql"
+ :supporting-libraries
+ *postgresql-supporting-libraries*))
+
+(database-type-load-foreign :postgresql)
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: postgresql-package.cl
+;;;; Purpose: Package definition for low-level PostgreSQL interface
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: postgresql-package.cl,v 1.1 2002/03/23 14:04:53 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+(defpackage :postgresql
+ (:nicknames :pgsql)
+ (:use :common-lisp)
+ (:export
+ #:pgsql-oid
+ #:pgsql-conn-status-type
+ #:pgsql-conn-status-type#connection-ok
+ #:pgsql-conn-status-type#connection-bad
+ #:pgsql-exec-status-type
+ #:pgsql-exec-status-type#empty-query
+ #:pgsql-exec-status-type#command-ok
+ #:pgsql-exec-status-type#tuples-ok
+ #:pgsql-exec-status-type#copy-out
+ #:pgsql-exec-status-type#copy-in
+ #:pgsql-exec-status-type#bad-response
+ #:pgsql-exec-status-type#nonfatal-error
+ #:pgsql-exec-status-type#fatal-error
+ #:pgsql-conn
+ #:pgsql-result
+
+ ;; Functions
+ #:PQsetdbLogin
+ #:PQlogin
+ #:PQfinish
+ #:PQstatus
+ #:PQerrorMessage
+ #:PQexec
+ #:PQresultStatus
+ #:PQresultErrorMessage
+ #:PQntuples
+ #:PQnfields
+ #:PQfname
+ #:PQfnumber
+ #:PQftype
+ #:PQfsize
+ #:PQcmdStatus
+ #:PQoidStatus
+ #:PQcmdTuples
+ #:PQgetvalue
+ #:PQgetlength
+ #:PQgetisnull
+ #:PQclear
+ )
+ (:documentation "This is the low-level interface to PostgreSQL."))
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: postgresql-sql.sql
+;;;; Purpose: High-level PostgreSQL interface using UFFI
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: postgresql-sql.cl,v 1.1 2002/03/23 14:04:53 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+(defpackage :clsql-postgresql
+ (:use :common-lisp :clsql-sys :postgresql)
+ (:export #:postgresql-database)
+ (:documentation "This is the CLSQL interface to PostgreSQL."))
+
+(in-package :clsql-postgresql)
+
+
+(defun tidy-error-message (message)
+ (unless (stringp message)
+ (setq message (uffi:convert-from-foreign-string message)))
+ (let ((message (string-right-trim '(#\Return #\Newline) message)))
+ (cond
+ ((< (length message) (length "ERROR:"))
+ message)
+ ((string= message "ERROR:" :end1 6)
+ (string-left-trim '(#\Space) (subseq message 6)))
+ (t
+ message))))
+
+(defmethod database-initialize-database-type ((database-type
+ (eql :postgresql)))
+ t)
+
+(uffi:def-type pgsql-conn-def pgsql-conn)
+(uffi:def-type pgsql-result-def pgsql-result)
+
+
+(defclass postgresql-database (database)
+ ((conn-ptr :accessor database-conn-ptr :initarg :conn-ptr
+ :type pgsql-conn-def)))
+
+(defmethod database-name-from-spec (connection-spec (database-type
+ (eql :postgresql)))
+ (check-connection-spec connection-spec database-type
+ (host db user password &optional port options tty))
+ (destructuring-bind (host db user password &optional port options tty)
+ connection-spec
+ (declare (ignore password options tty))
+ (concatenate 'string host (if port ":") (if port port) "/" db "/" user)))
+
+
+(defmethod database-connect (connection-spec (database-type (eql :postgresql)))
+ (check-connection-spec connection-spec database-type
+ (host db user password &optional port options tty))
+ (destructuring-bind (host db user password &optional port options tty)
+ connection-spec
+ (uffi:with-cstring (host-native host)
+ (uffi:with-cstring (user-native user)
+ (uffi:with-cstring (password-native password)
+ (uffi:with-cstring (db-native db)
+ (uffi:with-cstring (port-native port)
+ (uffi:with-cstring (options-native options)
+ (uffi:with-cstring (tty-native tty)
+ (let ((connection (PQsetdbLogin host-native port-native
+ options-native tty-native
+ db-native user-native
+ password-native)))
+ (declare (type pgsql-conn-def connection))
+ (when (not (eq (PQstatus connection)
+ pgsql-conn-status-type#connection-ok))
+ (error 'clsql-connect-error
+ :database-type database-type
+ :connection-spec connection-spec
+ :errno (PQstatus connection)
+ :error (tidy-error-message
+ (PQerrorMessage connection))))
+ (make-instance 'postgresql-database
+ :name (database-name-from-spec connection-spec
+ database-type)
+ :conn-ptr connection)))))))))))
+
+
+(defmethod database-disconnect ((database postgresql-database))
+ (PQfinish (database-conn-ptr database))
+ (setf (database-conn-ptr database) nil)
+ t)
+
+(defmethod database-query (query-expression (database postgresql-database))
+ (let ((conn-ptr (database-conn-ptr database)))
+ (declare (type pgsql-conn-def conn-ptr))
+ (uffi:with-cstring (query-native query-expression)
+ (let ((result (PQexec conn-ptr query-native)))
+ (when (uffi:null-pointer-p result)
+ (error 'clsql-sql-error
+ :database database
+ :expression query-expression
+ :errno nil
+ :error (tidy-error-message (PQerrorMessage conn-ptr))))
+ (unwind-protect
+ (case (PQresultStatus result)
+ (#.pgsql-exec-status-type#empty-query
+ nil)
+ (#.pgsql-exec-status-type#tuples-ok
+ (loop for tuple-index from 0 below (PQntuples result)
+ collect
+ (loop for i from 0 below (PQnfields result)
+ collect
+ (if (zerop (PQgetisnull result tuple-index i))
+ (uffi:convert-from-cstring
+ (PQgetvalue result tuple-index i))
+ nil))))
+ (t
+ (error 'clsql-sql-error
+ :database database
+ :expression query-expression
+ :errno (PQresultStatus result)
+ :error (tidy-error-message
+ (PQresultErrorMessage result)))))
+ (PQclear result))))))
+
+(defmethod database-execute-command (sql-expression
+ (database postgresql-database))
+ (let ((conn-ptr (database-conn-ptr database)))
+ (declare (type pgsql-conn-def conn-ptr))
+ (uffi:with-cstring (sql-native sql-expression)
+ (let ((result (PQexec conn-ptr sql-native)))
+ (when (uffi:null-pointer-p result)
+ (error 'clsql-sql-error
+ :database database
+ :expression sql-expression
+ :errno nil
+ :error (tidy-error-message (PQerrorMessage conn-ptr))))
+ (unwind-protect
+ (case (PQresultStatus result)
+ (#.pgsql-exec-status-type#command-ok
+ t)
+ ((#.pgsql-exec-status-type#empty-query
+ #.pgsql-exec-status-type#tuples-ok)
+ (warn "Strange result...")
+ t)
+ (t
+ (error 'clsql-sql-error
+ :database database
+ :expression sql-expression
+ :errno (PQresultStatus result)
+ :error (tidy-error-message
+ (PQresultErrorMessage result)))))
+ (PQclear result))))))
+
+(defstruct postgresql-result-set
+ (res-ptr (uffi:make-null-pointer 'pgsql-result)
+ :type pgsql-result-def)
+ (num-tuples 0)
+ (num-fields 0)
+ (tuple-index 0))
+
+(defmethod database-query-result-set (query-expression
+ (database postgresql-database)
+ &optional full-set)
+ (let ((conn-ptr (database-conn-ptr database)))
+ (declare (type pgsql-conn-def conn-ptr))
+ (uffi:with-cstring (query-native query-expression)
+ (let ((result (PQexec conn-ptr query-native)))
+ (when (uffi:null-pointer-p result)
+ (error 'clsql-sql-error
+ :database database
+ :expression query-expression
+ :errno nil
+ :error (tidy-error-message (PQerrorMessage conn-ptr))))
+ (case (PQresultStatus result)
+ ((#.pgsql-exec-status-type#empty-query
+ #.pgsql-exec-status-type#tuples-ok)
+ (if full-set
+ (values (make-postgresql-result-set
+ :res-ptr result
+ :num-fields (PQnfields result)
+ :num-tuples (PQntuples result))
+ (PQnfields result)
+ (PQntuples result))
+ (values (make-postgresql-result-set
+ :res-ptr result
+ :num-fields (PQnfields result)
+ :num-tuples (PQntuples result))
+ (PQnfields result))))
+ (t
+ (unwind-protect
+ (error 'clsql-sql-error
+ :database database
+ :expression query-expression
+ :errno (PQresultStatus result)
+ :error (tidy-error-message
+ (PQresultErrorMessage result)))
+ (PQclear result))))))))
+
+(defmethod database-dump-result-set (result-set (database postgresql-database))
+ (let ((res-ptr (postgresql-result-set-res-ptr result-set)))
+ (declare (type pgsql-result-def res-ptr))
+ (PQclear res-ptr)
+ t))
+
+(defmethod database-store-next-row (result-set (database postgresql-database)
+ list)
+ (let ((result (postgresql-result-set-res-ptr result-set)))
+ (declare (type pgsql-result-def result))
+ (if (>= (postgresql-result-set-tuple-index result-set)
+ (postgresql-result-set-num-tuples result-set))
+ nil
+ (loop with tuple-index = (postgresql-result-set-tuple-index result-set)
+ for i from 0 below (postgresql-result-set-num-fields result-set)
+ for rest on list
+ do
+ (setf (car rest)
+ (if (zerop (PQgetisnull result tuple-index i))
+ (uffi:convert-from-cstring
+ (PQgetvalue result tuple-index i))
+ nil))
+ finally
+ (incf (postgresql-result-set-tuple-index result-set))
+ (return list)))))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: postgresql.cl
+;;;; Purpose: Low-level PostgreSQL interface using UFFI
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: postgresql-uffi.cl,v 1.1 2002/03/23 14:04:53 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :postgresql)
+
+
+;;;; This file implements as little of the FFI bindings to the
+;;;; PostgreSQL client libraries as we could get away with.
+;;;; Especially all the PostgreSQL-specific goodies aren't there, and
+;;;; we just use void pointers where we can get away with it, which
+;;;; thanks to the design of the PostgreSQL client libraries is pretty
+;;;; much everywhere, in contrast to the MySQL client libraries for
+;;;; example.
+
+;;;; Type definitions
+
+;;; Basic Types
+
+(uffi:def-foreign-type pgsql-oid :unsigned-int)
+
+(uffi:def-enum pgsql-conn-status-type
+ (:connection-ok
+ :connection-bad))
+
+(uffi:def-enum pgsql-exec-status-type
+ (:empty-query
+ :command-ok
+ :tuples-ok
+ :copy-out
+ :copy-in
+ :bad-response
+ :nonfatal-error
+ :fatal-error))
+
+(uffi:def-foreign-type pgsql-conn :pointer-void)
+(uffi:def-foreign-type pgsql-result :pointer-void)
+
+;;(declaim (inline PQsetdbLogin)) ;; causes compile error in LW 4.2.0
+(uffi:def-function ("PQsetdbLogin" PQsetdbLogin)
+ ((pghost :cstring)
+ (pgport :cstring)
+ (pgoptions :cstring)
+ (pgtty :cstring)
+ (dbName :cstring)
+ (login :cstring)
+ (pwd :cstring))
+ :returning pgsql-conn)
+
+(declaim (inline PQfinish))
+(uffi:def-function ("PQfinish" PQfinish)
+ ((conn pgsql-conn))
+ :module "postgresql"
+ :returning :void)
+
+(declaim (inline PQstatus))
+(uffi:def-function ("PQstatus" PQstatus)
+ ((conn pgsql-conn))
+ :module "postgresql"
+ :returning pgsql-conn-status-type)
+
+(declaim (inline PQerrorMessage))
+(uffi:def-function ("PQerrorMessage" PQerrorMessage)
+ ((conn pgsql-conn))
+ :module "postgresql"
+ :returning :cstring)
+
+(declaim (inline PQexec))
+(uffi:def-function ("PQexec" PQexec)
+ ((conn pgsql-conn)
+ (query :cstring))
+ :module "postgresql"
+ :returning pgsql-result)
+
+(declaim (inline PQresultStatus))
+(uffi:def-function ("PQresultStatus" PQresultStatus)
+ ((res pgsql-result))
+ :module "postgresql"
+ :returning pgsql-exec-status-type)
+
+(declaim (inline PQresultErrorMessage))
+(uffi:def-function ("PQresultErrorMessage" PQresultErrorMessage)
+ ((res pgsql-result))
+ :module "postgresql"
+ :returning :cstring)
+
+(declaim (inline PQntuples))
+(uffi:def-function ("PQntuples" PQntuples)
+ ((res pgsql-result))
+ :module "postgresql"
+ :returning :int)
+
+(declaim (inline PQnfields))
+(uffi:def-function ("PQnfields" PQnfields)
+ ((res pgsql-result))
+ :module "postgresql"
+ :returning :int)
+
+(declaim (inline PQfname))
+(uffi:def-function ("PQfname" PQfname)
+ ((res pgsql-result)
+ (field-num :int))
+ :module "postgresql"
+ :returning :cstring)
+
+(declaim (inline PQfnumber))
+(uffi:def-function ("PQfnumber" PQfnumber)
+ ((res pgsql-result)
+ (field-name :cstring))
+ :module "postgresql"
+ :returning :int)
+
+(declaim (inline PQftype))
+(uffi:def-function ("PQftype" PQftype)
+ ((res pgsql-result)
+ (field-num :int))
+ :module "postgresql"
+ :returning pgsql-oid)
+
+(declaim (inline PQfsize))
+(uffi:def-function ("PQfsize" PQfsize)
+ ((res pgsql-result)
+ (field-num :int))
+ :module "postgresql"
+ :returning :short)
+
+(declaim (inline PQcmdStatus))
+(uffi:def-function ("PQcmdStatus" PQcmdStatus)
+ ((res pgsql-result))
+ :module "postgresql"
+ :returning :cstring)
+
+(declaim (inline PQoidStatus))
+(uffi:def-function ("PQoidStatus" PQoidStatus)
+ ((res pgsql-result))
+ :module "postgresql"
+ :returning :cstring)
+
+(declaim (inline PQcmdTuples))
+(uffi:def-function ("PQcmdTuples" PQcmdTuples)
+ ((res pgsql-result))
+ :module "postgresql"
+ :returning :cstring)
+
+(declaim (inline PQgetvalue))
+(uffi:def-function ("PQgetvalue" PQgetvalue)
+ ((res pgsql-result)
+ (tup-num :int)
+ (field-num :int))
+ :module "postgresql"
+ :returning :cstring)
+
+(declaim (inline PQgetlength))
+(uffi:def-function ("PQgetlength" PQgetlength)
+ ((res pgsql-result)
+ (tup-num :int)
+ (field-num :int))
+ :module "postgresql"
+ :returning :int)
+
+(declaim (inline PQgetisnull))
+(uffi:def-function ("PQgetisnull" PQgetisnull)
+ ((res pgsql-result)
+ (tup-num :int)
+ (field-num :int))
+ :module "postgresql"
+ :returning :int)
+
+(declaim (inline PQclear))
+(uffi:def-function ("PQclear" PQclear)
+ ((res pgsql-result))
+ :module "postgresql"
+ :returning :void)
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: set-logical.cl
+;;;; Purpose: Sets a logical host for src/binaries based on a pathname.
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+
+;;; Setup logical pathname translaton with separate binary directories
+;;; for each implementation
+
+;; push allegro case sensitivity on *features*
+#+allegro
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (if (or (eq excl:*current-case-mode* :case-sensitive-lower)
+ (eq excl:*current-case-mode* :case-sensitive-upper))
+ (pushnew :case-sensitive cl:*features*)
+ (pushnew :case-insensitive cl:*features*)))
+
+(defconstant +set-logical-compiler-name+
+ #+(and allegro ics case-sensitive) "acl-modern"
+ #+(and allegro (not ics) case-sensitive) "acl-modern8"
+ #+(and allegro ics (not case-sensitive)) "acl-ansi"
+ #+(and allegro (not ics) (not case-sensitive)) "acl-ansi8"
+ #+lispworks "lispworks"
+ #+clisp "clisp"
+ #+cmu "cmucl"
+ #+sbcl "sbcl"
+ #+corman "corman"
+ #+mcl "mcl"
+ #+openmcl "openmcl"
+ #-(or allegro lispworks clisp cmu sbcl corman mcl openmcl) "unknown")
+
+(defun set-logical-host-for-pathname (host base-pathname)
+ (setf (logical-pathname-translations host)
+ `(("ROOT;" ,(make-pathname
+ :host (pathname-host base-pathname)
+ :device (pathname-device base-pathname)
+ :directory (pathname-directory base-pathname)))
+ ("**;bin;*.*.*" ,(merge-pathnames
+ (make-pathname
+ :name :wild
+ :type :wild
+ :directory
+ (append '(:relative :wild-inferiors
+ ".bin" #.+set-logical-compiler-name+)))
+ base-pathname))
+ ("**;*.*.*" ,(merge-pathnames
+ (make-pathname
+ :name :wild
+ :type :wild
+ :directory '(:relative :wild-inferiors))
+ base-pathname))))
+ )
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: functional.cl
+;;;; Purpose: Functional interface
+;;;; Programmer: Pierre R. Mai
+;;;;
+;;;; Copyright (c) 1999-2001 Pierre R. Mai
+;;;;
+;;;; $Id: functional.cl,v 1.1 2002/03/23 14:04:54 kevin Exp $
+;;;;
+;;;; This file is part of CLSQL.
+;;;;
+;;;; CLSQL is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; CLSQL is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with CLSQL; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-sys)
+
+
+;;;; This file implements the more advanced functions of the
+;;;; functional SQL interface, which are just nicer layers above the
+;;;; basic SQL interface.
+
+(defun insert-records
+ (&key into attributes values av-pairs query (database *default-database*))
+ "Insert records into the given table according to the given options."
+ (cond
+ ((and av-pairs (or attributes values))
+ (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records."))
+ ((and (or av-pairs values) query)
+ (error
+ "Supply either query or values/av-pairs to call of insert-records."))
+ ((and attributes (not query)
+ (or (not (listp values)) (/= (length attributes) (length values))))
+ (error "You must supply a matching values list when using attributes in call of insert-records."))
+ (query
+ (execute-command
+ (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query)
+ :database database))
+ (t
+ (execute-command
+ (multiple-value-bind (attributes values)
+ (if av-pairs
+ (values (mapcar #'first av-pairs) (mapcar #'second av-pairs))
+ (values attributes values))
+ (format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})"
+ into attributes values))
+ :database database))))
+
+(defun delete-records (&key from where (database *default-database*))
+ "Delete the indicated records from the given database."
+ (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where)
+ :database database))
+
+(defun update-records (table &key attributes values av-pairs where (database *default-database*))
+ "Update the specified records in the given database."
+ (cond
+ ((and av-pairs (or attributes values))
+ (error "Supply either av-pairs or values (and possibly attributes) to call of update-records."))
+ ((and attributes
+ (or (not (listp values)) (/= (length attributes) (length values))))
+ (error "You must supply a matching values list when using attributes in call of update-records."))
+ ((or (and attributes (not values)) (and values (not attributes)))
+ (error "You must supply both values and attributes in call of update-records."))
+ (t
+ (execute-command
+ (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]"
+ table
+ (or av-pairs
+ (mapcar #'list attributes values))
+ where)
+ :database database))))
+
+(defmacro with-database ((db-var connection-spec &rest connect-args) &body body)
+ "Evaluate the body in an environment, where `db-var' is bound to the
+database connection given by `connection-spec' and `connect-args'.
+The connection is automatically closed on exit from the body."
+ `(let ((,db-var (connect ,connection-spec ,@connect-args)))
+ (unwind-protect
+ (let ((,db-var ,db-var)) ,@body)
+ (disconnect :database ,db-var))))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: package.cl
+;;;; Purpose: Package definition for high-level SQL interface
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: package.cl,v 1.1 2002/03/23 14:04:54 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+;;;; This file makes the required package definitions for CLSQL's
+;;;; core packages.
+;;;;
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+(defpackage :clsql-sys
+ (:use :common-lisp)
+ (:export
+ ;; "Private" exports for use by interface packages
+ #:check-connection-spec
+ #:database-type-load-foreign
+ #:database-initialize-database-type
+ #:database-connect
+ #:database-disconnect
+ #:database-query
+ #:database-execute-command
+ #:database-query-result-set
+ #:database-dump-result-set
+ #:database-store-next-row
+ ;; Shared exports for re-export by CLSQL
+ .
+ #1=(#:clsql-condition
+ #:clsql-error
+ #:clsql-simple-error
+ #:clsql-warning
+ #:clsql-simple-warning
+ #:clsql-invalid-spec-error
+ #:clsql-invalid-spec-error-connection-spec
+ #:clsql-invalid-spec-error-database-type
+ #:clsql-invalid-spec-error-template
+ #:clsql-connect-error
+ #:clsql-connect-error-database-type
+ #:clsql-connect-error-connection-spec
+ #:clsql-connect-error-errno
+ #:clsql-connect-error-error
+ #:clsql-sql-error
+ #:clsql-sql-error-database
+ #:clsql-sql-error-expression
+ #:clsql-sql-error-errno
+ #:clsql-sql-error-error
+ #:clsql-database-warning
+ #:clsql-database-warning-database
+ #:clsql-database-warning-message
+ #:clsql-exists-condition
+ #:clsql-exists-condition-new-db
+ #:clsql-exists-condition-old-db
+ #:clsql-exists-warning
+ #:clsql-exists-error
+ #:clsql-closed-error
+ #:clsql-closed-error-database
+ #:*loaded-database-types*
+ #:reload-database-types
+ #:*default-database-type*
+ #:*initialized-database-types*
+ #:initialize-database-type
+ #:*connect-if-exists*
+ #:*default-database*
+ #:connected-databases
+ #:database
+ #:database-name
+ #:closed-database
+ #:find-database
+ #:database-name-from-spec
+ #:connect
+ #:disconnect
+ #:query
+ #:execute-command
+ #:map-query
+ #:do-query
+ #:insert-records
+ #:delete-records
+ #:update-records
+ #:select
+ #:with-database))
+ (:documentation "This is the INTERNAL SQL-Interface package of CLSQL."))
+
+(defpackage #:clsql
+ (:import-from #:clsql-sys . #1#)
+ (:export . #1#)
+ (:documentation "This is the SQL-Interface package of CLSQL."))
+);eval-when
+
+(defpackage #:clsql-user
+ (:use #:common-lisp #:clsql)
+ (:documentation "This is the user package for experimenting with CLSQL."))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: sql.cl
+;;;; Purpose: High-level SQL interface
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: sql.cl,v 1.1 2002/03/23 14:04:54 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-sys)
+
+;;;; Modified to use CMUCL-COMPAT library and to fix format strings in
+;;;; error messages
+
+;;;; Simple implementation of SQL along the lines of Harlequin's Common SQL
+
+;;; Conditions
+(define-condition clsql-condition ()
+ ())
+
+(define-condition clsql-error (error clsql-condition)
+ ())
+
+(define-condition clsql-simple-error (simple-condition clsql-error)
+ ())
+
+(define-condition clsql-warning (warning clsql-condition)
+ ())
+
+(define-condition clsql-simple-warning (simple-condition clsql-warning)
+ ())
+
+(define-condition clsql-invalid-spec-error (clsql-error)
+ ((connection-spec :initarg :connection-spec
+ :reader clsql-invalid-spec-error-connection-spec)
+ (database-type :initarg :database-type
+ :reader clsql-invalid-spec-error-database-type)
+ (template :initarg :template
+ :reader clsql-invalid-spec-error-template))
+ (:report (lambda (c stream)
+ (format stream "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A"
+ (clsql-invalid-spec-error-connection-spec c)
+ (clsql-invalid-spec-error-database-type c)
+ (clsql-invalid-spec-error-template c)))))
+
+(defmacro check-connection-spec (connection-spec database-type template)
+ "Check the connection specification against the provided template,
+and signal an clsql-invalid-spec-error if they don't match."
+ `(handler-case
+ (destructuring-bind ,template ,connection-spec
+ (declare (ignore ,@template))
+ t)
+ (error () (error 'clsql-invalid-spec-error
+ :connection-spec ,connection-spec
+ :database-type ,database-type
+ :template (quote ,template)))))
+
+(define-condition clsql-connect-error (clsql-error)
+ ((database-type :initarg :database-type
+ :reader clsql-connect-error-database-type)
+ (connection-spec :initarg :connection-spec
+ :reader clsql-connect-error-connection-spec)
+ (errno :initarg :errno :reader clsql-connect-error-errno)
+ (error :initarg :error :reader clsql-connect-error-error))
+ (:report (lambda (c stream)
+ (format stream "While trying to connect to database ~A~% using database-type ~A:~% Error ~D / ~A~% has occurred."
+ (database-name-from-spec
+ (clsql-connect-error-connection-spec c)
+ (clsql-connect-error-database-type c))
+ (clsql-connect-error-database-type c)
+ (clsql-connect-error-errno c)
+ (clsql-connect-error-error c)))))
+
+(define-condition clsql-sql-error (clsql-error)
+ ((database :initarg :database :reader clsql-sql-error-database)
+ (expression :initarg :expression :reader clsql-sql-error-expression)
+ (errno :initarg :errno :reader clsql-sql-error-errno)
+ (error :initarg :error :reader clsql-sql-error-error))
+ (:report (lambda (c stream)
+ (format stream "While accessing database ~A~% with expression ~S:~% Error ~D / ~A~% has occurred."
+ (clsql-sql-error-database c)
+ (clsql-sql-error-expression c)
+ (clsql-sql-error-errno c)
+ (clsql-sql-error-error c)))))
+
+(define-condition clsql-database-warning (clsql-warning)
+ ((database :initarg :database :reader clsql-database-warning-database)
+ (message :initarg :message :reader clsql-database-warning-message))
+ (:report (lambda (c stream)
+ (format stream "While accessing database ~A~% Warning: ~A~% has occurred."
+ (clsql-database-warning-database c)
+ (clsql-database-warning-message c)))))
+
+(define-condition clsql-exists-condition (clsql-condition)
+ ((old-db :initarg :old-db :reader clsql-exists-condition-old-db)
+ (new-db :initarg :new-db :reader clsql-exists-condition-new-db
+ :initform nil))
+ (:report (lambda (c stream)
+ (format stream "In call to ~S:~%" 'connect)
+ (cond
+ ((null (clsql-exists-condition-new-db c))
+ (format stream
+ " There is an existing connection ~A to database ~A."
+ (clsql-exists-condition-old-db c)
+ (database-name (clsql-exists-condition-old-db c))))
+ ((eq (clsql-exists-condition-new-db c)
+ (clsql-exists-condition-old-db c))
+ (format stream
+ " Using existing connection ~A to database ~A."
+ (clsql-exists-condition-old-db c)
+ (database-name (clsql-exists-condition-old-db c))))
+ (t
+ (format stream
+ " Created new connection ~A to database ~A~% ~
+although there is an existing connection (~A)."
+ (clsql-exists-condition-new-db c)
+ (database-name (clsql-exists-condition-new-db c))
+ (clsql-exists-condition-old-db c)))))))
+
+(define-condition clsql-exists-warning (clsql-exists-condition
+ clsql-warning)
+ ())
+
+(define-condition clsql-exists-error (clsql-exists-condition
+ clsql-error)
+ ())
+
+(define-condition clsql-closed-error (clsql-error)
+ ((database :initarg :database :reader clsql-closed-error-database))
+ (:report (lambda (c stream)
+ (format stream "The database ~A has already been closed."
+ (clsql-closed-error-database c)))))
+
+;;; Database Types
+
+(defvar *loaded-database-types* nil
+ "Contains a list of database types which have been defined/loaded.")
+
+(defun reload-database-types ()
+ "Reloads any foreign code for the loaded database types after a dump."
+ (mapc #'database-type-load-foreign *loaded-database-types*))
+
+(defgeneric database-type-load-foreign (database-type)
+ (:documentation
+ "The internal generic implementation of reload-database-types.")
+ (:method :after (database-type)
+ (pushnew database-type *loaded-database-types*)))
+
+(defvar *default-database-type* nil
+ "Specifies the default type of database. Currently only :mysql is
+supported.")
+
+(defvar *initialized-database-types* nil
+ "Contains a list of database types which have been initialized by calls
+to initialize-database-type.")
+
+(defun initialize-database-type (&key (database-type *default-database-type*))
+ "Initialize the given database-type, if it is not already
+initialized, as indicated by `*initialized-database-types*'."
+ (if (member database-type *initialized-database-types*)
+ t
+ (when (database-initialize-database-type database-type)
+ (push database-type *initialized-database-types*)
+ t)))
+
+(defgeneric database-initialize-database-type (database-type)
+ (:documentation
+ "The internal generic implementation of initialize-database-type."))
+
+;;; Database handling
+
+(defvar *connect-if-exists* :error
+ "Default value for the if-exists parameter of connect calls.")
+
+(defvar *connected-databases* nil
+ "List of active database objects.")
+
+(defun connected-databases ()
+ "Return the list of active database objects."
+ *connected-databases*)
+
+(defvar *default-database* nil
+ "Specifies the default database to be used.")
+
+(defclass database ()
+ ((name :initarg :name :reader database-name))
+ (:documentation
+ "This class is the supertype of all databases handled by CLSQL."))
+
+(defmethod print-object ((object database) stream)
+ (print-unreadable-object (object stream :type t :identity t)
+ (write-string (if (slot-boundp object 'name)
+ (database-name object)
+ "<unbound>")
+ stream)))
+
+(defclass closed-database ()
+ ((name :initarg :name :reader database-name))
+ (:documentation
+ "This class represents all databases after they are closed via
+`disconnect'."))
+
+(defmethod print-object ((object closed-database) stream)
+ (print-unreadable-object (object stream :type t :identity t)
+ (write-string (if (slot-boundp object 'name)
+ (database-name object)
+ "<unbound>")
+ stream)))
+
+(defun signal-closed-database-error (database)
+ (cerror "Ignore this error and return nil."
+ 'clsql-closed-error
+ :database database))
+
+(defun find-database (database &optional (errorp t))
+ (etypecase database
+ (database
+ ;; Return the database object itself
+ database)
+ (string
+ (or (find database (connected-databases)
+ :key #'database-name
+ :test #'string=)
+ (when errorp
+ (cerror "Return nil."
+ 'clsql-simple-error
+ :format-control "There exists no database called ~A."
+ :format-arguments (list database)))))))
+
+(defun connect (connection-spec
+ &key (if-exists *connect-if-exists*)
+ (database-type *default-database-type*))
+ "Connects to a database of the given database-type, using the type-specific
+connection-spec. if-exists is currently ignored."
+ (let* ((db-name (database-name-from-spec connection-spec database-type))
+ (old-db (find-database db-name nil))
+ (result nil))
+ (if old-db
+ (case if-exists
+ (:new
+ (setq result
+ (database-connect connection-spec database-type)))
+ (:warn-new
+ (setq result
+ (database-connect connection-spec database-type))
+ (warn 'clsql-exists-warning :old-db old-db :new-db result))
+ (:error
+ (restart-case
+ (error 'clsql-exists-error :old-db old-db)
+ (create-new ()
+ :report "Create a new connection."
+ (setq result
+ (database-connect connection-spec database-type)))
+ (use-old ()
+ :report "Use the existing connection."
+ (setq result old-db))))
+ (:warn-old
+ (setq result old-db)
+ (warn 'clsql-exists-warning :old-db old-db :new-db old-db))
+ (:old
+ (setq result old-db)))
+ (setq result
+ (database-connect connection-spec database-type)))
+ (when result
+ (pushnew result *connected-databases*)
+ (setq *default-database* result)
+ result)))
+
+(defgeneric database-name-from-spec (connection-spec database-type)
+ (:documentation
+ "Returns the name of the database that would be created if connect
+was called with the connection-spec."))
+
+(defgeneric database-connect (connection-spec database-type)
+ (:documentation "Internal generic implementation of connect."))
+
+(defun disconnect (&key (database *default-database*))
+ "Closes the connection to database. Resets *default-database* if that
+database was disconnected and only one other connection exists."
+ (when (database-disconnect database)
+ (setq *connected-databases* (delete database *connected-databases*))
+ (when (eq database *default-database*)
+ (setq *default-database* (car *connected-databases*)))
+ (change-class database 'closed-database)
+ t))
+
+(defgeneric database-disconnect (database)
+ (:method ((database closed-database))
+ (signal-closed-database-error database))
+ (:documentation "Internal generic implementation of disconnect."))
+
+;;; Basic operations on databases
+
+(defmethod query (query-expression &key (database *default-database*))
+ "Execute the SQL query expression query-expression on the given database.
+Returns a list of lists of values of the result of that expression."
+ (database-query query-expression database))
+
+(defgeneric database-query (query-expression database)
+ (:method (query-expression (database closed-database))
+ (declare (ignore query-expression))
+ (signal-closed-database-error database))
+ (:documentation "Internal generic implementation of query."))
+
+(defmethod execute-command (sql-expression &key (database *default-database*))
+ "Execute the SQL command expression sql-expression on the given database.
+Returns true on success or nil on failure."
+ (database-execute-command sql-expression database))
+
+(defgeneric database-execute-command (sql-expression database)
+ (:method (sql-expression (database closed-database))
+ (declare (ignore sql-expression))
+ (signal-closed-database-error database))
+ (:documentation "Internal generic implementation of execute-command."))
+
+;;; Mapping and iteration
+(defgeneric database-query-result-set
+ (query-expression database &optional full-set)
+ (:method (query-expression (database closed-database) &optional full-set)
+ (declare (ignore query-expression full-set))
+ (signal-closed-database-error database)
+ (values nil nil nil))
+ (:documentation
+ "Internal generic implementation of query mapping. Starts the
+query specified by query-expression on the given database and returns
+a result-set to be used with database-store-next-row and
+database-dump-result-set to access the returned data. The second
+value is the number of columns in the result-set, if there are any.
+If full-set is true, the number of rows in the result-set is returned
+as a third value, if this is possible (otherwise nil is returned for
+the third value). This might have memory and resource usage
+implications, since many databases will require the query to be
+executed in full to answer this question. If the query produced no
+results then nil is returned for all values that would have been
+returned otherwise. If an error occurs during query execution, the
+function should signal a clsql-sql-error."))
+
+(defgeneric database-dump-result-set (result-set database)
+ (:method (result-set (database closed-database))
+ (declare (ignore result-set))
+ (signal-closed-database-error database))
+ (:documentation "Dumps the received result-set."))
+
+(defgeneric database-store-next-row (result-set database list)
+ (:method (result-set (database closed-database) list)
+ (declare (ignore result-set list))
+ (signal-closed-database-error database))
+ (:documentation
+ "Returns t and stores the next row in the result set in list or
+returns nil when result-set is finished."))
+
+
+
+(defun map-query (output-type-spec function query-expression
+ &key (database *default-database*))
+ "Map the function over all tuples that are returned by the query in
+query-expression. The results of the function are collected as
+specified in output-type-spec and returned like in MAP."
+ ;; DANGER Will Robinson: Parts of the code for implementing
+ ;; map-query (including the code below and the helper functions
+ ;; called) are highly CMU CL specific.
+ ;; KMR -- these have been replaced with cross-platform instructions above
+ (macrolet ((type-specifier-atom (type)
+ `(if (atom ,type) ,type (car ,type))))
+ (case (type-specifier-atom output-type-spec)
+ ((nil) (map-query-for-effect function query-expression database))
+ (list (map-query-to-list function query-expression database))
+ ((simple-vector simple-string vector string array simple-array
+ bit-vector simple-bit-vector base-string
+ simple-base-string)
+ (map-query-to-simple output-type-spec
+ function query-expression database))
+ (t
+ (funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t)
+ function query-expression :database database)))))
+
+(defun map-query-for-effect (function query-expression database)
+ (multiple-value-bind (result-set columns)
+ (database-query-result-set query-expression database)
+ (when result-set
+ (unwind-protect
+ (do ((row (make-list columns)))
+ ((not (database-store-next-row result-set database row))
+ nil)
+ (apply function row))
+ (database-dump-result-set result-set database)))))
+
+(defun map-query-to-list (function query-expression database)
+ (multiple-value-bind (result-set columns)
+ (database-query-result-set query-expression database)
+ (when result-set
+ (unwind-protect
+ (let ((result (list nil)))
+ (do ((row (make-list columns))
+ (current-cons result (cdr current-cons)))
+ ((not (database-store-next-row result-set database row))
+ (cdr result))
+ (rplacd current-cons (list (apply function row)))))
+ (database-dump-result-set result-set database)))))
+
+
+(defun map-query-to-simple (output-type-spec function query-expression database)
+ (multiple-value-bind (result-set columns rows)
+ (database-query-result-set query-expression database t)
+ (when result-set
+ (unwind-protect
+ (if rows
+ ;; We know the row count in advance, so we allocate once
+ (do ((result
+ (cmucl-compat:make-sequence-of-type output-type-spec rows))
+ (row (make-list columns))
+ (index 0 (1+ index)))
+ ((not (database-store-next-row result-set database row))
+ result)
+ (declare (fixnum index))
+ (setf (aref result index)
+ (apply function row)))
+ ;; Database can't report row count in advance, so we have
+ ;; to grow and shrink our vector dynamically
+ (do ((result
+ (cmucl-compat:make-sequence-of-type output-type-spec 100))
+ (allocated-length 100)
+ (row (make-list columns))
+ (index 0 (1+ index)))
+ ((not (database-store-next-row result-set database row))
+ (cmucl-compat:shrink-vector result index))
+ (declare (fixnum allocated-length index))
+ (when (>= index allocated-length)
+ (setq allocated-length (* allocated-length 2)
+ result (adjust-array result allocated-length)))
+ (setf (aref result index)
+ (apply function row))))
+ (database-dump-result-set result-set database)))))
+
+(defmacro do-query (((&rest args) query-expression
+ &key (database '*default-database*))
+ &body body)
+ (let ((result-set (gensym))
+ (columns (gensym))
+ (row (gensym))
+ (db (gensym)))
+ `(let ((,db ,database))
+ (multiple-value-bind (,result-set ,columns)
+ (database-query-result-set ,query-expression ,db)
+ (when ,result-set
+ (unwind-protect
+ (do ((,row (make-list ,columns)))
+ ((not (database-store-next-row ,result-set ,db ,row))
+ nil)
+ (destructuring-bind ,args ,row
+ ,@body))
+ (database-dump-result-set ,result-set ,db)))))))
+
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: test-clsql.cl
+;;;; Purpose: Basic test of CLSQL
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: test-clsql.cl,v 1.1 2002/03/23 14:04:49 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+(defun get-spec-and-type ()
+ (format t "~&Test CLSQL")
+ (format t "~&==========~%")
+ (format t "~&Enter connection type (:mysql :postgresql :postgresql-socket")
+ #+allegro (format t " :aodbc")
+ (format t ") [default END]: ")
+ (let ((type-string (read-line)))
+ (if (zerop (length type-string))
+ (values nil nil)
+ (let* ((type (read-from-string type-string))
+ (spec (get-spec type
+ (ecase type
+ ((:mysql :postgresql :postgresql-socket)
+ '("host" "database" "user" "password"))
+ (:aodbc
+ '("dsn" "user" "password"))))))
+ (when (eq type :mysql)
+ (test-clsql-mysql spec))
+ (values spec type)))))
+
+
+(defun get-spec (type spec-format)
+ (let (spec)
+ (format t "~&Connection Spec for ~A" (symbol-name type))
+ (format t "~&------------------------------")
+
+ (dolist (elem spec-format)
+ (format t "~&Enter ~A: " elem)
+ (push (read-line) spec))
+ (nreverse spec)))
+
+(defun test-clsql (spec type)
+ (let ((db (clsql:connect spec :database-type type :if-exists :new)))
+ (unwind-protect
+ (progn
+ (ignore-errors
+ (clsql:execute-command
+ "DROP TABLE test_clsql" :database db))
+ (clsql:execute-command
+ "CREATE TABLE test_clsql (i integer, sqrt float, sqrt_str CHAR(20))" :database db)
+ (dotimes (i 10)
+ (clsql:execute-command
+ (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
+ i (sqrt i) (format nil "~d" (sqrt i)))
+ :database db))
+ (pprint (clsql:map-query 'vector #'list "select * from test_clsql" :database db))
+ (clsql:execute-command "DROP TABLE test_clsql"))
+ (clsql:disconnect :database db)))
+ )
+
+(defun test-clsql-mysql (spec)
+ (let ((db (clsql-mysql::database-connect spec :mysql)))
+ (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
+ (clsql-mysql::database-execute-command
+ "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
+ (dotimes (i 10)
+ (clsql-mysql::database-execute-command
+ (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
+ i (sqrt i) (format nil "~d" (sqrt i)))
+ db))
+ (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db t)))
+ (format t "~&Number rows: ~D~%" (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
+ (clsql-mysql::database-dump-result-set res db))
+ (clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
+ (clsql-mysql::database-disconnect db)))
+
+
+(do ((done nil))
+ (done)
+ (multiple-value-bind (spec type) (get-spec-and-type)
+ (if spec
+ (test-clsql spec type)
+ (setq done t))))
+
+
+
projects / clsql.git / commitdiff