1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: SQL utility functions
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Mar 2002
10 ;;;; $Id: utils.lisp,v 1.2 2002/10/21 07:45:50 kevin Exp $
12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
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 ;;;; *************************************************************************
19 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
20 (in-package :clsql-base-sys)
22 (defun number-to-sql-string (num)
27 (float-to-sql-string (coerce num 'double-float)))
29 (float-to-sql-string num))))
31 (defun float-to-sql-string (num)
32 "Convert exponent character for SQL"
33 (let ((str (write-to-string num :readably t)))
36 (substitute #\e #\f str))
38 (substitute #\e #\d str))
40 (substitute #\e #\l str))
42 (substitute #\e #\S str))
44 (substitute #\e #\F str))
46 (substitute #\e #\D str))
48 (substitute #\e #\L str))
50 (substitute #\e #\S str))
54 (defun sql-escape (identifier)
55 "Change hyphens to underscores, ensure string"
56 (let* ((unescaped (etypecase identifier
57 (symbol (symbol-name identifier))
59 (escaped (make-string (length unescaped))))
60 (dotimes (i (length unescaped))
61 (setf (char escaped i)
62 (cond ((equal (char unescaped i) #\-)
66 (char unescaped i)))))
70 (defun sql-escape-quotes (s)
71 "Escape quotes for SQL string writing"
72 (substitute-string-for-char s #\' "''"))
74 (defun substitute-string-for-char (procstr match-char subst-str)
75 "Substitutes a string for a single matching character of a string"
76 (let ((pos (position match-char procstr)))
79 (subseq procstr 0 pos) subst-str
80 (substitute-string-for-char
81 (subseq procstr (1+ pos)) match-char subst-str))