Plasma GitLab Archive
Projects Blog Knowledge

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


This web site is published by Informatikbüro Gerd Stolpmann
Powered by Caml