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