11 let common_prefix = function
15 if String.length x
<= i
then i
17 if List.for_all
(fun s
-> i
< String.length s
&& s
.[i
] = x
.[i
]) l
then
24 let parse_one_exn (sql
,props
) =
25 if Sqlgg_config.debug1
() then prerr_endline sql
;
26 let (schema
,params
,kind
) = Parser.parse_stmt sql
in
27 (* fill inferred sql for VALUES or SET *)
28 let (sql
,params
) = match kind
with
29 | Stmt.Insert
(Some
(kind
,schema
), _
) ->
30 let (pre
,each
,post
) = match kind
with
31 | Stmt.Values
-> "(", (fun _
-> ""), ")"
32 | Stmt.Assign
-> "", (fun name
-> name ^
" = "), ""
34 let module B
= Buffer
in
35 let b = B.create
100 in
39 let params'
= ref [] in
40 let first = common_prefix & List.map
(fun attr
-> attr
.RA.name
) schema
in
41 schema
>> List.iter
(fun attr
->
42 if !params'
<> [] then B.add_string
b ",";
43 let attr_ref_prefix = each attr
.RA.name
in
44 let attr_name = String.slice ~
first attr
.RA.name
in
45 let attr_ref = "@" ^
attr_name in
46 let pos_start = B.length
b + String.length
attr_ref_prefix in
47 let pos_end = pos_start + String.length
attr_ref in
48 let param = ((Some
attr_name,(pos_start,pos_end)),attr
.RA.domain
) in
49 B.add_string
b attr_ref_prefix;
50 B.add_string
b attr_ref;
51 params'
:= param :: !params'
54 (B.contents
b, params @ (List.rev
!params'
))
57 {Stmt.schema
=schema
; params=params; kind
=kind
; props
=Props.set props
"sql" sql
}
61 Some
(parse_one_exn x
)
63 | Parser_utils.Error
(exn
,(line
,cnum
,tok
,tail
)) ->
65 let extra = match exn
with
66 | RA.Schema.Error
(_
,msg
) -> msg
67 | exn
-> Printexc.to_string exn
70 Error.log
"==> %s" sql;
71 if cnum
= String.length
sql && tok
= "" then
72 Error.log
"Error: %s" extra
74 Error.log
"Position %u:%u Tokens: %s%s\nError: %s" line cnum tok
(String.slice ~last
:32 tail
) extra;
78 let parse_one (sql,props
as x
) =
79 match Props.get props
"noparse" with
80 | Some _
-> Some
{ Stmt.schema
=[]; params=[]; kind
=Stmt.Other
; props
=Props.set props
"sql" sql }
84 while Option.map p
(Enum.peek e
) = Some
true do
88 type token
= [`Comment
of string | `Token
of string | `Char
of char
|
89 `Space
of string | `Prop
of string * string | `Semicolon
]
91 let get_statements ch
=
92 let lexbuf = Lexing.from_channel ch
in
93 let tokens = Enum.from
(fun () ->
94 if lexbuf.Lexing.lex_eof_reached
then raise
Enum.No_more_elements
else
95 match Sql_lexer.ruleStatement
lexbuf with
96 | `Eof
-> raise
Enum.No_more_elements
100 let b = Buffer.create
1024 in
101 let props = ref Props.empty
in
102 let answer () = Buffer.contents
b, !props in
104 match Enum.get
tokens with
105 | None
-> if smth
then Some
(answer ()) else None
108 | `Comment s
-> ignore s
; loop smth
(* do not include comments (option?) *)
109 | `Char c
-> Buffer.add_char
b c
; loop true
110 | `Space _
when smth
= false -> loop smth
(* drop leading whitespaces *)
111 | `Token s
| `Space s
-> Buffer.add_string
b s
; loop true
112 | `Prop
(n
,v
) -> props := Props.set
!props n v
; loop smth
113 | `Semicolon
-> Some
(answer ())
117 let extract () = try extract () with e
-> Error.log
"lexer failed (%s)" (Printexc.to_string e
); None
in
119 match extract () with
120 | None
-> raise
Enum.No_more_elements
122 begin match parse_one sql with
125 if not
(RA.Schema.is_unique stmt
.Stmt.schema
) then
126 Error.log
"Error: this SQL statement will produce rowset with duplicate column names:\n%s\n" (fst
sql);
130 Enum.from
next >> List.of_enum
132 let with_channel filename f
=
133 match catch open_in filename
with
134 | None
-> Error.log
"cannot open file : %s" filename
; f None
135 | Some ch
-> Std.finally
(fun () -> close_in_noerr ch
) f
(Some ch
)