From 6ba23404433eaf240f37e2905aed999a4d4bf342 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sat, 27 Apr 2002 21:12:32 +0000 Subject: [PATCH] r1799: added transaction support --- interfaces/mysql/mysql-usql.cl | 216 ++++++++++++++++++--------------- 1 file changed, 117 insertions(+), 99 deletions(-) diff --git a/interfaces/mysql/mysql-usql.cl b/interfaces/mysql/mysql-usql.cl index 10413a6..ea2b12e 100644 --- a/interfaces/mysql/mysql-usql.cl +++ b/interfaces/mysql/mysql-usql.cl @@ -1,99 +1,117 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: mysql-usql.cl -;;;; Purpose: MySQL interface functions to support UncommonSQL -;;;; Programmers: Kevin M. Rosenberg and onShore Development Inc -;;;; Date Started: Mar 2002 -;;;; -;;;; $Id: mysql-usql.cl,v 1.3 2002/04/07 15:11:04 kevin Exp $ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg -;;;; and by onShore Development Inc. -;;;; -;;;; CLSQL users are granted the rights to distribute and use this software -;;;; as governed by the terms of the Lisp Lesser GNU Public License -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. -;;;; ************************************************************************* - -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :clsql-mysql) - -(defmethod database-list-tables ((database mysql-database) - &key (system-tables nil)) - (declare (ignore system-tables)) - (mapcar #'car (database-query "show tables" database :auto))) - - - -(defmethod database-list-attributes ((table string) (database mysql-database)) - (mapcar #'car - (database-query - (format nil "SHOW COLUMNS FROM ~A" table) - database nil))) - -(defmethod database-attribute-type (attribute (table string) - (database mysql-database)) - (let ((result - (mapcar #'cadr - (database-query - (format nil - "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute) - database nil)))) - (let* ((str (car result)) - (end-str (position #\( str)) - (substr (subseq str 0 end-str))) - (if substr - (intern (string-upcase substr) :keyword) nil)))) - - -(defun %sequence-name-to-table (sequence-name) - (concatenate 'string "_usql_seq_" (sql-escape sequence-name))) - -(defmethod database-create-sequence (sequence-name - (database mysql-database)) - (let ((table-name (%sequence-name-to-table sequence-name))) - (database-execute-command - (concatenate 'string "CREATE TABLE " table-name - " (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)") - database) - (database-execute-command - (concatenate 'string "INSERT INTO " table-name - " VALUES (0)") - database))) - -(defmethod database-drop-sequence (sequence-name - (database mysql-database)) - (database-execute-command - (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name)) - database)) - -(defmethod database-sequence-next (sequence-name (database mysql-database)) - (database-execute-command - (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name) - " SET id=LAST_INSERT_ID(id+1)") - database) - (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database))) - -#+ignore -(defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp) - (database mysql-database)) - (with-slots (clsql-sys::modifier clsql-sys::components) - expr - (if clsql-sys::modifier - (progn - (clsql-sys::output-sql clsql-sys::components database) - (write-char #\: sql-sys::*sql-stream*) - (write-char #\: sql-sys::*sql-stream*) - (write-string (symbol-name clsql-sys::modifier) - clsql-sys::*sql-stream*))))) - -#+ignore -(defmethod database-output-sql-as-type ((type (eql 'integer)) val - (database mysql-database)) - ;; typecast it so it uses the indexes - (when val - (make-instance 'clsql-sys::sql-typecast-exp - :modifier 'int8 - :components val))) +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: mysql-usql.cl +;;;; Purpose: MySQL interface functions to support UncommonSQL +;;;; Programmers: Kevin M. Rosenberg and onShore Development Inc +;;;; Date Started: Mar 2002 +;;;; +;;;; $Id: mysql-usql.cl,v 1.4 2002/04/27 21:12:32 kevin Exp $ +;;;; +;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; and by onShore Development Inc. +;;;; +;;;; CLSQL users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. +;;;; ************************************************************************* + +(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) +(in-package :clsql-mysql) + +;; Table and attribute introspection + +(defmethod database-list-tables ((database mysql-database) + &key (system-tables nil)) + (declare (ignore system-tables)) + (mapcar #'car (database-query "show tables" database :auto))) + + +(defmethod database-list-attributes ((table string) (database mysql-database)) + (mapcar #'car + (database-query + (format nil "SHOW COLUMNS FROM ~A" table) + database nil))) + +(defmethod database-attribute-type (attribute (table string) + (database mysql-database)) + (let ((result + (mapcar #'cadr + (database-query + (format nil + "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute) + database nil)))) + (let* ((str (car result)) + (end-str (position #\( str)) + (substr (subseq str 0 end-str))) + (if substr + (intern (string-upcase substr) :keyword) nil)))) + +;;; Sequence functions + +(defun %sequence-name-to-table (sequence-name) + (concatenate 'string "_usql_seq_" (sql-escape sequence-name))) + +(defmethod database-create-sequence (sequence-name + (database mysql-database)) + (let ((table-name (%sequence-name-to-table sequence-name))) + (database-execute-command + (concatenate 'string "CREATE TABLE " table-name + " (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)") + database) + (database-execute-command + (concatenate 'string "INSERT INTO " table-name + " VALUES (0)") + database))) + +(defmethod database-drop-sequence (sequence-name + (database mysql-database)) + (database-execute-command + (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name)) + database)) + +(defmethod database-sequence-next (sequence-name (database mysql-database)) + (database-execute-command + (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name) + " SET id=LAST_INSERT_ID(id+1)") + database) + (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database))) + +;; Transactions + +(defmethod database-start-transaction ((database mysql-database)) + "Start a transaction in DATABASE." + (database-execute-command "BEGIN" database)) + +(defmethod database-commit-transaction ((database mysql-database)) + "Commit current transaction in DATABASE." + (database-execute-command "COMMIT" database)) + +(defmethod database-abort-transaction ((database mysql-database)) + "Abort current transaction in DATABASE." + (database-execute-command "ROLLBACK" database)) + +;; Misc USQL functions + +#+ignore +(defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp) + (database mysql-database)) + (with-slots (clsql-sys::modifier clsql-sys::components) + expr + (if clsql-sys::modifier + (progn + (clsql-sys::output-sql clsql-sys::components database) + (write-char #\: sql-sys::*sql-stream*) + (write-char #\: sql-sys::*sql-stream*) + (write-string (symbol-name clsql-sys::modifier) + clsql-sys::*sql-stream*))))) + +#+ignore +(defmethod database-output-sql-as-type ((type (eql 'integer)) val + (database mysql-database)) + ;; typecast it so it uses the indexes + (when val + (make-instance 'clsql-sys::sql-typecast-exp + :modifier 'int8 + :components val))) -- 2.34.1