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
*)
;;