#<p>
# Database utility methods.
#</p>
#<p>
# <b>Author:</b> Steve Wampler (<i>sbw@tapestry.tucson.az.us</i>)
#</p>
#<p>
# This file is in the <i>public domain</i>.
#</p>
package database
import lang
#<p>
# General purpose utility methods for help in working with SQL databases.
#</p>
#<p>
# This is a singleton class. There is only one instance of it,
# no matter how many times you think you are calling the
# constructor.
#</p>
class DButils : Object ()
###################################################
# General support methods
###################################################
#<p>
# Escape single quotes and backslashes
# <[returns copy of <tt>s</tt> with quotes and backslashes escaped]>
#</p>
method escape(s:"" # String to examine for single quotes and backslashes
)
local ns := ""
s ? {
while ns ||:= ::tab(::upto('\e\'')) do {
ns ||:= if ="'" then "''" else "\e\e"
}
ns ||:= ::tab(0)
}
return ns
end
#<p>
# <[returns a list of column names from the database record <tt>rec</tt>]>
#</p>
method getColNames(rec # Record produced by fetch method in Database class
)
local cNames
every ::put(cNames := [], ::key(rec))
return cNames
end
###################################################
# Support methods for building up WHERE clauses
###################################################
#<p>
# Add a condition clause to a string of condition clauses
# using conjunction. If values is a structure (list or
# record), then adds a series of clauses joined by
# disjunction.
# <[param wc existing WHERE clause to add condition to]>
# <[param field name of field involved in condition test]>
# <[param test condition to check on field, eg: <tt>"="</tt>]>
# <[param values one or more values to test <tt>field</tt> against]>
# <[returns modifed WHERE clause with new conditions added, joined
# by AND]>
#</p>
#<p>
# Example:
#<pre>
# addCondition("", "id", "=", ["one","'two","three"])
#</pre>
# produces:
#<pre>
# "((id='one') OR (id='two') OR (id='three'))"
#</pre>
#</p>
#<p>
# Example:
#<pre>
# addCondition("(id='one')", "part_no", "=", "two")
#</pre>
# produces:
#<pre>
# "(id='one') AND (part_no='two')"
#</pre>
#</p>
#<p>
# Also locates '*' (simple wildcards) in values and adjusts
# test to 'like' provided test had been '='.
#</p>
#<p>
# Example:
#<pre>
# addCondition("", "filename", "=", "sam*.icn")
#</pre>
# produces:
#<pre>
# "(filename LIKE 'sam%.icn')"
#</pre>
#</p>
method addCondition(wc:"", field, test, values)
local nc
/wc := ""
if nc := mapToSQL(field, test, values) then {
if "" ~== wc then wc ||:= " AND "
wc ||:= "(" || nc || ")"
return wc
}
end
#<p>
# Build a set of SQL tests joined by
# disjunction. If values is a string, it's a single test
# otherwise, step through elements, building tests
# joined with disjunction.
# <[param field name of field involved in test]>
# <[param test condition to test, eg: <tt>"="</tt>]>
# <[param values one or more values to test <tt>field</tt> against]>
# <[returns SQL WHERE clause with conditions joined by disjunction]>
#</p>
#<p><i>Internal use only.</i></p>
method mapToSQL(field, test, values)
local nc := ""
if (::string|::numeric)(values) then {
nc := mapSQLExpr(field, test, values)
}
else {
nc := "(" || mapSQLExpr(field, test, values[1]) || ")"
every val := values[2 to *values] do {
nc ||:= " OR (" || mapSQLExpr(field, test, val) || ")"
}
}
return nc
end
#<p>
# Look for wildcards in value and if found,
# modify expression into SQL wildcard syntax
# <[param field name of field involved in test]>
# <[param op test to perform, eg: <tt>"="</tt>. This may get
# changed to equivalent SQL wild-card operation.]>
# <[param value used to test fields]>
# <[returns SQL WHERE clause for wild-card comparisions]>
#</p>
#<p><i>Internal use only.</i></p>
method mapSQLExpr(field, op, value)
if ::type(value) == "string" then {
if (op == ("="|"~~")) & ::upto('*', value) then {
op := "LIKE"
value := ::map(value, "*", "%")
}
else if (op == "~~*") & ::upto('*', value) then {
op := "ILIKE"
value := ::map(value, "*", "%")
}
value := "'" || escape(value) || "'"
}
return field || " " || op || " " || value
end
######################################################################
# Support methods for building up column descriptions for CREATE TABLE
######################################################################
#<p>
# Add a column description to a list (string) of column descriptions
# Can be used to help simplify calls to <tt>CREATE TABLE</tt>
# <[param cd string of existing column descriptions]>
# <[param colName name of column]>
# <[param colType type of column]>
# <[param colConstraints any constraints placed on column type]>
# <[returns modified column descriptions string]>
#</p>
method addColDesc(cd:"", colName, colType, colConstraints)
if *cd > 0 then cd ||:= ", "
return cd || colName || " " || colType || " " || colConstraints
end
initially # forces this into a singleton class
DButils := create |self
end
This page produced by UniDoc on 2021/04/15 @ 23:59:43.