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)
  25                                  &key (system-tables nil))
  26   (declare (ignore system-tables))
  27   (mapcar #'car (database-query "show tables" database :auto)))
  28
  29
  30 (defmethod database-list-attributes ((table string) (database mysql-database))
  31   (mapcar #'car
  32           (database-query
  33            (format nil "SHOW COLUMNS FROM ~A" table)
  34            database nil)))
  35
  36 (defmethod database-attribute-type (attribute (table string)
  37                                     (database mysql-database))
  38   (let ((result
  39           (mapcar #'cadr
  40                   (database-query
  41                    (format nil
  42                            "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute)
  43                    database nil))))
  44     (let* ((str (car result))
  45            (end-str (position #\( str))
  46            (substr (subseq str 0 end-str)))
  47       (if substr
  48       (intern (string-upcase substr) :keyword) nil))))
  49
  50 ;;; Sequence functions
  51
  52 (defun %sequence-name-to-table (sequence-name)
  53   (concatenate 'string "_usql_seq_" (sql-escape sequence-name)))
  54
  55 (defmethod database-create-sequence (sequence-name
  56                                      (database mysql-database))
  57   (let ((table-name (%sequence-name-to-table sequence-name)))
  58     (database-execute-command
  59      (concatenate 'string "CREATE TABLE " table-name
  60                   " (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)")
  61      database)
  62     (database-execute-command
  63      (concatenate 'string "INSERT INTO " table-name
  64                   " VALUES (-1)")
  65      database)))
  66
  67 (defmethod database-drop-sequence (sequence-name
  68                                    (database mysql-database))
  69   (database-execute-command
  70    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
  71    database))
  72
  73 (defmethod database-sequence-next (sequence-name (database mysql-database))
  74   (database-execute-command
  75    (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name)
  76                 " SET id=LAST_INSERT_ID(id+1)")
  77    database)
  78   (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database)))
  79
  80 ;; Misc USQL functions
  81
  82 #|
  83 #+ignore
  84 (defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp)
  85                                 (database mysql-database))
  86   (with-slots (clsql-sys::modifier clsql-sys::components)
  87     expr
  88     (if clsql-sys::modifier
  89         (progn
  90           (clsql-sys::output-sql clsql-sys::components database)
  91           (write-char #\: sql-sys::*sql-stream*)
  92           (write-char #\: sql-sys::*sql-stream*)
  93           (write-string (symbol-name clsql-sys::modifier)
  94                         clsql-sys::*sql-stream*)))))
  95
  96 #+ignore
  97 (defmethod database-output-sql-as-type ((type (eql 'integer)) val
  98                                         (database mysql-database))
  99   ;; typecast it so it uses the indexes
 100   (when val
 101     (make-instance 'clsql-sys::sql-typecast-exp
 102                    :modifier 'int8
 103                    :components val)))
 104 |#