Because sweet girls are the best, officially rebranding Logarion to Kosuzu
Signed-off-by: Izuru Yakumo <yakumo.izuru@chaotic.ninja> git-svn-id: file:///srv/svn/repo/kosuzu/trunk@73 eb64cd80-c68d-6f47-b6a3-0ada418499da
This commit is contained in:
yakumo.izuru
71
cmd/txt/atom.ml
Normal file
71
cmd/txt/atom.ml
Normal file
@@ -0,0 +1,71 @@
|
||||
let ext = ".atom"
|
||||
|
||||
let esc = Converter.Html.esc
|
||||
|
||||
let element tag content = "<" ^ tag ^ ">" ^ content ^ "</" ^ tag ^ ">"
|
||||
|
||||
let opt_element tag_name content =
|
||||
if content <> ""
|
||||
then element tag_name content
|
||||
else ""
|
||||
|
||||
module P = Parsers.Plain_text.Make (Converter.Html)
|
||||
|
||||
let id txt = "<id>urn:txtid:" ^ Kosuzu.(txt.Text.id) ^ "</id>\n"
|
||||
let title text = "<title>" ^ esc text.Kosuzu.Text.title ^ "</title>\n"
|
||||
|
||||
let authors text =
|
||||
let u acc addr = acc ^ element "uri" addr in
|
||||
let open Kosuzu in
|
||||
let fn txt a =
|
||||
a ^ "<author>" ^ (opt_element "name" @@ esc txt.Person.name)
|
||||
^ (List.fold_left u "" txt.Person.addresses)
|
||||
^ "</author>\n" in
|
||||
Person.Set.fold fn text.Text.authors ""
|
||||
|
||||
let updated txt = let open Kosuzu in
|
||||
"<updated>"^ Date.(txt.Text.date |> listing |> rfc_string) ^"</updated>\n"
|
||||
|
||||
let htm_entry base_url text =
|
||||
let open Kosuzu in
|
||||
let u = Text.short_id text in
|
||||
"<entry>\n<link rel=\"alternate\" href=\"" ^ base_url ^ "/" ^ u ^ ".htm\" />\n"
|
||||
^ title text ^ id text ^ updated text ^ authors text
|
||||
^ (opt_element "summary" @@ esc @@ Text.str "abstract" text)
|
||||
^ String_set.fold (fun elt a -> a ^ "<category term=\"" ^ esc elt ^ "\"/>\n") (Text.set "topics" text) ""
|
||||
^ "</entry>\n"
|
||||
|
||||
let gmi_entry base_url text =
|
||||
let open Kosuzu in
|
||||
let u = Text.short_id text in
|
||||
"<entry>\n<link rel=\"alternate\" href=\"" ^ base_url ^ "/" ^ u ^ ".gmi\" />\n"
|
||||
^ title text ^ id text ^ updated text ^ authors text
|
||||
^ (opt_element "summary" @@ esc @@ Text.str "abstract" text)
|
||||
^ String_set.fold (fun elt a -> a ^ "<category term=\"" ^ elt ^ "\"/>\n") (Text.set "topics" text) ""
|
||||
^ "</entry>\n"
|
||||
|
||||
let base_url kv protocol = try
|
||||
let locs = Kosuzu.Store.KV.find "Locations" kv in
|
||||
let _i = Str.(search_forward (regexp (protocol ^ "://[^;]*")) locs 0) in
|
||||
Str.(matched_string locs)
|
||||
with Not_found -> Printf.eprintf "Missing location for %s, add it to txt.conf\n" protocol; ""
|
||||
|
||||
let indices alternate_type c =
|
||||
let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in
|
||||
let title = try Kosuzu.Store.KV.find "Title" c.Conversion.kv with Not_found -> "" in
|
||||
let entry, fname, protocol_regexp = match alternate_type with
|
||||
| "text/gemini" -> gmi_entry, "gmi.atom", "gemini"
|
||||
| "text/html" | _ -> htm_entry, "feed.atom", "https?"
|
||||
in
|
||||
let base_url = base_url c.kv protocol_regexp in
|
||||
let self = Filename.concat base_url fname in
|
||||
file fname @@ (*TODO: alternate & self per url*)
|
||||
{|<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom" xml:base="|} ^ base_url ^ {|"><title>|}
|
||||
^ title ^ {|</title><link rel="alternate" type="|} ^ alternate_type ^ {|" href="|}
|
||||
^ base_url ^ {|/" /><link rel="self" type="application/atom+xml" href="|}
|
||||
^ self ^ {|" /><id>urn:txtid:|} ^ c.Conversion.id ^ "</id><updated>"
|
||||
^ Kosuzu.Date.now () ^ "</updated>\n"
|
||||
^ List.fold_left (fun acc t -> acc ^ entry base_url t) "" c.texts
|
||||
^ "</feed>"
|
||||
|
||||
let converter format = Conversion.{ ext; page = None; indices = Some (indices format) }
|
||||
22
cmd/txt/authors.ml
Normal file
22
cmd/txt/authors.ml
Normal file
@@ -0,0 +1,22 @@
|
||||
open Kosuzu
|
||||
let authors r topics_opt =
|
||||
let predicates = Archive.(predicate topics topics_opt) in
|
||||
let predicate text = List.fold_left (fun a e -> a && e text) true predicates in
|
||||
let author_union a (e, _) = Person.Set.union a e.Text.authors in
|
||||
let s = File_store.fold ~r ~predicate author_union Person.Set.empty in
|
||||
Person.Set.iter (fun x -> print_endline (Person.to_string x)) s
|
||||
|
||||
open Cmdliner
|
||||
let recurse = Arg.(value & flag & info ["R"] ~doc: "Include texts in subdirectories too")
|
||||
let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv:"topics" ~doc: "Display authors who have written on topics")
|
||||
|
||||
let authors_t = Term.(const authors $ recurse $ topics)
|
||||
|
||||
let cmd =
|
||||
let doc = "List authors" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "List author names" ]
|
||||
in
|
||||
let info = Cmd.info "authors" ~doc ~man in
|
||||
Cmd.v info authors_t
|
||||
74
cmd/txt/conversion.ml
Normal file
74
cmd/txt/conversion.ml
Normal file
@@ -0,0 +1,74 @@
|
||||
open Kosuzu
|
||||
|
||||
module Rel = struct
|
||||
|
||||
module Rel_set = Set.Make(String)
|
||||
module Id_map = Map.Make(String)
|
||||
|
||||
type t = { last_rel: string; ref_set: String_set.t; rep_set: String_set.t }
|
||||
type map_t = t Id_map.t
|
||||
|
||||
let empty = { last_rel = ""; ref_set = Rel_set.empty; rep_set = Rel_set.empty }
|
||||
let empty_map = Id_map.empty
|
||||
|
||||
let acc_ref date source target = Id_map.update target (function
|
||||
| None -> Some { last_rel = date;
|
||||
ref_set = Rel_set.singleton source;
|
||||
rep_set = Rel_set.empty }
|
||||
| Some rel -> Some { rel with
|
||||
last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel;
|
||||
ref_set = Rel_set.add source rel.ref_set })
|
||||
|
||||
let acc_rep date source target = Id_map.update target (function
|
||||
| None -> Some { last_rel = date;
|
||||
rep_set = Rel_set.singleton source;
|
||||
ref_set = Rel_set.empty }
|
||||
| Some rel -> Some { rel with
|
||||
last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel;
|
||||
rep_set = Rel_set.add source rel.rep_set })
|
||||
|
||||
let acc_txt rels (text, _paths) =
|
||||
let acc_ref = acc_ref (Date.listing text.Text.date) text.Text.id in
|
||||
let acc_rep = acc_rep (Date.listing text.Text.date) text.Text.id in
|
||||
let rels = String_set.fold acc_ref (Text.set "references" text) rels in
|
||||
let rels = String_set.fold acc_rep (Text.set "in-reply-to" text) rels in
|
||||
rels
|
||||
|
||||
let acc_pck rels peer =
|
||||
let path = try List.hd peer.Peers.pack.Header_pack.info.locations with Failure _->"" in
|
||||
try Header_pack.fold
|
||||
(fun rels id t _title _authors _topics refs_ls reps_ls ->
|
||||
let acc_ref = acc_ref (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in
|
||||
let acc_rep = acc_rep (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in
|
||||
let rels = String_set.fold acc_ref (String_set.of_list refs_ls) rels in
|
||||
let rels = String_set.fold acc_rep (String_set.of_list reps_ls) rels in
|
||||
rels)
|
||||
rels peer.Peers.pack
|
||||
with e -> prerr_endline "acc_pck"; raise e
|
||||
end
|
||||
|
||||
|
||||
type t = {
|
||||
id: string;
|
||||
dir: string;
|
||||
kv: string Store.KV.t;
|
||||
topic_roots: string list;
|
||||
topics: (String_set.t * String_set.t) Topic_set.Map.t;
|
||||
relations: Rel.map_t;
|
||||
texts: Text.t list
|
||||
}
|
||||
|
||||
type fn_t = {
|
||||
ext: string;
|
||||
page: (t -> Kosuzu.Text.t -> string) option;
|
||||
indices: (t -> unit) option;
|
||||
}
|
||||
|
||||
let empty () = {
|
||||
id = ""; dir = "";
|
||||
kv = Store.KV.empty;
|
||||
topic_roots = [];
|
||||
topics = Topic_set.Map.empty;
|
||||
relations = Rel.Id_map.empty;
|
||||
texts = []
|
||||
}
|
||||
95
cmd/txt/convert.ml
Normal file
95
cmd/txt/convert.ml
Normal file
@@ -0,0 +1,95 @@
|
||||
open Kosuzu
|
||||
|
||||
let is_older s d = try Unix.((stat d).st_mtime < (stat s).st_mtime) with _-> true
|
||||
|
||||
let convert cs r (text, files) = match Text.str "Content-Type" text with
|
||||
| "" | "text/plain" ->
|
||||
let source = List.hd files in
|
||||
let dest = Filename.concat r.Conversion.dir (Text.short_id text) in
|
||||
List.fold_left (fun a f ->
|
||||
match f.Conversion.page with None -> false || a
|
||||
| Some page ->
|
||||
let dest = dest ^ f.Conversion.ext in
|
||||
(if is_older source dest || Conversion.Rel.Id_map.mem text.Text.id r.relations
|
||||
then (File_store.file dest (page r text); true) else false)
|
||||
|| a)
|
||||
false cs
|
||||
| x -> Printf.eprintf "Can't convert Content-Type: %s file: %s" x text.Text.title; false
|
||||
|
||||
let converters types kv =
|
||||
let n = String.split_on_char ',' types in
|
||||
let t = [] in
|
||||
let t = if List.(mem "all" n || mem "htm" n) then (Html.converter kv)::t else t in
|
||||
let t = if List.(mem "all" n || mem "atom" n) then (Atom.converter "text/html")::t else t in
|
||||
let t = if List.(mem "all" n || mem "gmi" n) then (Gemini.converter)::t else t in
|
||||
let t = if List.(mem "all" n || mem "gmi-atom" n) then (Atom.converter "text/gemini")::t else t in
|
||||
t
|
||||
|
||||
let directory converters noindex repo =
|
||||
let order = File_store.oldest in
|
||||
let repo =
|
||||
let open Conversion in
|
||||
let rels = File_store.fold ~dir:repo.dir ~order Rel.acc_txt Rel.empty_map in
|
||||
let relations = Peers.fold Rel.acc_pck rels in
|
||||
{ repo with relations } in
|
||||
let acc (ts,ls,acc) ((elt,_) as r) = Topic_set.to_map ts (Text.set "topics" elt), elt::ls,
|
||||
if convert converters repo r then acc+1 else acc in
|
||||
let topics, texts, count =
|
||||
File_store.fold ~dir:repo.Conversion.dir ~order acc (Topic_set.Map.empty, [], 0) in
|
||||
let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" repo.kv)
|
||||
with Not_found -> Topic_set.roots topics in
|
||||
let repo = Conversion.{ repo with topic_roots; topics; texts = List.rev texts } in
|
||||
if not noindex then
|
||||
List.iter (fun c -> match c.Conversion.indices with None -> () | Some f -> f repo) converters;
|
||||
Printf.printf "Converted: %d Indexed: %d\n" count (List.length texts)
|
||||
|
||||
let load_kv dir =
|
||||
let kv = File_store.of_kv_file () in
|
||||
let idx = Filename.concat dir "index.pck" in
|
||||
if not (Sys.file_exists idx) then kv else
|
||||
match Header_pack.of_string @@ File_store.to_string (idx) with
|
||||
| Error s -> prerr_endline s; kv
|
||||
| Ok { info; peers; _ } ->
|
||||
let kv = if Store.KV.mem "Id" kv then kv else Store.KV.add "Id" info.Header_pack.id kv in
|
||||
let kv = if Store.KV.mem "Title" kv then kv else Store.KV.add "Title" info.Header_pack.title kv in
|
||||
let kv = if Store.KV.mem "Locations" kv then kv else Store.KV.add "Locations" (String.concat ";\n" info.Header_pack.locations) kv in
|
||||
let kv = Store.KV.add "Peers" (String.concat ";\n" Header_pack.(to_str_list peers)) kv in
|
||||
kv
|
||||
|
||||
let at_path types noindex path = match path with
|
||||
| "" -> prerr_endline "unspecified text file or directory"
|
||||
| path when Sys.file_exists path ->
|
||||
if Sys.is_directory path then (
|
||||
let kv = load_kv path in
|
||||
let repo = { (Conversion.empty ()) with dir = path; kv } in
|
||||
directory (converters types kv) noindex repo
|
||||
) else (
|
||||
match File_store.to_text path with
|
||||
| Error s -> prerr_endline s
|
||||
| Ok text ->
|
||||
let dir = "." in
|
||||
let open Conversion in
|
||||
let relations = File_store.(fold ~dir ~order:newest Rel.acc_txt Rel.empty_map) in
|
||||
let repo = { (Conversion.empty ()) with dir; kv = load_kv ""; relations } in
|
||||
ignore @@ convert (converters types repo.kv) repo (text, [path])
|
||||
)
|
||||
| path -> Printf.eprintf "Path doesn't exist: %s" path
|
||||
|
||||
open Cmdliner
|
||||
|
||||
let path = Arg.(value & pos 0 string "" & info [] ~docv:"path" ~doc:"Text file or directory to convert. If directory is provided, it must contain an index.pck (see: txt index)")
|
||||
let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"output type" ~doc:"Convert to file type")
|
||||
let noindex = Arg.(value & flag & info ["noindex"] ~doc:"Don't create indices in target format")
|
||||
|
||||
let convert_t = Term.(const at_path $ types $ noindex $ path)
|
||||
|
||||
let cmd =
|
||||
let doc = "Convert texts" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "Convert text or indexed texts within a directory to another format.";
|
||||
`P "If path is a directory must contain an index.pck.";
|
||||
`P "Run `txt index` first." ]
|
||||
in
|
||||
let info = Cmd.info "convert" ~doc ~man in
|
||||
Cmd.v info convert_t
|
||||
6
cmd/txt/dune
Normal file
6
cmd/txt/dune
Normal file
@@ -0,0 +1,6 @@
|
||||
(executable
|
||||
(name txt)
|
||||
(public_name txt)
|
||||
(modules txt authors convert conversion edit file index last listing
|
||||
new topics html atom gemini peers pull recent unfile)
|
||||
(libraries text_parse.converter text_parse.parsers kosuzu msgpck curl str cmdliner))
|
||||
22
cmd/txt/edit.ml
Normal file
22
cmd/txt/edit.ml
Normal file
@@ -0,0 +1,22 @@
|
||||
open Cmdliner
|
||||
let id = Arg.(value & pos 0 string "" & info [] ~docv: "text ID")
|
||||
let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories")
|
||||
let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order")
|
||||
let time = Arg.(value & flag & info ["t"] ~doc: "Sort by time, newest first")
|
||||
let number = Arg.(value & opt (some int) None & info ["n"] ~docv: "number" ~doc: "Number of entries to list")
|
||||
let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated names" ~doc: "Texts by authors")
|
||||
let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "Comma-separated topics" ~doc: "Texts by topics")
|
||||
|
||||
let edit_t = Term.(const (Kosuzu.Archive.apply_sys_util "EDITOR" "nano") $ recurse $ time $ reverse $ number $ authed $ topics $ id)
|
||||
|
||||
let cmd =
|
||||
let doc = "Edit a text" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "Launches EDITOR (nano if environment variable is unset) with text path as parameter.";
|
||||
`P "If -R is used, the ID search space includes texts found in subdirectories, too.";
|
||||
`S Manpage.s_environment;
|
||||
`P "EDITOR - Default editor name" ]
|
||||
in
|
||||
let info = Cmd.info "edit" ~doc ~man in
|
||||
Cmd.v info edit_t
|
||||
23
cmd/txt/file.ml
Normal file
23
cmd/txt/file.ml
Normal file
@@ -0,0 +1,23 @@
|
||||
open Kosuzu
|
||||
let file files =
|
||||
let dirs, files = File_store.split_filetypes files in
|
||||
let _link_as_named dir file = Unix.link file (Filename.concat dir file) in
|
||||
let link_with_id dir file =
|
||||
match File_store.to_text file with Error s -> prerr_endline s
|
||||
| Ok t -> Unix.link file (Filename.concat dir (Text.short_id t^".txt")) in
|
||||
let link = link_with_id in
|
||||
List.iter (fun d -> List.iter (link d) files) dirs
|
||||
|
||||
open Cmdliner
|
||||
let files = Arg.(value & pos_all string [] & info [] ~docv: "Text filenames and subdirectories")
|
||||
let file_t = Term.(const file $ files)
|
||||
|
||||
let cmd =
|
||||
let doc = "File texts in subdirectories" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "Files all texts in parameter in every directory in parameter, using hardlinks";
|
||||
`P "Use it to create sub-repositories for sharing or converting" ]
|
||||
in
|
||||
let info = Cmd.info "file" ~doc ~man in
|
||||
Cmd.v info file_t
|
||||
100
cmd/txt/gemini.ml
Normal file
100
cmd/txt/gemini.ml
Normal file
@@ -0,0 +1,100 @@
|
||||
let ext = ".gmi"
|
||||
|
||||
module GeminiConverter = struct
|
||||
include Converter.Gemini
|
||||
let angled_uri u a = if String.sub u 0 10 <> "urn:txtid:" then
|
||||
angled_uri u a else angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a
|
||||
end
|
||||
|
||||
let page _conversion text =
|
||||
let open Kosuzu.Text in
|
||||
"# " ^ text.title
|
||||
^ "\nAuthors: " ^ Kosuzu.Person.Set.to_string text.authors
|
||||
^ "\nDate: " ^ Kosuzu.Date.(pretty_date @@ listing text.date)
|
||||
^ let module T = Parsers.Plain_text.Make (GeminiConverter) in
|
||||
"\n" ^ T.of_string text.body ""
|
||||
|
||||
let date_index title meta_list =
|
||||
List.fold_left
|
||||
(fun a m ->
|
||||
a ^ "=> " ^ Kosuzu.Text.short_id m ^ ".gmi " ^
|
||||
Kosuzu.(Date.(pretty_date (listing m.date)) ^ " " ^ m.title) ^ "\n")
|
||||
("# " ^ title ^ "\n\n## Posts by date\n\n") meta_list
|
||||
|
||||
let to_dated_links ?(limit) meta_list =
|
||||
let meta_list = match limit with
|
||||
| None -> meta_list
|
||||
| Some limit->
|
||||
let rec reduced acc i = function
|
||||
| [] -> acc
|
||||
| h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in
|
||||
List.rev @@ reduced [] 0 meta_list
|
||||
in
|
||||
List.fold_left
|
||||
(fun a m ->
|
||||
a
|
||||
^ "=> " ^ Kosuzu.Text.short_id m ^ ".gmi "
|
||||
^ Kosuzu.(Date.(pretty_date (listing m.Text.date))) ^ " "
|
||||
^ m.Kosuzu.Text.title ^ "\n")
|
||||
"" meta_list
|
||||
|
||||
let topic_link root topic =
|
||||
let replaced_space = String.map (function ' '->'+' | x->x) in
|
||||
"=> index." ^ replaced_space root ^ ".gmi " ^ String.capitalize_ascii topic ^ "\n"
|
||||
|
||||
let text_item path meta =
|
||||
let open Kosuzu in
|
||||
"=> " ^ path ^ Text.short_id meta ^ ".gmi "
|
||||
^ Date.(pretty_date (listing meta.Text.date)) ^ " "
|
||||
^ meta.Text.title ^ "\n"
|
||||
|
||||
let listing_index topic_map topic_roots path metas =
|
||||
let rec item_group topics =
|
||||
List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics
|
||||
and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with
|
||||
| None -> ""
|
||||
| Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics)
|
||||
and items topic =
|
||||
let items =
|
||||
let open Kosuzu in
|
||||
List.fold_left
|
||||
(fun a e ->
|
||||
if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e))
|
||||
then text_item path e ^ a else a) "" metas in
|
||||
match items with
|
||||
| "" -> ""
|
||||
| x -> "## " ^ String.capitalize_ascii topic ^ "\n\n" ^ x
|
||||
in
|
||||
item_group topic_roots
|
||||
|
||||
let fold_topic_roots topic_roots =
|
||||
let list_item root t = topic_link root t in
|
||||
List.fold_left (fun a x -> a ^ list_item x x) "" (List.rev topic_roots)
|
||||
|
||||
let topic_main_index r title topic_roots metas =
|
||||
"# " ^ title ^ "\n\n"
|
||||
^ (if topic_roots <> [] then ("## Main topics\n\n" ^ fold_topic_roots topic_roots) else "")
|
||||
^ "\n## Latest\n\n" ^ to_dated_links ~limit:10 metas
|
||||
^ "\n=> index.date.gmi More by date\n\n"
|
||||
^ let peers = Kosuzu.Store.KV.find "Peers" r.Conversion.kv in
|
||||
if peers = "" then "" else
|
||||
List.fold_left (fun a s -> Printf.sprintf "%s=> %s\n" a s) "## Peers\n\n"
|
||||
(Str.split (Str.regexp ";\n") peers)
|
||||
|
||||
let topic_sub_index title topic_map topic_root metas =
|
||||
"# " ^ title ^ "\n\n"
|
||||
^ listing_index topic_map [topic_root] "" metas
|
||||
|
||||
let indices r =
|
||||
let open Kosuzu in
|
||||
let file name = File_store.file (Filename.concat r.Conversion.dir name) in
|
||||
let index_name = try Store.KV.find "Gemini-index" r.kv with Not_found -> "index.gmi" in
|
||||
let title = try Store.KV.find "Title" r.Conversion.kv with Not_found -> "" in
|
||||
if index_name <> "" then file index_name (topic_main_index r title r.topic_roots r.texts);
|
||||
file "index.date.gmi" (date_index title r.texts);
|
||||
List.iter
|
||||
(fun topic -> file ("index." ^ topic ^ ".gmi")
|
||||
(topic_sub_index title r.topics topic r.texts))
|
||||
r.topic_roots
|
||||
|
||||
let converter = Conversion.{ ext; page = Some page; indices = Some indices}
|
||||
181
cmd/txt/html.ml
Normal file
181
cmd/txt/html.ml
Normal file
@@ -0,0 +1,181 @@
|
||||
type templates_t = { header: string option; footer: string option }
|
||||
type t = { templates : templates_t; style : string }
|
||||
|
||||
let ext = ".htm"
|
||||
let empty_templates = { header = None; footer = None }
|
||||
let default_opts = { templates = empty_templates; style = "" }
|
||||
|
||||
let init kv =
|
||||
let open Kosuzu in
|
||||
let to_string key kv = match Store.KV.find key kv with
|
||||
| fname -> Some (File_store.to_string fname)
|
||||
| exception Not_found -> None in
|
||||
let header = to_string "HTM-header" kv in
|
||||
let footer = to_string "HTM-footer" kv in
|
||||
let style = match to_string "HTM-style" kv with
|
||||
| Some s -> Printf.sprintf "<style type=\"text/css\">%s</style>\n" s | None -> "" in
|
||||
{ templates = { header; footer}; style }
|
||||
|
||||
let wrap conv htm text_title body =
|
||||
let site_title = try Kosuzu.Store.KV.find "Title" conv.Conversion.kv with Not_found -> "" in
|
||||
let replace x = let open Str in
|
||||
global_replace (regexp "{{archive-title}}") site_title x
|
||||
|> global_replace (regexp "{{text-title}}") text_title
|
||||
in
|
||||
let feed = try Kosuzu.Store.KV.find "HTM-feed" conv.Conversion.kv
|
||||
with Not_found -> if Sys.file_exists (Filename.concat conv.Conversion.dir "feed.atom")
|
||||
then "feed.atom" else "" in
|
||||
let header = match htm.templates.header with
|
||||
| Some x -> replace x
|
||||
| None -> Printf.(sprintf "<a href='.'>%s</a>%s" site_title
|
||||
(if feed <> "" then sprintf "<a href='%s' id='feed'>feed</a>" feed else ""))
|
||||
in
|
||||
let footer = match htm.templates.footer with None -> "" | Some x -> replace x in
|
||||
Printf.sprintf "<!DOCTYPE HTML>\n<html>\n<head>\n<link rel=\"icon\" href=\"/favicon.ico\">\n<title>%s%s</title>\n%s\n%s\n<meta name=\"generator\" content=\"Kosuzu\">\n<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">\n<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">\n</head>\n<body>\n%s%s%s</body>\n</html>"
|
||||
text_title (if site_title <> "" then (" • " ^ site_title) else "")
|
||||
htm.style
|
||||
(if feed <> "" then Printf.sprintf "<link rel='alternate' href='%s' type='application/atom+xml'>" feed else "")
|
||||
header body footer
|
||||
|
||||
let topic_link root topic =
|
||||
let replaced_space = String.map (function ' '->'+' | x->x) in
|
||||
"<a href='index." ^ root ^ ".htm#" ^ replaced_space topic ^ "'>"
|
||||
^ String.capitalize_ascii topic ^ "</a>"
|
||||
|
||||
module HtmlConverter = struct
|
||||
include Converter.Html
|
||||
let uid_uri u a = Printf.sprintf "%s<a href='%s%s'><%s></a>" a u ext u
|
||||
let angled_uri u a =
|
||||
if try String.sub u 0 10 = "urn:txtid:" with Invalid_argument _ -> false
|
||||
then angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a else angled_uri u a
|
||||
end
|
||||
|
||||
let page htm conversion text =
|
||||
let open Kosuzu in
|
||||
let open Text in
|
||||
let module T = Parsers.Plain_text.Make (HtmlConverter) in
|
||||
let sep_append ?(sep=", ") a x = match a,x with "",_ -> x | _, "" -> a | _ -> a ^ sep ^ x in
|
||||
let opt_kv key value = if String.length value > 0
|
||||
then "<dt>" ^ key ^ "<dd>" ^ value else "" in
|
||||
let authors = Person.Set.to_string text.authors in
|
||||
let header =
|
||||
let time x = Printf.sprintf {|<time datetime="%s">%s</time>|}
|
||||
(Date.rfc_string x) (Date.pretty_date x) in
|
||||
let topic_links x =
|
||||
let to_linked t a =
|
||||
let ts = Topic_set.of_string t in
|
||||
sep_append a (List.fold_left (fun a t -> sep_append ~sep:" > " a (topic_link (List.hd ts) t)) "" ts) in
|
||||
String_set.fold to_linked x "" in
|
||||
let ref_links x =
|
||||
let link l = HtmlConverter.uid_uri l "" in
|
||||
String_set.fold (fun r a -> sep_append a (link r)) x "" in
|
||||
let references, replies = let open Conversion in
|
||||
let Rel.{ref_set; rep_set; _} = try Rel.Id_map.find text.id conversion.relations with Not_found -> Rel.empty in
|
||||
ref_links ref_set, ref_links rep_set in
|
||||
"<article><header><dl>"
|
||||
^ opt_kv "Title:" text.title
|
||||
^ opt_kv "Authors:" authors
|
||||
^ opt_kv "Date:" (time (Date.listing text.date))
|
||||
^ opt_kv "Series:" (str_set "series" text)
|
||||
^ opt_kv "Topics:" (topic_links (set "topics" text))
|
||||
^ opt_kv "Id:" text.id
|
||||
^ opt_kv "Refers:" (ref_links (set "references" text))
|
||||
^ opt_kv "In reply to:" (ref_links (set "in-reply-to" text))
|
||||
^ opt_kv "Referred by:" references
|
||||
^ opt_kv "Replies:" replies
|
||||
^ {|</dl></header><pre style="white-space:pre-wrap">|} in
|
||||
wrap conversion htm text.title ((T.of_string text.body header) ^ "</pre></article>")
|
||||
|
||||
let to_dated_links ?(limit) meta_list =
|
||||
let meta_list = match limit with
|
||||
| None -> meta_list
|
||||
| Some limit->
|
||||
let rec reduced acc i = function
|
||||
| [] -> acc
|
||||
| h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in
|
||||
List.rev @@ reduced [] 0 meta_list in
|
||||
List.fold_left
|
||||
(fun a m -> Printf.sprintf "%s <li> %s <a href=\"%s.htm\">%s</a>" a Kosuzu.(Date.(pretty_date (listing m.Text.date)))
|
||||
(Kosuzu.Text.short_id m) m.Kosuzu.Text.title)
|
||||
"" meta_list
|
||||
|
||||
let date_index ?(limit) conv htm meta_list =
|
||||
match limit with
|
||||
| Some limit -> wrap conv htm "Index" (to_dated_links ~limit meta_list)
|
||||
| None -> wrap conv htm "Index" (to_dated_links meta_list)
|
||||
|
||||
let fold_topic_roots topic_roots =
|
||||
let list_item root t = "<li>" ^ topic_link root t in
|
||||
"<nav><h2>Main topics</h2>"
|
||||
^ List.fold_left (fun a x -> a ^ list_item x x) "<ul>" (List.rev topic_roots)
|
||||
^ "</ul></nav>"
|
||||
|
||||
let fold_topics topic_map topic_roots metas =
|
||||
let open Kosuzu in
|
||||
let rec unordered_list root topic =
|
||||
List.fold_left (fun a x -> a ^ list_item root x) "<ul>" topic
|
||||
^ "</ul>"
|
||||
and sub_items root topic = match Topic_set.Map.find_opt topic topic_map with
|
||||
| None -> ""
|
||||
| Some (_, subtopics) -> unordered_list root (String_set.elements subtopics)
|
||||
and list_item root t =
|
||||
let item =
|
||||
if List.exists (fun x -> String_set.mem t (String_set.map Topic_set.topic (Text.set "topics" x))) metas
|
||||
then topic_link root t else String.capitalize_ascii t in
|
||||
"<ul><li>" ^ item ^ sub_items root t ^ "</ul>" in
|
||||
"<nav><h2>Topics</h2>"
|
||||
^ List.fold_left (fun a x -> a ^ list_item x x) "<ul>" (List.rev topic_roots)
|
||||
^ "</ul></nav>"
|
||||
|
||||
let text_item path meta =
|
||||
let open Kosuzu in
|
||||
"<time>" ^ Date.(pretty_date (listing meta.Text.date))
|
||||
^ {|</time> <a href="|} ^ path ^ Text.short_id meta ^ {|.htm">|} ^ meta.Text.title
|
||||
^ "</a><br>"
|
||||
|
||||
let listing_index topic_map topic_roots path metas =
|
||||
let rec item_group topics =
|
||||
List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics
|
||||
and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with
|
||||
| None -> ""
|
||||
| Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics)
|
||||
and items topic =
|
||||
let items =
|
||||
let open Kosuzu in
|
||||
List.fold_left
|
||||
(fun a e ->
|
||||
if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e))
|
||||
then text_item path e ^ a else a) "" metas in
|
||||
match items with
|
||||
| "" -> ""
|
||||
| x -> {|<h2 id="|} ^ topic ^ {|">|} ^ String.capitalize_ascii topic ^ "</h2>" ^ x in
|
||||
"<nav><h1>Texts</h1>" ^ item_group topic_roots ^ "</nav>"
|
||||
|
||||
let topic_main_index conv htm topic_roots metas =
|
||||
wrap conv htm "Topics"
|
||||
(fold_topic_roots topic_roots
|
||||
^ "<nav><h1>Latest</h1><ul>" ^ to_dated_links ~limit:10 metas
|
||||
^ {|</ul></nav><hr><a href="index.date.htm">More by date</a>|}
|
||||
^ let peers = try Kosuzu.Store.KV.find "Peers" conv.kv with Not_found -> "" in
|
||||
(if peers = "" then "" else
|
||||
List.fold_left (fun a s -> Printf.sprintf {|%s<li><a href="%s">%s</a>|} a s s) "<h1>Peers</h1><ul>"
|
||||
(Str.split (Str.regexp ";\n") (Kosuzu.Store.KV.find "Peers" conv.kv))
|
||||
^ "</ul>"))
|
||||
|
||||
let topic_sub_index conv htm topic_map topic_root metas =
|
||||
wrap conv htm topic_root
|
||||
(fold_topics topic_map [topic_root] metas
|
||||
^ listing_index topic_map [topic_root] "" metas)
|
||||
|
||||
let indices htm c =
|
||||
let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in
|
||||
let index_name = try Kosuzu.Store.KV.find "HTM-index" c.Conversion.kv with Not_found -> "index.html" in
|
||||
if index_name <> "" then file index_name (topic_main_index c htm c.topic_roots c.texts);
|
||||
file "index.date.htm" (date_index c htm c.texts);
|
||||
List.iter
|
||||
(fun root -> file ("index." ^ root ^ ".htm") (topic_sub_index c htm c.topics root c.texts))
|
||||
c.topic_roots
|
||||
|
||||
let converter kv =
|
||||
let htm = init kv in
|
||||
Conversion.{ ext; page = Some (page htm); indices = Some (indices htm) }
|
||||
93
cmd/txt/index.ml
Normal file
93
cmd/txt/index.ml
Normal file
@@ -0,0 +1,93 @@
|
||||
open Kosuzu
|
||||
|
||||
let text_editor name x =
|
||||
let fname, out = Filename.open_temp_file name "" in
|
||||
output_string out x; flush out;
|
||||
let r = match Unix.system ("$EDITOR " ^ fname) with
|
||||
| Unix.WEXITED 0 ->
|
||||
let inp = open_in fname in
|
||||
let line = input_line inp in
|
||||
close_in inp; line
|
||||
| _ -> failwith "Failed launching editor to edit value" in
|
||||
close_out out;
|
||||
Unix.unlink fname;
|
||||
r
|
||||
|
||||
let text_editor_lines name x =
|
||||
let fname, out = Filename.open_temp_file name "" in
|
||||
List.iter (fun s -> output_string out (s ^ "\n")) x; flush out;
|
||||
let r = match Unix.system ("$EDITOR " ^ fname) with
|
||||
| Unix.WEXITED 0 ->
|
||||
let inp = open_in fname in
|
||||
let lines =
|
||||
let rec acc a =
|
||||
try let a = String.trim (input_line inp) :: a in acc a
|
||||
with End_of_file -> a in
|
||||
acc [] in
|
||||
close_in inp; lines
|
||||
| _ -> failwith "Failed launching editor to edit value" in
|
||||
close_out out;
|
||||
Unix.unlink fname;
|
||||
r
|
||||
|
||||
let print_pack pck =
|
||||
let s ss = String.concat "\n\t" ss in
|
||||
let open Header_pack in
|
||||
Printf.printf "Id: %s\nTitle: %s\nAuthors: %s\nLocations:\n\t%s\nPeers:\n\t%s\n"
|
||||
pck.info.id pck.info.title (String.concat "," pck.info.people)
|
||||
(s pck.info.locations) (s (to_str_list pck.peers))
|
||||
|
||||
type t = { dir : string; index_path: string; pck : Header_pack.t }
|
||||
|
||||
let index r print title auth locs peers =
|
||||
let edit name index param = if print then index else match param with
|
||||
| Some "" -> text_editor name index | Some p -> p
|
||||
| None -> index in
|
||||
let edits name index param = if print then index else match param with
|
||||
| Some "" -> text_editor_lines name index | Some p -> String_set.list_of_csv p
|
||||
| None -> index in
|
||||
let edits_mp name index param = if print then index else match param with
|
||||
| Some "" -> Header_pack.str_list (text_editor_lines name (Header_pack.to_str_list index))
|
||||
| Some p -> Header_pack.str_list (String_set.list_of_csv p)
|
||||
| None -> index in
|
||||
let info = Header_pack.{ r.pck.info with
|
||||
title = edit "Title" r.pck.info.title title;
|
||||
people = edits "People" r.pck.info.people auth;
|
||||
locations = edits "Locations" r.pck.info.locations locs;
|
||||
} in
|
||||
let pack = Header_pack.{ info; fields;
|
||||
texts = of_text_list @@ File_store.fold ~dir:r.dir (fun a (t,_) -> of_text a t) [];
|
||||
peers = edits_mp "Peers" r.pck.peers peers;
|
||||
} in
|
||||
if print then print_pack pack
|
||||
else (File_store.file r.index_path (Header_pack.string pack))
|
||||
|
||||
let load dir =
|
||||
let kv = File_store.of_kv_file () in
|
||||
let index_path = Filename.concat dir "index.pck" in
|
||||
index { dir; index_path; pck = Header_pack.of_kv kv }
|
||||
|
||||
open Cmdliner
|
||||
let print = Arg.(value & flag & info ["print"] ~doc: "Print info")
|
||||
let title = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["t"; "title"] ~docv: "string" ~doc: "Title for index")
|
||||
let auth = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["a"; "authors"] ~docv: "Comma-separated names" ~doc: "Index authors")
|
||||
let locs = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["l"; "location"] ~docv: "Comma-separated URLs" ~doc: "Repository URLs")
|
||||
let peers = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["p"; "peers"] ~docv: "Comma-separated URLs" ~doc: "URLs to other known text repositories")
|
||||
let dir = Arg.(value & pos 0 string "." & info [] ~docv: "Directory to index")
|
||||
|
||||
let index_t = Term.(const load $ dir $ print $ title $ auth $ locs $ peers)
|
||||
|
||||
let cmd =
|
||||
let doc = "Generate an index.pck for texts in a directory" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "An index contains:\n";
|
||||
`P "* n info section with: title for the index, the authors, locations (URLs) the texts can be accessed.";
|
||||
`P "* listing of texts with: ID, date, title, authors, topics.";
|
||||
`P "* list of other text repositories (peers)";
|
||||
`S Manpage.s_environment;
|
||||
`P "EDITOR - Default editor name";
|
||||
`S Manpage.s_see_also;
|
||||
`P "MessagePack format. https://msgpack.org" ] in
|
||||
let info = Cmd.info "index" ~doc ~man in
|
||||
Cmd.v info index_t
|
||||
35
cmd/txt/last.ml
Normal file
35
cmd/txt/last.ml
Normal file
@@ -0,0 +1,35 @@
|
||||
open Kosuzu
|
||||
|
||||
let last a ((t,_) as pair) = match a with
|
||||
| None -> Some pair
|
||||
| Some (t', _) as pair' ->
|
||||
if Text.newest t t' > 0 then Some pair else pair'
|
||||
|
||||
let last_mine a ((t, _) as pair) =
|
||||
let name = Person.Set.of_string (Sys.getenv "USER") in
|
||||
let open Text in
|
||||
match a with
|
||||
| None -> if Person.Set.subset name t.authors then Some pair else None
|
||||
| Some (t', _) as pair' ->
|
||||
if Text.newest t t' > 0 && Person.Set.subset name t'.authors
|
||||
then Some pair else pair'
|
||||
|
||||
let last search_mine =
|
||||
let filter = if search_mine then last_mine else last in
|
||||
match File_store.fold filter None with
|
||||
| None -> ()
|
||||
| Some (_, f) -> List.iter print_endline f
|
||||
|
||||
open Cmdliner
|
||||
|
||||
let mine = Arg.(value & flag & info ["mine"] ~doc: "Last text authored by me")
|
||||
let last_t = Term.(const last $ mine)
|
||||
|
||||
let cmd =
|
||||
let doc = "Most recent text" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "Print the filename of most recent text" ]
|
||||
in
|
||||
let info = Cmd.info "last" ~doc ~man in
|
||||
Cmd.v info last_t
|
||||
44
cmd/txt/listing.ml
Normal file
44
cmd/txt/listing.ml
Normal file
@@ -0,0 +1,44 @@
|
||||
open Kosuzu
|
||||
module FS = File_store
|
||||
module A = Archive
|
||||
|
||||
let listing r order_opt reverse_opt number_opt paths_opt authors_opt topics_opt dir =
|
||||
let dir = if dir = "" then FS.txtdir () else dir in
|
||||
let predicates = A.predicate A.authored authors_opt @ A.predicate A.topics topics_opt in
|
||||
let predicate text = List.fold_left (fun a e -> a && e text) true predicates in
|
||||
let list_text (t, fnames) = Printf.printf "%s | %s | %s | %s %s\n"
|
||||
(Text.short_id t) Date.(pretty_date @@ listing t.Text.date)
|
||||
(Person.Set.to_string ~names_only:true t.Text.authors)
|
||||
t.Text.title (if paths_opt then (List.fold_left (Printf.sprintf "%s\n@ %s") "" fnames) else "")
|
||||
in
|
||||
match order_opt with
|
||||
| false -> FS.iter ~r ~dir ~predicate list_text
|
||||
| true ->
|
||||
let order = match reverse_opt with true -> FS.newest | false -> FS.oldest in
|
||||
match number_opt with
|
||||
| Some number -> FS.iter ~r ~dir ~predicate ~order ~number list_text
|
||||
| None -> FS.iter ~r ~dir ~predicate ~order list_text
|
||||
|
||||
open Cmdliner
|
||||
|
||||
let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories")
|
||||
let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order")
|
||||
let time = Arg.(value & flag & info ["t"] ~doc: "Sort by time, newest first")
|
||||
let paths = Arg.(value & flag & info ["p"] ~doc: "Show file paths")
|
||||
let number = Arg.(value & opt (some int) None & info ["n"] ~docv: "number" ~doc: "Number of entries to list")
|
||||
let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "comma-separated names" ~doc: "Texts by authors")
|
||||
let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "comma-separated topics" ~doc: "Texts by topics")
|
||||
let dir = Arg.(value & pos 0 string "" & info [] ~docv: "directory to index")
|
||||
|
||||
let listing_t = Term.(const listing $ recurse $ time $ reverse $ number $ paths $ authed $ topics $ dir)
|
||||
|
||||
let cmd =
|
||||
let doc = "List texts" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "Displays text id, date, author, title for a directory.";
|
||||
`P "If directory argument is omitted, TXTDIR is used, where empty value defaults to ~/.local/share/texts.";
|
||||
`P "If -R is used, list header information for texts found in subdirectories, too." ]
|
||||
in
|
||||
let info = Cmd.info "list" ~doc ~man in
|
||||
Cmd.v info listing_t
|
||||
29
cmd/txt/new.ml
Normal file
29
cmd/txt/new.ml
Normal file
@@ -0,0 +1,29 @@
|
||||
open Kosuzu
|
||||
open Cmdliner
|
||||
|
||||
let new_txt title topics_opt =
|
||||
let kv = Kosuzu.File_store.of_kv_file () in
|
||||
let authors = Person.Set.of_string (try Kosuzu.Store.KV.find "Authors" kv
|
||||
with Not_found -> Sys.getenv "USER") in
|
||||
let text = { (Text.blank ()) with title; authors } in
|
||||
let text = try Text.with_str_set text "Topics" (Option.get topics_opt) with _->text in
|
||||
match File_store.with_text text with
|
||||
| Error s -> prerr_endline s
|
||||
| Ok (filepath, _note) ->
|
||||
print_endline filepath
|
||||
|
||||
let title = Arg.(value & pos 0 string "" & info [] ~docv: "title" ~doc: "Title for new article")
|
||||
let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv: "Comma-separated topics" ~doc: "Topics for new article")
|
||||
|
||||
let new_t = Term.(const new_txt $ title $ topics)
|
||||
|
||||
let cmd =
|
||||
let doc = "Create a new article" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "Create a new article";
|
||||
`S Manpage.s_environment;
|
||||
`P "USER - The login name of the user, used if the Authors field is blank" ]
|
||||
in
|
||||
let info = Cmd.info "new" ~doc ~man in
|
||||
Cmd.v info new_t
|
||||
42
cmd/txt/peers.ml
Normal file
42
cmd/txt/peers.ml
Normal file
@@ -0,0 +1,42 @@
|
||||
let print_peers_of_peer p =
|
||||
let open Kosuzu.Header_pack in
|
||||
match Msgpck.to_list p.peers with [] -> ()
|
||||
| ps -> print_endline @@
|
||||
List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps
|
||||
|
||||
type filter_t = { authors: Kosuzu.Person.Set.t; topics: Kosuzu.String_set.t }
|
||||
|
||||
let print_peer () peer =
|
||||
let open Kosuzu.Peers in
|
||||
Printf.printf "%s" peer.path;
|
||||
List.iter (Printf.printf "\t%s\n") peer.pack.info.locations
|
||||
|
||||
let remove_repo id =
|
||||
let repopath = Filename.concat Kosuzu.Peers.text_dir id in
|
||||
match Sys.is_directory repopath with
|
||||
| false -> Printf.eprintf "No repository %s in %s" id Kosuzu.Peers.text_dir
|
||||
| true ->
|
||||
let cmd = Printf.sprintf "rm -r %s" repopath in
|
||||
Printf.printf "Run: %s ? (y/N) %!" cmd;
|
||||
match input_char stdin with
|
||||
|'y'-> if Sys.command cmd = 0 then print_endline "Removed" else prerr_endline "Failed"
|
||||
| _ -> ()
|
||||
|
||||
let peers = function
|
||||
| Some id -> remove_repo id
|
||||
| None ->
|
||||
Printf.printf "Peers in %s\n" Kosuzu.Peers.text_dir;
|
||||
Kosuzu.Peers.fold print_peer ()
|
||||
|
||||
open Cmdliner
|
||||
let remove = Arg.(value & opt (some string) None & info ["remove"] ~docv:"Repository ID" ~doc:"Remove repository texts and from future pulling")
|
||||
let peers_t = Term.(const peers $ remove)
|
||||
|
||||
let cmd =
|
||||
let doc = "List current peers" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "List current peers and associated information" ]
|
||||
in
|
||||
let info = Cmd.info "peers" ~doc ~man in
|
||||
Cmd.v info peers_t
|
||||
137
cmd/txt/pull.ml
Normal file
137
cmd/txt/pull.ml
Normal file
@@ -0,0 +1,137 @@
|
||||
let writer accum data =
|
||||
Buffer.add_string accum data;
|
||||
String.length data
|
||||
|
||||
let getContent connection url =
|
||||
Curl.set_url connection url;
|
||||
Curl.perform connection
|
||||
|
||||
let curl_pull url =
|
||||
let result = Buffer.create 4069
|
||||
and errorBuffer = ref "" in
|
||||
let connection = Curl.init () in
|
||||
try
|
||||
Curl.set_errorbuffer connection errorBuffer;
|
||||
Curl.set_writefunction connection (writer result);
|
||||
Curl.set_followlocation connection true;
|
||||
Curl.set_url connection url;
|
||||
Curl.perform connection;
|
||||
Curl.cleanup connection;
|
||||
Ok result
|
||||
with
|
||||
| Curl.CurlException (_reason, _code, _str) ->
|
||||
Curl.cleanup connection;
|
||||
Error (Printf.sprintf "Error: %s %s" url !errorBuffer)
|
||||
| Failure s ->
|
||||
Curl.cleanup connection;
|
||||
Error (Printf.sprintf "Caught exception: %s" s)
|
||||
|
||||
let newer time id dir =
|
||||
match Kosuzu.File_store.to_text @@ Filename.(concat dir (Kosuzu.Id.short id) ^ ".txt") with
|
||||
| Error x -> prerr_endline x; true
|
||||
| Ok txt -> time > (Kosuzu.(Header_pack.date (Date.listing txt.date)))
|
||||
| exception (Sys_error _) -> true
|
||||
|
||||
let print_peers p =
|
||||
let open Kosuzu.Header_pack in
|
||||
match Msgpck.to_list p.peers with [] -> ()
|
||||
| ps -> print_endline @@
|
||||
List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps
|
||||
|
||||
type filter_t = { authors: Kosuzu.Person.Set.t; topics: Kosuzu.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 (Kosuzu.Text.short_id text ^ ".txt")
|
||||
|
||||
let pull_text url dir id =
|
||||
let u = Filename.concat url ((Kosuzu.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
|
||||
match Kosuzu.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 per_text url dir filter print i id time title authors topics _refs _reps = match id with
|
||||
| "" -> Printf.eprintf "\nInvalid id for %s\n" title
|
||||
| id -> let open Kosuzu 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 = Filename.concat url "index.pck" in
|
||||
match curl_pull index_url with
|
||||
| Error s -> prerr_endline s; false
|
||||
| Ok body ->
|
||||
match Kosuzu.Header_pack.of_string (Buffer.contents body) with
|
||||
| Error s -> Printf.printf "Error with %s: %s\n" url s; false
|
||||
| Ok pk when pk.info.id = "" ->
|
||||
Printf.printf "Empty ID index.pck, skipping %s\n" url; false
|
||||
| Ok pk when not (Kosuzu.Validate.validate_id_length pk.info.id) ->
|
||||
Printf.printf "Index pack ID longer than 32 characters, skipping %s\n" url; false
|
||||
| Ok pk when not (Kosuzu.Validate.validate_id_chars pk.info.id) ->
|
||||
Printf.printf "Index pack contains invalid ID characters, skipping %s\n" url; false
|
||||
| Ok pk ->
|
||||
let dir = Filename.concat Kosuzu.Peers.text_dir pk.info.id in
|
||||
Kosuzu.File_store.with_dir dir;
|
||||
let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640
|
||||
(Filename.concat dir "index.pck") in
|
||||
output_string file ( Kosuzu.Header_pack.string {
|
||||
pk with info = { pk.info with locations = url::pk.info.locations }});
|
||||
close_out file;
|
||||
let filter = let open Kosuzu 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 name = match pk.info.title with "" -> url | title -> title in
|
||||
let print = printers (string_of_int @@ Kosuzu.Header_pack.numof_texts pk) name dir in
|
||||
try Kosuzu.Header_pack.iteri (per_text url dir filter print) pk; print_newline (); true
|
||||
with Invalid_argument msg -> Printf.printf "\nFailed to parse %s: %s\n%!" url msg; false
|
||||
|
||||
let pull_list auths topics =
|
||||
Curl.global_init Curl.CURLINIT_GLOBALALL;
|
||||
let pull got_one peer_url = if got_one then got_one else
|
||||
(pull_index peer_url auths topics) in
|
||||
let open Kosuzu in
|
||||
let fold_locations init peer =
|
||||
ignore @@ List.fold_left pull init peer.Peers.pack.Header_pack.info.locations;
|
||||
false
|
||||
in
|
||||
ignore @@ Peers.fold fold_locations false;
|
||||
Curl.global_cleanup ()
|
||||
|
||||
let pull url auths topics = match url with
|
||||
| "" -> pull_list auths topics | x -> ignore (pull_index x auths topics)
|
||||
|
||||
open Cmdliner
|
||||
let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] ~docv:"Comma-separated names" ~doc:"Filter by authors")
|
||||
let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv:"Comma-separated topics" ~doc:"Filter by topics")
|
||||
let url = Arg.(value & pos 0 string "" & info [] ~docv:"URL" ~doc:"Repository location")
|
||||
|
||||
let pull_t = Term.(const pull $ url $ authors $ topics)
|
||||
|
||||
let cmd =
|
||||
let doc = "Pull listed texts" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "Pull texts from known repositories." ]
|
||||
in
|
||||
let info = Cmd.info "pull" ~doc ~man in
|
||||
Cmd.v info pull_t
|
||||
23
cmd/txt/recent.ml
Normal file
23
cmd/txt/recent.ml
Normal file
@@ -0,0 +1,23 @@
|
||||
open Kosuzu
|
||||
module FS = File_store
|
||||
module A = Archive
|
||||
|
||||
open Cmdliner
|
||||
let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories")
|
||||
let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order")
|
||||
let paths = Arg.(value & flag & info ["p"] ~doc: "Show file paths")
|
||||
let number = Arg.(value & opt (some int) (Some 10) & info ["n"] ~docv: "number" ~doc: "Number of entries to list")
|
||||
let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated names" ~doc: "Texts by authors")
|
||||
let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "Comma-separated topics" ~doc: "Texts with topics")
|
||||
let dir = Arg.(value & pos 0 string "" & info [] ~docv: "Directory to index")
|
||||
|
||||
let recent_t = Term.(const Listing.listing $ recurse $ (const true) $ reverse $ number $ paths $ authed $ topics $ dir)
|
||||
let cmd =
|
||||
let doc = "List recent texts" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "List header information of most recent texts.";
|
||||
`P "If -R is used, list header information for texts found in subdirectories, too, along with their filepaths" ]
|
||||
in
|
||||
let info = Cmd.info "recent" ~doc ~man in
|
||||
Cmd.v info recent_t
|
||||
21
cmd/txt/topics.ml
Normal file
21
cmd/txt/topics.ml
Normal file
@@ -0,0 +1,21 @@
|
||||
open Kosuzu
|
||||
let topics r authors_opt =
|
||||
let predicates = Archive.(predicate authored authors_opt) in
|
||||
let predicate text = List.fold_left (fun a e -> a && e text) true predicates in
|
||||
let topic_union a (e, _) = String_set.union a (Text.set "topics" e) in
|
||||
let s = File_store.fold ~r ~predicate topic_union String_set.empty in
|
||||
print_endline @@ String_set.to_string s
|
||||
|
||||
open Cmdliner
|
||||
let recurse = Arg.(value & flag & info ["R"] ~doc: "Include texts in subdirectories")
|
||||
let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated authors" ~doc: "Topics by authors")
|
||||
let topics_t = Term.(const topics $ recurse $ authed)
|
||||
|
||||
let cmd =
|
||||
let doc = "List topics" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "List of topics" ]
|
||||
in
|
||||
let info = Cmd.info "topics" ~doc ~man in
|
||||
Cmd.v info topics_t
|
||||
36
cmd/txt/txt.ml
Normal file
36
cmd/txt/txt.ml
Normal file
@@ -0,0 +1,36 @@
|
||||
open Cmdliner
|
||||
|
||||
let subs = [
|
||||
Authors.cmd;
|
||||
Convert.cmd;
|
||||
Edit.cmd;
|
||||
File.cmd;
|
||||
Index.cmd;
|
||||
Last.cmd;
|
||||
Listing.cmd;
|
||||
New.cmd;
|
||||
Peers.cmd;
|
||||
Pull.cmd;
|
||||
Recent.cmd;
|
||||
Topics.cmd;
|
||||
Unfile.cmd;
|
||||
]
|
||||
|
||||
let default_cmd = Term.(ret (const (`Help (`Pager, None))))
|
||||
|
||||
let txt =
|
||||
let doc = "Discover, collect and exchange texts" in
|
||||
let man = [
|
||||
`S Manpage.s_authors;
|
||||
`P "orbifx <mailto:fox@orbitalfox.eu>";
|
||||
`P "Izuru Yakumo <mailto:yakumo.izuru@chaotic.ninja>";
|
||||
`S Manpage.s_bugs;
|
||||
`P "Please report them at <mailto:kosuzu-dev@chaotic.ninja>";
|
||||
`S Manpage.s_see_also;
|
||||
`P "This program is named after Kosuzu Motoori from Touhou Suzunaan: Forbidden Scrollery";
|
||||
`P "https://en.touhouwiki.net/wiki/Forbidden_Scrollery" ]
|
||||
in
|
||||
Cmd.group (Cmd.info "txt" ~version:"%%VERSION%%" ~doc ~man) ~default:default_cmd subs
|
||||
|
||||
let main () = exit (Cmd.eval txt)
|
||||
let () = main ()
|
||||
21
cmd/txt/unfile.ml
Normal file
21
cmd/txt/unfile.ml
Normal file
@@ -0,0 +1,21 @@
|
||||
open Kosuzu
|
||||
|
||||
let unfile files =
|
||||
let dirs, files = File_store.split_filetypes files in
|
||||
let unlink dir file = try Unix.unlink (Filename.concat dir file) with
|
||||
Unix.(Unix_error(ENOENT,_,_))-> () in
|
||||
List.iter (fun d -> List.iter (unlink d) files) dirs
|
||||
|
||||
open Cmdliner
|
||||
let files = Arg.(value & pos_all string [] & info [] ~docv: "Text filenames and subdirectories")
|
||||
|
||||
let unfile_t = Term.(const unfile $ files)
|
||||
|
||||
let cmd =
|
||||
let doc = "Unfile texts from subdirectories" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "Unfile texts in parameter from directories in parameter, by removing hardlinks" ]
|
||||
in
|
||||
let info = Cmd.info "unfile" ~doc ~man in
|
||||
Cmd.v info unfile_t
|
||||
Reference in New Issue
Block a user