[19] | 1 | let ext = ".atom"
|
---|
| 2 |
|
---|
[2] | 3 | let esc = Converter.Html.esc
|
---|
| 4 |
|
---|
| 5 | let element tag content = "<" ^ tag ^ ">" ^ content ^ "</" ^ tag ^ ">"
|
---|
| 6 |
|
---|
| 7 | let opt_element tag_name content =
|
---|
| 8 | if content <> ""
|
---|
| 9 | then element tag_name content
|
---|
| 10 | else ""
|
---|
| 11 |
|
---|
| 12 | module P = Parsers.Plain_text.Make (Converter.Html)
|
---|
| 13 |
|
---|
[3] | 14 | let id txt = "<id>urn:uuid:" ^ Logarion.(txt.Text.id) ^ "</id>"
|
---|
[2] | 15 | let title text = "<title>" ^ esc text.Logarion.Text.title ^ "</title>"
|
---|
| 16 |
|
---|
| 17 | let authors text =
|
---|
[3] | 18 | let u acc addr = acc ^ element "uri" addr in
|
---|
[2] | 19 | let open Logarion in
|
---|
| 20 | let fn txt a =
|
---|
| 21 | a ^ "<author>" ^ (opt_element "name" @@ esc txt.Person.name)
|
---|
| 22 | ^ (List.fold_left u "" txt.Person.addresses)
|
---|
| 23 | ^ "</author>" in
|
---|
| 24 | Person.Set.fold fn text.Text.authors ""
|
---|
| 25 |
|
---|
| 26 | let updated txt = let open Logarion in
|
---|
| 27 | "<updated>"^ Date.(txt.Text.date |> listing |> rfc_string) ^"</updated>"
|
---|
| 28 |
|
---|
| 29 | let htm_entry base_url text =
|
---|
| 30 | let open Logarion in
|
---|
| 31 | let u = Text.short_id text in
|
---|
| 32 | "<entry><link rel=\"alternate\" href=\"" ^ base_url ^ "/" ^ u ^ ".htm\" />"
|
---|
| 33 | ^ title text ^ id text ^ updated text ^ authors text
|
---|
| 34 | ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text)
|
---|
| 35 | ^ String_set.fold (fun elt a -> a ^ "<category term=\"" ^ esc elt ^ "\"/>") (Text.set "topics" text) ""
|
---|
| 36 | ^ "<content type=\"xhtml\"><div xmlns=\"http://www.w3.org/1999/xhtml\">"
|
---|
| 37 | ^ P.of_string text.body ""
|
---|
| 38 | ^ "</div></content></entry>\n"
|
---|
| 39 |
|
---|
| 40 | let gmi_entry base_url text =
|
---|
| 41 | let open Logarion in
|
---|
| 42 | let u = Text.short_id text in
|
---|
| 43 | "<entry><link rel=\"alternate\" href=\"" ^ base_url ^ "/" ^ u ^ ".gmi\" />"
|
---|
| 44 | ^ title text ^ id text ^ updated text ^ authors text
|
---|
| 45 | ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text)
|
---|
| 46 | ^ String_set.fold (fun elt a -> a ^ "<category term=\"" ^ elt ^ "\"/>") (Text.set "topics" text) ""
|
---|
| 47 | ^ "</entry>\n"
|
---|
| 48 |
|
---|
[19] | 49 | let base_url kv protocol = try
|
---|
| 50 | let locs = Logarion.Store.KV.find "Locations" kv in
|
---|
| 51 | let _i = Str.(search_forward (regexp (protocol ^ "://[^;]*")) locs 0) in
|
---|
| 52 | Str.(matched_string locs)
|
---|
[26] | 53 | with Not_found -> Printf.eprintf "Missing location for %s, add it to txt.conf\n" protocol; ""
|
---|
[19] | 54 |
|
---|
| 55 | let indices alternate_type c =
|
---|
| 56 | let file name = Logarion.File_store.file (Filename.concat c.Conversion.dir name) in
|
---|
| 57 | let title = try Logarion.Store.KV.find "Title" c.Conversion.kv with Not_found -> "" in
|
---|
| 58 | let entry, fname, protocol_regexp = match alternate_type with
|
---|
| 59 | | "text/gemini" -> gmi_entry, "gmi.atom", "gemini"
|
---|
| 60 | | "text/html" | _ -> htm_entry, "feed.atom", "https?"
|
---|
| 61 | in
|
---|
| 62 | let base_url = base_url c.kv protocol_regexp in
|
---|
| 63 | let self = Filename.concat base_url fname in
|
---|
[26] | 64 | file fname @@ (*TODO: alternate & self per url*)
|
---|
[19] | 65 | {|<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom" xml:base="|} ^ base_url ^ {|"><title>|}
|
---|
| 66 | ^ title ^ {|</title><link rel="alternate" type="|} ^ alternate_type ^ {|" href="|}
|
---|
| 67 | ^ base_url ^ {|/" /><link rel="self" type="application/atom+xml" href="|}
|
---|
| 68 | ^ self ^ {|" /><id>urn:uuid:|} ^ c.Conversion.id ^ "</id><updated>"
|
---|
| 69 | ^ Logarion.Date.now () ^ "</updated>\n"
|
---|
| 70 | ^ List.fold_left (fun acc t -> acc ^ entry base_url t) "" c.texts
|
---|
| 71 | ^ "</feed>"
|
---|
| 72 |
|
---|
| 73 | let converter format = Conversion.{ ext; page = None; indices = Some (indices format) }
|
---|