tools/gitgrep.ml

   1 (* adjust as convenient *)
   2 let prefix = "/tmp/"
   3 let prefix = ""
   4
   5 (* The -grouped option means that all - and + code must appear in a
   6 single contiguous block of - + code.  This option has no effect on the
   7 other kinds of patterns, ie Changelog (C) or Context (@) *)
   8
   9 (* example: gitgrep -grouped -maxlen 25 - "[A-Z][A-Z]+" + "[A-Z][A-Z]+"
  10 usb_21_22 *)
  11
  12 type dir = Minus | Plus | Context | ChangeLog
  13
  14 type res = Git of string | Block of int * string
  15
  16 let grouped = ref false
  17 let maxlen = ref None
  18
  19 let space = Str.regexp " "
  20
  21 let matches pattern line =
  22   try let _ = Str.search_forward pattern line 0 in true
  23   with Not_found -> false
  24
  25 let res = ref []
  26
  27 let scan dir pattern i =
  28   let rec loop skipping cl git =
  29     let line = input_line i in
  30     match Str.split space line with
  31       ["commit";git] -> loop false true git
  32     | "diff"::_ -> loop skipping false git
  33     | _ ->
  34         if String.length line > 0 && not skipping &&
  35           ((String.get line 0 = '-' && dir = Minus) or
  36            (String.get line 0 = '+' && dir = Plus) or
  37            (cl && dir = ChangeLog) or
  38            (not (String.get line 0 = '-') && not (String.get line 0 = '+') &&
  39             dir = Context)) &&
  40           matches pattern line
  41         then (res := Git(git)::!res; loop true cl git)
  42         else loop skipping cl git in
  43   loop false false ""
  44
  45 (* for Minus and Plus directions only *)
  46 let scan_grouped dir pattern i =
  47   let block = ref 0 in
  48   (* mp = true in minus-plus region *)
  49   let rec loop mp git =
  50     let line = input_line i in
  51     match Str.split space line with
  52       ["commit";git] -> loop false git
  53     | "diff"::_ -> loop false git
  54     | _ ->
  55         if String.length line > 0
  56         then
  57             let first_char = String.get line 0 in
  58             let new_mp =
  59               match first_char with
  60                 '-' | '+' -> (if not mp then block := !block + 1; true)
  61               | _ -> false in
  62             match (first_char,dir) with
  63               ('-',Minus) | ('+',Plus) ->
  64                 let info = Block(!block,git) in
  65                 (if matches pattern line && not (List.mem info !res)
  66                 then res := info::!res);
  67                 loop new_mp git
  68             | _ -> loop new_mp git
  69         else loop mp git in
  70   loop false ""
  71
  72 let scan_line max i =
  73   let rec loop skipping num git =
  74     let line = input_line i in
  75     match Str.split space line with
  76       ["commit";git1] ->
  77         loop false (-1) git1
  78     | "diff"::_ ->
  79         if num > max && not skipping
  80         then (res:=Git(git)::!res;loop true (num+1) git)
  81         else loop skipping (if num = (-1) then 1 else num+1) git
  82     | _ ->
  83         if num > max && not skipping
  84         then (res:=Git(git)::!res;loop true (num+1) git)
  85         else loop skipping (if num = (-1) then num else num+1) git in
  86   loop false (-1) ""
  87
  88 let dot = Str.regexp "\\."
  89
  90 let open_git file =
  91   let tmp = prefix^file in
  92   if Sys.file_exists tmp
  93   then open_in tmp
  94   else
  95     match List.rev (Str.split dot file) with
  96       last::rest ->
  97         let last_int = int_of_string last in
  98         if last_int = 0
  99         then
 100           failwith
 101             "can't go back one version from 0; make the log file by hand";
 102         let prev =
 103           String.concat "." (List.rev ((string_of_int (last_int-1))::rest)) in
 104         let _ =
 105           Sys.command
 106             (Printf.sprintf "git log -p v%s..v%s > %s" prev file tmp) in
 107         open_in tmp
 108     | _ -> open_in file
 109
 110 let rec split_args = function
 111     [] -> []
 112   | "-grouped"::rest   -> grouped := true; split_args rest
 113   | "-maxlen"::len::rest -> maxlen := Some (int_of_string len); split_args rest
 114   | "-"::pattern::rest -> (Minus,Str.regexp pattern) :: split_args rest
 115   | "+"::pattern::rest -> (Plus,Str.regexp pattern) :: split_args rest
 116   | "@"::pattern::rest -> (Context,Str.regexp pattern) :: split_args rest
 117   | "C"::pattern::rest -> (ChangeLog,Str.regexp pattern) :: split_args rest
 118   | _ -> failwith "bad argument list"
 119
 120 let process_one (dir,pattern) version =
 121   res := [];
 122   let i = open_git version in
 123   try
 124     if !grouped && (dir = Minus or dir = Plus)
 125     then scan_grouped dir pattern i
 126     else scan dir pattern i
 127   with End_of_file -> (close_in i; List.rev !res)
 128
 129 let process_len max version =
 130   res := [];
 131   let i = open_git version in
 132   try scan_line max i
 133   with End_of_file -> (close_in i; List.rev !res)
 134
 135 let inter l1 l2 =
 136   List.rev
 137     (List.fold_left
 138        (function prev ->
 139          function
 140              (Git(git)) as x ->
 141                let rec loop = function
 142                    [] -> prev
 143                  | Git(git1)::rest when git = git1 -> x::prev
 144                  | Block(b1,git1)::rest when git = git1 -> Block(b1,git1)::prev
 145                  | _::rest -> loop rest in
 146                loop l2
 147            | (Block(block,git)) as x ->
 148                let rec loop = function
 149                    [] -> prev
 150                  | Git(git1)::rest when git = git1 -> x::prev
 151                  | Block(b1,git1)::rest when block = b1 && git = git1 ->
 152                      Block(b1,git1)::prev
 153                  | _::rest -> loop rest in
 154                loop l2)
 155        [] l1)
 156
 157 let _ =
 158   if Array.length Sys.argv < 4
 159   then failwith "arguments: -/+/@/C pattern -/+/@/C pattern ... version";
 160   let args = List.tl(Array.to_list Sys.argv) in
 161   let version = List.hd(List.rev args) in
 162   let pairs = List.rev(List.tl(List.rev args)) in
 163   let requirements = split_args pairs in
 164   let res =
 165     List.map (function Git x -> x | Block (_,x) -> x)
 166       (List.fold_left
 167          (function all ->
 168            function pattern ->
 169              inter (process_one pattern version) all)
 170          (process_one (List.hd requirements) version)
 171          (List.tl requirements)) in
 172   let res =
 173     if !grouped
 174     then
 175       List.rev
 176         (List.fold_left
 177            (function prev ->
 178              function x -> if List.mem x prev then prev else x::prev)
 179            [] res)
 180     else res in
 181   let res =
 182     match !maxlen with
 183       None -> res
 184     | Some max ->
 185         let badgits = process_len max version in
 186         List.filter (function x -> not(List.mem (Git(x)) badgits)) res in
 187   List.iter (function name -> Printf.printf "%s\n" name) res