X-Git-Url: https://git.xandkar.net/?p=dups.git;a=blobdiff_plain;f=dups.ml;h=28c266388e3bd0e31d932fcf9734dc3d0bb248ba;hp=8ff8874b7cf84ec76b965bda441e35cae1a4a22a;hb=5c0100d2862a04f55b18b702da4f617302b913f9;hpb=a9a56d74122233b99d8d6401b1f50009a993cd0a

diff --git a/dups.ml b/dups.ml
index 8ff8874..28c2663 100644
--- a/dups.ml
+++ b/dups.ml
@@ -2,7 +2,7 @@ open Printf
 
 module Array = ArrayLabels
 module List  = ListLabels
-module StrSet= Set.Make(String)
+module StrSet = Set.Make(String)
 module Unix  = UnixLabels
 
 module Stream : sig
@@ -89,12 +89,17 @@ module File : sig
 
   val lookup : string Stream.t -> t Stream.t
   (** Lookup file info for given paths *)
+
+  module Set : sig include Set.S with type elt := t end
 end = struct
   type t =
     { path : string
     ; size : int
     }
 
+  let compare {path=p1; _} {path=p2; _} =
+    Stdlib.compare p1 p2
+
   let lookup paths =
     Stream.map paths ~f:(fun path ->
       let {Unix.st_size = size; _} = Unix.lstat path in
@@ -132,6 +137,12 @@ end = struct
           next ()
     in
     Stream.create next
+
+  module Set = Set.Make(struct
+    type elt = t
+    type t = elt
+    let compare = compare
+  end)
 end
 
 type input =
@@ -142,11 +153,19 @@ type output =
   | Stdout
   | Directory of string
 
+type opt =
+  { input  : input
+  ; output : output
+  ; ignore : Str.regexp option
+  ; sample : int
+  }
+
 type count =
   { considered  : int ref
   ; empty       : int ref
   ; ignored     : int ref
   ; unique_size : int ref
+  ; unique_sample : int ref
   ; hashed      : int ref
   }
 
@@ -176,21 +195,42 @@ let make_input_stream input ignore count =
 
 let make_output_fun = function
   | Stdout ->
-      fun digest n_paths paths ->
-        printf "%s %d\n%!" (Digest.to_hex digest) n_paths;
-        List.iter (StrSet.elements paths) ~f:(printf "    %S\n%!")
+      fun digest n_files files ->
+        printf "%s %d\n%!" (Digest.to_hex digest) n_files;
+        List.iter (File.Set.elements files) ~f:(fun {File.path; _} ->
+          printf "    %S\n%!" path
+        )
   | Directory dir ->
-      fun digest _ paths ->
+      fun digest _ files ->
         let digest = Digest.to_hex digest in
         let dir = Filename.concat dir (String.sub digest 0 2) in
         Unix.mkdir dir ~perm:0o700;
         let oc = open_out (Filename.concat dir digest) in
-        List.iter (StrSet.elements paths) ~f:(fun path ->
+        List.iter (File.Set.elements files) ~f:(fun {File.path; _} ->
           output_string oc (sprintf "%S\n%!" path)
         );
         close_out oc
 
-let main input output ignore =
+let sample path ~len =
+  let buf = Bytes.make len ' ' in
+  let ic = open_in_bin path in
+  let rec read pos len =
+    assert (len >= 0);
+    if len = 0 then
+      ()
+    else begin
+      let chunk_size = input ic buf pos len in
+      if chunk_size = 0 then (* EOF *)
+        ()
+      else
+        read (pos + chunk_size) (len - chunk_size)
+    end
+  in
+  read 0 len;
+  close_in ic;
+  Bytes.to_string buf
+
+let main {input; output; ignore; sample = sample_len} =
   let t0 = Sys.time () in
   let count =
     { considered  = ref 0
@@ -198,69 +238,89 @@ let main input output ignore =
     ; ignored     = ref 0
     ; unique_size = ref 0
     ; hashed      = ref 0
+    ; unique_sample     = ref 0
     }
   in
   let output = make_output_fun  output in
   let input  = make_input_stream input ignore count in
-  let paths_by_size = Hashtbl.create 1_000_000 in
-  let paths_by_digest = Hashtbl.create 1_000_000 in
-  let process tbl path ~f =
-    let key = f path in
-    let count, paths =
-      match Hashtbl.find_opt tbl key with
+  let files_by_size = Hashtbl.create 1_000_000 in
+  let files_by_sample = Hashtbl.create 1_000_000 in
+  let files_by_digest = Hashtbl.create 1_000_000 in
+  let process tbl ~group ~file =
+    let count, files =
+      match Hashtbl.find_opt tbl group with
       | None ->
-          (0, StrSet.empty)
-      | Some (n, paths) ->
-          (n, paths)
+          (0, File.Set.empty)
+      | Some (n, files) ->
+          (n, files)
     in
-    Hashtbl.replace tbl key (count + 1, StrSet.add path paths)
+    Hashtbl.replace tbl group (count + 1, File.Set.add file files)
   in
-  Stream.iter input ~f:(fun {File.path; size} ->
-    process paths_by_size path ~f:(fun _ -> size)
+  Stream.iter input ~f:(fun ({File.size; _} as file) ->
+    process files_by_size ~group:size ~file
   );
   Hashtbl.iter
-    (fun _ (n, paths) ->
+    (fun _ (n, files) ->
       (* Skip files with unique sizes *)
       if n > 1 then
-        StrSet.iter
-          (fun path ->
-            incr count.hashed;
-            process paths_by_digest path ~f:Digest.file
+        File.Set.iter
+          (fun ({File.path; _} as file) ->
+            process
+              files_by_sample
+              ~group:(sample path ~len:sample_len)
+              ~file
           )
-          paths
+          files
       else
         incr count.unique_size;
     )
-    paths_by_size;
-  Hashtbl.iter (fun d (n, ps) -> if n > 1 then output d n ps) paths_by_digest;
+    files_by_size;
+  Hashtbl.iter
+    (fun _ (n, files) ->
+      (* Skip files with unique samples *)
+      if n > 1 then
+        File.Set.iter
+          (fun ({File.path; _} as file) ->
+            incr count.hashed;
+            process files_by_digest ~group:(Digest.file path) ~file
+          )
+          files
+      else
+        incr count.unique_sample;
+    )
+    files_by_sample;
+  Hashtbl.iter
+    (fun d (n, files) ->
+      if n > 1 then
+        output d n files
+    )
+    files_by_digest;
   let t1 = Sys.time () in
   eprintf "Time                       : %f seconds\n%!" (t1 -. t0);
   eprintf "Considered                 : %d\n%!" !(count.considered);
   eprintf "Hashed                     : %d\n%!" !(count.hashed);
   eprintf "Skipped due to 0      size : %d\n%!" !(count.empty);
   eprintf "Skipped due to unique size : %d\n%!" !(count.unique_size);
+  eprintf "Skipped due to unique sample : %d\n%!" !(count.unique_sample);
   eprintf "Ignored due to regex match : %d\n%!" !(count.ignored)
 
-let () =
-  let input  = ref Stdin in
-  let output = ref Stdout in
-  let ignore = ref None in
-  let assert_file_exists path =
-    if Sys.file_exists path then
-      ()
-    else begin
-      eprintf "File does not exist: %S\n%!" path;
+let get_opt () : opt =
+  let assert_ test x msg =
+    if not (test x) then begin
+      eprintf "%s\n%!" msg;
       exit 1
     end
   in
+  let assert_file_exists path =
+    assert_ Sys.file_exists path (sprintf "File does not exist: %S" path)
+  in
   let assert_file_is_dir path =
-    if Sys.is_directory path then
-      ()
-    else begin
-      eprintf "File is not a directory: %S\n%!" path;
-      exit 1
-    end
+    assert_ Sys.is_directory path (sprintf "File is not a directory: %S" path)
   in
+  let input  = ref Stdin in
+  let output = ref Stdout in
+  let ignore = ref None in
+  let sample = ref 256 in
   let spec =
     [ ( "-out"
       , Arg.String (fun path ->
@@ -274,6 +334,10 @@ let () =
       , Arg.String (fun regexp -> ignore := Some (Str.regexp regexp))
       , " Ignore file paths which match this regexp pattern (see Str module)."
       )
+    ; ( "-sample"
+      , Arg.Set_int sample
+      , (sprintf " Byte size of file samples to use. Default: %d" !sample)
+      )
     ]
   in
   Arg.parse
@@ -288,4 +352,15 @@ let () =
           input := Directories (path :: paths)
     )
     "";
-  main !input !output !ignore
+  assert_
+    (fun x -> x > 0)
+    !sample
+    (sprintf "Sample size cannot be negative: %d" !sample);
+  { input  = !input
+  ; output = !output
+  ; ignore = !ignore
+  ; sample = !sample
+  }
+
+let () =
+  main (get_opt ())