File: uutil.ml

package info (click to toggle)
unison2.32.52 2.32.52-7
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 4,184 kB
  • ctags: 4,027
  • sloc: ml: 23,058; objc: 4,161; makefile: 514; ansic: 494; sh: 80
file content (154 lines) | stat: -rw-r--r-- 4,996 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
(* Unison file synchronizer: src/uutil.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce 

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*)


(*****************************************************************************)
(*                      Unison name and version                              *)
(*****************************************************************************)

let myName = ProjectInfo.myName

let myVersion = ProjectInfo.myVersion

let myMajorVersion = ProjectInfo.myMajorVersion

let myNameAndVersion = myName ^ " " ^ myVersion

(*****************************************************************************)
(*                             HASHING                                       *)
(*****************************************************************************)

let hash2 x y = (17 * x + 257 * y) land 0x3FFFFFFF

external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"

let hash x = hash_param 10 100 x

(*****************************************************************************)
(*                             File sizes                                    *)
(*****************************************************************************)

module type FILESIZE = sig
  type t
  val zero : t
  val dummy : t
  val add : t -> t -> t
  val sub : t -> t -> t
  val toFloat : t -> float
  val toString : t -> string
  val ofInt : int -> t
  val ofInt64 : int64 -> t
  val toInt : t -> int
  val toInt64 : t -> int64
  val fromStats : Unix.LargeFile.stats -> t
  val hash : t -> int
  val percentageOfTotalSize : t -> t -> float
end

module Filesize : FILESIZE = struct
  type t = int64
  let zero = Int64.zero
  let dummy = Int64.minus_one
  let add = Int64.add
  let sub = Int64.sub
  let toFloat = Int64.to_float
  let toString = Int64.to_string
  let ofInt x = Int64.of_int x
  let ofInt64 x = x
  let toInt x = Int64.to_int x
  let toInt64 x = x
  let fromStats st = st.Unix.LargeFile.st_size
  let hash x =
    hash2 (Int64.to_int x) (Int64.to_int (Int64.shift_right_logical x 31))
  let percentageOfTotalSize current total =
    let total = toFloat total in
    if total = 0. then 100.0 else
    toFloat current *. 100.0 /. total
end

(*****************************************************************************)
(*                       File tranfer progress display                       *)
(*****************************************************************************)

module File =
  struct
    type t = int
    let dummy = -1
    let ofLine l = l
    let toLine l = assert (l <> dummy); l
    let toString l = if l=dummy then "<dummy>" else string_of_int l
  end

let progressPrinter = ref (fun _ _ _ -> ())
let setProgressPrinter p = progressPrinter := p
let showProgress i bytes ch =
  if i <> File.dummy then !progressPrinter i bytes ch

let statusPrinter = ref None
let setUpdateStatusPrinter p = statusPrinter := p
let showUpdateStatus path =
  match !statusPrinter with
    Some f -> f path
  | None   -> Trace.statusDetail path

(*****************************************************************************)
(*               Copy bytes from one file_desc to another                    *)
(*****************************************************************************)

let bufsize = 16384
let bufsizeFS = Filesize.ofInt bufsize
let buf = String.create bufsize

let readWrite source target notify =
  let len = ref 0 in
  let rec read () =
    let n = input source buf 0 bufsize in
    if n > 0 then begin
      output target buf 0 n;
      len := !len + n;
      if !len > 100 * 1024 then begin
        notify !len;
        len := 0
      end;
      read ()
    end else if !len > 0 then
      notify !len
  in
  Util.convertUnixErrorsToTransient "readWrite" read

let readWriteBounded source target len notify =
  let l = ref 0 in
  let rec read len =
    if len > Filesize.zero then begin
      let n =
        input source buf 0
          (if len > bufsizeFS then bufsize else Filesize.toInt len)
      in
      if n > 0 then begin
        let _ = output target buf 0 n in
        l := !l + n;
        if !l > 100 * 1024 then begin
          notify !l;
          l := 0
        end;
        read (Filesize.sub len (Filesize.ofInt n))
      end else if !l > 0 then
        notify !l
    end else if !l > 0 then
      notify !l
  in
  Util.convertUnixErrorsToTransient "readWriteBounded" (fun () -> read len)