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
|
(*
* Copyright (C) 2006-2009 Citrix Systems Inc.
*
* This program 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; version 2.1 only. with the special
* exception on linking described in file LICENSE.
*
* This program 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.
*)
type ty =
| Set_bool of bool ref
| Set_int of int ref
| Set_string of string ref
| Set_float of float ref
| Unit of (unit -> unit)
| Bool of (bool -> unit)
| Int of (int -> unit)
| String of (string -> unit)
| Float of (float -> unit)
exception Error of (string * string) list
let trim_start lc s =
let len = String.length s and i = ref 0 in
while !i < len && (List.mem s.[!i] lc)
do
incr i
done;
if !i < len then String.sub s !i (len - !i) else ""
let trim_end lc s =
let i = ref (String.length s - 1) in
while !i > 0 && (List.mem s.[!i] lc)
do
decr i
done;
if !i >= 0 then String.sub s 0 (!i + 1) else ""
let rec split ?limit:(limit=(-1)) c s =
let i = try String.index s c with Not_found -> -1 in
let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in
if i = -1 || nlimit = 0 then
[ s ]
else
let a = String.sub s 0 i
and b = String.sub s (i + 1) (String.length s - i - 1) in
a :: (split ~limit: nlimit c b)
let parse_line stream =
let lc = [ ' '; '\t' ] in
let trim_spaces s = trim_end lc (trim_start lc s) in
let to_config s =
match split ~limit:2 '=' s with
| k :: v :: [] -> Some (trim_end lc k, trim_start lc v)
| _ -> None in
let rec read_filter_line () =
try
let line = trim_spaces (input_line stream) in
if String.length line > 0 && line.[0] <> '#' then
match to_config line with
| None -> read_filter_line ()
| Some x -> x :: read_filter_line ()
else
read_filter_line ()
with
End_of_file -> [] in
read_filter_line ()
let parse filename =
let stream = open_in filename in
let cf = parse_line stream in
close_in stream;
cf
let validate cf expected other =
let err = ref [] in
let append x = err := x :: !err in
List.iter (fun (k, v) ->
try
if not (List.mem_assoc k expected) then
other k v
else let ty = List.assoc k expected in
match ty with
| Unit f -> f ()
| Bool f -> f (bool_of_string v)
| String f -> f v
| Int f -> f (int_of_string v)
| Float f -> f (float_of_string v)
| Set_bool r -> r := (bool_of_string v)
| Set_string r -> r := v
| Set_int r -> r := int_of_string v
| Set_float r -> r := (float_of_string v)
with
| Not_found -> append (k, "unknown key")
| Failure "int_of_string" -> append (k, "expect int arg")
| Failure "bool_of_string" -> append (k, "expect bool arg")
| Failure "float_of_string" -> append (k, "expect float arg")
| exn -> append (k, Printexc.to_string exn)
) cf;
if !err != [] then raise (Error !err)
(** read a filename, parse and validate, and return the errors if any *)
let read filename expected other =
let cf = parse filename in
validate cf expected other
|
