diff --git a/cli/pull.ml b/cli/pull.ml index 6337e3f..0fb161f 100644 --- a/cli/pull.ml +++ b/cli/pull.ml @@ -49,42 +49,44 @@ let print_peers p = | ps -> print_endline @@ List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps -let parse_index _is_selected fn url dir p = - let open Logarion.Header_pack in - match Msgpck.to_list p.texts with - | [] -> Printf.printf "%s => %s, has empty index\n" p.info.title dir; false - | texts -> - let numof_texts = string_of_int @@ List.length texts in - let text_num_len = String.length numof_texts in - Printf.printf "%*d/%s %s => %s\r" text_num_len 0 numof_texts p.info.title dir; - let of_pck i x = - Printf.printf "\r%*d/%s %!" text_num_len (i+1) numof_texts; - match x with - | Msgpck.List (id::time::title::_authors::_topics) -> - (match Logarion.Header_pack.to_id id with - | "" -> Printf.eprintf "Invalid id for%s " (Msgpck.to_string title) - | id -> - let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x in - if newer t id dir then fn url dir id) - | _ -> prerr_endline ("Invalid record structure") in - List.iteri of_pck texts; - print_newline (); - true +type filter_t = { authors: Logarion.Person.Set.t; topics: Logarion.String_set.t } + +let print_pull_start width total title dir = + Printf.printf "%*d/%s %s => %s %!" width 0 total title dir + +let print_pull width total i = + Printf.printf "\r%*d/%s %!" width (i+1) total + +let printers total title dir = + let width = String.length total in + print_pull_start width total title dir; + print_pull width total let fname dir text = Filename.concat dir (Logarion.Text.short_id text ^ ".txt") + let pull_text url dir id = let u = Filename.concat url ((Logarion.Id.short id) ^ ".txt") in match curl_pull u with | Error msg -> Printf.eprintf "Failed getting %s: %s" u msg - | Ok txt -> - let txt = Buffer.contents txt in + | Ok txt -> let txt = Buffer.contents txt in match Logarion.Text.of_string txt with | Error s -> prerr_endline s | Ok text -> let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (fname dir text) in output_string file txt; close_out file -let pull_index url _authors _topics = +let per_text url dir filter print i id time title authors topics = match id with + | "" -> Printf.eprintf "\nInvalid id for %s\n" title + | id -> let open Logarion in + print i; + if newer time id dir + && (String_set.empty = filter.topics + || String_set.exists (fun t -> List.mem t topics) filter.topics) + && (Person.Set.empty = filter.authors + || Person.Set.exists (fun t -> List.mem (Person.to_string t) authors) filter.authors) + then pull_text url dir id + +let pull_index url authors_opt topics_opt = let index_url = url ^ "/index.pck" in match curl_pull index_url with | Error s -> prerr_endline s; false @@ -94,15 +96,18 @@ let pull_index url _authors _topics = | Ok pk -> let dir = Filename.concat Logarion.Peers.text_dir pk.info.id in Logarion.File_store.with_dir dir; - let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (Filename.concat dir "index.pck") in + let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 + (Filename.concat dir "index.pck") in output_string file ( Logarion.Header_pack.string { pk with info = { pk.info with locations = url::pk.info.locations }}); close_out file; -(* let predicates = A.predicate A.authored authors_opt*) -(* @ A.predicate A.topics topics_opt in*) - let is_selected text = List.fold_left (fun a e -> a && e text) true [](*predicates*) in - try parse_index is_selected pull_text url dir pk with - Invalid_argument msg -> Printf.eprintf "Failed to parse: %s\n%!" msg; false + let filter = let open Logarion in { + authors = (match authors_opt with Some s -> Person.Set.of_string s | None -> Person.Set.empty); + topics =( match topics_opt with Some s -> String_set.of_string s | None -> String_set.empty); + } in + let print = printers (string_of_int @@ Logarion.Header_pack.numof_texts pk) pk.info.title dir in + try Logarion.Header_pack.iteri (per_text url dir filter print) pk; print_newline (); true + with Invalid_argument msg -> Printf.eprintf "\nFailed to parse %s: %s\n%!" url msg; false let pull_list auths topics = Curl.global_init Curl.CURLINIT_GLOBALALL; diff --git a/lib/header_pack.ml b/lib/header_pack.ml index f776d8b..9157060 100644 --- a/lib/header_pack.ml +++ b/lib/header_pack.ml @@ -68,6 +68,19 @@ let contains text = function | id -> text.Text.id = id) | _ -> prerr_endline ("Invalid record pattern"); false +let numof_texts pack = List.length (Msgpck.to_list pack.texts) + +let iteri fn pack = + let of_pck i = function Msgpck.List (id::time::title::authors::topics::[]) -> + let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i + | x -> Msgpck.to_uint32 x in + let id = to_id id in + let title = Msgpck.to_string title in + let topics = to_str_list topics in + let authors = to_str_list authors in + fn i id t title authors topics + | _ -> prerr_endline ("\n\nInvalid record structure\n\n") + in List.iteri of_pck (Msgpck.to_list pack.texts); (*let pack_filename ?(filename="index.pck") archive =*) (* let dir = Store.KV.find "Export-Dir" archive.File_store.kv in (*raises Not_found*)*)