File: splitpatch.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 (841 lines) | stat: -rw-r--r-- 26,915 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
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
(*
 * This file is part of Coccinelle, lincensed 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
 *)

(* split patch per file *)

(* ------------------------------------------------------------------------ *)
(* The following are a reminder of what this information should look like.
These values are not used.  See the README file for information on how to
create a .splitpatch file in your home directory. *)

let from = ref "email@xyz.org"
let git_tree = ref "/var/linuxes/linux-next"
let git_options = ref "--cc=kernel-janitors@vger.kernel.org --suppress-cc=self"
let not_linux = ref "--suppress-cc=self"
let prefix_before = ref (Some "/var/linuxes/linux-next")
let prefix_after = ref (Some "/var/julia/linuxcopy")

(* ------------------------------------------------------------------------ *)
(* misc *)

let process_output_to_list2 = fun command ->
  let chan = Unix.open_process_in command in
  let res = ref ([] : string list) in
  let rec process_otl_aux () =
    let e = input_line chan in
    res := e::!res;
    process_otl_aux() in
  try process_otl_aux ()
  with End_of_file ->
    let stat = Unix.close_process_in chan in (List.rev !res,stat)
let cmd_to_list command = let (l,_) = process_output_to_list2 command in l
let process_output_to_list = cmd_to_list
let cmd_to_list_and_status = process_output_to_list2

let safe_chop_extension s = try Filename.chop_extension s with _ -> s

let safe_get_extension s =
  match List.rev (Str.split (Str.regexp_string ".") s) with
    [_] -> None
  | ext::_ -> Some ext
  | _ -> None

let intersect l1 l2 =
  List.rev
    (List.fold_left (fun i cur -> if List.mem cur l2 then cur :: i else i)
       [] l1)

let union l1 l2 =
  List.rev
    (List.fold_left
       (fun i cur -> if not(List.mem cur l2) then cur :: i else i)
       l2 l1)

(* ------------------------------------------------------------------------ *)
(* set configuration variables *)

let from_from_template prefile template =
  let template =
    if Sys.file_exists template
    then template
    else prefile in
  let signed_offs =
    cmd_to_list (Printf.sprintf "grep Signed-off-by: %s" template) in
  match signed_offs with
    x::xs -> String.concat " " (List.tl(Str.split (Str.regexp "[ \t]+") x))
  | _ -> failwith "No Signed-off-by in template file"

let from_from_gitconfig path =
  let config = path^"/.git/config" in
  if Sys.file_exists config
  then
    let i = open_in config in
    let rec inner_loop _ =
      let l = input_line i in
      match Str.split (Str.regexp "[ \t]+") l with
	"from"::"="::f -> from := String.concat " " f
      |	_ ->
	  if String.length l >= 1 && String.get l 0 = '['
	  then ()
	  else inner_loop() in
    let rec outer_loop _ =
      let l = input_line i in
      if l = "[sendemail]"
      then inner_loop()
      else outer_loop() in
    (try outer_loop() with Not_found -> ());
    close_in i

let read_configs prefile template =
  let temporary_git_tree = ref None in
  git_options := "";
  prefix_before := None;
  prefix_after := None;
  (* get information in message template, lowest priority *)
  from := from_from_template prefile template;
  (* get information in git config *)
  let rec loop = function
      "/" -> ()
    | path ->
	if Sys.file_exists ".git"
	then
	  begin temporary_git_tree := Some path; from_from_gitconfig path end
	else loop (Filename.dirname path) in
  loop (Sys.getcwd());
  (* get information from .splitpatch *)
  let home = List.hd(cmd_to_list "ls -d ~") in
  let config = home^"/.splitpatch" in
  (if Sys.file_exists config
  then
    let i = open_in config in
    let rec loop _ =
      let l = input_line i in
      (* bounded split doesn't split at = in value part *)
      (match Str.bounded_split (Str.regexp "[ \t]*=[ \t]*") l 2 with
	["from";s] -> from := s
      | ["git_tree";s] -> temporary_git_tree := Some s
      | ["git_options";s] -> git_options := s; not_linux := s
      | ["prefix_before";s] -> prefix_before := Some s
      | ["prefix_after";s] -> prefix_after := Some s
      | _ -> Printf.fprintf stderr "unknown line: %s\n" l);
      loop() in
    try loop() with End_of_file -> close_in i);
  match !temporary_git_tree with
    None -> failwith "Unable to find Linux source tree"
  | Some g -> git_tree := g

(* ------------------------------------------------------------------------ *)

let maintainer_command file =
  Printf.sprintf
    "cd %s; scripts/get_maintainer.pl --nokeywords --separator , --nogit --nogit-fallback --norolestats -f %s"
    !git_tree file

let maintainer_list_command file =
  Printf.sprintf
    "cd %s; scripts/get_maintainer.pl --nokeywords --nogit --nogit-fallback --norolestats --nom -f %s"
    !git_tree file

let subsystem_command file =
  Printf.sprintf
    "cd %s; scripts/get_maintainer.pl --nokeywords --nogit-fallback --subsystem --norolestats -f %s | grep -v @"
    !git_tree file

let subject_command file =
  Printf.sprintf "cd %s; git log --pretty=oneline --abbrev-commit %s"
    !git_tree file

let affected_files sha =
  Printf.sprintf "cd %s; git show --oneline --name-only %s"
    !git_tree sha

let checkpatch_command file =
  Printf.sprintf "cd %s; scripts/checkpatch.pl %s" !git_tree file

let default_string = "THE REST" (* split by file *)

(* ------------------------------------------------------------------------ *)
(* ------------------------------------------------------------------------ *)
(* Template file processing *)

let read_up_to_dashes i =
  let lines = ref [] in
  let rec loop _ =
    let l = input_line i in
    if l = "---"
    then ()
    else begin lines := l :: !lines; loop() end in
  (try loop() with End_of_file -> ());
  let lines =
    match !lines with
      ""::lines -> List.rev lines (* drop last line if blank *)
    | lines -> List.rev lines in
  match lines with
    ""::lines -> lines (* drop first line if blank *)
  | _ -> lines

let get_template_information prefile file =
  if Sys.file_exists file
  then
    let i = open_in file in
    (* subject *)
    let subject = read_up_to_dashes i in
    match subject with
      [subject] ->
	let cover = read_up_to_dashes i in
	let message = read_up_to_dashes i in
	let nonmessage = read_up_to_dashes i in
	if message = []
	then (subject,None,cover,[])
	else (subject,Some cover,message,nonmessage)
    | _ ->
	failwith
	  ("Subject must be exactly one line "^
	   (string_of_int (List.length subject)))
  else
    let i = open_in prefile in
    let rec loop _ =
      let l = input_line i in
      if Str.string_match (Str.regexp "Subject:.*[]] ") l 0
      then l
      else loop() in
    let l = loop() in
    let subject_len = String.length (Str.matched_string l) in
    let subject = String.sub l subject_len (String.length l - subject_len) in
    let message = read_up_to_dashes i in
    (* use provided message as the message in each patch and as the
       cover letter *)
    (subject,Some message,message,[])

(* ------------------------------------------------------------------------ *)
(* ------------------------------------------------------------------------ *)
(* Info processing *)

let get_info info_file =
  let tbl = Hashtbl.create 101 in
  (if Sys.file_exists info_file
  then
    let lines = cmd_to_list (Printf.sprintf "grep ^## %s" info_file) in
    List.iter
      (function line ->
	if Str.string_match (Str.regexp "## *") line 0
	then
	  let line =
	    let match_end = Str.match_end () in
	    String.sub line match_end
	      (String.length line - match_end) in
	  try
	    let line =
	      match !prefix_before with
		None -> line
	      | Some pb ->
		  let pb = pb^"/" in
		  String.concat "" (Str.split (Str.regexp pb) line) in
	    let end_of_file =
	      Str.search_forward (Str.regexp " *: *") line 0 in
	    let match_end = Str.match_end () in
	    let file = String.sub line 0 end_of_file in
	    let info =
	      String.sub line match_end (String.length line - match_end) in
	    let cell =
	      try Hashtbl.find tbl file
	      with Not_found ->
		let cell = ref [] in
		Hashtbl.add tbl file cell;
		cell in
	    cell := info :: !cell
	  with Not_found ->
	    Printf.fprintf stderr "no file found in %s\n" line)
      lines);
  tbl

(* ------------------------------------------------------------------------ *)
(* ------------------------------------------------------------------------ *)
(* Patch processing *)

let spaces = Str.regexp "[ \t]+"

let fix_before_after l prefix = function
    Some old_prefix ->
      (match Str.split spaces l with
	("diff"|"+++"|"---")::_ ->
	  (match Str.split (Str.regexp old_prefix) l with
	    [a;b] ->
	      (match Str.split_delim (Str.regexp ("[ \t]"^prefix)) a with
		[_;""] -> a^b (* prefix is already there *)
	      |	_ -> a^prefix^b)
	  | _ -> l)
      |	_ -> l)
  | _ -> l

let fix_date l =
  match Str.split spaces l with
    (("+++"|"---") as a)::path::rest -> Printf.sprintf "%s %s" a path
  | _ -> l

(* ------------------------------------------------------------------------ *)

let get_file diff_line =
  match Str.split (Str.regexp " a/") diff_line with
    [before;after] ->
      (match Str.split spaces after with
        file::_ -> file
      | _ -> failwith "no file?")
  | _ -> failwith "no file?"

let is_diff = Str.regexp "diff "
let split_patch i =
  let patches = ref [] in
  let cur = ref [] in
  let file = ref "" in
  let get_size l =
    match Str.split_delim (Str.regexp ",") l with
      [_;size] -> int_of_string size
    | [_] -> 1
    | _ -> failwith ("bad size: "^l) in
  let rec read_diff_or_atat _ =
    let l = input_line i in
    let l = fix_date(fix_before_after l "a" !prefix_before) in
    let l = fix_date(fix_before_after l "b" !prefix_after) in
    match Str.split spaces l with
      "diff"::_ ->
	(if List.length !cur > 0
	then patches := (!file,List.rev !cur) :: !patches);
	cur := [l];
	file := get_file l;
	read_diff()
    | "@@"::min::pl::"@@"::rest ->
	let msize = get_size min in
	let psize = get_size pl in
	cur := l :: !cur;
	read_hunk msize psize
    | "\\"::_ -> cur := l :: !cur; read_diff_or_atat()
    | _ -> read_diff_or_atat()
	(*
	failwith
	  "expected diff or @@ (diffstat information should not be present)" *)
  and read_diff _ =
    let l = input_line i in
    let l = fix_date(fix_before_after l "a" !prefix_before) in
    let l = fix_date(fix_before_after l "b" !prefix_after) in
    cur := l :: !cur;
    match Str.split spaces l with
      "+++"::_ -> read_diff_or_atat()
    | _ -> read_diff()
  and read_hunk msize psize =
    if msize = 0 && psize = 0
    then read_diff_or_atat()
    else
      let l = input_line i in
      cur := l :: !cur;
      match String.get l 0 with
	'-' -> read_hunk (msize - 1) psize
      |	'+' -> read_hunk msize (psize - 1)
      |	_ -> read_hunk (msize - 1) (psize - 1) in
  try read_diff_or_atat()
  with End_of_file -> List.rev ((!file,(List.rev !cur))::!patches)

(* ------------------------------------------------------------------------ *)

let uctr = ref 0

let found_a_maintainer = ref false

let common_prefix l1 l2 =
  let rec loop = function
      ([],_) | (_,[]) -> []
    | (x::xs,y::ys) when x = y -> x :: (loop (xs,ys))
    | _ -> [] in
  match loop (l1,l2) with
    [] -> None
  | res -> Some (String.concat "/" res)

let find_common_path file cell =
  let fs = Str.split (Str.regexp "/") file in
  let rec loop = function
      [] ->
	let c1 = ref [] in
	cell := ((ref file),c1)::!cell;
	c1
    | (f,c1)::xs ->
	(match common_prefix fs (Str.split (Str.regexp "/") !f) with
	  None -> loop xs
	| Some cp -> f := cp; c1) in
  loop !cell

let resolve_maintainers patches =
  let maintainer_table = Hashtbl.create (List.length patches) in
  List.iter
    (function (file,rest) ->
      let maintainers =
	match (cmd_to_list (maintainer_command file)) with
	  m::_ -> found_a_maintainer := true; m
	| [] -> (* maybe the file is new? *)
	    (match cmd_to_list (maintainer_command (Filename.dirname file))
	    with
	      m::_ -> found_a_maintainer := true; m
	    | [] ->
		uctr := !uctr + 1;
		"unknown"^(string_of_int !uctr)) in
      let subsystems =
	cmd_to_list (subsystem_command file) in
      let info = (subsystems,maintainers) in
      let cell =
	try Hashtbl.find maintainer_table info
	with Not_found ->
	  let cell = ref [] in
	  Hashtbl.add maintainer_table info cell;
	  cell in
      let cell1 = find_common_path file cell in
      cell1 := (file,rest) :: !cell1)
    patches;
  maintainer_table

(* ------------------------------------------------------------------------ *)
(* most common subject from the git logs *)

let last_char s = String.get s ((String.length s) - 1)

let get_counts l =
(*Printf.printf "getting counts for:\n";
  List.iter
    (function (bonus,x) ->
      Printf.printf "  %d: %s\n" bonus (String.concat " " x))
    l;
  Printf.printf "\n"; *)
  let tbl = Hashtbl.create 101 in
  let ct = ref 0 in
  let max = ((List.length l) / 10) + 1 in (* 10 ranges *)
  List.iter
    (function file ->
      ct := !ct + 1;
      let cell =
	try Hashtbl.find tbl file
	with Not_found ->
	  let cell = ref 0.0 in
	  Hashtbl.add tbl file cell;
	  cell in
      (* only use 5 ranges *)
      let weight = 1. /. (float_of_int ((!ct / (max * 2)) + 1)) in
      cell := !cell +. weight)
    l;
  let weighted =
    List.rev
      (List.sort compare
	 (Hashtbl.fold (fun k v rest -> (!v,k)::rest) tbl [])) in
(*List.iter
    (function (wt,(bonus,x)) ->
      Printf.printf "  %f: %d: %s\n" wt bonus (String.concat " " x))
    weighted; *)
  let rec loop n = function
      [] -> []
    | (_,k)::rest -> (k,n) :: (loop (n+1) rest) in
  loop 1 weighted

let superset l1 l2 = List.for_all (function x -> List.mem x l1) l2

let get_most_common_subject files default =
  let all =
    List.map (function file -> cmd_to_list (subject_command file)) files in
  let entries =
    List.map
      (function entries ->
	List.rev
	  (List.fold_left
	     (fun prev line ->
	       match Str.split (Str.regexp " +") line with
		 [] -> failwith ("bad git log line: " ^ line)
	       | commit::rest ->
		   let rec loop = function
		       [] -> []
		     | x::y::xs when last_char x = ']' && last_char y = ':' ->
			 (x^" "^y) :: loop xs
		     | x::xs ->
			 if last_char x = ':'
			 then x :: loop xs
			 else [] in
		   let tags = loop rest in
		  (* ignore lines with no : *)
		   match tags with
		     [] -> prev
		   | _ ->
		       let aff_files =
			 List.tl (cmd_to_list (affected_files commit)) in
		       let bonus = (* 0 is better *)
			 if superset files aff_files then 0 else 1 in
		       (bonus,tags)::prev)
	     [] entries))
      all in
  (* Does there exist a file for which we have no information? *)
  if List.exists (function x -> x = []) all
  then default^":"
  else
    let common_entries =
      List.fold_left intersect (List.hd entries) (List.tl entries) in
    let entries = List.map get_counts entries in
    let common_entry_counts =
      List.sort compare
	(List.map
	   (function (bonus,entry) as allentry ->
	     (bonus,
	      (List.fold_left (+) 0
		 (List.map (List.assoc allentry) entries),
	       entry)))
	   common_entries) in
(*  Printf.printf "Files:\n";
    List.iter (function f -> Printf.printf "  %s\n" f) files;
    Printf.printf "Subjects:\n";
    List.iter
      (function (ct,(bonus,f)) ->
	Printf.printf "  %d: %d: %s\n" ct bonus (String.concat " " f))
      common_entry_counts;
    Printf.printf "\n"; *)
    match common_entry_counts with
      [] -> default^":"
    | (_,(_,x))::_ -> String.concat " " x

(* ------------------------------------------------------------------------ *)

let print_all o l =
  List.iter (function x -> Printf.fprintf o "%s\n" x) l

let make_mail_header o date maintainers ctr number cover subject =
  Printf.fprintf o "From nobody %s\n" date;
  Printf.fprintf o "From: %s\n" !from;
  (match Str.split (Str.regexp_string ",") maintainers with
    [x] -> Printf.fprintf o "To: %s\n" x
  | x::xs ->
      Printf.fprintf o "To: %s\n" x;
      Printf.fprintf o "Cc: %s\n" (String.concat "," xs)
  | _ -> failwith "no maintainers");
  if number = 1 && not cover
  then Printf.fprintf o "Subject: [PATCH] %s\n\n" subject
  else
    if number >= 100
    then Printf.fprintf o "Subject: [PATCH %03d/%d] %s\n\n" ctr number subject
    else if number >= 10
    then Printf.fprintf o "Subject: [PATCH %02d/%d] %s\n\n" ctr number subject
    else Printf.fprintf o "Subject: [PATCH %d/%d] %s\n\n" ctr number subject

let print_info o info_tbl files =
  let do_one prefix file =
    try
      let lines = List.rev (!(Hashtbl.find info_tbl file)) in
      Printf.fprintf o "%s" prefix;
      List.iter (function line -> Printf.fprintf o "%s\n" line) lines;
      Printf.fprintf o "\n"
    with Not_found -> () in
  match files with
    [file] -> do_one "" file
  | l ->
      List.iter (function file -> do_one (Printf.sprintf "%s:\n" file) file) l

let cluster_by_dir diffs =
  let info =
    List.sort compare
      (List.map
	 (function (file,diff) ->
	   (Filename.dirname file, file, diff))
	 diffs) in
  let rec loop = function
      [] -> []
    | (dir,file,diffs)::rest ->
	match loop rest with
	  ((dira,filea,diffsa)::r)::rest ->
	    if dir = dira
	    then ((dir,file,diffs)::(dira,filea,diffsa)::r)::rest
	    else [(dir,file,diffs)]::((dira,filea,diffsa)::r)::rest
	| [] -> [[(dir,file,diffs)]]
	| []::_ -> failwith "not possible" in
  List.map (List.map (function (dir,file,diffs) -> (file,diffs)))
    (loop info)

let is_name s =
  List.length (Str.split (Str.regexp " ") s) > 1

let make_message_files subject cover message nonmessage date maintainer_tables
    patch front add_ext nomerge dirmerge merge info_tbl =
  let ctr = ref 0 in
  let elements =
    List.concat
      (List.map
	 (function maintainer_table ->
	     if merge || dirmerge
	     then
	       begin
		 let hist = Hashtbl.create 101 in
		 let hashadd name =
		   let cell =
		     try Hashtbl.find hist name
		     with Not_found ->
		       let cell = ref 0 in
		       Hashtbl.add hist name cell;
		       cell in
		   cell := !cell + 1 in
		 let maintainers =
		   Hashtbl.fold
		     (fun (services,maintainers) diffs rest ->
		       let maints = Str.split (Str.regexp ",") maintainers in
		       List.iter hashadd maints;
		       union maints rest)
		     maintainer_table [] in
		 let (_,common) =
		   Hashtbl.fold
		     (fun name ct (mx,mxnm) ->
		       if is_name name && !ct > mx
		       then (!ct,name)
		       else (mx,mxnm))
		     hist (0,"???") in
		 let (m1,others) =
		   List.partition (fun x -> x = common) maintainers in
		 let maintainers = m1 @ others in
		 let diffs =
		   Hashtbl.fold
		     (fun (services,maintainers) diffs rest ->
		       let diffs =
			 List.concat
			   (List.map (function (common,diffs) -> !diffs)
			      !diffs) in
		       diffs @ rest)
		     maintainer_table [] in
		 ctr := !ctr + 1;
		 let (files,diffs) = List.split (List.rev diffs) in
		 let subject = get_most_common_subject files "???" in
		 [(subject,
		   (!ctr,false,String.concat "," maintainers,files,diffs))]
	       end
	     else
	       Hashtbl.fold
		 (function (services,maintainers) ->
		   function diffs ->
		     function rest ->
		       if services=[default_string] || nomerge
		       then
	                 (* if no maintainer, then one file per diff *)
			 let diffs =
			   List.concat
			     (List.map (function (common,diffs) -> !diffs)
				!diffs) in
			 (List.map
			    (function (file,diff) ->
			      ctr := !ctr + 1;
			      let subject =
				get_most_common_subject [file] file in
			      (subject,(!ctr,true,maintainers,[file],[diff])))
			    (List.rev diffs)) @
			 rest
		       else
			 if dirmerge
			 then
			   let diffs =
			     List.concat
			       (List.map (function (common,diffs) -> !diffs)
				  !diffs) in
			   let diffs = cluster_by_dir diffs in
			   List.map
			     (function diffs ->
			       ctr := !ctr + 1;
			       let (files,diffs) =
				 List.split (List.rev diffs) in
			       let subject =
				 get_most_common_subject files "???" in
			       (subject,(!ctr,false,maintainers,files,diffs)))
			     diffs @
			   rest
			 else
			   (List.map
			      (function (common,diffs) ->
				ctr := !ctr + 1;
				let (files,diffs) =
				  List.split (List.rev !diffs) in
				let subject =
				  get_most_common_subject files !common in
				(subject,(!ctr,false,maintainers,files,diffs)))
			      !diffs) @
			   rest)
		 maintainer_table [])
	 maintainer_tables) in
  let number = List.length elements in
  let elements =
    List.sort
      (fun (_,(ctr1,_,_,_,_)) (_,(ctr2,_,_,_,_)) -> compare ctr1 ctr2)
      elements in
  let generated =
    List.map
      (function (common,(ctr,the_rest,maintainers,files,diffs)) ->
	let output_file = add_ext(Printf.sprintf "%s%d" front ctr) in
	let o = open_out output_file in
	make_mail_header o date maintainers ctr number (not (cover=None))
	  (Printf.sprintf "%s %s" common subject);
	print_info o info_tbl files;
	print_all o message;
	Printf.fprintf o "\n---\n";
	print_all o nonmessage;
	(if not (nonmessage = []) then Printf.fprintf o "\n");
	let (nm,o1) = Filename.open_temp_file "patch" "patch" in
	List.iter (print_all o1) (List.rev diffs);
	close_out o1;
	let diffstat =
	  cmd_to_list
	    (Printf.sprintf "diffstat -p1 < %s ; /bin/rm %s" nm nm) in
	List.iter (print_all o) [diffstat];
	Printf.fprintf o "\n";
	List.iter (print_all o) diffs;
	Printf.fprintf o "\n";
	close_out o;
	let (info,stat) =
	  cmd_to_list_and_status
	    (checkpatch_command ((Sys.getcwd())^"/"^output_file)) in
	(if not(stat = Unix.WEXITED 0)
	then (print_all stderr info; Printf.fprintf stderr "\n"));
	output_file)
      elements in
  let later = add_ext(Printf.sprintf "%s%d" front (number+1)) in
  if Sys.file_exists later
  then Printf.fprintf stderr "Warning: %s and other files may be left over from a previous run\n" later;
  generated

let make_cover_file n file subject cover front date maintainer_tables =
  match cover with
    None -> ()
  | Some cover ->
      let common_maintainers =
	let start = ref true in
	List.fold_left
	  (fun prev maintainer_table ->
	    Hashtbl.fold
	      (function (services,maintainers) ->
		function diffs ->
		  function rest ->
		    let cur = Str.split (Str.regexp_string ",") maintainers in
		    if !start
		    then begin start := false; cur end
		    else intersect cur rest)
	      maintainer_table prev)
	  [] maintainer_tables in
      let maintainers_and_lists =
	List.fold_left
	  (fun prev maintainer_table ->
	    Hashtbl.fold
	      (function (services,maintainers) ->
		function diffs ->
		  function rest ->
		    let files = List.map (function (file,_) -> !file) !diffs in
		    List.fold_left
		      (function prev ->
			function file ->
			  union (cmd_to_list (maintainer_list_command file))
			    prev)
		      rest files)
	      maintainer_table prev)
	  common_maintainers maintainer_tables in
      let maintainers_and_lists = String.concat "," maintainers_and_lists in
      let output_file = Printf.sprintf "%s.cover" front in
      let o = open_out output_file in
      make_mail_header o date maintainers_and_lists 0 n true subject;
      print_all o cover;
      Printf.fprintf o "\n---\n\n";
      let l = cmd_to_list (Printf.sprintf "diffstat -p1 < %s" file) in
      let adjust_after =
	match !prefix_after with
	  None -> l
	| Some pa ->
	    let pa = (String.concat "/" (Str.split (Str.regexp "/") pa))^"/" in
	    List.map
	      (function l -> String.concat "" (Str.split (Str.regexp pa) l))
	      l in
      List.iter
	(function line -> Printf.fprintf o "%s\n" line)
	adjust_after;
      close_out o;
      ()

let mail_sender = "cocci-send-email.perl"
let mail_sender = "git send-email" (* use this when it works *)

let generate_command front cover generated =
  let output_file = front^".cmd" in
  let o = open_out output_file in
  (match cover with
    None ->
      Printf.fprintf o
	"%s --to-cmd=true --no-thread --from=\"%s\" %s $* %s\n"
	mail_sender !from !git_options
	(String.concat " " generated)
  | Some cover ->
      Printf.fprintf o
	"%s --to-cmd=true --thread --from=\"%s\" %s $* %s\n"
	mail_sender !from !git_options
	(String.concat " " ((front^".cover") :: generated)));
  close_out o

let make_output_files subject cover message nonmessage
    maintainer_tables patch nomerge dirmerge merge info_tbl =
  let date = List.hd (cmd_to_list "date") in
  let front = safe_chop_extension patch in
  let add_ext =
    match safe_get_extension patch with
      Some ext -> (function s -> s ^ "." ^ ext)
    | None -> (function s -> s) in
  let generated =
    make_message_files subject cover message nonmessage date maintainer_tables
      patch front add_ext nomerge dirmerge merge info_tbl in
  make_cover_file (List.length generated) patch subject cover front date
    maintainer_tables;
  generate_command front cover generated

(* ------------------------------------------------------------------------ *)

let nomerge = ref false
let dirmerge = ref false
let merge = ref false

let parse_args l =
  let (other_args,files) =
    List.partition (function a -> String.length a > 1 && String.get a 0 = '-')
      l in
  let (nomergep,other_args) =
    List.partition (function a -> List.mem a ["--nomerge";"-nomerge"])
      other_args in
  (if not(nomergep = []) then nomerge := true);
  let (dirmergep,other_args) =
    List.partition (function a -> List.mem a ["--dirmerge";"-dirmerge"])
      other_args in
  (* lazy solution: one directory up from the file level *)
  (if not(dirmergep = []) then dirmerge := true);
  let (mergep,other_args) =
    List.partition (function a -> List.mem a ["--merge";"-merge"])
      other_args in
  (* lazy solution: one directory up from the file level *)
  (if not(mergep = []) then merge := true);
  match files with
    [file] -> (file,String.concat " " other_args)
  | _ -> failwith "Only one file allowed"

let _ =
  let (file,git_args) = parse_args (List.tl (Array.to_list Sys.argv)) in
  let message_file = (safe_chop_extension file)^".msg" in
  let info_file = (safe_chop_extension file)^".info" in
  (* set up environment *)
  read_configs file message_file;
  (* get message information *)
  let (subject,cover,message,nonmessage) =
    get_template_information file message_file in
  (* get file-specific information, if any *)
  let info_tbl = get_info info_file in
  (* split patch *)
  let i = open_in file in
  let patches = split_patch i in
  let patches =
    if !dirmerge
    then cluster_by_dir patches
    else [patches] in
  close_in i;
  let maintainer_tables = List.map resolve_maintainers patches in
  (if !found_a_maintainer = false then git_options := !not_linux);
  (if not (git_args = "") then git_options := !git_options^" "^git_args);
  make_output_files subject cover message nonmessage
    maintainer_tables file !nomerge !dirmerge !merge info_tbl