X-Git-Url: https://git.xandkar.net/?p=dups.git;a=blobdiff_plain;f=dups.ml;h=8ff8874b7cf84ec76b965bda441e35cae1a4a22a;hp=697894d4c3c1d08d6a421e8038fd278da708f53c;hb=a9a56d74122233b99d8d6401b1f50009a993cd0a;hpb=34107832c93f775a6879b1d8ec123f3679eb154b;ds=sidebyside diff --git a/dups.ml b/dups.ml index 697894d..8ff8874 100644 --- a/dups.ml +++ b/dups.ml @@ -12,21 +12,57 @@ module Stream : sig val iter : 'a t -> f:('a -> unit) -> unit + val map : 'a t -> f:('a -> 'b) -> 'b t + + val filter : 'a t -> f:('a -> bool) -> 'a t + val concat : ('a t) list -> 'a t end = struct module S = Stream type 'a t = - ('a S.t) list + {mutable streams : ('a S.t) list} let create f = - [S.from (fun _ -> f ())] + {streams = [S.from (fun _ -> f ())]} + + let rec next t = + match t.streams with + | [] -> + None + | s :: streams -> + (match S.next s with + | exception Stream.Failure -> + t.streams <- streams; + next t + | x -> + Some x + ) + + let map t ~f = + create (fun () -> + match next t with + | None -> None + | Some x -> Some (f x) + ) + + let filter t ~f = + let rec filter () = + match next t with + | None -> + None + | Some x when f x -> + Some x + | Some _ -> + filter () + in + create filter let iter t ~f = - List.iter t ~f:(S.iter f) + List.iter t.streams ~f:(S.iter f) let concat ts = - List.concat ts + {streams = List.concat (List.map ts ~f:(fun {streams} -> streams))} end module In_channel : sig @@ -42,19 +78,40 @@ end = struct ) end -module Directory_tree : sig - val find_files : string -> string Stream.t +module File : sig + type t = + { path : string + ; size : int + } + + val find : string -> t Stream.t + (** Find all files in the directory tree, starting from the given root path *) + + val lookup : string Stream.t -> t Stream.t + (** Lookup file info for given paths *) end = struct - let find_files root = + type t = + { path : string + ; size : int + } + + let lookup paths = + Stream.map paths ~f:(fun path -> + let {Unix.st_size = size; _} = Unix.lstat path in + {path; size} + ) + + let find root = let dirs = Queue.create () in let files = Queue.create () in let explore parent = Array.iter (Sys.readdir parent) ~f:(fun child -> let path = Filename.concat parent child in - let {Unix.st_kind = file_kind; _} = Unix.lstat path in + let {Unix.st_kind = file_kind; st_size; _} = Unix.lstat path in match file_kind with | Unix.S_REG -> - Queue.add path files + let file = {path; size = st_size} in + Queue.add file files | Unix.S_DIR -> Queue.add path dirs | Unix.S_CHR @@ -85,12 +142,37 @@ type output = | Stdout | Directory of string -let make_input_stream = function - | Stdin -> - In_channel.lines stdin - | Directories paths -> - let paths = StrSet.elements (StrSet.of_list paths) in - Stream.concat (List.map paths ~f:Directory_tree.find_files) +type count = + { considered : int ref + ; empty : int ref + ; ignored : int ref + ; unique_size : int ref + ; hashed : int ref + } + +let make_input_stream input ignore count = + let input = + match input with + | Stdin -> + File.lookup (In_channel.lines stdin) + | Directories paths -> + let paths = StrSet.elements (StrSet.of_list paths) in + Stream.concat (List.map paths ~f:File.find) + in + Stream.filter input ~f:(fun {File.path; size} -> + incr count.considered; + let empty = size = 0 in + let ignored = + match ignore with + | Some regexp when (Str.string_match regexp path 0) -> + true + | Some _ | None -> + false + in + if empty then incr count.empty; + if ignored then incr count.ignored; + (not empty) && (not ignored) + ) let make_output_fun = function | Stdout -> @@ -109,36 +191,55 @@ let make_output_fun = function close_out oc let main input output ignore = + let t0 = Sys.time () in + let count = + { considered = ref 0 + ; empty = ref 0 + ; ignored = ref 0 + ; unique_size = ref 0 + ; hashed = ref 0 + } + in let output = make_output_fun output in - let input = make_input_stream input 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 path_count = ref 0 in - let t0 = Sys.time () in - let process path = - try - let digest = Digest.file path in - let count, paths = - match Hashtbl.find_opt paths_by_digest digest with - | None -> - (0, StrSet.empty) - | Some (n, paths) -> - (n, paths) - in - Hashtbl.replace paths_by_digest digest (count + 1, StrSet.add path paths) - with Sys_error e -> - eprintf "WARNING: Failed to process %S: %S\n%!" path e + let process tbl path ~f = + let key = f path in + let count, paths = + match Hashtbl.find_opt tbl key with + | None -> + (0, StrSet.empty) + | Some (n, paths) -> + (n, paths) + in + Hashtbl.replace tbl key (count + 1, StrSet.add path paths) in - Stream.iter input ~f:(fun path -> - incr path_count; - match ignore with - | Some regexp when (Str.string_match regexp path 0) -> - () - | Some _ | None -> - process path + Stream.iter input ~f:(fun {File.path; size} -> + process paths_by_size path ~f:(fun _ -> size) ); + Hashtbl.iter + (fun _ (n, paths) -> + (* Skip files with unique sizes *) + if n > 1 then + StrSet.iter + (fun path -> + incr count.hashed; + process paths_by_digest path ~f:Digest.file + ) + paths + 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; let t1 = Sys.time () in - eprintf "Processed %d files in %f seconds.\n%!" !path_count (t1 -. t0) + 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 "Ignored due to regex match : %d\n%!" !(count.ignored) let () = let input = ref Stdin in