source: code/trunk/cli/index.ml@ 55

Last change on this file since 55 was 22, checked in by fox, 2 years ago

Use txt.conf to generate index.pck meta; fix double load while indexing

File size: 3.6 KB
Line 
1open Logarion
2
3let text_editor name x =
4 let fname, out = Filename.open_temp_file name "" in
5 output_string out x; flush out;
6 let r = match Unix.system ("$EDITOR " ^ fname) with
7 | Unix.WEXITED 0 ->
8 let inp = open_in fname in
9 let line = input_line inp in
10 close_in inp; line
11 | _ -> failwith "Failed launching editor to edit value" in
12 close_out out;
13 Unix.unlink fname;
14 r
15
16let text_editor_lines name x =
17 let fname, out = Filename.open_temp_file name "" in
18 List.iter (fun s -> output_string out (s ^ "\n")) x; flush out;
19 let r = match Unix.system ("$EDITOR " ^ fname) with
20 | Unix.WEXITED 0 ->
21 let inp = open_in fname in
22 let lines =
23 let rec acc a =
24 try let a = String.trim (input_line inp) :: a in acc a
25 with End_of_file -> a in
26 acc [] in
27 close_in inp; lines
28 | _ -> failwith "Failed launching editor to edit value" in
29 close_out out;
30 Unix.unlink fname;
31 r
32
33let print_pack pck =
34 let s ss = String.concat "\n\t" ss in
35 let open Header_pack in
36 Printf.printf "Id: %s\nTitle: %s\nAuthors: %s\nLocations:\n\t%s\nPeers:\n\t%s\n"
37 pck.info.id pck.info.title (String.concat "," pck.info.people)
38 (s pck.info.locations) (s (to_str_list pck.peers))
39
40type t = { dir : string; index_path: string; pck : Header_pack.t }
41
42let index r print title auth locs peers =
43 let edit name index param = if print then index else match param with
44 | Some "" -> text_editor name index | Some p -> p
45 | None -> index in
46 let edits name index param = if print then index else match param with
47 | Some "" -> text_editor_lines name index | Some p -> String_set.list_of_csv p
48 | None -> index in
49 let edits_mp name index param = if print then index else match param with
50 | Some "" -> Header_pack.str_list (text_editor_lines name (Header_pack.to_str_list index))
51 | Some p -> Header_pack.str_list (String_set.list_of_csv p)
52 | None -> index in
53 let info = Header_pack.{ r.pck.info with
54 title = edit "Title" r.pck.info.title title;
55 people = edits "People" r.pck.info.people auth;
56 locations = edits "Locations" r.pck.info.locations locs;
57 } in
58 let pack = Header_pack.{ info; fields;
59 texts = of_text_list @@ File_store.fold ~dir:r.dir (fun a (t,_) -> of_text a t) [];
60 peers = edits_mp "Peers" r.pck.peers peers;
61 } in
62 if print then print_pack pack
63 else (File_store.file r.index_path (Header_pack.string pack))
64
65let load dir =
66 let kv = File_store.of_kv_file () in
67 let index_path = Filename.concat dir "index.pck" in
68 index { dir; index_path; pck = Header_pack.of_kv kv }
69
70open Cmdliner
71let term =
72 let print= Arg.(value & flag & info ["print"] ~doc:"print info") in
73 let title= Arg.(value & opt ~vopt:(Some "") (some string) None & info ["t"; "title"]
74 ~docv:"string" ~doc:"Title for index") in
75 let auth = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["a"; "authors"]
76 ~docv:"comma-separated names" ~doc:"Index authors") in
77 let locs = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["l"; "locations"]
78 ~docv:"comma-separated URLs" ~doc:"repository URLs") in
79 let peers= Arg.(value & opt ~vopt:(Some "") (some string) None & info ["p"; "peers"]
80 ~docv:"comma-separated URLs" ~doc:"URLs to other known text repositories") in
81 let dir = Arg.(value & pos 0 string "." & info []
82 ~docv:"directory to index") in
83 let doc = "Generate an index.pck for texts in a directory" in
84 Term.(const load $ dir $ print $ title $ auth $ locs $ peers),
85 Term.info "index" ~doc
86 ~man:[ `S "DESCRIPTION"; `Pre "An index contains:\n
87* an info section with: title for the index, the authors, locations (URLs) the texts can be access\n
88* listing of texts with: ID, date, title, authors, topics\n
89* list of other text repositories (peers)\n\n
90MessagePack format. <msgpack.org>" ]
91
Note: See TracBrowser for help on using the repository browser.