1 |
(* PostgreSQL database interface for mod_caml programs. |
2 |
* Copyright (C) 2003 Merjis Ltd. |
3 |
* |
4 |
* This library is free software; you can redistribute it and/or |
5 |
* modify it under the terms of the GNU Library General Public |
6 |
* License as published by the Free Software Foundation; either |
7 |
* version 2 of the License, or (at your option) any later version. |
8 |
* |
9 |
* This library is distributed in the hope that it will be useful, |
10 |
* but WITHOUT ANY WARRANTY; without even the implied warranty of |
11 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 |
* Library General Public License for more details. |
13 |
* |
14 |
* You should have received a copy of the GNU Library General Public |
15 |
* License along with this library; if not, write to the Free |
16 |
* Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
17 |
* |
18 |
* $Id: dbi_postgres.ml,v 1.1 2003/09/30 17:20:12 rwmj Exp $ |
19 |
*) |
20 |
|
21 |
module Connection = Postgres.Connection |
22 |
module Result = Postgres.Result |
23 |
|
24 |
(* XXX Rather naive method of finding the [?] placeholders in the query |
25 |
* string. We parse up the query into [ "select name from foo where id = "; |
26 |
* "?"; " and bar = "; "?" ]. This doesn't handle naked question-marks within |
27 |
* strings properly of course. |
28 |
*) |
29 |
let rec split_query query = |
30 |
try |
31 |
let i = String.index query '?' in |
32 |
let n = String.length query in |
33 |
let before, after = |
34 |
String.sub query 0 i, String.sub query (i+1) (n-(i+1)) in |
35 |
let after_split, count = split_query after in |
36 |
(before :: "?" :: after_split), (count+1) |
37 |
with |
38 |
Not_found -> [query], 0 |
39 |
|
40 |
(* Damn. [Postgres] module doesn't export the PQescapeString function, so |
41 |
* I've had to write it myself. |
42 |
*) |
43 |
let escape_string s = |
44 |
String.concat "" [ "'"; |
45 |
(Pcre.replace ~pat:"'" ~templ:"''" s); |
46 |
"'" ] |
47 |
|
48 |
class statement dbh conn in_transaction original_query = |
49 |
|
50 |
(* Split up the query, and calculate the number of placeholders. *) |
51 |
let query, nr_args = split_query original_query in |
52 |
|
53 |
object (self) |
54 |
inherit Dbi.statement dbh |
55 |
|
56 |
val mutable tuples = None |
57 |
val mutable next_tuple = 0 |
58 |
val mutable ntuples = 0 |
59 |
val mutable nfields = 0 |
60 |
|
61 |
method execute args = |
62 |
if dbh#closed then |
63 |
failwith "Dbi_postgres: executed called on a closed database handle."; |
64 |
|
65 |
if Array.length args <> nr_args then |
66 |
invalid_arg "Dbi_postgres: execute called with wrong number of args."; |
67 |
|
68 |
(* Finish previous statement, if any. *) |
69 |
self#finish; |
70 |
|
71 |
(* In transaction? If not we need to issue a BEGIN WORK command. *) |
72 |
if not !in_transaction then ( |
73 |
(* So we don't go into an infinite recursion ... *) |
74 |
in_transaction := true; |
75 |
|
76 |
let sth = dbh#prepare_cached "begin work" in |
77 |
sth#execute [| |] |
78 |
); |
79 |
|
80 |
(* Substitute the arguments and create the query which we'll send to |
81 |
* the database. |
82 |
*) |
83 |
let i = ref 0 in |
84 |
let query = |
85 |
String.concat "" |
86 |
(List.map |
87 |
(function |
88 |
"?" -> |
89 |
let arg = args.(!i) in |
90 |
incr i; |
91 |
(match arg with |
92 |
`Null -> |
93 |
"null" |
94 |
| `Int i -> |
95 |
string_of_int i |
96 |
| `String s -> |
97 |
escape_string s) |
98 |
| str -> str) query) in |
99 |
|
100 |
(* Send the query to the database. *) |
101 |
let res = Connection.exec conn query in |
102 |
|
103 |
match Result.status res with |
104 |
Result.Empty_query -> |
105 |
() |
106 |
| Result.Command_ok -> |
107 |
() |
108 |
| Result.Tuples_ok -> |
109 |
tuples <- Some res; |
110 |
next_tuple <- 0; |
111 |
ntuples <- Result.ntuples res; |
112 |
nfields <- Result.nfields res |
113 |
| Result.Copy_out |
114 |
| Result.Copy_in -> |
115 |
failwith "XXX copyin/copyout not implemented" |
116 |
| Result.Bad_response |
117 |
| Result.Fatal_error -> |
118 |
dbh#close; |
119 |
raise (Dbi.SQL_error (Result.error res)) |
120 |
| Result.Nonfatal_error -> |
121 |
prerr_endline ("Dbi_postgres: non-fatal error: " ^ Result.error res) |
122 |
|
123 |
method fetch1 = |
124 |
match tuples with |
125 |
None -> failwith "Dbi_postgres: call execute before calling fetch." |
126 |
| Some tuples -> |
127 |
if next_tuple >= ntuples then raise Not_found; |
128 |
|
129 |
(* Fetch each field in the tuple. *) |
130 |
let row = |
131 |
Array.init nfields |
132 |
(fun i -> |
133 |
if Result.getisnull tuples next_tuple i then |
134 |
"" (* Best we can do with strings. *) |
135 |
else |
136 |
Result.getvalue tuples next_tuple i) in |
137 |
|
138 |
next_tuple <- next_tuple + 1; |
139 |
row |
140 |
|
141 |
method fetchall = |
142 |
let rows = ref [] in |
143 |
let rec loop () = |
144 |
let row = self#fetch1 in |
145 |
rows := row :: !rows; |
146 |
loop () |
147 |
in |
148 |
try |
149 |
loop (); [] |
150 |
with |
151 |
Not_found -> List.rev !rows |
152 |
|
153 |
method bind_columns cols = |
154 |
failwith "XXX not implemented yet" |
155 |
|
156 |
method next = |
157 |
failwith "XXX not implemented yet" |
158 |
|
159 |
method serial seq = |
160 |
let sth = dbh#prepare_cached "select currval (?)" in |
161 |
sth#execute [|`String seq|]; |
162 |
|
163 |
let row = sth#fetch1 in |
164 |
int_of_string row.(0) |
165 |
|
166 |
method finish = |
167 |
(match tuples with |
168 |
None -> () |
169 |
| Some tuples -> |
170 |
(* XXX PQclear is not exposed through Postgres library! *) |
171 |
()); |
172 |
tuples <- None |
173 |
|
174 |
end |
175 |
|
176 |
and connection ?host ?port ?user ?password database = |
177 |
|
178 |
(* XXX Not sure if this allows you to pass arbitrary conninfo stuff in the |
179 |
* database field. It should do. Otherwise we should use an assoc list |
180 |
* to pass arbitrary parameters to the underlying database. |
181 |
*) |
182 |
let conninfo = |
183 |
Postgres.conninfo ?host ?port ?user ?password ~dbname:database () in |
184 |
let conn = Connection.connect conninfo in |
185 |
|
186 |
(* We pass this reference around to the statement class so that all |
187 |
* statements belonging to this connection can keep track of our |
188 |
* transaction state and issue the appropriate BEGIN WORK command at |
189 |
* the right time. |
190 |
*) |
191 |
let in_transaction = ref false in |
192 |
|
193 |
object (self) |
194 |
inherit Dbi.connection ?host ?port ?user ?password database as super |
195 |
|
196 |
method host = Some (Connection.host conn) |
197 |
method port = Some (Connection.port conn) |
198 |
method user = Some (Connection.user conn) |
199 |
method password = Some (Connection.pass conn) |
200 |
method database = Connection.db conn |
201 |
|
202 |
method database_type = "postgres" |
203 |
|
204 |
method prepare query = |
205 |
if self#closed then |
206 |
failwith "Dbi_postgres: prepare called on closed database handle."; |
207 |
new statement |
208 |
(self : #Dbi.connection :> Dbi.connection) |
209 |
conn in_transaction query |
210 |
|
211 |
method commit = |
212 |
let sth = self#prepare_cached "commit work" in |
213 |
sth#execute [| |]; |
214 |
in_transaction := false |
215 |
|
216 |
method rollback = |
217 |
let sth = self#prepare_cached "rollback work" in |
218 |
sth#execute [| |]; |
219 |
in_transaction := false |
220 |
|
221 |
method close = |
222 |
Connection.finish conn; |
223 |
super#close |
224 |
|
225 |
initializer |
226 |
if Connection.status conn = Connection.Bad then |
227 |
raise (Dbi.SQL_error (Connection.error_message conn)) |
228 |
end |