interfaces/mysql/mysql-usql.cl

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