Release coccinelle-0.2.4
[bpt/coccinelle.git] / tools / gitgrep.ml
CommitLineData
9bc82bae
C
1(*
2 * Copyright 2010, INRIA, University of Copenhagen
3 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
4 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
5 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
6 * This file is part of Coccinelle.
7 *
8 * Coccinelle is free software: you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation, according to version 2 of the License.
11 *
12 * Coccinelle is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
19 *
20 * The authors reserve the right to distribute this or future versions of
21 * Coccinelle under other licenses.
22 *)
23
24
c491d8ee
C
25(*
26 * Copyright 2010, INRIA, University of Copenhagen
27 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
28 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
29 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
30 * This file is part of Coccinelle.
31 *
32 * Coccinelle is free software: you can redistribute it and/or modify
33 * it under the terms of the GNU General Public License as published by
34 * the Free Software Foundation, according to version 2 of the License.
35 *
36 * Coccinelle is distributed in the hope that it will be useful,
37 * but WITHOUT ANY WARRANTY; without even the implied warranty of
38 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
39 * GNU General Public License for more details.
40 *
41 * You should have received a copy of the GNU General Public License
42 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
43 *
44 * The authors reserve the right to distribute this or future versions of
45 * Coccinelle under other licenses.
46 *)
47
48
34e49164
C
49(* adjust as convenient *)
50let prefix = "/tmp/"
51let prefix = ""
52
53(* The -grouped option means that all - and + code must appear in a
54single contiguous block of - + code. This option has no effect on the
55other kinds of patterns, ie Changelog (C) or Context (@) *)
56
57(* example: gitgrep -grouped -maxlen 25 - "[A-Z][A-Z]+" + "[A-Z][A-Z]+"
58usb_21_22 *)
59
60type dir = Minus | Plus | Context | ChangeLog
61
62type res = Git of string | Block of int * string
63
64let grouped = ref false
65let maxlen = ref None
66
67let space = Str.regexp " "
68
69let matches pattern line =
70 try let _ = Str.search_forward pattern line 0 in true
71 with Not_found -> false
72
73let res = ref []
74
75let scan dir pattern i =
76 let rec loop skipping cl git =
77 let line = input_line i in
78 match Str.split space line with
79 ["commit";git] -> loop false true git
80 | "diff"::_ -> loop skipping false git
81 | _ ->
82 if String.length line > 0 && not skipping &&
83 ((String.get line 0 = '-' && dir = Minus) or
84 (String.get line 0 = '+' && dir = Plus) or
85 (cl && dir = ChangeLog) or
86 (not (String.get line 0 = '-') && not (String.get line 0 = '+') &&
87 dir = Context)) &&
88 matches pattern line
89 then (res := Git(git)::!res; loop true cl git)
90 else loop skipping cl git in
91 loop false false ""
92
93(* for Minus and Plus directions only *)
94let scan_grouped dir pattern i =
95 let block = ref 0 in
96 (* mp = true in minus-plus region *)
97 let rec loop mp git =
98 let line = input_line i in
99 match Str.split space line with
100 ["commit";git] -> loop false git
101 | "diff"::_ -> loop false git
102 | _ ->
103 if String.length line > 0
104 then
105 let first_char = String.get line 0 in
106 let new_mp =
107 match first_char with
108 '-' | '+' -> (if not mp then block := !block + 1; true)
109 | _ -> false in
110 match (first_char,dir) with
111 ('-',Minus) | ('+',Plus) ->
112 let info = Block(!block,git) in
113 (if matches pattern line && not (List.mem info !res)
114 then res := info::!res);
115 loop new_mp git
116 | _ -> loop new_mp git
117 else loop mp git in
118 loop false ""
119
120let scan_line max i =
121 let rec loop skipping num git =
122 let line = input_line i in
123 match Str.split space line with
124 ["commit";git1] ->
125 loop false (-1) git1
126 | "diff"::_ ->
127 if num > max && not skipping
128 then (res:=Git(git)::!res;loop true (num+1) git)
129 else loop skipping (if num = (-1) then 1 else num+1) git
130 | _ ->
131 if num > max && not skipping
132 then (res:=Git(git)::!res;loop true (num+1) git)
133 else loop skipping (if num = (-1) then num else num+1) git in
134 loop false (-1) ""
135
136let dot = Str.regexp "\\."
137
138let open_git file =
139 let tmp = prefix^file in
140 if Sys.file_exists tmp
141 then open_in tmp
142 else
143 match List.rev (Str.split dot file) with
144 last::rest ->
145 let last_int = int_of_string last in
146 if last_int = 0
147 then
148 failwith
149 "can't go back one version from 0; make the log file by hand";
150 let prev =
151 String.concat "." (List.rev ((string_of_int (last_int-1))::rest)) in
152 let _ =
153 Sys.command
154 (Printf.sprintf "git log -p v%s..v%s > %s" prev file tmp) in
155 open_in tmp
156 | _ -> open_in file
157
158let rec split_args = function
159 [] -> []
160 | "-grouped"::rest -> grouped := true; split_args rest
161 | "-maxlen"::len::rest -> maxlen := Some (int_of_string len); split_args rest
162 | "-"::pattern::rest -> (Minus,Str.regexp pattern) :: split_args rest
163 | "+"::pattern::rest -> (Plus,Str.regexp pattern) :: split_args rest
164 | "@"::pattern::rest -> (Context,Str.regexp pattern) :: split_args rest
165 | "C"::pattern::rest -> (ChangeLog,Str.regexp pattern) :: split_args rest
166 | _ -> failwith "bad argument list"
167
168let process_one (dir,pattern) version =
169 res := [];
170 let i = open_git version in
171 try
172 if !grouped && (dir = Minus or dir = Plus)
173 then scan_grouped dir pattern i
174 else scan dir pattern i
175 with End_of_file -> (close_in i; List.rev !res)
176
177let process_len max version =
178 res := [];
179 let i = open_git version in
180 try scan_line max i
181 with End_of_file -> (close_in i; List.rev !res)
182
183let inter l1 l2 =
184 List.rev
185 (List.fold_left
186 (function prev ->
187 function
188 (Git(git)) as x ->
189 let rec loop = function
190 [] -> prev
191 | Git(git1)::rest when git = git1 -> x::prev
192 | Block(b1,git1)::rest when git = git1 -> Block(b1,git1)::prev
193 | _::rest -> loop rest in
194 loop l2
195 | (Block(block,git)) as x ->
196 let rec loop = function
197 [] -> prev
198 | Git(git1)::rest when git = git1 -> x::prev
199 | Block(b1,git1)::rest when block = b1 && git = git1 ->
200 Block(b1,git1)::prev
201 | _::rest -> loop rest in
202 loop l2)
203 [] l1)
204
205let _ =
206 if Array.length Sys.argv < 4
207 then failwith "arguments: -/+/@/C pattern -/+/@/C pattern ... version";
208 let args = List.tl(Array.to_list Sys.argv) in
209 let version = List.hd(List.rev args) in
210 let pairs = List.rev(List.tl(List.rev args)) in
211 let requirements = split_args pairs in
212 let res =
213 List.map (function Git x -> x | Block (_,x) -> x)
214 (List.fold_left
215 (function all ->
216 function pattern ->
217 inter (process_one pattern version) all)
218 (process_one (List.hd requirements) version)
219 (List.tl requirements)) in
220 let res =
221 if !grouped
222 then
223 List.rev
224 (List.fold_left
225 (function prev ->
226 function x -> if List.mem x prev then prev else x::prev)
227 [] res)
228 else res in
229 let res =
230 match !maxlen with
231 None -> res
232 | Some max ->
233 let badgits = process_len max version in
234 List.filter (function x -> not(List.mem (Git(x)) badgits)) res in
235 List.iter (function name -> Printf.printf "%s\n" name) res