db-mysql/mysql-usql.lisp

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