r8914: rework test suites

[clsql.git] / base / utils.lisp

diff --git a/base/utils.lisp b/base/utils.lisp
index 5514dc72ed9b5757ba0128e20ae22fcde37f5e95..3f9ad8a6348862c3dce8723b4cd5dee1d80db835 100644 (file)
--- a/base/utils.lisp
+++ b/base/utils.lisp
@@ -2,22 +2,21 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Name:         utils.cl
+;;;; Name:         utils.lisp
 ;;;; Purpose:      SQL utility functions
 ;;;; Programmer:   Kevin M. Rosenberg
 ;;;; Date Started: Mar 2002
 ;;;;
-;;;; $Id: utils.lisp,v 1.1 2002/09/30 10:19:01 kevin Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
 ;;;;
 ;;;; 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-base-sys)
+(in-package #:clsql-base-sys)
 
 (defun number-to-sql-string (num)
   (etypecase num
@@ -36,16 +35,22 @@
       (substitute #\e #\f str))
      ((find #\d str)
       (substitute #\e #\d str))
+     ((find #\l str)
+      (substitute #\e #\l str))
+     ((find #\s str)
+      (substitute #\e #\S str))
      ((find #\F str)
       (substitute #\e #\F str))
      ((find #\D str)
       (substitute #\e #\D str))
+     ((find #\L str)
+      (substitute #\e #\L str))
      ((find #\S str)
       (substitute #\e #\S str))
      (t
       str))))
 
-  (defun sql-escape (identifier)
+(defun sql-escape (identifier)
   "Change hyphens to underscores, ensure string"
   (let* ((unescaped (etypecase identifier
                       (symbol (symbol-name identifier))
@@ -76,3 +81,34 @@
       procstr)))
 
 
+(defun delimited-string-to-list (string &optional (separator #\space) 
+                                                 skip-terminal)
+  "Split a string with delimiter, from KMRCL."
+  (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0))
+          (type string string)
+          (type character separator))
+  (do* ((len (length string))
+       (output '())
+       (pos 0)
+       (end (position-char separator string pos len)
+            (position-char separator string pos len)))
+       ((null end)
+       (if (< pos len)
+           (push (subseq string pos) output)
+           (when (or (not skip-terminal) (zerop len))
+             (push "" output)))
+       (nreverse output))
+    (declare (type fixnum pos len)
+            (type (or null fixnum) end))
+    (push (subseq string pos end) output)
+    (setq pos (1+ end))))
+
+(defun string-to-list-connection-spec (str)
+  (let ((at-pos (position #\@ str)))
+    (cond
+      ((and at-pos (> (length str) at-pos))
+       ;; Connection spec is SQL*NET format
+       (append (delimited-string-to-list (subseq str 0 at-pos) #\/)
+              (list (subseq str (1+ at-pos)))))
+      (t
+       (delimited-string-to-list str #\/)))))