src/main.ml

   1 (**
   2   Main
   3 *)
   4
   5 open Printf
   6 open Operators
   7 open ListMore
   8 open ExtString
   9 open Apply
  10
  11 module L = List
  12 module S = String
  13
  14 let repeat f x k =
  15   let rec loop () =
  16     match f x with
  17     | Some z -> k z
  18     | None -> ()
  19   in
  20   loop ()
  21
  22 let parse_one_exn (sql,props) =
  23     if Config.debug1 () then  prerr_endline sql;
  24     let (s,p,k) = Parser.parse_stmt sql in
  25     (* fill VALUES *)
  26     let (sql,p) = match k with
  27     | Stmt.Insert (Some s,_) ->
  28       let module B = Buffer in
  29       let b = B.create 100 in
  30       B.add_string b sql;
  31       B.add_string b " (";
  32       let params = ref [] in
  33       s >> List.iter (fun attr ->
  34         if !params <> [] then B.add_string b ",";
  35         let name = "@" ^ attr.RA.name in
  36         let param = ((Some attr.RA.name,(B.length b,B.length b + String.length name)),attr.RA.domain) in
  37         B.add_string b name;
  38         params := param :: !params
  39       );
  40       B.add_string b ")";
  41       (B.contents b, p @ (List.rev !params))
  42     | _ -> (sql,p)
  43     in
  44     {Stmt.schema=s; params=p; kind=k; props=Props.set props "sql" sql}
  45
  46 let parse_one x =
  47   try
  48     Some (parse_one_exn x)
  49   with
  50   | Parser_utils.Error (exn,(line,cnum,tok,tail)) ->
  51     begin
  52      let extra = Printexc.to_string exn in
  53      let sql = fst x in
  54      Error.log "==> %s" sql;
  55      if cnum = String.length sql && tok = "" then
  56        Error.log "Exception %s" extra
  57      else
  58        Error.log "Exception %s in %u:%u at \"%s%s\"" extra line cnum tok (String.slice ~last:32 tail);
  59      None
  60     end
  61
  62 let parse_one (sql,props as x) =
  63   match Props.get props "noparse" with
  64   | Some _ -> Some { Stmt.schema=[]; params=[]; kind=Stmt.Other; props=Props.set props "sql" sql }
  65   | None -> parse_one x
  66
  67 let get_statements ch =
  68   let lexbuf = Lexing.from_channel ch in
  69   let f () = try Sql_lexer.ruleStatement Props.empty lexbuf with _ -> None in
  70   let rec next () =
  71     match f () with
  72     | None -> raise Enum.No_more_elements
  73     | Some sql ->
  74       begin match parse_one sql with
  75       | None -> next ()
  76       | Some stmt ->
  77           if not (RA.Schema.is_unique stmt.Stmt.schema) then
  78             Error.log "Error: this SQL statement will produce rowset with duplicate column names:\n%s\n" (fst sql);
  79           stmt
  80       end
  81   in
  82   Enum.from next
  83
  84 let with_channel filename f =
  85   match catch open_in filename with
  86   | None -> Error.log "cannot open file : %s" filename; f None
  87   | Some ch -> Std.finally (fun () -> close_in_noerr ch) f (Some ch)
  88