connect.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          connect.lisp
   6 ;;;; Purpose:       Low-level SQL routines data for UMLisp
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2000
   9 ;;;;
  10 ;;;; $Id: connect.lisp,v 1.2 2002/12/02 15:57:17 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of Hyperobject-SQL, is
  13 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
  14 ;;;; *************************************************************************
  15
  16 (in-package :hyperobject)
  17 (eval-when (:compile-toplevel :execute)
  18   (declaim (optimize (speed 2) (safety 2) (compilation-speed 0) (debug 2))))
  19
  20 (defvar *ho-sql-db* "ho")
  21 (defun ho-sql-db ()
  22   *ho-sql-db*)
  23 (defun ho-sql-db! (dbname)
  24   (sql-disconnect-pooled)
  25   (setq *ho-sql-db* dbname))
  26
  27 (defvar *ho-sql-user* "secret")
  28 (defun ho-sql-user ()
  29   *ho-sql-user*)
  30 (defun ho-sql-user! (u)
  31   (sql-disconnect-pooled)
  32   (setq *ho-sql-user* u))
  33
  34 (defvar *ho-sql-passwd* "secret")
  35 (defun ho-sql-passwd ()
  36   *ho-sql-passwd*)
  37 (defun ho-sql-passwd! (p)
  38   (sql-disconnect-pooled)
  39   (setq *ho-sql-passwd* p))
  40
  41 (defvar *ho-sql-host* "localhost")
  42 (defun ho-sql-host ()
  43   *ho-sql-host*)
  44 (defun ho-sql-host! (h)
  45   (sql-disconnect-pooled)
  46   (setq *ho-sql-host* h))
  47
  48 (defvar *ho-sql-type* :mysql)
  49 (defun ho-sql-type ()
  50   *ho-sql-type*)
  51 (defun ho-sql-type! (h)
  52   (sql-disconnect-pooled)
  53   (setq *ho-sql-type* h))
  54
  55 (defun sql-connect ()
  56   "Connect to HO database, automatically used pooled connections"
  57   (clsql:connect `(,(ho-sql-host) ,(ho-sql-db) ,(ho-sql-user) ,(ho-sql-passwd))
  58                  :database-type *ho-sql-type* :pool t))
  59
  60 (defun sql-disconnect (conn)
  61   "Disconnect from HO database, but put connection back into pool"
  62   (clsql:disconnect :database conn))
  63
  64 (defun sql-disconnect-pooled ()
  65   (clsql:disconnect-pooled))
  66
  67 (defmacro with-sql-connection ((conn) &body body)
  68   `(let ((,conn (sql-connect)))
  69      (unwind-protect
  70          (progn ,@body)
  71        (when ,conn (clsql:disconnect :database ,conn)))))
  72
  73 (defun sql-query (cmd conn &key (types :auto))
  74   (clsql:query cmd :database conn :types types))
  75
  76 (defun sql-execute (cmd conn)
  77   (clsql:execute-command cmd :database conn))
  78
  79 ;;; Pool of open connections
  80
  81 (defmacro with-mutex-sql ((conn) &body body)
  82   `(let ((,conn (sql-connect)))
  83      (unwind-protect
  84          (progn ,@body)
  85        (when ,conn (sql-disconnect ,conn)))))
  86
  87 (defun mutex-sql-execute (cmd)
  88   (with-mutex-sql (conn)
  89     (sql-execute cmd conn)))
  90
  91 (defun mutex-sql-query (cmd &key (types :auto))
  92   (with-mutex-sql (conn)
  93     (sql-query cmd conn :types types)))