1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279
|
#
# Copyright (C) 1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
#
# Copyright (C) 2003 Proc Place.
# Berkeley copyright as above.
#
# Copyright (C) 2004 Superconnect, Ltd.
# Berkeley copyright as above.
#
# Copyright (C) 2005-2019 FlightAware, LLC
# Berkeley copyright as above.
#
#
# postgres interface stuff
#
package provide sc_postgres 1.3
package require Tclx
package require Pgtcl
namespace eval sc_pg {
#
# foreach_tuple - given a postgres result, an array name, and a code
# body, fill the array in turn with each result tuple and execute
# the code body against it.
#
proc foreach_tuple {res arrayName body} {
upvar $arrayName $arrayName
set numTuples [pg_result $res -numTuples]
for {set i 0} {$i < $numTuples} {incr i} {
pg_result $res -tupleArray $i $arrayName
uplevel 1 $body
}
}
#
# quote - make string legally quoted for postgres
# (obsoleted by pg_quote... it used to do it with a bunch of regexps)
#
proc quote_sql {string} {
return [pg_quote $string]
}
#
# gen_sql_insert_from_array - return a sql insert statement based on the
# contents of an array
#
proc gen_insert_from_array {tableName arrayName} {
upvar $arrayName array
set nameList [array names array]
set result [gen_insert_front_part $tableName $nameList]
foreach name $nameList {
append result "[pg_quote $array($name)],"
}
return "[string range $result 0 end-1]);"
}
#
# gen_sql_update_from_array - return a sql update statement based on the
# contents of an array and a list of key fields
#
proc gen_update_from_array {tableName arrayName keyFields {nullableColumns ""}} {
upvar $arrayName array
set result "update $tableName set "
foreach element [array names array] {
# don't emit key fields into the update body
if {[lsearch $keyFields $element] >= 0} {
continue
}
append result "$element = [pg_quote $array($element)], "
}
foreach element $nullableColumns {
if {![info exists array($element)]} {
append result "$element = NULL, "
}
}
set result "[string range $result 0 end-2] where ("
foreach key $keyFields {
if {![info exists array($key)]} {
error "required key field '$key' not found in array '$arrayName'"
}
append result "$key = [pg_quote $array($key)] and "
}
return "[string range $result 0 end-5]);"
}
#
# gen_insert_front_part - generate a sql insert front part
#
proc gen_insert_front_part {tableName nameList} {
return "insert into $tableName ([join $nameList ","]) values ("
}
#
# gen_insert_back_part - generate a sql insert back part
#
proc gen_insert_back_part {valueList} {
set result ""
foreach value $valueList {
append result "[pg_quote $value],"
}
return "[string range $result 0 end-1]);"
}
#
# gen_insert_simplex_front_part - generate a sql insert command based on
# contents of a properly ordered list (fields same as the order in the table)
#
proc gen_insert_simplex_front_part {tableName} {
set result "insert into $tableName values ("
}
#
# perform_insert - generate a sql insert command based on the contents
# of an array and execute it against the specified database session
#
proc perform_insert {session insertStatement} {
set result [pg_exec $session $insertStatement]
set status [pg_result $result -status]
pg_result $result -clear
return $status
}
#
# gen_insert_from_lists - generate a sql insert command based on the
# contents of an element list and a corresponding value list
#
proc gen_insert_from_lists {tableName nameList valueList} {
set result [gen_insert_front_part $tableName $nameList]
foreach value $valueList {
append result "[pg_quote $value],"
}
return "[string range $result 0 end-1]);"
}
#
# perform_insert_from_lists - generate a sql insert command based on the
# contents of an element list and a corresponding value list
# and execute it against the specified database session
#
proc perform_insert_from_lists {session tableName nameList valueList} {
set result [pg_exec $session [gen_insert_from_lists $tableName $nameList $valueList]]
set status [pg_result $result -status]
pg_result $result -clear
return $status
}
#
# perform_insert_from_array - generate a sql insert command based on the
# contents of an array and execute it against the specified database session
#
proc perform_insert_from_array {session tableName arrayName} {
upvar $arrayName array
set result [pg_exec $session [gen_insert_from_array $tableName array]]
set status [pg_result $result -status]
pg_result $result -clear
return $status
}
#
# perform_update_from_array - generate a sql update command based on the
# contents of an array and execute it against the specified database session
#
proc perform_update_from_array {session tableName arrayName keyFields} {
upvar $arrayName array
set result [pg_exec $session [gen_update_from_array $tableName array $keyFields]]
set status [pg_result $result -status]
pg_result $result -clear
return $status
}
#
# clock_to_sql_time - convert a clock value (integer seconds since 1970) to a
# sql standard abstime value, accurate to a day.
#
# Month Day [ Hour : Minute : Second ] Year [ Timezone ]
#
proc clock_to_sql_time {clock} {
return [clock format $clock -format "%b %d %Y" -gmt 1]
}
#
# clock_to_precise_sql_time - generate a SQL time from an integer clock
# time (seconds since 1970), accurate to the second, with timezone
#
proc clock_to_precise_sql_time {clock} {
return [clock format $clock -format "%b %d %H:%M:%S %Y GMT" -gmt 1]
}
#
# clock_to_precise_sql_time_without_timezone - generate a SQL time from an
# integer clock time (seconds since 1970), accurate to the second, without
# timezone info (using local timezone)
#
proc clock_to_precise_sql_time_without_timezone {clock} {
return [clock format $clock -format "%b %d %H:%M:%S %Y"]
}
#
# convert a sql standard abstime value to a clock value (integer
# seconds since 1970)
#
proc sql_time_to_clock {date} {
if {$date == ""} {
return 0
}
set firstPeriod [string first "." $date]
if {$firstPeriod >= 0} {
set date [string range $date 0 [expr $firstPeriod - 1]]
}
return [clock scan $date -gmt 1]
}
#
# convert a sql time with timezone to a clock value (seconds since 1970)
#
# ERROR - this ain't right, it discards timezone and assumes local
#
proc sql_time_with_timezone_to_clock {date} {
if {$date == ""} {
return 0
}
if {![regexp {(.*:..)[^-]*(.*)} $date dummy a b]} {
error "unable to convert time-with-timezone value $date"
}
return [clock scan "$a"]
}
#
# res_must_succeed - a postgres result must be PGRES_COMMAND_OK and
# if not throw an error, and if so, clear the postgres result.
#
proc res_must_succeed {res} {
set status [pg_result $res -status]
if {$status != "PGRES_COMMAND_OK" && $status != "PGRES_TUPLES_OK"} {
set errorString [pg_result $res -error]
pg_result $res -clear
error $errorString
}
pg_result $res -clear
}
#
# res_dont_care - any postgres result is OK, we don't care,
# clear the postgres result and return.
#
proc res_dont_care {res} {
set status [pg_result $res -status]
if {$status != "PGRES_COMMAND_OK" && $status != "PGRES_TUPLES_OK"} {
puts "[pg_result $res -error] (ignored)"
pg_result $res -clear
return 0
}
pg_result $res -clear
return 1
}
}
# vim: set ts=8 sw=4 sts=4 noet :
|