~ubuntu-branches/ubuntu/trusty/ocamlnet/trusty

« back to all changes in this revision

Viewing changes to src/netstring/netstring_pcre.mlp

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-09-02 14:12:33 UTC
  • mfrom: (18.2.3 sid)
  • Revision ID: james.westby@ubuntu.com-20110902141233-zbj0ygxb92u6gy4z
Tags: 3.4-1
* New upstream release
  - add a new NetcgiRequire directive to ease dependency management
    (Closes: #637147)
  - remove patches that were applied upstream:
    + Added-missing-shebang-lines-in-example-shell-scripts
    + Try-also-ocamlc-for-POSIX-threads

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(* $Id: netstring_pcre.mlp 1588 2011-04-28 13:59:54Z gerd $
 
2
 * ----------------------------------------------------------------------
 
3
 *
 
4
 *)
 
5
 
 
6
IFDEF HAVE_PCRE THEN
 
7
 
 
8
type regexp = Pcre.regexp;;
 
9
type split_result = Pcre.split_result =
 
10
  | Text of string
 
11
  | Delim of string
 
12
  | Group of int * string
 
13
  | NoGroup
 
14
;;
 
15
 
 
16
type result = Pcre.substrings;;
 
17
 
 
18
let regexp s =
 
19
  Pcre.regexp ~flags:[`MULTILINE] s
 
20
;;
 
21
 
 
22
let regexp_case_fold s =
 
23
  Pcre.regexp ~flags:[`MULTILINE; `CASELESS] s
 
24
;;
 
25
 
 
26
let quote s =
 
27
  Pcre.quote s
 
28
;;
 
29
 
 
30
let regexp_string s =
 
31
  regexp (quote s)
 
32
;;
 
33
 
 
34
let regexp_string_case_fold s =
 
35
  regexp_case_fold (quote s)
 
36
;;
 
37
 
 
38
let string_match pat s pos =
 
39
  try
 
40
    let result = Pcre.exec ~rex:pat ~flags:[`ANCHORED] ~pos s in
 
41
    Some result
 
42
  with Not_found -> None
 
43
;;
 
44
 
 
45
let search_forward pat s pos =
 
46
  let result = Pcre.exec ~rex:pat ~pos s in
 
47
  fst (Pcre.get_substring_ofs result 0), result
 
48
;;
 
49
 
 
50
let search_backward pat s pos =
 
51
  let rec search p =
 
52
    try
 
53
      (* `ANCHORED: virtually prepends "^" to the regexp *)
 
54
      let result = Pcre.exec ~flags:[`ANCHORED] ~rex:pat ~pos:p s in
 
55
      fst (Pcre.get_substring_ofs result 0), result
 
56
    with
 
57
      Not_found ->
 
58
        if p > 0 then search (p-1) else raise Not_found
 
59
  in
 
60
  search pos
 
61
;;
 
62
 
 
63
let matched_string result _ =
 
64
  (* Unfortunately, Pcre.get_substring will not raise Not_found if there is
 
65
   * no matched string. Instead, it returns "", but this value cannot be
 
66
   * distinguished from an empty match.
 
67
   * The workaround is to call Pcre.get_substring_ofs first. This function
 
68
   * will raise Not_found if there is not any matched string.
 
69
   *
 
70
   * NOTE: Current versions of Pcre do return Not_found!
 
71
   *)
 
72
  ignore(Pcre.get_substring_ofs result 0);
 
73
  Pcre.get_substring result 0
 
74
;;
 
75
 
 
76
let match_beginning result =
 
77
  fst (Pcre.get_substring_ofs result 0)
 
78
;;
 
79
 
 
80
let match_end result =
 
81
  snd (Pcre.get_substring_ofs result 0)
 
82
;;
 
83
 
 
84
let matched_group result n _ =
 
85
  (* See also the comment for [matched_string] *)
 
86
  if n < 0 || n >= Pcre.num_of_subs result then raise Not_found;
 
87
  ignore(Pcre.get_substring_ofs result n);
 
88
  Pcre.get_substring result n
 
89
;;
 
90
 
 
91
let group_beginning result n =
 
92
  fst (Pcre.get_substring_ofs result n)
 
93
;;
 
94
 
 
95
let group_end result n =
 
96
  snd (Pcre.get_substring_ofs result n)
 
97
;;
 
98
 
 
99
let templ_re = Pcre.regexp "(?:\\\\\\d)|[\\$\\\\]" ;;
 
100
  (* matches a backslash and a digit, or a single dollar or a single
 
101
   * backslash.
 
102
   *)
 
103
 
 
104
let tr_templ s =
 
105
  (* Convert \n to $n etc. *)
 
106
  (* Unfortunately we cannot just replace \ by $. *)
 
107
  let rec tr l =
 
108
    match l with
 
109
        Pcre.Delim "$" :: l' -> "$$" :: tr l'
 
110
      | Pcre.Delim "\\" :: Pcre.Delim "$" :: l'  -> "$$" :: tr l'
 
111
      | Pcre.Delim "\\" :: Pcre.Delim s :: l' -> s :: tr l'
 
112
      | Pcre.Delim "\\" :: Pcre.Text s :: l' -> s :: tr l'
 
113
      | [ Pcre.Delim "\\" ] -> failwith "trailing backslash"
 
114
      | Pcre.Delim d :: l' ->
 
115
          assert(d.[0] = '\\');
 
116
          let n = Char.code d.[1] - Char.code '0' in
 
117
          if n = 0 then
 
118
            "$&" :: tr l'
 
119
          else
 
120
            ("$" ^ string_of_int n ^ "$!") :: tr l'
 
121
      | Pcre.Text t :: l' -> t :: tr l'
 
122
      | Pcre.Group(_,_) :: _ -> assert false
 
123
      | Pcre.NoGroup :: _ -> assert false
 
124
      | [] -> []
 
125
  in
 
126
  let l = Pcre.full_split ~rex:templ_re ~max:(-1) s in
 
127
  String.concat "" (tr l)
 
128
;;
 
129
 
 
130
 
 
131
let global_replace pat templ s =
 
132
  Pcre.replace ~rex:pat ~itempl:(Pcre.subst (tr_templ templ)) s
 
133
;;
 
134
 
 
135
let replace_first pat templ s =
 
136
  Pcre.replace_first ~rex:pat ~itempl:(Pcre.subst (tr_templ templ)) s
 
137
;;
 
138
 
 
139
let global_substitute pat subst s =
 
140
  Pcre.substitute_substrings ~rex:pat ~subst:(fun r -> subst r s) s
 
141
;;
 
142
 
 
143
let string_before s n =
 
144
  String.sub s 0 n
 
145
;;
 
146
 
 
147
let string_after s n =
 
148
  String.sub s n (String.length s - n)
 
149
;;
 
150
 
 
151
let first_chars s len =
 
152
  String.sub s 0 len
 
153
;;
 
154
 
 
155
let last_chars s len =
 
156
  String.sub s (String.length s - len) len
 
157
;;
 
158
 
 
159
(*
 
160
 * Uncomment for next version of Pcre
 
161
let substitute_first ?groups ~pat ~subst s =
 
162
  Pcre.substitute_substrings_first ~rex:pat ~subst:(fun r -> subst r s) s
 
163
;;
 
164
*)
 
165
 
 
166
let substitute_first pat subst s =
 
167
  (* Do it yourself in the meantime *)
 
168
  try
 
169
    let substrs = Pcre.exec ~rex:pat s in (* or Not_found *)
 
170
    let (match_beg,match_end) = Pcre.get_substring_ofs substrs 0 in
 
171
    let replacement_text = subst substrs s in
 
172
    String.concat "" [string_before s match_beg;
 
173
                      replacement_text;
 
174
                      string_after s match_end]
 
175
  with
 
176
      Not_found -> s
 
177
;;
 
178
  
 
179
 
 
180
 
 
181
(* Copied from Str for exact compatibility: *)
 
182
let bounded_split expr text num =
 
183
  let start =
 
184
    try
 
185
      let start_substrs = Pcre.exec ~rex:expr ~flags:[`ANCHORED] text in
 
186
                          (* or Not_found *)
 
187
      let (_,match_end) = Pcre.get_substring_ofs start_substrs 0 in
 
188
      match_end
 
189
    with
 
190
        Not_found -> 0
 
191
  in
 
192
  let rec split start n =
 
193
    if start >= String.length text then [] else
 
194
    if n = 1 then [string_after text start] else
 
195
      try
 
196
        let next_substrs = Pcre.exec ~rex:expr ~pos:start text 
 
197
        in (* or Not_found *)
 
198
        let (pos,match_end) = Pcre.get_substring_ofs next_substrs 0 in
 
199
        String.sub text start (pos-start) :: split match_end (n-1)
 
200
      with Not_found ->
 
201
        [string_after text start] in
 
202
  split start num
 
203
;;
 
204
 
 
205
let split sep s = bounded_split sep s 0
 
206
;;
 
207
 
 
208
(* Copied from Str for exact compatibility: *)
 
209
let bounded_split_delim expr text num =
 
210
  let rec split start n =
 
211
    if start > String.length text then [] else
 
212
    if n = 1 then [string_after text start] else
 
213
      try
 
214
        let next_substrs = Pcre.exec ~rex:expr ~pos:start text 
 
215
        in (* or Not_found *)
 
216
        let (pos,match_end) = Pcre.get_substring_ofs next_substrs 0 in
 
217
        String.sub text start (pos-start) :: split match_end (n-1)
 
218
      with Not_found ->
 
219
        [string_after text start] in
 
220
  if text = "" then [] else split 0 num
 
221
;;
 
222
 
 
223
let split_delim sep text = bounded_split_delim sep text 0 ;;
 
224
 
 
225
let full_split sep s =
 
226
  Pcre.full_split ~rex:sep ~max:(-1) s
 
227
;;
 
228
 
 
229
let bounded_full_split sep s max =
 
230
  let max' = if max <= 0 then -1 else max in
 
231
  Pcre.full_split ~rex:sep ~max:max' s
 
232
;;
 
233
 
 
234
ELSE
 
235
type regexp
 
236
type split_result =
 
237
  | Text of string
 
238
  | Delim of string
 
239
  | Group of int * string
 
240
  | NoGroup
 
241
type result
 
242
 
 
243
let regexp _ = 
 
244
  invalid_arg "Netstring_pcre: unavailable"
 
245
let regexp_case_fold _ = 
 
246
  invalid_arg "Netstring_pcre: unavailable"
 
247
let quote _ = 
 
248
  invalid_arg "Netstring_pcre: unavailable"
 
249
let regexp_string _ = 
 
250
  invalid_arg "Netstring_pcre: unavailable"
 
251
let regexp_string_case_fold _ = 
 
252
  invalid_arg "Netstring_pcre: unavailable"
 
253
let string_match _ _ _ = 
 
254
  invalid_arg "Netstring_pcre: unavailable"
 
255
let search_forward _ _ _ = 
 
256
  invalid_arg "Netstring_pcre: unavailable"
 
257
let search_backward _ _ _ =
 
258
  invalid_arg "Netstring_pcre: unavailable"
 
259
let matched_string _ _ = 
 
260
  invalid_arg "Netstring_pcre: unavailable"
 
261
let match_beginning _ = 
 
262
  invalid_arg "Netstring_pcre: unavailable"
 
263
let match_end _ = 
 
264
  invalid_arg "Netstring_pcre: unavailable"
 
265
let matched_group _ _ _ = 
 
266
  invalid_arg "Netstring_pcre: unavailable"
 
267
let group_beginning _ _ = 
 
268
  invalid_arg "Netstring_pcre: unavailable"
 
269
let group_end _ _ = 
 
270
  invalid_arg "Netstring_pcre: unavailable"
 
271
let global_replace _ _ _ = 
 
272
  invalid_arg "Netstring_pcre: unavailable"
 
273
let replace_first _ _ _ = 
 
274
  invalid_arg "Netstring_pcre: unavailable"
 
275
let global_substitute _ _ _ = 
 
276
  invalid_arg "Netstring_pcre: unavailable"
 
277
let substitute_first _ _ _ = 
 
278
  invalid_arg "Netstring_pcre: unavailable"
 
279
let split _ _ = 
 
280
  invalid_arg "Netstring_pcre: unavailable"
 
281
let bounded_split _ _ _ = 
 
282
  invalid_arg "Netstring_pcre: unavailable"
 
283
let split_delim _ _ = 
 
284
  invalid_arg "Netstring_pcre: unavailable"
 
285
let bounded_split_delim _ _ = 
 
286
  invalid_arg "Netstring_pcre: unavailable"
 
287
let full_split _ _ = 
 
288
  invalid_arg "Netstring_pcre: unavailable"
 
289
let bounded_full_split _ _ _ = 
 
290
  invalid_arg "Netstring_pcre: unavailable"
 
291
let string_before _ _ = 
 
292
  invalid_arg "Netstring_pcre: unavailable"
 
293
let string_after _ _ = 
 
294
  invalid_arg "Netstring_pcre: unavailable"
 
295
let first_chars _ _ = 
 
296
  invalid_arg "Netstring_pcre: unavailable"
 
297
let last_chars _ _ = 
 
298
  invalid_arg "Netstring_pcre: unavailable"
 
299
 
 
300
ENDIF