helm/DEVEL/pxp/netstring/netstring_str.ml

   1 (* $Id$
   2  * ----------------------------------------------------------------------
   3  *
   4  *)
   5
   6 let lock   = ref (fun () -> ());;
   7 let unlock = ref (fun () -> ());;
   8
   9 let init_mt new_lock new_unlock =
  10   lock   := new_lock;
  11   unlock := new_unlock
  12 ;;
  13
  14 let protect f =
  15   !lock();
  16   try
  17     let r = f() in
  18     !unlock();
  19     r
  20   with
  21       x ->
  22         !unlock();
  23         raise x
  24 ;;
  25
  26 type regexp = Str.regexp;;
  27 type split_result = Str.split_result = Text of string | Delim of string;;
  28
  29 type result =
  30     { pos : int;
  31       match_beg : int;
  32       match_end : int;
  33       group_beg : int array;
  34       group_end : int array;
  35     }
  36 ;;
  37
  38 let regexp s =
  39   protect
  40     (fun () -> Str.regexp s)
  41 ;;
  42
  43 let regexp_case_fold s =
  44   protect
  45     (fun () -> Str.regexp_case_fold s)
  46 ;;
  47
  48 let quote s =
  49   protect
  50     (fun () -> Str.quote s)
  51 ;;
  52
  53 let regexp_string s =
  54   protect
  55     (fun () -> Str.regexp_string s)
  56 ;;
  57
  58 let regexp_string_case_fold s =
  59   protect
  60     (fun () -> Str.regexp_string_case_fold s)
  61 ;;
  62
  63 let return_result pos n_groups =
  64   let r =
  65     { pos = pos;
  66       match_beg = (try Str.match_beginning() with Not_found -> -1);
  67       match_end = (try Str.match_end()       with Not_found -> -1);
  68       group_beg = Array.create n_groups (-1);
  69       group_end = Array.create n_groups (-1);
  70     }
  71   in
  72   for g = 0 to n_groups - 1 do
  73     r.group_beg.(g) <- (try Str.group_beginning (g+1) with Not_found -> -1);
  74     r.group_end.(g) <- (try Str.group_end (g+1)       with Not_found -> -1);
  75   done;
  76   r
  77 ;;
  78
  79 let string_match ?(groups = 9) ~pat s ~pos =
  80   protect
  81     (fun () ->
  82        if Str.string_match pat s pos then
  83          Some (return_result pos groups)
  84        else
  85          None
  86     )
  87 ;;
  88
  89 let string_partial_match ?(groups = 9) ~pat s ~pos =
  90   protect
  91     (fun () ->
  92        if Str.string_partial_match pat s pos then
  93          Some (return_result pos groups)
  94        else
  95          None
  96     )
  97 ;;
  98
  99 let search_forward ?(groups = 9) ~pat s ~pos =
 100   protect
 101     (fun () ->
 102        let i = Str.search_forward pat s pos in
 103        i, return_result pos groups
 104     )
 105 ;;
 106
 107 let search_backward ?(groups = 9) ~pat s ~pos =
 108   protect
 109     (fun () ->
 110        let i = Str.search_backward pat s pos in
 111        i, return_result pos groups
 112     )
 113 ;;
 114
 115 let matched_string result s =
 116   if result.match_beg < 0 or result.match_end < 0 then raise Not_found;
 117   String.sub s result.match_beg (result.match_end - result.match_beg)
 118 ;;
 119
 120 let match_beginning result =
 121   if result.match_beg < 0 then raise Not_found;
 122   result.match_beg
 123 ;;
 124
 125 let match_end result =
 126   if result.match_end < 0 then raise Not_found;
 127   result.match_end
 128 ;;
 129
 130 let matched_group result n s =
 131   if n < 0 || n >= Array.length result.group_beg then raise Not_found;
 132   let gbeg = result.group_beg.(n-1) in
 133   let gend = result.group_end.(n-1) in
 134   if gbeg < 0 or gend < 0 then raise Not_found;
 135   String.sub s gbeg (gend - gbeg)
 136 ;;
 137
 138 let group_beginning result n =
 139   if n < 0 || n >= Array.length result.group_beg then raise Not_found;
 140   let gbeg = result.group_beg.(n-1) in
 141   if gbeg < 0 then raise Not_found else
 142     gbeg
 143 ;;
 144
 145 let group_end result n =
 146   if n < 0 || n >= Array.length result.group_end then raise Not_found;
 147   let gend = result.group_end.(n-1) in
 148   if gend < 0 then raise Not_found else
 149     gend
 150 ;;
 151
 152 let global_replace ~pat ~templ s =
 153   protect
 154     (fun () ->
 155        Str.global_replace pat templ s)
 156 ;;
 157
 158 let replace_first ~pat ~templ s =
 159   protect
 160     (fun () ->
 161        Str.replace_first pat templ s)
 162 ;;
 163
 164 let global_substitute ?(groups = 9) ~pat ~subst s =
 165   protect
 166     (fun () ->
 167        let xsubst s =
 168          let r = return_result 0 groups in
 169          subst r s
 170        in
 171        Str.global_substitute pat xsubst s)
 172 ;;
 173
 174 let substitute_first ?(groups = 9) ~pat ~subst s =
 175   protect
 176     (fun () ->
 177        let xsubst s =
 178          let r = return_result 0 groups in
 179          subst r s
 180        in
 181        Str.substitute_first pat xsubst s)
 182 ;;
 183
 184 (* replace_matched: n/a *)
 185
 186 let split ~sep s =
 187   protect
 188     (fun () ->
 189        Str.split sep s)
 190 ;;
 191
 192 let bounded_split ~sep s ~max =
 193   protect
 194     (fun () ->
 195        Str.bounded_split sep s max)
 196 ;;
 197
 198 let split_delim ~sep s =
 199   protect
 200     (fun () ->
 201        Str.split_delim sep s)
 202 ;;
 203
 204 let bounded_split_delim ~sep s ~max =
 205   protect
 206     (fun () ->
 207        Str.bounded_split_delim sep s max)
 208 ;;
 209
 210 let full_split ~sep s =
 211   protect
 212     (fun () ->
 213        Str.full_split sep s)
 214 ;;
 215
 216 let bounded_full_split ~sep s ~max =
 217   protect
 218     (fun () ->
 219        Str.bounded_full_split sep s max)
 220 ;;
 221
 222 let string_before = Str.string_before;;
 223 let string_after = Str.string_after;;
 224 let first_chars = Str.first_chars;;
 225 let last_chars = Str.last_chars;;
 226
 227 (* ======================================================================
 228  * History:
 229  *
 230  * $Log$
 231  * Revision 1.1  2000/11/17 09:57:28  lpadovan
 232  * Initial revision
 233  *
 234  * Revision 1.2  2000/06/25 21:15:48  gerd
 235  *      Checked thread-safety.
 236  *
 237  * Revision 1.1  2000/06/25 20:48:19  gerd
 238  *      Initial revision.
 239  *
 240  *
 241  *)