File: mysql.ml

package info (click to toggle)
mysql-ocaml 1.0.4-2%2Betch1
  • links: PTS
  • area: main
  • in suites: etch
  • size: 728 kB
  • ctags: 717
  • sloc: sh: 2,278; ml: 599; ansic: 531; makefile: 74; perl: 41
file content (607 lines) | stat: -rw-r--r-- 22,689 bytes parent folder | download | duplicates (5)
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
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
(*pp camlp4o *)
(*
    Ocaml-MySQL: MySQL bindings for Ocaml.
    Copyright (C) 2001-2003 Shawn Wagner <shawnw@speakeasy.org>
                  1998, 1999 Christian Lindig <lindig@eecs.harvard.edu>

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
*)

module Map = MoreLabels.Map
module String = StdLabels.String
module Array = StdLabels.Array

module StrMap = Map.Make(struct type t = string let compare = compare end)

open Genlex


exception Error of string

let _ = Callback.register_exception "mysql error" (Error "Registering Callback")

(* let error msg   = raise (Error msg) *)
let fail  msg   = raise (Failure msg)

type dbd        (* database connection handle *)
type result     (* handle to access result from query *)


(* Do not change any type definition that is used by external functions 
   without changing the C source code accordingly! *)

(* Error codes *)
(* Auto-generated on Thu Feb 20 06:10:26 2003 from MySQL headers. *)
type error_code = Aborting_connection | Access_denied_error | Alter_info | Bad_db_error | Bad_field_error | Bad_host_error | Bad_null_error | Bad_table_error | Blob_cant_have_default | Blob_key_without_length | Blob_used_as_key | Blobs_and_no_terminated | Cant_create_db | Cant_create_file | Cant_create_table | Cant_create_thread | Cant_delete_file | Cant_drop_field_or_key | Cant_find_dl_entry | Cant_find_system_rec | Cant_find_udf | Cant_get_stat | Cant_get_wd | Cant_initialize_udf | Cant_lock | Cant_open_file | Cant_open_library | Cant_read_charset | Cant_read_dir | Cant_remove_all_fields | Cant_reopen_table | Cant_set_wd | Checkread | Columnaccess_denied_error | Commands_out_of_sync | Con_count_error | Conn_host_error | Connection_error | Db_create_exists | Db_drop_delete | Db_drop_exists | Db_drop_rmdir | Dbaccess_denied_error | Delayed_cant_change_lock | Delayed_insert_table_locked | Disk_full | Dup_entry | Dup_fieldname | Dup_key | Dup_keyname | Dup_unique | Empty_query | Error_on_close | Error_on_read | Error_on_rename | Error_on_write | Field_specified_twice | File_exists_error | File_not_found | File_used | Filsort_abort | Forcing_close | Form_not_found | Function_not_defined | Get_errno | Got_signal | Grant_wrong_host_or_user | Handshake_error | Hashchk | Host_is_blocked | Host_not_privileged | Illegal_grant_for_table | Illegal_ha | Insert_info | Insert_table_used | Invalid_default | Invalid_group_func_use | Invalid_use_of_null | Ipsock_error | Key_column_does_not_exits | Key_not_found | Kill_denied_error | Load_info | Localhost_connection | Mix_of_group_func_and_fields | Multiple_pri_key | Namedpipe_connection | Namedpipeopen_error | Namedpipesetstate_error | Namedpipewait_error | Net_error_on_write | Net_fcntl_error | Net_packet_too_large | Net_packets_out_of_order | Net_read_error | Net_read_error_from_pipe | Net_read_interrupted | Net_uncompress_error | Net_write_interrupted | Nisamchk | No | No_db_error | No_raid_compiled | No_such_index | No_such_table | No_such_thread | No_tables_used | No_unique_logfile | Non_uniq_error | Nonexisting_grant | Nonexisting_table_grant | Nonuniq_table | Normal_shutdown | Not_allowed_command | Not_form_file | Not_keyfile | Null_column_in_index | Old_keyfile | Open_as_readonly | Out_of_memory | Out_of_resources | Out_of_sortmemory | Outofmemory | Parse_error | Password_anonymous_user | Password_no_match | Password_not_allowed | Primary_cant_have_null | Ready | Record_file_full | Regexp_error | Requires_primary_key | Server_gone_error | Server_handshake_err | Server_lost | Server_shutdown | Shutdown_complete | Socket_create_error | Stack_overrun | Syntax_error | Table_cant_handle_auto_increment | Table_cant_handle_blob | Table_exists_error | Table_must_have_columns | Table_not_locked | Table_not_locked_for_write | Tableaccess_denied_error | Tcp_connection | Textfile_not_readable | Too_big_fieldlength | Too_big_rowsize | Too_big_select | Too_big_set | Too_long_ident | Too_long_key | Too_long_string | Too_many_delayed_threads | Too_many_fields | Too_many_key_parts | Too_many_keys | Too_many_rows | Too_many_tables | Udf_exists | Udf_no_paths | Unexpected_eof | Unknown_character_set | Unknown_com_error | Unknown_error | Unknown_host | Unknown_procedure | Unknown_table | Unsupported_extension | Update_info | Update_without_key_in_safe_mode | Version_error | Wrong_auto_key | Wrong_column_name | Wrong_db_name | Wrong_field_spec | Wrong_field_terminators | Wrong_field_with_group | Wrong_group_field | Wrong_host_info | Wrong_key_column | Wrong_mrg_table | Wrong_outer_join | Wrong_paramcount_to_procedure | Wrong_parameters_to_procedure | Wrong_sub_key | Wrong_sum_select | Wrong_table_name | Wrong_value_count | Wrong_value_count_on_row | Yes

let error_of_int code = match code with
| 1000 -> Hashchk
| 1001 -> Nisamchk
| 1002 -> No
| 1003 -> Yes
| 1004 -> Cant_create_file
| 1005 -> Cant_create_table
| 1006 -> Cant_create_db
| 1007 -> Db_create_exists
| 1008 -> Db_drop_exists
| 1009 -> Db_drop_delete
| 1010 -> Db_drop_rmdir
| 1011 -> Cant_delete_file
| 1012 -> Cant_find_system_rec
| 1013 -> Cant_get_stat
| 1014 -> Cant_get_wd
| 1015 -> Cant_lock
| 1016 -> Cant_open_file
| 1017 -> File_not_found
| 1018 -> Cant_read_dir
| 1019 -> Cant_set_wd
| 1020 -> Checkread
| 1021 -> Disk_full
| 1022 -> Dup_key
| 1023 -> Error_on_close
| 1024 -> Error_on_read
| 1025 -> Error_on_rename
| 1026 -> Error_on_write
| 1027 -> File_used
| 1028 -> Filsort_abort
| 1029 -> Form_not_found
| 1030 -> Get_errno
| 1031 -> Illegal_ha
| 1032 -> Key_not_found
| 1033 -> Not_form_file
| 1034 -> Not_keyfile
| 1035 -> Old_keyfile
| 1036 -> Open_as_readonly
| 1037 -> Outofmemory
| 1038 -> Out_of_sortmemory
| 1039 -> Unexpected_eof
| 1040 -> Con_count_error
| 1041 -> Out_of_resources
| 1042 -> Bad_host_error
| 1043 -> Handshake_error
| 1044 -> Dbaccess_denied_error
| 1045 -> Access_denied_error
| 1046 -> No_db_error
| 1047 -> Unknown_com_error
| 1048 -> Bad_null_error
| 1049 -> Bad_db_error
| 1050 -> Table_exists_error
| 1051 -> Bad_table_error
| 1052 -> Non_uniq_error
| 1053 -> Server_shutdown
| 1054 -> Bad_field_error
| 1055 -> Wrong_field_with_group
| 1056 -> Wrong_group_field
| 1057 -> Wrong_sum_select
| 1058 -> Wrong_value_count
| 1059 -> Too_long_ident
| 1060 -> Dup_fieldname
| 1061 -> Dup_keyname
| 1062 -> Dup_entry
| 1063 -> Wrong_field_spec
| 1064 -> Parse_error
| 1065 -> Empty_query
| 1066 -> Nonuniq_table
| 1067 -> Invalid_default
| 1068 -> Multiple_pri_key
| 1069 -> Too_many_keys
| 1070 -> Too_many_key_parts
| 1071 -> Too_long_key
| 1072 -> Key_column_does_not_exits
| 1073 -> Blob_used_as_key
| 1074 -> Too_big_fieldlength
| 1075 -> Wrong_auto_key
| 1076 -> Ready
| 1077 -> Normal_shutdown
| 1078 -> Got_signal
| 1079 -> Shutdown_complete
| 1080 -> Forcing_close
| 1081 -> Ipsock_error
| 1082 -> No_such_index
| 1083 -> Wrong_field_terminators
| 1084 -> Blobs_and_no_terminated
| 1085 -> Textfile_not_readable
| 1086 -> File_exists_error
| 1087 -> Load_info
| 1088 -> Alter_info
| 1089 -> Wrong_sub_key
| 1090 -> Cant_remove_all_fields
| 1091 -> Cant_drop_field_or_key
| 1092 -> Insert_info
| 1093 -> Insert_table_used
| 1094 -> No_such_thread
| 1095 -> Kill_denied_error
| 1096 -> No_tables_used
| 1097 -> Too_big_set
| 1098 -> No_unique_logfile
| 1099 -> Table_not_locked_for_write
| 1100 -> Table_not_locked
| 1101 -> Blob_cant_have_default
| 1102 -> Wrong_db_name
| 1103 -> Wrong_table_name
| 1104 -> Too_big_select
| 1105 -> Unknown_error
| 1106 -> Unknown_procedure
| 1107 -> Wrong_paramcount_to_procedure
| 1108 -> Wrong_parameters_to_procedure
| 1109 -> Unknown_table
| 1110 -> Field_specified_twice
| 1111 -> Invalid_group_func_use
| 1112 -> Unsupported_extension
| 1113 -> Table_must_have_columns
| 1114 -> Record_file_full
| 1115 -> Unknown_character_set
| 1116 -> Too_many_tables
| 1117 -> Too_many_fields
| 1118 -> Too_big_rowsize
| 1119 -> Stack_overrun
| 1120 -> Wrong_outer_join
| 1121 -> Null_column_in_index
| 1122 -> Cant_find_udf
| 1123 -> Cant_initialize_udf
| 1124 -> Udf_no_paths
| 1125 -> Udf_exists
| 1126 -> Cant_open_library
| 1127 -> Cant_find_dl_entry
| 1128 -> Function_not_defined
| 1129 -> Host_is_blocked
| 1130 -> Host_not_privileged
| 1131 -> Password_anonymous_user
| 1132 -> Password_not_allowed
| 1133 -> Password_no_match
| 1134 -> Update_info
| 1135 -> Cant_create_thread
| 1136 -> Wrong_value_count_on_row
| 1137 -> Cant_reopen_table
| 1138 -> Invalid_use_of_null
| 1139 -> Regexp_error
| 1140 -> Mix_of_group_func_and_fields
| 1141 -> Nonexisting_grant
| 1142 -> Tableaccess_denied_error
| 1143 -> Columnaccess_denied_error
| 1144 -> Illegal_grant_for_table
| 1145 -> Grant_wrong_host_or_user
| 1146 -> No_such_table
| 1147 -> Nonexisting_table_grant
| 1148 -> Not_allowed_command
| 1149 -> Syntax_error
| 1150 -> Delayed_cant_change_lock
| 1151 -> Too_many_delayed_threads
| 1152 -> Aborting_connection
| 1153 -> Net_packet_too_large
| 1154 -> Net_read_error_from_pipe
| 1155 -> Net_fcntl_error
| 1156 -> Net_packets_out_of_order
| 1157 -> Net_uncompress_error
| 1158 -> Net_read_error
| 1159 -> Net_read_interrupted
| 1160 -> Net_error_on_write
| 1161 -> Net_write_interrupted
| 1162 -> Too_long_string
| 1163 -> Table_cant_handle_blob
| 1164 -> Table_cant_handle_auto_increment
| 1165 -> Delayed_insert_table_locked
| 1166 -> Wrong_column_name
| 1167 -> Wrong_key_column
| 1168 -> Wrong_mrg_table
| 1169 -> Dup_unique
| 1170 -> Blob_key_without_length
| 1171 -> Primary_cant_have_null
| 1172 -> Too_many_rows
| 1173 -> Requires_primary_key
| 1174 -> No_raid_compiled
| 1175 -> Update_without_key_in_safe_mode
| 2000 -> Unknown_error
| 2001 -> Socket_create_error
| 2002 -> Connection_error
| 2003 -> Conn_host_error
| 2004 -> Ipsock_error
| 2005 -> Unknown_host
| 2006 -> Server_gone_error
| 2007 -> Version_error
| 2008 -> Out_of_memory
| 2009 -> Wrong_host_info
| 2010 -> Localhost_connection
| 2011 -> Tcp_connection
| 2012 -> Server_handshake_err
| 2013 -> Server_lost
| 2014 -> Commands_out_of_sync
| 2015 -> Namedpipe_connection
| 2016 -> Namedpipewait_error
| 2017 -> Namedpipeopen_error
| 2018 -> Namedpipesetstate_error
| 2019 -> Cant_read_charset
| 2020 -> Net_packet_too_large
| _ -> Unknown_error


(* Status of MySQL database after an operation. Especially indicates empty 
   result sets *)

type status     =
                | StatusOK
                | StatusEmpty
                | StatusError of error_code

(* database field type *)

type dbty       = IntTy         (* 0  *)
                | FloatTy       (* 1  *)
                | StringTy      (* 2  *)
                | SetTy         (* 3  *)
                | EnumTy        (* 4  *)
                | DateTimeTy    (* 5  *)
                | DateTy        (* 6  *)
                | TimeTy        (* 7  *)
                | YearTy        (* 8  *)
                | TimeStampTy   (* 9  *)
                | UnknownTy     (* 10 *)
                | Int64Ty       (* 11 *)
		| BlobTy        (* 12 *)
		| DecimalTy	(* 13 *)

let pretty_type = function
  | IntTy -> "integer"
  | FloatTy -> "float"
  | StringTy -> "string"
  | SetTy -> "set"
  | EnumTy -> "enum"
  | DateTimeTy  -> "datetime"
  | DateTy        -> "date"
  | TimeTy        -> "time"
  | YearTy        -> "year"
  | TimeStampTy   -> "timestamp"
  | UnknownTy     -> "unknown"
  | Int64Ty       -> "int64"
  | BlobTy        -> "blob"
  | DecimalTy     -> "decimal"


(* database login informations -- use None for default values *)

type db         =
                { dbhost    : string option  (*    database server host *)
                ; dbname    : string option  (*    database name        *)
                ; dbport    : int option     (*    port                 *)
                ; dbpwd     : string option  (*    user password          *)
                ; dbuser    : string option  (*    database user        *)
                }

type field = { name : string; (* Name of the field *)
               table : string option; (* Table name, or None if a constructed field *)
               def : string option; (* Default value of the field *)
               ty : dbty;
               max_length : int; (* Maximum width of field for the result set *)
               flags : int; (* Flags set *)
               decimals : int (* Number of decimals for numeric fields *)
             } 



(* low level C interface *)

let defaults = { dbhost = None; dbname = None; dbport = None; dbpwd = None; dbuser = None }
                                
external connect    : db -> dbd                             = "db_connect"

let quick_connect ?host ?database ?port ?password ?user () =
  connect { dbhost = host; dbname = database; dbport = port; dbpwd = password; dbuser = user }

external change_user : dbd -> db -> unit                    = "db_change_user"    

let quick_change ?user ?password ?database conn =
  change_user conn { defaults with
		       dbuser = user; dbpwd = password; dbname = database }

external select_db   : dbd -> string -> unit                = "db_select_db"
external list_dbs    : dbd -> ?pat:string -> unit -> string array option = "db_list_dbs"
external disconnect : dbd -> unit                           = "db_disconnect"
external ping       : dbd -> unit                           = "db_ping"
external exec       : dbd -> string -> result               = "db_exec"
external real_status     : dbd -> int                         = "db_status"
external errmsg     : dbd -> string option                  = "db_errmsg"
external escape     : string -> string                      = "db_escape"
external fetch      : result -> string option array option  = "db_fetch" 
external to_row     : result -> int64 -> unit                 = "db_to_row"
external size       : result -> int64                         = "db_size"
external affected    : dbd -> int64                           = "db_affected"
external insert_id: dbd -> int64 = "db_insert_id"
external fields     : result -> int                         = "db_fields"
external client_info : unit -> string = "db_client_info"
external host_info   : dbd -> string = "db_host_info"
external server_info : dbd -> string = "db_server_info"
external proto_info  : dbd -> int    = "db_proto_info"
external fetch_field : result -> field option = "db_fetch_field"
external fetch_fields : result -> field array option = "db_fetch_fields"
external fetch_field_dir : result -> int -> field option = "db_fetch_field_dir"

let status dbd =
  let x = real_status dbd in
  match x with
    0 -> StatusOK
  | 1065 -> StatusEmpty
  | _ -> StatusError (error_of_int x)

let errno dbd = error_of_int (real_status dbd)

(* [sub start len str] returns integer obtained from substring of length 
   [len] from [str] *)
  
let sub start len str = int_of_string (String.sub str ~pos:start ~len)

(* xxx2ml parses a string returned from a MySQL field typed xxx and turns it into a 
   corresponding OCaml value.

   MySQL uses the following representations for date/time values
    
   DATETIME     yyyy-mm-dd hh:mm:ss
   DATE         yyyy-mm-dd'
   TIME         hh:mm:ss'
   YEAR         yyyy'
   TIMESTAMP    YYYYMMDDHHMMSS'
*)   
 

let int2ml   str        = int_of_string str
let decimal2ml   str    = str
let int322ml str        = Int32.of_string str
let int642ml str        = Int64.of_string str
let nativeint2ml str    = Nativeint.of_string str
let float2ml str        = float_of_string str
let str2ml   str        = str
let enum2ml  str        = str
let blob2ml  str        = str

(* [set2ml str] parses a comma separated list of words in [str] and
   returns them in a list.  MySQL uses this format for sets of values
   *)

let set2ml str =
    let lexer       = make_lexer [ "," ]                                in
    let tokens      = lexer(Stream.of_string str)                       in
    let rec list    = parser
                      | [< 'Ident i; t = tail >]    -> i :: t
                      | [< >]                       -> []               
    and tail        = parser
                      | [< 'Kwd ","; l = list >]    -> l
                      | [< >]                       -> []               in
            try
                list tokens
            with Parsing.Parse_error -> fail ("not a proper set: " ^ str)


let datetime2ml str =
    assert (String.length str = 19);

    let year    = sub 0  4 str   in
    let month   = sub 5  2 str   in 
    let day     = sub 8  2 str   in
    let hour    = sub 11 2 str   in
    let minute  = sub 14 2 str   in
    let second  = sub 17 2 str   in
        (year,month,day,hour,minute,second)

let date2ml str =
    assert (String.length str = 10);

    let year    = sub 0  4 str   in
    let month   = sub 5  2 str   in 
    let day     = sub 8  2 str   in
        (year,month,day)

   
let time2ml str =
    assert (String.length str = 8);
     
    let hour    = sub 0 2 str   in
    let minute  = sub 3 2 str   in
    let second  = sub 6 2 str   in
        (hour,minute,second)
    
                                  
let year2ml str =
    assert (String.length str = 4);
    sub 0 4 str
    

let timestamp2ml str =
    assert (String.length str = 14);

    let year    = sub 0  4 str   in
    let month   = sub 4  2 str   in 
    let day     = sub 6  2 str   in
    let hour    = sub 8  2 str   in
    let minute  = sub 10 2 str   in
    let second  = sub 12 2 str   in
        (year,month,day,hour,minute,second)


            

(* [opt f v] applies [f] to optional value [v]. Use this to fetch
   data of known type from database fields which might be NULL:
   [opt int2ml str] *)

let opt f arg = match arg with 
    | None      -> None
    | Some x    -> Some (f x)
    
(* [not_null f v] applies [f] to [Some v]. Use this to fetch data of known 
   type from database fields which never can be NULL: [not_null int2ml str] 
*)
    
let not_null f arg = match arg with
    | None      -> fail "not_null was applied to None"
    | Some x    -> f x 


let names result =
  Array.init (fields result) ~f:(function offset ->
    match fetch_field_dir result offset with
      Some field -> field.name
    | None -> "")
  
let types result =
  Array.init (fields result) ~f:(function offset ->
    match fetch_field_dir result offset with
      Some field -> field.ty
    | None -> (fail "Unknown type in field"))

(* [column result] returns a function [col] which fetches columns from
   results by column name.  [col] has type string -> 'a array -> 'b. 
   Where the first argument is the name of the column. 
   

        let r   = exec dbd "select * from table"  in
        let col = col r                           in
        let rec loop = function
            None   -> []
            Some a -> not_null int2ml (col "label" a) :: loop (fetch r)
        in 
            loop (fetch r)
        
*)

        
let column result =
    let names = names result                                    in
    let map   = (* maps names to positions *)
        match Array.length names with
        | 0 -> StrMap.empty
        | n -> let rec loop i map =
                 if   i = n 
                 then map
                 else loop (i+1) (StrMap.add ~key:names.(i) ~data:i map)
               in
                 loop 0 StrMap.empty                            in
     (* return column name from array and apply f *)
     let col ~key ~row =
       row.(StrMap.find key map)
     in
        col

(* ml2xxx encodes OCaml values into strings that match the MysQL syntax of 
   the corresponding type *)
  
let ml2str str  = "'" ^ escape str ^ "'"
let ml2blob     = ml2str
let ml2int x    = string_of_int x
let ml2decimal x    = x
let ml322int x  = Int32.to_string x
let ml642int x  = Int64.to_string x
let mlnative2int x = Nativeint.to_string x
let ml2float x  = string_of_float x
let ml2enum x   = escape x
let ml2set x    = let rec loop arg = match arg with
                    | []        -> ""
                    | [x]       -> escape x
                    | x::y::ys  -> escape x ^ "," ^ loop (y::ys)
                  in
                    loop x  

let ml2datetimel ~year ~month ~day ~hour ~min ~sec =
    Printf.sprintf "'%04d-%02d-%02d %02d:%02d:%02d'"
      year month day hour min sec
let ml2datetime (year,month,day,hour,min,sec) =
  ml2datetimel ~year ~month ~day ~hour ~min ~sec

let ml2datel ~year ~month ~day =
  Printf.sprintf "%04d-%02d-%02d" year month day
let ml2date (year,month,day) =
  ml2datel ~year ~month ~day

let ml2timel ~hour ~min ~sec =
  Printf.sprintf "%02d:%02d%02d" hour min sec
let ml2time (hour,min,sec) =
  ml2timel ~hour ~min ~sec

let ml2year yyyy = Printf.sprintf "%04d" yyyy

let ml2timestampl ~year ~month ~day ~hour ~min ~sec =
    Printf.sprintf "%04d%02d%02d%02d%02d%02d" year month day hour min sec
let ml2timestamp (year,month,day,hour,min,sec) =
  ml2timestampl ~year ~month ~day ~hour ~min ~sec



(* [values vs] creates from a list of values in MySQL format
   a vector (x,y,z,..) for the MySQL values construct *)

let values vs = 
    let rec loop arg = match arg with
        | []        -> ""
        | [x]       -> x
        | x::y::ys  -> x ^ "," ^ loop (y::ys)
    in
        "(" ^ loop vs ^ ")"


(* Apply f to each row or a specific column of the results *)
let iter res ~f =
  if size res > Int64.zero then
    let rec loop () =
      match fetch res with
	  Some row -> f row; loop ()
	| None -> () in
      to_row res Int64.zero;
      loop ()

let iter_col res ~key ~f =
  let col = column res ~key in
  iter res ~f:(function row -> f (col ~row))

let iter_cols res ~key ~f =
  let col = column res in
  iter res ~f:(function row -> f (Array.map key ~f:(function key -> col ~key ~row)))

let map res ~f =
  if size res > Int64.zero then
    let rec loop lst = 
      match fetch res with
	  Some row -> loop (f row :: lst)
	| None -> lst in
      to_row res Int64.zero;
      List.rev (loop [])
  else
    []
      
let map_col res ~key ~f =
  let col = column res ~key in
  map res ~f:(function row -> f (col ~row))

let map_cols res ~key ~f =
  let col = column res in
  map res ~f:(function row -> f (Array.map key ~f:(function key -> col ~key ~row)))