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

diff --git a/base/utils.lisp b/base/utils.lisp
index 879c675..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$
 ;;;;
-;;;; 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
@@ -82,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 #\/)))))