1
(***********************************************************************)
5
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
7
(* Copyright 2001 Institut National de Recherche en Informatique et *)
8
(* en Automatique. All rights reserved. This file is distributed *)
9
(* only by permission. *)
11
(***********************************************************************)
26
entries : (string, entry) Hashtbl.t
30
printf "First name : %s\n" e.first_name;
31
printf "Last name : %s\n" e.last_name;
32
printf "Addr : %s\n" e.address;
33
printf "Tel : %s\n" e.tel;
34
printf "URL : %s\n" e.url;;
36
let print_address_book ab =
37
print_string "Adresse book from ";
40
Hashtbl.iter (fun k e -> print_entry e; print_newline ()) ab.entries;;
42
let read_address_book_ic ic =
43
(input_value ic : address_book);;
45
let save_address_book_oc oc ab =
46
(output_value oc (ab : address_book));;
48
let read_address_book ab =
49
let ic = open_in_bin ab in
50
read_address_book_ic ic;
53
let save_address_book ab =
54
let oc = open_out_bin ab.file in
55
save_address_book_oc oc ab;
58
let make_entry id fn ln a t u = {
67
let dummy_entry = make_entry "" "" "" "" "" "";;
69
let dummy_file = "book";;
72
ref {file = dummy_file; entries = Hashtbl.create 100};;
74
let init_address_book ab =
75
if ab <> "" then read_address_book ab else read_address_book dummy_file;;
77
let verify_absent ab e =
78
let es = ab.entries in
79
if Hashtbl.mem es e.ident &&
80
List.mem e (Hashtbl.find_all es e.ident) then
82
(sprintf "Entry %s is already stored in adress book %s" e.last_name ab.file);;
84
let verify_present ab e =
85
let es = ab.entries in
87
if not (Hashtbl.mem es id) || not (List.mem e (Hashtbl.find_all es id)) then
89
(sprintf "Entry %s is not stored in adress book %s" n ab.file);;
91
let add_entry ab n e =
93
let es = ab.entries in
96
let rec list_remove x = function
98
| y :: l -> if y = x then l else y :: list_remove x l;;
100
let remove_entry ab e =
101
let es = ab.entries in
102
let eqs = Hashtbl.find_all es e.name in
103
let but_e = list_remove e eqs in
104
List.iter (fun e -> Hashtbl.remove es e.name) eqs;
105
List.iter (fun e -> Hashtbl.add es e.name e) but_e;;
107
let modify_entry ab e new_e =
109
verify_absent ab new_e;
111
add_entry ab e.name new_e;;
113
let delete_entry ab e =
117
let search_named_entry ab n =
118
Hashtbl.find_all ab.entries n;;
122
Hashtbl.iter (fun k v -> if p k v then res := v :: !res) ab.entries;
125
let search_regexp_entry foldp ab pat =
126
let re = if foldp then Str.regexp_case_fold pat else Str.regexp pat in
127
search ab (fun k v -> Str.string_match re k 0);;
129
let full_text_regexp_search foldp ab pat =
130
let re = if foldp then Str.regexp_case_fold pat else Str.regexp pat in
133
Str.string_match re v.name 0 ||
134
Str.string_match re v.address 0 ||
135
Str.string_match re v.tel 0 ||
136
Str.string_match re v.url 0);;
138
type search_entry_predicate = {
139
name_pred : string -> bool;
140
address_pred : string -> bool;
141
tel_pred : string -> bool;
142
url_pred : string -> bool;
145
type search_entry_pattern = {
147
address_pat : string;
152
let full_search ab se =
155
se.name_pred v.name ||
156
se.address_pred v.address ||
160
let full_text_regexp_search foldp ab pat =
161
let regexp = if foldp then Str.regexp_case_fold else Str.regexp in
162
let str_match p s = Str.string_match (regexp p) s 0 in
164
name_pred = str_match pat.name_pat;
165
address_pred = str_match pat.address_pat;
166
tel_pred = str_match pat.tel_pat;
167
url_pred = str_match pat.url_pat;
171
let make_name_entry_pattern pat = {
178
let make_full_text_entry_pattern pat = {
185
let full_search ab pat =
186
full_text_regexp_search true ab (make_full_text_entry_pattern pat);;
188
let enter_new_entry n a t u = add_entry !the_book n (make_entry n a t u);;
192
"Domaine de Voluceau"
194
"http://pauillac.inria.fr/~weis/";;
196
print_address_book !the_book;;
added
removed
examples/tools/address_book.new.ml
