simplesqlcommon.ml

   1 type sqlexpr =
   2   [ SENum of string and string
   3   | SEStr of string
   4   | SECall of string and list sqlexpr
   5   | SEIdent of string
   6   ]
   7 ;
   8
   9
  10 type sqlcmd =
  11   [ Create_table of string and list sqlcolspec
  12   | Insert of string and list string and list sqlexpr
  13   | Ignore_command
  14   ]
  15  and sqlcolspec = (string * string * option (int * int))  (* name, type, wid *)
  16 ;
  17
  18
  19 value rtrim s =
  20   let rec inner i =
  21     if i = -1
  22     then ""
  23     else
  24       if s.[i] = ' '
  25       then
  26         inner (i-1)
  27       else
  28         String.sub s 0 (i + 1)
  29   in
  30     inner (String.length s - 1)
  31 ;
  32
  33 value ltrim s =
  34   let slen = String.length s
  35   in
  36   let rec inner i =
  37     if i = slen
  38     then ""
  39     else
  40       if s.[i] = ' '
  41       then
  42         inner (i+1)
  43       else
  44         String.sub s i (slen - i)
  45   in
  46     inner 0
  47 ;
  48
  49
  50 value lrtrim s = ltrim (rtrim s)
  51 ;
  52
  53
  54 value looks_like_number s =
  55   let len = String.length s in
  56   if len = 0
  57   then False
  58   else
  59     inner 0
  60     where rec inner i =
  61       if i = len then True
  62       else
  63       let c = s.[i] in
  64       if ((c >= '0' && c <= '9') || (i = 0 && (c = '-' || c = '+')))
  65       then inner (i+1)
  66       else False
  67 ;
  68
  69
  70 value string_exists p s =
  71   let len = String.length s in
  72   inner 0
  73   where rec inner i =
  74     if i = len
  75     then False
  76     else
  77       if p s.[i]
  78       then
  79         True
  80       else
  81         inner (i+1)
  82 ;
  83
  84
  85 value looks_like_frac s =
  86      (s = "")
  87   || (not (string_exists (fun c -> c < '0' || c > '9') s))
  88 ;
  89
  90
  91 value split_number s =
  92   let (n_int, n_frac) =
  93     try
  94       let dot =
  95         try
  96           String.index s '.'
  97         with
  98         [ Not_found -> String.index s ',' ]
  99       in
 100       ( (String.sub s 0 dot)
 101       , (String.sub s (dot+1) ((String.length s) - dot - 1) )
 102       )
 103     with
 104     [ Not_found -> (s, "") ]
 105   in
 106   let ((n_int, n_frac) as npair) = (lrtrim n_int, lrtrim n_frac)
 107   in
 108 (*
 109   let () = Printf.printf "npair = %S , %S\n" n_int n_frac in
 110 *)
 111   let fail () =
 112     failwith (Printf.sprintf "value %S doesn't look like number" s)
 113   in
 114   match ( n_int, n_frac
 115         , looks_like_number n_int, looks_like_number n_frac
 116         ) with
 117   [ ("", "", _, _) -> ("", "")
 118   | ("", _, _, True) -> ("0", n_frac)
 119   | (_, "", True, _) -> (n_int, "")
 120   | (_, _, True, True) -> npair
 121   | _ -> fail ()
 122   ]
 123 ;
 124
 125
 126 value compare_ident a b =
 127   Pervasives.compare (String.uppercase a) (String.uppercase b)
 128 ;
 129
 130
 131 value (int_of_sqlnum : string -> int) sn =
 132   int_of_string sn
 133 ;
 134
 135
 136 open Printf
 137 ;
 138
 139
 140 value string_of_ident i = i
 141 ;
 142
 143 value rec string_of_sqlexpr e =
 144   match e with
 145   [ SENum a b -> sprintf "Num(%s.%s)" a b
 146   | SEStr s -> sprintf "Str(%S)" s
 147   | SECall f el ->
 148       sprintf
 149         "Call(%s, (%s))"
 150         f
 151         (String.concat ", " (List.map string_of_sqlexpr el))
 152   | SEIdent s -> sprintf "Ident(%s)" s
 153   ]
 154 ;
 155
 156
 157 value string_of_colspec cs =
 158   let (nam, ty, optsz) = cs in
 159   let sz =
 160     match optsz with
 161     [ None -> ""
 162     | Some (wid, dec) -> sprintf "(%i, %i)" wid dec
 163     ]
 164   in
 165     sprintf "%s %s %s" nam ty sz
 166 ;
 167
 168
 169 value string_of_sqlcmd sc =
 170   match sc with
 171   [ Create_table n cs ->
 172       sprintf "Create_table(%s,%s);\n"
 173         n
 174         (String.concat "" (List.map (fun s -> sprintf "  %s\n" (string_of_colspec s)) cs))
 175   | Insert n cs vs ->
 176       sprintf "Insert(%s,\n%s\n%s\n);\n"
 177         n
 178         (String.concat ", " (List.map string_of_ident cs))
 179         (String.concat ", " (List.map string_of_sqlexpr vs))
 180   | Ignore_command -> sprintf "Ignore_command;\n"
 181   ]
 182 ;
 183
 184
 185 value (execute_sql_command_val : ref (sqlcmd -> unit)) =
 186   ref (fun _ -> failwith "execute_sql_command_val not defined")
 187 ;
 188