db-mysql/mysql-usql.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          mysql-usql.cl
   6 ;;;; Purpose:       MySQL interface functions to support UncommonSQL
   7 ;;;; Programmers:   Kevin M. Rosenberg and onShore Development Inc
   8 ;;;; Date Started:  Mar 2002
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;; and by onShore Development Inc.
  14 ;;;;
  15 ;;;; CLSQL users are granted the rights to distribute and use this software
  16 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  17 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  18 ;;;; *************************************************************************
  19
  20 (in-package #:clsql-mysql)
  21
  22 ;; Table and attribute introspection
  23
  24 (defmethod database-list-tables ((database mysql-database) &key (owner nil))
  25   (declare (ignore owner))
  26   (remove-if #'(lambda (s)
  27                  (and (>= (length s) 10)
  28                       (string= (subseq s 0 10) "_usql_seq_")))
  29              (mapcar #'car (database-query "SHOW TABLES" database nil))))
  30
  31 ;; MySQL 4.1 does not support views
  32 (defmethod database-list-views ((database mysql-database)
  33                                 &key (owner nil))
  34   (declare (ignore owner database))
  35   nil)
  36
  37 (defmethod database-list-indexes ((database mysql-database)
  38                                   &key (owner nil))
  39   (let ((result '()))
  40     (dolist (table (database-list-tables database :owner owner) result)
  41       (mapc #'(lambda (index) (push (nth 2 index) result))
  42             (database-query
  43              (format nil "SHOW INDEX FROM ~A" (string-upcase table))
  44              database nil)))))
  45
  46 (defmethod database-list-attributes ((table string) (database mysql-database)
  47                                      &key (owner nil))
  48   (declare (ignore owner))
  49   (mapcar #'car
  50           (database-query
  51            (format nil "SHOW COLUMNS FROM ~A" table)
  52            database nil)))
  53
  54 (defmethod database-attribute-type (attribute (table string)
  55                                     (database mysql-database)
  56                                     &key (owner nil))
  57   (declare (ignore owner))
  58   (let ((result
  59          (mapcar #'cadr
  60                  (database-query
  61                   (format nil
  62                           "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute)
  63                   database nil))))
  64     (let* ((str (car result))
  65            (end-str (position #\( str))
  66            (substr (subseq str 0 end-str)))
  67       (if substr
  68       (intern (string-upcase substr) :keyword) nil))))
  69
  70 ;;; Sequence functions
  71
  72 (defun %sequence-name-to-table (sequence-name)
  73   (concatenate 'string "_usql_seq_" (sql-escape sequence-name)))
  74
  75 (defun %table-name-to-sequence-name (table-name)
  76   (and (>= (length table-name) 10)
  77        (string= (subseq table-name 0 10) "_usql_seq_")
  78        (subseq table-name 10)))
  79
  80 (defmethod database-create-sequence (sequence-name
  81                                      (database mysql-database))
  82   (let ((table-name (%sequence-name-to-table sequence-name)))
  83     (database-execute-command
  84      (concatenate 'string "CREATE TABLE " table-name
  85                   " (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)")
  86      database)
  87     (database-execute-command
  88      (concatenate 'string "INSERT INTO " table-name
  89                   " VALUES (-1)")
  90      database)))
  91
  92 (defmethod database-drop-sequence (sequence-name
  93                                    (database mysql-database))
  94   (database-execute-command
  95    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
  96    database))
  97
  98 (defmethod database-list-sequences ((database mysql-database)
  99                                     &key (owner nil))
 100   (declare (ignore owner))
 101   (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s)))
 102           (database-query "SHOW TABLES LIKE '%usql_seq%'"
 103                           database nil)))
 104
 105 (defmethod database-set-sequence-position (sequence-name
 106                                            (position integer)
 107                                            (database mysql-database))
 108   (database-execute-command
 109    (format nil "UPDATE ~A SET id=~A" (%sequence-name-to-table sequence-name)
 110            position)
 111    database)
 112   (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database)))
 113
 114 (defmethod database-sequence-next (sequence-name (database mysql-database))
 115   (database-execute-command
 116    (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name)
 117                 " SET id=LAST_INSERT_ID(id+1)")
 118    database)
 119   (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database)))
 120
 121 (defmethod database-sequence-last (sequence-name (database mysql-database))
 122   (declare (ignore sequence-name database)))
 123
 124 ;; Misc USQL functions
 125
 126 #|
 127 #+ignore
 128 (defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp)
 129                                 (database mysql-database))
 130   (with-slots (clsql-sys::modifier clsql-sys::components)
 131     expr
 132     (if clsql-sys::modifier
 133         (progn
 134           (clsql-sys::output-sql clsql-sys::components database)
 135           (write-char #\: sql-sys::*sql-stream*)
 136           (write-char #\: sql-sys::*sql-stream*)
 137           (write-string (symbol-name clsql-sys::modifier)
 138                         clsql-sys::*sql-stream*)))))
 139
 140 #+ignore
 141 (defmethod database-output-sql-as-type ((type (eql 'integer)) val
 142                                         (database mysql-database))
 143   ;; typecast it so it uses the indexes
 144   (when val
 145     (make-instance 'clsql-sys::sql-typecast-exp
 146                    :modifier 'int8
 147                    :components val)))
 148 |#