File: database.ml

package info (click to toggle)
netclient 0.91-10
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 2,096 kB
  • ctags: 1,539
  • sloc: ml: 8,808; sh: 527; makefile: 203
file content (200 lines) | stat: -rw-r--r-- 4,174 bytes parent folder | download | duplicates (12)
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
*)
;;