Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 172 lines (138 sloc) 5.206 kb
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18
19 (* Simple library, like Buffer but fixed size but can also look like String if required *)
20
21 type buf = { mutable str : string; mutable i : int }
22 type t = buf
23
bbb47cb Norman Scaife [enhance] libbase: Made Buf module optionally resizable according to gl...
nrs135 authored
24 type resize_mode =
25 | RM_stdout
26 | RM_stderr
27 | RM_custom of (string -> unit)
28 | RM_failwith
29 | RM_exit
30 | RM_noresize
31
32 let auto_resize = ref RM_stderr
33
34 let empty () = { str=""; i=0; }
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
35
36 let create size = { str=String.create size; i=0; }
37
38 let make size ch = { str=String.make size ch; i=size; }
39
bbb47cb Norman Scaife [enhance] libbase: Made Buf module optionally resizable according to gl...
nrs135 authored
40 (* More conservative than Buffer, we grow more slowly and
41 * we allow shrinkage by giving negative values to extra.
42 *)
43 let resize buf extra =
44 let strlen = String.length buf.str in
45 let target = max 0 (if extra >= 0 then buf.i + extra else strlen + extra) in
46 let newsize =
47 if extra >= 0
48 then
49 let newsize = ref (max strlen 2) in
50 while !newsize < target do
51 newsize := max (!newsize+1) ((!newsize + !newsize + !newsize) / 2)
52 done;
53 if !newsize > Sys.max_string_length
54 then
55 if target <= Sys.max_string_length
56 then Sys.max_string_length
57 else failwith "Buf.resize: cannot increase size of buffer"
58 else !newsize
59 else target
60 in
61 let str = String.create newsize in
62 let newlen = min buf.i newsize in
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
63 if buf.i > 0 then String.unsafe_blit buf.str 0 str 0 newlen;
64 buf.str <- str;
bbb47cb Norman Scaife [enhance] libbase: Made Buf module optionally resizable according to gl...
nrs135 authored
65 buf.i <- newlen;
66 if newsize > strlen
67 then
68 let msg = Printf.sprintf "Buf.resize called (now %d), please resize your buffers" newsize in
69 match !auto_resize with
70 | RM_stdout -> Printf.printf "%s\n%!" msg
71 | RM_stderr -> Printf.eprintf "%s\n%!" msg
72 | RM_custom f -> f msg
73 | RM_failwith -> failwith msg
74 | RM_exit -> exit 1
75 | RM_noresize -> ()
76
77 let autoresize buf extra msg =
78 if !auto_resize <> RM_noresize
79 then resize buf extra
80 else invalid_arg msg
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
81
79660b4 Norman Scaife [feature] libbase: Added copy to Buf.
nrs135 authored
82 let copy buf = { str=String.copy buf.str; i=buf.i }
83
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
84 let clear buf = buf.i <- 0
85
86 let reset buf = buf.str <- ""; buf.i <- 0
87
88 let length buf = buf.i
89
90 let real_length buf = String.length buf.str
91
92 let get buf i =
93 if i < 0 || i >= buf.i then invalid_arg (Printf.sprintf "Buf.get index out of bounds %d" i);
94 String.get buf.str i
95 let nth = get
96
97 let unsafe_get buf i = String.unsafe_get buf.str i
98
99 let set buf i ch =
100 if i < 0 || i >= buf.i then invalid_arg (Printf.sprintf "Buf.set index out of bounds %d" i);
101 String.set buf.str i ch
102
103 let unsafe_set buf i ch = String.unsafe_set buf.str i ch
104
105 let sub buf base len =
732d845 Norman Scaife [feature] libbase: Added add_substring to Buf.
nrs135 authored
106 if base < 0 || base + len > buf.i then invalid_arg (Printf.sprintf "Buf.sub index out of bounds %d %d" base len);
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
107 String.sub buf.str base len
108
109 let add_char buf ch =
bbb47cb Norman Scaife [enhance] libbase: Made Buf module optionally resizable according to gl...
nrs135 authored
110 if String.length buf.str - buf.i < 1 then autoresize buf 1 (Printf.sprintf "Buf.add_char %c" ch);
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
111 buf.str.[buf.i] <- ch;
112 buf.i <- buf.i + 1
113
732d845 Norman Scaife [feature] libbase: Added add_substring to Buf.
nrs135 authored
114 let add_substring buf str base len =
bbb47cb Norman Scaife [enhance] libbase: Made Buf module optionally resizable according to gl...
nrs135 authored
115 if String.length buf.str - buf.i < len then autoresize buf len (Printf.sprintf "Buf.add_substring %s %d %d" str base len);
732d845 Norman Scaife [feature] libbase: Added add_substring to Buf.
nrs135 authored
116 String.unsafe_blit str base buf.str buf.i len;
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
117 buf.i <- buf.i + len
118
732d845 Norman Scaife [feature] libbase: Added add_substring to Buf.
nrs135 authored
119 let append buf str len = add_substring buf str 0 len
120
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
121 let extend buf len =
bbb47cb Norman Scaife [enhance] libbase: Made Buf module optionally resizable according to gl...
nrs135 authored
122 if String.length buf.str - buf.i < len then autoresize buf len (Printf.sprintf "Buf.extend %d" len);
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
123 buf.i <- buf.i + len
124
125 let add_string buf str =
126 append buf str (String.length str)
127
128 let add_buf buf1 buf2 =
129 append buf1 buf2.str buf2.i
130
131 let of_string str = { str; i=String.length str; }
132
133 let to_string buf = String.sub buf.str 0 buf.i
134 let contents = to_string
135
136 let spare buf = String.length buf.str - buf.i
137
138 (* Test code *)
139 (*
140 let buf = of_string "abc";;
141 let () = set buf 1 'B';;
142 let ch = get buf 0;;
143 let ch = get buf 1;;
144 let ch = get buf 2;;
145 let str = try ignore (get buf 3); "NOT OK" with Invalid_argument str -> "OK: "^str;;
146 let str = try ignore (set buf 4 'x'); "NOT OK" with Invalid_argument str -> "OK: "^str;;
147 let buf = create 5;;
148 let () = add_char buf 'D';;
149 let () = add_string buf "ef";;
150 let len = length buf;;
151 let rlen = real_length buf;;
152 let str = to_string buf;;
153 let () = resize buf 8;;
154 let len = length buf;;
155 let rlen = real_length buf;;
156 let str = to_string buf;;
bbb47cb Norman Scaife [enhance] libbase: Made Buf module optionally resizable according to gl...
nrs135 authored
157 let () = resize buf (-2);;
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
158 let len = length buf;;
159 let rlen = real_length buf;;
160 let str = to_string buf;;
bbb47cb Norman Scaife [enhance] libbase: Made Buf module optionally resizable according to gl...
nrs135 authored
161 let str =
162 try ignore (add_char (empty()) 'x');
163 if !auto_resize <> RM_noresize then "OK: resized" else "NOT OK"
164 with Invalid_argument str ->
165 if !auto_resize <> RM_noresize then "NOT OK" else "OK: "^str;;
b2c8070 Norman Scaife [feature] mongo: New files for mongo API.
nrs135 authored
166 let () = resize buf 10;;
167 let () = add_string buf "fghi";;
168 let str = to_string buf;;
169 let str = sub buf 1 3;;
170 let str = try ignore (sub buf 100 100); "NOT OK" with Invalid_argument str -> "OK: "^str;;
171 *)
Something went wrong with that request. Please try again.