/[modcaml]/modcaml/dbi_postgres.ml
ViewVC logotype

Contents of /modcaml/dbi_postgres.ml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations) (download)
Tue Sep 30 18:11:01 2003 UTC (20 years, 8 months ago) by rwmj
Branch: MAIN
Changes since 1.1: +36 -4 lines
Added commit, rollback methods.

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

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26