db-mysql/mysql-usql.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-\r
   2 ;;;; *************************************************************************\r
   3 ;;;; FILE IDENTIFICATION\r
   4 ;;;;\r
   5 ;;;; Name:          mysql-usql.cl\r
   6 ;;;; Purpose:       MySQL interface functions to support UncommonSQL\r
   7 ;;;; Programmers:   Kevin M. Rosenberg and onShore Development Inc\r
   8 ;;;; Date Started:  Mar 2002\r
   9 ;;;;\r
  10 ;;;; $Id: mysql-usql.cl,v 1.1 2002/09/18 07:43:40 kevin Exp $\r
  11 ;;;;\r
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg\r
  13 ;;;; and by onShore Development Inc.\r
  14 ;;;;\r
  15 ;;;; CLSQL users are granted the rights to distribute and use this software\r
  16 ;;;; as governed by the terms of the Lisp Lesser GNU Public License\r
  17 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.\r
  18 ;;;; *************************************************************************\r
  19 \r
  20 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))\r
  21 (in-package :clsql-mysql)\r
  22 \r
  23 ;; Table and attribute introspection\r
  24 \r
  25 (defmethod database-list-tables ((database mysql-database)\r
  26                                  &key (system-tables nil))\r
  27   (declare (ignore system-tables))\r
  28   (mapcar #'car (database-query "show tables" database :auto)))\r
  29     \r
  30 \r
  31 (defmethod database-list-attributes ((table string) (database mysql-database))\r
  32   (mapcar #'car\r
  33           (database-query\r
  34            (format nil "SHOW COLUMNS FROM ~A" table)\r
  35            database nil)))\r
  36 \r
  37 (defmethod database-attribute-type (attribute (table string)\r
  38                                     (database mysql-database))\r
  39   (let ((result\r
  40           (mapcar #'cadr\r
  41                   (database-query\r
  42                    (format nil\r
  43                            "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute)\r
  44                    database nil))))\r
  45     (let* ((str (car result))\r
  46            (end-str (position #\( str))\r
  47            (substr (subseq str 0 end-str)))\r
  48       (if substr\r
  49       (intern (string-upcase substr) :keyword) nil))))\r
  50 \r
  51 ;;; Sequence functions\r
  52 \r
  53 (defun %sequence-name-to-table (sequence-name)\r
  54   (concatenate 'string "_usql_seq_" (sql-escape sequence-name)))\r
  55 \r
  56 (defmethod database-create-sequence (sequence-name\r
  57                                      (database mysql-database))\r
  58   (let ((table-name (%sequence-name-to-table sequence-name)))\r
  59     (database-execute-command\r
  60      (concatenate 'string "CREATE TABLE " table-name\r
  61                   " (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)")\r
  62      database)\r
  63     (database-execute-command \r
  64      (concatenate 'string "INSERT INTO " table-name\r
  65                   " VALUES (0)")\r
  66      database)))\r
  67 \r
  68 (defmethod database-drop-sequence (sequence-name\r
  69                                    (database mysql-database))\r
  70   (database-execute-command\r
  71    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name)) \r
  72    database))\r
  73 \r
  74 (defmethod database-sequence-next (sequence-name (database mysql-database))\r
  75   (database-execute-command \r
  76    (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name)\r
  77                 " SET id=LAST_INSERT_ID(id+1)")\r
  78    database)\r
  79   (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database)))\r
  80 \r
  81 ;; Misc USQL functions\r
  82 \r
  83 #|\r
  84 #+ignore\r
  85 (defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp) \r
  86                                 (database mysql-database))\r
  87   (with-slots (clsql-sys::modifier clsql-sys::components)\r
  88     expr\r
  89     (if clsql-sys::modifier\r
  90         (progn\r
  91           (clsql-sys::output-sql clsql-sys::components database)\r
  92           (write-char #\: sql-sys::*sql-stream*)\r
  93           (write-char #\: sql-sys::*sql-stream*)\r
  94           (write-string (symbol-name clsql-sys::modifier) \r
  95                         clsql-sys::*sql-stream*)))))\r
  96 \r
  97 #+ignore\r
  98 (defmethod database-output-sql-as-type ((type (eql 'integer)) val\r
  99                                         (database mysql-database))\r
 100   ;; typecast it so it uses the indexes\r
 101   (when val\r
 102     (make-instance 'clsql-sys::sql-typecast-exp\r
 103                    :modifier 'int8\r
 104                    :components val)))\r
 105 |#\r