From 0021ae508f11cbfacf2a925580f3ecce93083b58 Mon Sep 17 00:00:00 2001 From: fox Date: Sun, 30 Oct 2022 14:48:02 +0000 Subject: [PATCH] Begin unifying conf and pck code; inline CSS; optional CSS & Atom git-svn-id: file:///srv/svn/repo/kosuzu/trunk@20 eb64cd80-c68d-6f47-b6a3-0ada418499da --- cli/conversion.ml | 11 +++++++++- cli/convert.ml | 55 ++++++++++++++++++++++++++--------------------- cli/html.ml | 30 +++++++++++++++----------- 3 files changed, 57 insertions(+), 39 deletions(-) diff --git a/cli/conversion.ml b/cli/conversion.ml index 80b74dc..b51709e 100644 --- a/cli/conversion.ml +++ b/cli/conversion.ml @@ -1,6 +1,7 @@ open Logarion type t = { - id: string; dir: string; + id: string; + dir: string; kv: string Store.KV.t; topic_roots: string list; topics: (String_set.t * String_set.t) Topic_set.Map.t; @@ -12,3 +13,11 @@ type fn_t = { page: (t -> Logarion.Text.t -> string) option; indices: (t -> unit) option; } + +let empty () = { + id = ""; dir = ""; + kv = Store.KV.empty; + topic_roots = []; + topics = Topic_set.Map.empty; + texts = [] +} diff --git a/cli/convert.ml b/cli/convert.ml index 39f6cbd..1f12fd9 100644 --- a/cli/convert.ml +++ b/cli/convert.ml @@ -1,7 +1,7 @@ open Logarion -let is_older source dest = try - Unix.((stat dest).st_mtime < (stat source).st_mtime) with _-> true +(*TODO: move to converters (style, feed checks)*) +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" -> @@ -26,47 +26,52 @@ let converters types kv = 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 dir id kv = - let empty = Topic_set.Map.empty in - let repo = Conversion.{ id; dir; kv; topic_roots = []; topics = empty; texts = [] } in +let directory converters noindex repo = let fn (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 ~order:newest fn (empty,[],0)) in - let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" kv) + let topics, texts, count = + File_store.(fold ~dir:repo.Conversion.dir ~order:newest fn (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 } 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 at_path types noindex path = - match path with "" -> prerr_endline "unspecified text file or directory" - | dir when Sys.file_exists dir && Sys.is_directory dir -> - let fname = Filename.concat dir "index.pck" in - (match Header_pack.of_string @@ File_store.to_string fname with - | Error s -> prerr_endline s +let load_kv dir = + let conf = Filename.concat dir ".convert.conf" in (* TODO: better name? *) + let kv = if Sys.file_exists conf then File_store.of_kv_file conf else Store.KV.empty 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 = let f = Filename.concat dir ".convert.conf" in (* TODO: better place to store convert conf? *) - if Sys.file_exists f then File_store.of_kv_file f else Store.KV.empty in + 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 = 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 - let cs = converters types kv in - directory cs noindex dir info.Header_pack.id kv) + kv + +let at_path types noindex path = match path with + | "" -> prerr_endline "unspecified text file or directory" | path when Sys.file_exists path -> - let repo = Conversion.{ - id = ""; dir = ""; kv = Store.KV.empty; topic_roots = []; - topics = Topic_set.Map.empty; texts = [] } in - let cs = converters types repo.kv in - (match File_store.to_text path with - | Ok text -> ignore @@ convert cs repo (text, [path]) - | Error s -> prerr_endline s) + 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 repo = { (Conversion.empty ()) with dir = ""; kv = load_kv "" } in + ignore @@ convert (converters types repo.kv) repo (text, [path]) + ) | path -> Printf.eprintf "Path doesn't exist: %s" path open Cmdliner let term = let path = Arg.(value & pos 0 string "" & info [] ~docv:"path" - ~doc:"Text file or directory to convert. Ff directory is provided, it must contain an index.pck (see: txt index)") in + ~doc:"Text file or directory to convert. If directory is provided, it must contain an index.pck (see: txt index)") in let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"output type" ~doc:"Convert to file type") in let noindex = Arg.(value & flag & info ["noindex"] diff --git a/cli/html.ml b/cli/html.ml index f8e4c93..1aa6e5d 100644 --- a/cli/html.ml +++ b/cli/html.ml @@ -1,9 +1,9 @@ type templates_t = { header: string option; footer: string option } -type t = { templates : templates_t } +type t = { templates : templates_t; style : string } let ext = ".htm" let empty_templates = { header = None; footer = None } -let default_opts = { templates = empty_templates } +let default_opts = { templates = empty_templates; style = "" } let init kv = let open Logarion in @@ -12,27 +12,31 @@ let init kv = | exception Not_found -> None in let header = to_string "HTM-header" kv in let footer = to_string "HTM-footer" kv in - { templates = { header; footer} } + let style = match to_string "HTM-style" kv with + | Some s -> Printf.sprintf "" s | None -> "" in + { templates = { header; footer}; style } let wrap conv htm text_title body = - let site_title = try Logarion.Store.KV.find "Title" conv.Conversion.kv - with Not_found -> "" in + let site_title = try Logarion.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 "{{archive-title}}") site_title x |> global_replace (regexp "{{text-title}}") text_title in + let feed = try Logarion.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 -> "
" ^ site_title ^ - "
" + | Some x -> replace x + | None -> Printf.(sprintf "
%s
%s" site_title + (if feed <> "" then sprintf "" feed else "")) in let footer = match htm.templates.footer with None -> "" | Some x -> replace x in - Printf.sprintf "%s%s\n\ - \ - \ + Printf.sprintf "%s%s\n%s\n%s\ \ \n%s%s%s" text_title (if site_title <> "" then (" • " ^ site_title) else "") + htm.style + (if feed <> "" then Printf.sprintf "" feed else "") header body footer let topic_link root topic = @@ -150,7 +154,7 @@ let topic_main_index conv htm topic_roots metas = (fold_topic_roots topic_roots ^ "