4
5:- module(plog_server, [
6 server/1,
7 server/2
8]). 9
10:- dynamic content/1. 11
12:- use_module(library(http/thread_httpd)). 13:- use_module(library(http/http_dispatch)). 14:- use_module(library(http/html_write)). 15:- use_module(library(http/http_parameters)). 16:- use_module(library(uri)). 17:- use_module(library(pcre)). 18:- use_module(library(http/http_path)). 19:- use_module(library(http/http_files)). 20
21:- use_module(plog_markdown). 22:- use_module(plog_style). 23
24
25:- http_handler(root(.), list_blogs, []). 26:- http_handler(root(blogs), list_blog, []). 27:- http_handler(root('rss.xml'), rss_handler, []). 28
29:- multifile http:location/3. 30http:location(images, root(images), []).
31:- multifile http:location/3. 32http:location(contents, root(contents), []).
33
34:- multifile http:location/3. 35http:location(images, root(images), []).
36:- multifile http:location/3. 37http:location(contents, root(contents), []).
38
39:- multifile user:file_search_path/2. 40user:file_search_path(images, 'images').
41:- multifile user:file_search_path/2. 42user:file_search_path(contents, 'contents').
43
44:- multifile plog:site_title/1, plog:site_link/1, plog:site_description/1. 45site_title(T) :- (plog:site_title(T) -> true ; T = 'BlauAnarchy\'s Blogs').
46site_link(L) :- (plog:site_link(L) -> true ; L = 'https://blauanarchy.org').
47site_description(D) :- (plog:site_description(D) -> true ; D = 'A Blog site on Symbolic Coherence, written in pure prolog.').
48
49:- http_handler(images(.), image_handler, [prefix]). 50:- http_handler(contents(.), content_handler, [prefix]). 51
52image_handler(Request) :-
53 http_reply_from_files('images', [], Request).
54content_handler(Request) :-
55 http_reply_from_files('contents', [], Request).
56
57rss_handler(_) :-
58 generate_rss(XML),
59 format('Content-type: application/rss+xml~n~n'),
60 format('~w', [XML]).
61
62content_files(Files) :-
63 absolute_file_name(contents, Dir, [ file_type(directory), access(read)]),
64 directory_files(Dir, Raw),
65 exclude(is_dot, Raw, Files).
66is_dot('.').
67is_dot('..').
68
69
70file_info(File, Size, Modified) :-
71 absolute_file_name(contents(File), Path, [access(read)]),
72 size_file(Path, Size),
73 time_file(Path, Modified).
74
75format_timestamp(Stamp, Time) :-
76 stamp_date_time(Stamp, DT, 'UTC'),
77 format_time(string(Time), '%Y-%m-%d %H:%M:%S', DT).
78
79server(Port) :-
80 server(Port, []).
81server(Port, Options) :-
82 set_paths_from_options(Options),
83 http_server(http_dispatch, [port(Port)]),
84 thread_get_message(never).
85
86set_paths_from_options(Options) :-
87 ( member(content_dir(ContentsDir), Options)
88 -> retractall(user:file_search_path(contents, _)),
89 asserta(user:file_search_path(contents, ContentsDir))
90 ; true
91 ),
92 ( member(images_dir(ImagesDir), Options)
93 -> retractall(user:file_search_path(images, _)),
94 asserta(user:file_search_path(images, ImagesDir))
95 ; true
96 ).
97
98list_blogs(_Request) :-
99 site_title(Title),
100 content_files(Files),
101 predsort(compare_by_published_desc, Files, Sorted),
102 reply_html_page(
103 title(Title),
104 [ \page_style ],
105 [
106 div([id(content)], [
107 h1(Title),
108 table(
109 [
110 \header|
111 \blogs(Sorted)
112 ]
113 ),
114 \pack_about
115 ])
116 ]
117 ).
118
119pack_about -->
120 html(footer([id(meta)], [
121 p([
122 'Built by ',
123 strong('Zhongying Qiao'),
124 ' using ',
125 code('Plog'),
126 ', an SWI-Prolog blog engine that renders Markdown at request time,',
127 ' in ',
128 strong('Pure Prolog.')
129 ]),
130 p([
131 a([ href('https://github.com/cryptoque/prolog-blog-engine')
132 , target('_blank')
133 , rel('noopener noreferrer')
134 ],
135 'View the source on GitHub')
136 ])
137 ])).
138
-->
140 html(tr([ th([class(title)], 'Title'), th([class(desc)], ''), th([class(time)], 'Last Updated At')])).
141
142blogs([]) --> [].
143blogs([H|T]) -->
144 {get_blog_display_name(H, H0)},
145 html(tr([td([class(title)], \blog_link(H0, H)), td([class(desc)], ''), td([class(time)], \get_published_at(H))])),
146 blogs(T).
147
148get_published_at(Blog) -->
149 { file_info(Blog, _, Created) },
150 { format_timestamp(Created, CreatedFormatted) },
151 html(CreatedFormatted).
152
153compare_by_published_desc(Order, BlogA, BlogB) :-
154 file_info(BlogA, _, TimeA),
155 file_info(BlogB, _, TimeB),
156 compare(TimeOrder, TimeB, TimeA),
157 ( TimeOrder == (=) -> compare(Order, BlogA, BlogB);
158 Order = TimeOrder
159 ).
160
161
162
163blog_link(Blog, Display) -->
164 { http_link_to_id(list_blog, [name=Display], HREF) },
165 html(a(href(HREF), Blog)).
166
167list_blog(Request) :-
168 http_parameters(Request, [name(Blog, [])]),
169 read_blog_files(Blog, Paragraphs),
170 [Innerparagraphs] = Paragraphs,
171 split_string(Innerparagraphs, "\n", "", ParagraphLines),
172 plog_markdown:render_paragraphs(ParagraphLines, HtmlParagraphs),
173 reply_html_page(
174 title('Title: ~w'-[Blog]),
175 [ \blog_style ],
176 [
177 div(id(content), HtmlParagraphs)
178 ]
179 ).
180
181get_blog_display_name(Blog, Path) :-
182 re_replace("_" /g , " ", Blog, Path0),
183 re_replace(".pl" /g , "", Path0, Path).
184
185read_blog_files(Blog, Paragraphs) :-
186 retractall(content(_)),
187 absolute_file_name(contents(Blog), Path, [access(read)]),
188 consult(Path),
189 findall(P, content(P), Paragraphs).
190
(XML) :-
192 site_title(Title),
193 site_link(Root),
194 site_description(Desc),
195 atomic_list_concat([Root, '/rss.xml'], FeedURL),
196
197 content_files(Files),
198 predsort(compare_by_published_desc, Files, Sorted),
199
200 findall(Item,
201 ( member(Blog, Sorted),
202 rss_item(Blog, Item)
203 ),
204 Items),
205
206 atomic_list_concat(Items, "\n", ItemsXML),
207
208 format(string(XML),
209'<?xml version=\'1.0\' encoding=\'ISO-8859-1\'?>
210<rss version=\'2.0\' xmlns:atom=\'http://www.w3.org/2005/Atom\'>
211<channel>
212<title>~w</title>
213<link>~w</link>
214<description>~w</description>
215<atom:link href=\'~w\' rel=\'self\' type=\'application/rss+xml\' />
216~w
217</channel>
218</rss>',
219 [Title, Root, Desc, FeedURL, ItemsXML]).
220
221
(Timestamp, RSS) :-
223 stamp_date_time(Timestamp, DT, 'UTC'),
224 format_time(string(RSS),
225 '%a, %d %b %Y %H:%M:%S GMT', DT).
226
(BlogFile, XML) :-
228 get_blog_display_name(BlogFile, Display),
229 file_info(BlogFile, _, Created),
230 rss_date(Created, PubDate),
231 http_link_to_id(list_blog, [name=BlogFile], RelLink),
232 site_link(Root),
233 uri_resolve(RelLink, Root, Link),
234 format(string(XML),
235'<item>
236<title>~w</title>
237<link>~w</link>
238<pubDate>~w</pubDate>
239<guid isPermaLink="true">~w</guid>
240</item>',
241 [Display, Link, PubDate, Link])