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.5 2002/03/25 06:07:06 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 ()
  29   (if (probe-file *config-pathname*)
  30       (with-open-file (stream *config-pathname* :direction :input)
  31         (setq *config* (read stream))
  32         (test-automated *config*))
  33       (test-interactive)))
  34
  35 (defun test-interactive ()
  36   (do ((done nil))
  37       (done)
  38     (multiple-value-bind (spec type) (get-spec-and-type)
  39       (if spec
  40           (clsql-test-table spec type)
  41           (setq done t)))))
  42
  43 (defun test-automated (config)
  44   (dolist (elem config)
  45     (let ((type (car elem))
  46           (spec (cadr elem)))
  47       #-allegro
  48       (unless (eq type :aodbc)
  49         (clsql-test-table spec type))
  50       #+allegro
  51       (clsql-test-table spec type)))
  52   )
  53
  54
  55
  56 (defun clsql-test-table (spec type)
  57   (when (eq type :mysql)
  58     (test-clsql-mysql spec))
  59   (let ((db (clsql:connect spec :database-type type :if-exists :new)))
  60     (unwind-protect
  61         (progn
  62           (ignore-errors
  63            (clsql:execute-command
  64             "DROP TABLE test_clsql" :database db))
  65           (clsql:execute-command
  66            "CREATE TABLE test_clsql (i integer, sqrt float, sqrt_str CHAR(20))" :database db)
  67           (dotimes (i 10)
  68             (clsql:execute-command
  69              (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
  70                      i (sqrt i) (format nil "~d" (sqrt i)))
  71              :database db))
  72           (pprint (clsql:map-query 'vector #'list "select * from test_clsql"
  73                                    :database db
  74                                    :field-types '(:int :double t)))
  75           (clsql:execute-command "DROP TABLE test_clsql"))
  76       (clsql:disconnect :database db)))
  77   )
  78
  79 (defun test-clsql-mysql (spec)
  80   (let ((db (clsql-mysql::database-connect spec :mysql)))
  81     (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
  82     (clsql-mysql::database-execute-command
  83      "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
  84     (dotimes (i 10)
  85       (clsql-mysql::database-execute-command
  86        (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
  87                i (sqrt i) (format nil "~d" (sqrt i)))
  88        db))
  89     (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :field-types nil)))
  90       (format t "~&Number rows: ~D~%" (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
  91       (clsql-mysql::database-dump-result-set res db))
  92     (clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
  93     (clsql-mysql::database-disconnect db)))
  94
  95
  96 (defun get-spec-and-type ()
  97   (format t "~&Test CLSQL")
  98   (format t "~&==========~%")
  99   (format t "~&Enter connection type (:mysql :postgresql :postgresql-socket")
 100   #+allegro (format t " :aodbc")
 101   (format t ") [default END]: ")
 102   (let ((type-string (read-line)))
 103     (if (zerop (length type-string))
 104         (values nil nil)
 105         (get-spec-for-type (read-from-string type-string)))))
 106
 107 (defun get-spec-for-type (type)
 108   (let ((spec (get-spec-using-format type
 109                         (ecase type
 110                           ((:mysql :postgresql :postgresql-socket)
 111                            '("host" "database" "user" "password"))
 112                           (:aodbc
 113                            '("dsn" "user" "password"))))))
 114     (values spec type)))
 115
 116
 117 (defun get-spec-using-format (type spec-format)
 118   (let (spec)
 119     (format t "~&Connection Spec for ~A" (symbol-name type))
 120     (format t "~&------------------------------")
 121
 122     (dolist (elem spec-format)
 123       (format t "~&Enter ~A: " elem)
 124       (push (read-line) spec))
 125     (nreverse spec)))