File: gitgrep.ml

package info (click to toggle)
coccinelle 1.0.8.deb-5
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 26,148 kB
  • sloc: ml: 136,392; ansic: 23,594; sh: 2,189; makefile: 2,157; perl: 1,576; lisp: 840; python: 823; awk: 70; csh: 12
file content (268 lines) | stat: -rw-r--r-- 7,419 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
(*
 * This file is part of Coccinelle, licensed under the terms of the GPL v2.
 * See copyright.txt in the Coccinelle source code for more information.
 * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr
 *)

(* adjust as convenient *)
let prefix = "/tmp/"
let prefix = ""

(* The -grouped option means that all - and + code must appear in a
single contiguous block of - + code.  This option has no effect on the
other kinds of patterns, ie Changelog (C) or Context (@) *)

(* example: gitgrep -grouped -maxlen 25 - "[A-Z][A-Z]+" + "[A-Z][A-Z]+"
usb_21_22
maxlen is per file, regardless of whether the pattern is found in that file.
 *)

(* Patterns can't use ^ and $ *)

type dir = Minus | Plus | Context | ChangeLog
type orientation = Pos | Neg

type res = Git of string | Block of int * string

let grouped = ref false
let maxlen = ref None

let space = Str.regexp " "

let matches pattern line =
  try let _ = Str.search_forward pattern line 0 in true
  with Not_found -> false

let match_one start dir cl pattern line =
  if ((start = '-' && dir = Minus) ||
      (start = '+' && dir = Plus) ||
      (cl && dir = ChangeLog) ||
      (not (start = '-') && not (start = '+') && dir = Context))
  then matches pattern line
  else false

let res = ref []

let changed = ref 0
let badgits = ref []
let add x = function (y::_) as a -> if x = y then a else x::a | _ -> [x]
let too_many_changed = function Some n -> !changed > n | None -> false

let scan allpatterns i maxlen =
  let allpospatterns =
    List.filter (function (_,Pos,_) -> true | _ -> false) allpatterns in
  let allnegpatterns =
    List.filter (function (_,Neg,_) -> true | _ -> false) allpatterns in
  let git = ref "" in
  let pospatterns = ref allpospatterns in
  let negpatterns = ref allnegpatterns in
  let clear_patterns _ = pospatterns := []; negpatterns := [] in
  let ender isalldone =
    (if too_many_changed maxlen
    then badgits := add !git !badgits
    else
      if isalldone
      then
	  if !pospatterns = [] && !negpatterns = allnegpatterns
	  then res := Git(!git)::!res);
    if isalldone
    then
      (pospatterns := allpospatterns;
       negpatterns := allnegpatterns) in
  let rec loop cl =
    let line = input_line i in
    match Str.split space line with
      ["commit";newgit] ->
	ender true;
	changed := 0;
	git := newgit;
	loop true
    | "diff"::_ ->
	ender false;
	changed := 0;
	loop false
    | _ ->
	if String.length line = 0
	then loop cl
	else
	  begin
	    let start = String.get line 0 in
	    (if start = '-' || start = '+' then changed := !changed + 1);
	    let fails =
	      List.exists
		(function (dir,ok,pattern) ->
		  match_one start dir cl pattern line)
		!negpatterns in
	    if fails
	    then
	      begin
		clear_patterns();
		loop cl
	      end
	    else
	      begin
		let remaining_patterns =
		  List.filter
		    (function (dir,ok,pattern) ->
		      not (* argument is true if match succeeds *)
			(match_one start dir cl pattern line))
		    !pospatterns in
		pospatterns := remaining_patterns;
		loop cl
	      end
	  end in
  try loop false
  with End_of_file -> ender true

(* for Minus and Plus directions only *)
let scan_grouped allpatterns i maxlen =
  let block = ref 0 in
  let git = ref "" in
  let patterns = ref allpatterns in
  let ender isdone =
    if too_many_changed maxlen
    then badgits := add !git !badgits
    else if isdone
    then
      begin
	(if !patterns = [] then res := Block(!block,!git)::!res);
	patterns := []
      end in
  (* mp = true in minus-plus region *)
  let rec loop mp =
    let line = input_line i in
    match Str.split space line with
      ["commit";newgit] ->
	ender true;
	patterns := allpatterns;
	changed := 0;
	block := 0;
	git := newgit;
	loop false
    | "diff"::_ ->
	ender false;
	changed := 0;
	loop false
    | _ ->
	if String.length line > 0
	then
	    let first_char = String.get line 0 in
	    (if first_char = '-' || first_char = '+'
	    then changed := !changed + 1);
	    let new_mp =
	      match first_char with
		'-' | '+' ->
		  if not mp
		  then
		    begin
		      ender true;
		      block := !block + 1;
		      true
		    end
		  else true
	      |	_ -> false in
	    let remaining_patterns =
	      List.filter
		(function (dir,ok,pattern) ->
		  not (* argument is true if the pattern matches *)
		    (match (first_char,dir) with
		      ('-',Minus) | ('+',Plus) -> matches pattern line
		    | _ -> false))
		!patterns in
	    patterns := remaining_patterns;
	    loop new_mp
	else loop mp in
  try loop false
  with End_of_file -> ender true

let dot = Str.regexp "\\."

let open_git file =
  let tmp = prefix^file in
  if Sys.file_exists tmp
  then open_in tmp
  else
    match List.rev (Str.split dot file) with
      last::rest ->
	let last_int = int_of_string last in
	if last_int = 0
	then
	  failwith
	    "can't go back one version from 0; make the log file by hand";
	let prev =
	  String.concat "." (List.rev ((string_of_int (last_int-1))::rest)) in
	let _ =
	  Sys.command
	    (Printf.sprintf "git log -p v%s..v%s > %s" prev file tmp) in
	open_in tmp
    | _ -> open_in file

let version = ref None

let isword s =
  Str.string_match (Str.regexp "^[[a-zA-Z][][a-zA-Z0-9_*+-]*$") s 0

let make_pattern s =
  if isword s
  then (Printf.eprintf "word\n"; Str.regexp (Printf.sprintf "\\b%s\\b" s))
  else (Printf.eprintf "not word\n"; Str.regexp s)

let rec split_args = function
    [] -> []
  | "-grouped"::rest   -> grouped := true; split_args rest
  | "-maxlen"::len::rest -> maxlen := Some (int_of_string len); split_args rest
  | "-version"::v::rest -> version := Some v; split_args rest
  | key::pattern::rest ->
      let pattern = make_pattern pattern in
      let rest = split_args rest in
      (match key with
	"-" -> (Minus,Pos,pattern) :: rest
      | "+" -> (Plus,Pos,pattern) :: rest
      | "@" -> (Context,Pos,pattern) :: rest
      | "C" -> (ChangeLog,Pos,pattern) :: rest
      | "no-" -> (Minus,Neg,pattern) :: rest
      | "no+" -> (Plus,Neg,pattern) :: rest
      | "no@" -> (Context,Neg,pattern) :: rest
      | "noC" -> (ChangeLog,Neg,pattern) :: rest
      | _ -> failwith "bad argument list")
  | _ -> failwith "bad argument list"

let process patterns version maxlen =
  res := [];
  let i =
    match version with Some version -> open_git version | None -> stdin in
  (if !grouped
  then scan_grouped patterns i maxlen
  else scan patterns i maxlen);
  ((match version with Some _ -> close_in i | None -> ()); List.rev !res)

let _ =
  if Array.length Sys.argv < 3
  then failwith "arguments: -/+/@/C pattern -/+/@/C pattern ... version";
  let args = List.tl(Array.to_list Sys.argv) in
  let requirements = split_args args in
  let version = !version in
  (if !grouped
  then
    if List.exists
	(function
	    (_,Neg,_) -> true
	  | (dir,_,_) -> not (dir = Minus || dir = Plus))
	requirements
    then
      failwith
	"only minus and plus requirements, and no negated requirements, allowed in the grouped case");
  let res =
    List.map (function Git x -> x | Block (_,x) -> x)
      (process requirements version !maxlen) in
  let res =
    if !grouped
    then
      List.rev
	(List.fold_left
	   (function prev ->
	     function x -> if List.mem x prev then prev else x::prev)
	   [] res)
    else res in
  let res = List.filter (function x -> not(List.mem x !badgits)) res in
  List.iter (function name -> Printf.printf "%s\n" name) res