1 ! Copyright (C) 2007, 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays assocs alien alien.syntax continuations io
4 kernel math math.parser namespaces make prettyprint quotations
5 sequences debugger db db.postgresql.lib db.postgresql.ffi
6 db.tuples db.types tools.annotations math.ranges
7 combinators classes locals words tools.walker
8 nmake accessors random db.queries destructors ;
12 TUPLE: postgresql-db < db
13 host port pgopts pgtty db user pass ;
15 TUPLE: postgresql-statement < statement ;
17 TUPLE: postgresql-result-set < result-set ;
19 M: postgresql-db make-db* ( seq db -- db )
26 M: postgresql-db db-open ( db -- db )
35 } cleave connect-postgres >>handle ;
37 M: postgresql-db dispose ( db -- )
40 M: postgresql-statement bind-statement* ( statement -- )
43 GENERIC: postgresql-bind-conversion ( tuple object -- low-level-binding )
45 M: sql-spec postgresql-bind-conversion ( tuple spec -- object )
46 slot-name>> swap get-slot-named <low-level-binding> ;
48 M: literal-bind postgresql-bind-conversion ( tuple literal-bind -- object )
49 nip value>> <low-level-binding> ;
51 M: generator-bind postgresql-bind-conversion ( tuple generate-bind -- object )
52 dup generator-singleton>> eval-generator
53 [ swap slot-name>> rot set-slot-named ] [ <low-level-binding> ] bi ;
55 M: postgresql-statement bind-tuple ( tuple statement -- )
57 [ postgresql-bind-conversion ] with map
60 M: postgresql-result-set #rows ( result-set -- n )
63 M: postgresql-result-set #columns ( result-set -- n )
66 : result-handle-n ( result-set -- handle n )
67 [ handle>> ] [ n>> ] bi ;
69 M: postgresql-result-set row-column ( result-set column -- object )
70 >r result-handle-n r> pq-get-string ;
72 M: postgresql-result-set row-column-typed ( result-set column -- object )
73 dup pick out-params>> nth type>>
74 >r >r result-handle-n r> r> postgresql-column-typed ;
76 M: postgresql-statement query-results ( query -- result-set )
78 over [ bind-statement ] keep
79 do-postgresql-bound-statement
81 dup do-postgresql-statement
83 postgresql-result-set new-result-set
86 M: postgresql-result-set advance-row ( result-set -- )
87 [ 1+ ] change-n drop ;
89 M: postgresql-result-set more-rows? ( result-set -- ? )
90 [ n>> ] [ max>> ] bi < ;
92 M: postgresql-statement dispose ( query -- )
96 M: postgresql-result-set dispose ( result-set -- )
104 M: postgresql-statement prepare-statement ( statement -- )
106 >r db get handle>> f r>
107 [ sql>> ] [ in-params>> ] bi
108 length f PQprepare postgresql-error
111 M: postgresql-db <simple-statement> ( sql in out -- statement )
112 postgresql-statement new-statement ;
114 M: postgresql-db <prepared-statement> ( sql in out -- statement )
115 <simple-statement> dup prepare-statement ;
119 sql-counter [ inc ] [ get 0# ] bi ;
121 M: postgresql-db bind% ( spec -- )
124 M: postgresql-db bind# ( spec object -- )
125 >r bind-name% f swap type>> r> <literal-bind> 1, ;
127 : create-table-sql ( class -- statement )
129 "create table " 0% 0%
133 dup type>> lookup-create-type 0%
138 : create-function-sql ( class -- statement )
141 "create function add_" 0% dup 0%
145 type>> lookup-type 0%
148 " returns bigint as '" 0%
153 over [ ", " 0% ] [ column-name>> 0% ] interleave
155 swap [ ", " 0% ] [ drop bind-name% ] interleave
157 "select currval(''" 0% 0% "_id_seq'');' language sql;" 0%
160 M: postgresql-db create-sql-statement ( class -- seq )
162 [ create-table-sql , ] keep
163 dup db-columns find-primary-key db-assigned-id-spec?
164 [ create-function-sql , ] [ drop ] if
167 : drop-function-sql ( class -- statement )
169 "drop function add_" 0% 0%
172 [ ", " 0% ] [ type>> lookup-type 0% ] interleave
176 : drop-table-sql ( table -- statement )
178 "drop table " 0% 0% drop
181 M: postgresql-db drop-sql-statement ( class -- seq )
183 [ drop-table-sql , ] keep
184 dup db-columns find-primary-key db-assigned-id-spec?
185 [ drop-function-sql , ] [ drop ] if
188 M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
192 dup find-primary-key 2,
194 [ ", " 0% ] [ bind% ] interleave
198 M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
202 dup [ ", " 0% ] [ column-name>> 0% ] interleave
207 dup type>> +random-id+ = [
213 ] [ type>> ] bi <generator-bind> 1,
221 M: postgresql-db insert-tuple* ( tuple statement -- )
224 M: postgresql-db persistent-table ( -- hashtable )
226 { +db-assigned-id+ { "integer" "serial primary key" f } }
227 { +user-assigned-id+ { f f "primary key" } }
228 { +random-id+ { "bigint" "bigint primary key" f } }
229 { TEXT { "text" "text" f } }
230 { VARCHAR { "varchar" "varchar" f } }
231 { INTEGER { "integer" "integer" f } }
232 { BIG-INTEGER { "bigint" "bigint" f } }
233 { UNSIGNED-BIG-INTEGER { "bigint" "bigint" f } }
234 { SIGNED-BIG-INTEGER { "bigint" "bigint" f } }
235 { DOUBLE { "real" "real" f } }
236 { DATE { "date" "date" f } }
237 { TIME { "time" "time" f } }
238 { DATETIME { "timestamp" "timestamp" f } }
239 { TIMESTAMP { "timestamp" "timestamp" f } }
240 { BLOB { "bytea" "bytea" f } }
241 { FACTOR-BLOB { "bytea" "bytea" f } }
242 { URL { "varchar" "varchar" f } }
243 { +foreign-id+ { f f "references" } }
244 { +autoincrement+ { f f "autoincrement" } }
245 { +unique+ { f f "unique" } }
246 { +default+ { f f "default" } }
247 { +null+ { f f "null" } }
248 { +not-null+ { f f "not null" } }
249 { system-random-generator { f f f } }
250 { secure-random-generator { f f f } }
251 { random-generator { f f f } }
254 ERROR: no-compound-found string object ;
255 M: postgresql-db compound ( string object -- string' )
257 { "default" [ first number>string join-space ] }
258 { "varchar" [ first number>string paren append ] }
260 first2 >r [ unparse join-space ] keep db-columns r>
261 swap [ slot-name>> = ] with find nip
262 column-name>> paren append
264 [ drop no-compound-found ]