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