Implement author & topic filter for txt pull
This commit is contained in:
orbifx
parent
d978b5fc3a
commit
939087ccf7
65
cli/pull.ml
65
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;
|
||||
|
|
|
|||
|
|
@ -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*)*)
|
||||
|
|
|
|||
Loading…
Reference in New Issue