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.2 2002/03/24 04:01:26 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 (defun get-spec-and-type ()
  24   (format t "~&Test CLSQL")
  25   (format t "~&==========~%")
  26   (format t "~&Enter connection type (:mysql :postgresql :postgresql-socket")
  27   #+allegro (format t " :aodbc")
  28   (format t ") [default END]: ")
  29   (let ((type-string (read-line)))
  30     (if (zerop (length type-string))
  31         (values nil nil)
  32         (get-spec-for-type (read-from-string type-string)))))
  33
  34 (defun get-spec-for-type (type)
  35   (let ((spec (get-spec type
  36                         (ecase type
  37                           ((:mysql :postgresql :postgresql-socket)
  38                            '("host" "database" "user" "password"))
  39                           (:aodbc
  40                            '("dsn" "user" "password"))))))
  41     (values spec type)))))
  42
  43
  44 (defun get-spec (type spec-format)
  45   (let (spec)
  46     (format t "~&Connection Spec for ~A" (symbol-name type))
  47     (format t "~&------------------------------")
  48
  49     (dolist (elem spec-format)
  50       (format t "~&Enter ~A: " elem)
  51       (push (read-line) spec))
  52     (nreverse spec)))
  53
  54 (defun test-clsql (spec type)
  55   (when (eq type :mysql)
  56     (test-clsql-mysql spec))
  57   (let ((db (clsql:connect spec :database-type type :if-exists :new)))
  58     (unwind-protect
  59         (progn
  60           (ignore-errors
  61            (clsql:execute-command
  62             "DROP TABLE test_clsql" :database db))
  63           (clsql:execute-command
  64            "CREATE TABLE test_clsql (i integer, sqrt float, sqrt_str CHAR(20))" :database db)
  65           (dotimes (i 10)
  66             (clsql:execute-command
  67              (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
  68                      i (sqrt i) (format nil "~d" (sqrt i)))
  69              :database db))
  70           (pprint (clsql:map-query 'vector #'list "select * from test_clsql" :database db))
  71           (clsql:execute-command "DROP TABLE test_clsql"))
  72       (clsql:disconnect :database db)))
  73   )
  74
  75 (defun test-clsql-mysql (spec)
  76   (let ((db (clsql-mysql::database-connect spec :mysql)))
  77     (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
  78     (clsql-mysql::database-execute-command
  79      "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
  80     (dotimes (i 10)
  81       (clsql-mysql::database-execute-command
  82        (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
  83                i (sqrt i) (format nil "~d" (sqrt i)))
  84        db))
  85     (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db t)))
  86       (format t "~&Number rows: ~D~%" (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
  87       (clsql-mysql::database-dump-result-set res db))
  88     (clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
  89     (clsql-mysql::database-disconnect db)))
  90
  91 #-non-interactive-test
  92 (do ((done nil))
  93     (done)
  94   (multiple-value-bind (spec type) (get-spec-and-type)
  95     (if spec
  96         (test-clsql spec type)
  97         (setq done t))))
  98
  99
 100