X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Futils.lisp;h=3f9ad8a6348862c3dce8723b4cd5dee1d80db835;hb=67e6b9eaab9c9bcf8b57cbd476581437e4876b26;hp=5514dc72ed9b5757ba0128e20ae22fcde37f5e95;hpb=998937376fa6f9ce29bd3c7954fb0ebca91c37d7;p=clsql.git

diff --git a/base/utils.lisp b/base/utils.lisp
index 5514dc7..3f9ad8a 100644
--- 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 #\/)))))