utils.ml

   1 module StringSet = Set.Make (struct type t = string let compare = compare end)
   2
   3 let decrlf line =
   4   if line.[String.length line - 1] = '\r'
   5   then
   6     String.sub line 0 (String.length line - 1)
   7   else
   8     line
   9
  10 let safe_input_line ic =
  11   try
  12     Some (input_line ic)
  13   with
  14     | End_of_file ->
  15         None
  16
  17 let iter_crlf_chan ic f =
  18   let rec loop () =
  19     let opt_line = safe_input_line ic in
  20       match opt_line with
  21         | Some line ->
  22             f (decrlf line);
  23             loop ()
  24         | None ->
  25             ()
  26   in
  27     loop ()
  28
  29 let fold_crlf_chan ic f init =
  30   let rec loop accu =
  31     let opt_line = safe_input_line ic in
  32       match opt_line with
  33         | Some line ->
  34             let accu = f (decrlf line) accu in
  35               loop accu
  36         | None ->
  37             accu
  38   in
  39     loop init
  40
  41 let process_status = function
  42   | Unix.WEXITED code ->
  43       code
  44   | Unix.WSIGNALED signum ->
  45       prerr_string "signalled ";
  46       prerr_int signum;
  47       prerr_newline ();
  48       101
  49   | Unix.WSTOPPED signum ->
  50       prerr_string "stopped ";
  51       prerr_int signum;
  52       prerr_newline ();
  53       102
  54
  55 let close_process_in ic =
  56   let status = Unix.close_process_in ic in
  57     process_status status
  58
  59 let close_process_full channels =
  60   let status = Unix.close_process_full channels in
  61     process_status status
  62
  63 let make_arg_string f argv pos =
  64   let rec loop accu i =
  65     if i >= Array.length argv
  66     then
  67       List.rev accu
  68     else
  69       let s = f argv.(i) in
  70       let accu = s :: accu in
  71         loop accu (succ i)
  72   in
  73   let arg_list = loop [] pos in
  74     String.concat " " arg_list
  75
  76 let safe_group_extents group_nr =
  77   try
  78     Str.group_beginning group_nr, Str.group_end group_nr
  79   with Not_found ->
  80     failwith "Internal error (cannot get group extents)"
  81
  82 let safe_group group_nr s =
  83   try
  84     Str.matched_group group_nr s
  85   with Not_found ->
  86     failwith "Internal error (cannot find matched group)"
  87
  88 let safe_group_end group_nr =
  89   try
  90     Str.group_end group_nr
  91   with Not_found ->
  92     failwith "Internal error (cannot find group end)"
  93
  94 let some_action f d = function
  95   | None ->
  96       d
  97   | Some v ->
  98       f v
  99
 100 let array_find_from p a pos =
 101   let rec loop i =
 102     if i >= Array.length a
 103     then
 104       false
 105     else
 106       p a.(i) || loop (succ i)
 107   in
 108     loop pos
 109
 110 let question_pred s = s = "/?" || s = "-?"
 111 let contains_question argv arg_start =
 112   array_find_from question_pred argv arg_start
 113
 114 let tool_name s =
 115   try
 116     Unix.getenv ("IMT_" ^ (String.uppercase s))
 117   with Not_found ->
 118     s
 119
 120 let build_reject_list () =
 121   let rejs =
 122     try
 123       Some (Unix.getenv "IMT_REJ")
 124     with Not_found ->
 125       None
 126   in
 127     match rejs with
 128       | None ->
 129           []
 130
 131       | Some rejs ->
 132           let l = String.length rejs in
 133           let rec collect accu old_pos =
 134             if old_pos >= l
 135             then
 136               accu
 137             else
 138               let pos =
 139                 try
 140                   String.index_from rejs old_pos ':'
 141                 with Not_found->
 142                   l
 143               in
 144               let s = String.sub rejs old_pos (pos - old_pos) in
 145               let accu = Str.regexp_string_case_fold s :: accu in
 146                 collect accu (pos + 1)
 147           in
 148             collect [] 0
 149
 150 let reject_path s = function
 151   | [] -> false
 152   | rejrel ->
 153       let rec find = function
 154         | [] -> false
 155         | rejre :: tl ->
 156             if Str.string_partial_match rejre s 0
 157             then
 158               true
 159             else
 160               find tl
 161       in
 162         find rejrel