test-clsql.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          test-clsql.cl
   6 ;;;; Purpose:       Basic test of CLSQL
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Mar 2002
   9 ;;;;
  10 ;;;; $Id: test-clsql.cl,v 1.8 2002/03/25 23:48:46 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; CLSQL users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;; *************************************************************************
  18
  19 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  20 (in-package :cl-user)
  21
  22
  23 (defvar *config-pathname* (make-pathname :name "test-clsql"
  24                                          :type "config"
  25                                          :defaults *load-truename*))
  26 (defparameter *config* nil)
  27
  28 (defun do-test (&optional (interactive nil))
  29   (if interactive
  30       (test-interactive)
  31     (if (probe-file *config-pathname*)
  32         (with-open-file (stream *config-pathname* :direction :input)
  33           (setq *config* (read stream))
  34           (test-automated *config*))
  35       (test-interactive))))
  36
  37 (defun test-interactive ()
  38   (do ((done nil))
  39       (done)
  40     (multiple-value-bind (spec type) (get-spec-and-type)
  41       (if spec
  42           (clsql-test-table spec type)
  43           (setq done t)))))
  44
  45 (defun test-automated (config)
  46   (dolist (elem config)
  47     (let ((type (car elem))
  48           (spec (cadr elem)))
  49       #-allegro
  50       (unless (eq type :aodbc)
  51         (clsql-test-table spec type))
  52       #+allegro
  53       (clsql-test-table spec type)))
  54   )
  55
  56
  57 (defun create-test-table (db)
  58   (ignore-errors
  59     (clsql:execute-command
  60      "DROP TABLE test_clsql" :database db))
  61   (clsql:execute-command
  62    "CREATE TABLE test_clsql (i integer, sqrt float, sqrt_str CHAR(20))" :database db)
  63   (dotimes (i 10)
  64     (clsql:execute-command
  65      (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
  66              i (sqrt i) (format nil "~d" (sqrt i)))
  67      :database db)))
  68
  69 (defun drop-test-table (db)
  70   (clsql:execute-command "DROP TABLE test_clsql"))
  71
  72 (defun clsql-test-table (spec type)
  73   (when (eq type :mysql)
  74     (test-clsql-mysql spec))
  75   (let ((db (clsql:connect spec :database-type type :if-exists :new)))
  76     (unwind-protect
  77         (progn
  78           (create-test-table db)
  79           (pprint (clsql:query "select * from test_clsql"
  80                                :database db
  81                                :types :auto))
  82           (pprint (clsql:map-query 'vector #'list "select * from test_clsql"
  83                                    :database db
  84                                    :types :auto)) ;;'(:int :double t)))
  85           (drop-test-table db))
  86       (clsql:disconnect :database db)))
  87   )
  88
  89 (defun test-clsql-mysql (spec)
  90   (let ((db (clsql-mysql::database-connect spec :mysql)))
  91     (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
  92     (clsql-mysql::database-execute-command
  93      "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
  94     (dotimes (i 10)
  95       (clsql-mysql::database-execute-command
  96        (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
  97                i (sqrt i) (format nil "~d" (sqrt i)))
  98        db))
  99     (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
 100       (format t "~&Number rows: ~D~%" (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
 101       (clsql-mysql::database-dump-result-set res db))
 102     (clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
 103     (clsql-mysql::database-disconnect db)))
 104
 105
 106 (defun get-spec-and-type ()
 107   (format t "~&Test CLSQL")
 108   (format t "~&==========~%")
 109   (format t "~&Enter connection type (:mysql :postgresql :postgresql-socket")
 110   #+allegro (format t " :aodbc")
 111   (format t ") [default END]: ")
 112   (let ((type-string (read-line)))
 113     (if (zerop (length type-string))
 114         (values nil nil)
 115         (get-spec-for-type (read-from-string type-string)))))
 116
 117 (defun get-spec-for-type (type)
 118   (let ((spec (get-spec-using-format type
 119                         (ecase type
 120                           ((:mysql :postgresql :postgresql-socket)
 121                            '("host" "database" "user" "password"))
 122                           (:aodbc
 123                            '("dsn" "user" "password"))))))
 124     (values spec type)))
 125
 126
 127 (defun get-spec-using-format (type spec-format)
 128   (let (spec)
 129     (format t "~&Connection Spec for ~A" (symbol-name type))
 130     (format t "~&------------------------------")
 131
 132     (dolist (elem spec-format)
 133       (format t "~&Enter ~A: " elem)
 134       (push (read-line) spec))
 135     (nreverse spec)))