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
|
type el =
{ url : string;
mutable code : int;
mutable time_ok : float;
mutable time_access : float;
mutable mime_type : string;
mutable visited : bool;
}
type t =
{ mutable a : el option array;
mutable l : int;
mutable h : (string, int) Hashtbl.t;
}
let space_re = Str.regexp "[ ]";;
let protect_spaces s =
(* TODO: repair this *)
(* Str.global_replace space_re s "+" *)
let s' = String.copy s in
for i = 0 to String.length s - 1 do
if s.[i] = ' ' then s'.[i] <- '+'
done;
s'
;;
let create() =
{ a = Array.make 100 None;
l = 0;
h = Hashtbl.create 100;
}
;;
let save db filename =
let f = open_out filename in
try
for i = 0 to db.l - 1 do
match db.a.(i) with
None -> ()
| Some x ->
output_string f (protect_spaces x.url);
output_string f " ";
output_string f (string_of_int x.code);
output_string f " ";
output_string f (string_of_float x.time_ok);
output_string f " ";
output_string f (string_of_float x.time_access);
output_string f " ";
output_string f x.mime_type;
output_string f "\n";
done;
close_out f
with
any ->
close_out f;
raise any
;;
let add db url =
(* TODO: normalize the URL with respect to capitalization *)
try
ignore(Hashtbl.find db.h url)
with
Not_found ->
if db.l >= Array.length db.a then begin
(* Allocate new space *)
let a' = Array.make (2 * db.l) None in
Array.blit db.a 0 a' 0 db.l;
db.a <- a';
end;
let x =
{ url = url;
code = 0;
time_ok = 0.0;
time_access = 0.0;
mime_type = "";
visited = false;
} in
db.a.(db.l) <- Some x;
Hashtbl.add db.h url db.l;
db.l <- db.l + 1
;;
let update db url code time_ok time_access mime_type =
let n = Hashtbl.find db.h url in
match db.a.(n) with
None -> assert false
| Some x ->
x.code <- code;
x.time_ok <- time_ok;
x.time_access <- time_access;
x.mime_type <- mime_type;
x.visited <- false;
;;
let lookup db url =
let n = Hashtbl.find db.h url in
match db.a.(n) with
None -> assert false
| Some x ->
x.code, x.time_ok, x.time_access, x.mime_type
;;
let restore filename =
let db = create() in
let f = open_in filename in
try
while true do
let line = input_line f in
let fields = Str.bounded_split_delim space_re line 5 in
match fields with
[ url; code; time_ok; time_access; mime_type ] ->
add db url;
update
db
url
(int_of_string code)
(float_of_string time_ok)
(float_of_string time_access)
mime_type
| _ ->
prerr_endline ("Questionable line: " ^ line)
done;
assert false
with
End_of_file ->
close_in f;
db
| any ->
close_in f;
raise any
;;
let iter db age interval =
let rec next_round () =
(* Iterate over the complete array: *)
let rec next_element k n t0 =
if k >= db.l then begin
if n > 0 then
next_round()
else
[< >]
end
else
match db.a.( k ) with
None -> assert false
| Some x ->
let v = x.visited in
let doit =
if (x.code >= 200 && x.code <= 299) || x.code = 304 then begin
(* Successful code *)
x.time_ok +. age <= t0
end
else begin
(* Failure code *)
x.code = 0 or x.time_access +. age <= t0
end
in
if doit && not v then begin
x.visited <- true;
[< '(x.url,x.code,x.time_ok,x.time_access,x.mime_type);
next_element (k+1) (n+1) (Unix.gettimeofday()) >]
end
else
next_element (k+1) n t0
in
next_element 0 0 (Unix.gettimeofday())
in
for k = 0 to db.l-1 do
match db.a.( k ) with
Some x -> x.visited <- false
| _ -> ()
done;
next_round ()
(*
let t0 = Unix.gettimeofday() in
let m = ref 1e30 in
for k = 0 to db.l - 1 do
match db.a.(k) with
None -> assert false
| Some x ->
if (x.code >= 200 && x.code <= 299) || x.code = 304 then begin
(* Successful code *)
m := min !m (x.time_ok +. age -. t0)
end
else begin
(* Failure code *)
m := min !m (x.time_access +. age -. t0)
end
done;
!m
*)
;;
|