Almost-minimal filesystem based blog.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

WRT.pm 31KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101
  1. package App::WRT;
  2. # From semver.org:
  3. #
  4. # Given a version number MAJOR.MINOR.PATCH, increment the:
  5. #
  6. # MAJOR version when you make incompatible API changes,
  7. # MINOR version when you add functionality in a backwards-compatible
  8. # manner, and
  9. # PATCH version when you make backwards-compatible bug fixes.
  10. #
  11. # Additional labels for pre-release and build metadata are available as
  12. # extensions to the MAJOR.MINOR.PATCH format.
  13. #
  14. # Honestly I have always found it just about impossible to follow semver
  15. # without overthinking a bunch of hair-splitting decisions and categories,
  16. # but whatever. I'll try to follow it, roughly.
  17. use version; our $VERSION = version->declare("v6.3.1");
  18. use strict;
  19. use warnings;
  20. no warnings 'uninitialized';
  21. use 5.10.0;
  22. use utf8;
  23. use Carp;
  24. use Cwd qw(getcwd abs_path);
  25. use Encode qw(decode encode);
  26. use File::Spec;
  27. use HTML::Entities;
  28. use JSON;
  29. use XML::Atom::SimpleFeed;
  30. use App::WRT::Date;
  31. use App::WRT::EntryStore;
  32. use App::WRT::FileIO;
  33. use App::WRT::HTML qw(:all);
  34. use App::WRT::Image qw(image_size);
  35. use App::WRT::Markup qw(line_parse image_markup eval_perl);
  36. use App::WRT::Util qw(dir_list file_get_contents);
  37. =pod
  38. =head1 NAME
  39. App::WRT - WRiting Tool, a static site/blog generator and related utilities
  40. =head1 SYNOPSIS
  41. Using the commandline tools:
  42. $ mkdir project
  43. $ cd project
  44. $ wrt init # set up some defaults
  45. $ wrt config # dump configuration values
  46. $ wrt ls # list entries
  47. $ wrt display new # print HTML for new entries to stdout
  48. $ wrt render-all # publish HTML to project/public/
  49. Using App::WRT in library form:
  50. #!/usr/bin/env perl
  51. use App::WRT;
  52. my $w = App::WRT->new(
  53. entry_dir => 'archives',
  54. url_root => '/',
  55. # etc.
  56. );
  57. print $w->display(@ARGV);
  58. =head1 INSTALLING
  59. It's possible but not likely this would run on a Perl as old as 5.10.0. In
  60. practice, I know that it works under 5.26.2. It should be fine on any
  61. reasonably modern Linux distribution, and may work on MacOS or a BSD of your
  62. choosing. It's possible that it would run under the Windows Subsystem for
  63. Linux, but it would definitely fail under vanilla Windows; it currently makes
  64. too many assumptions about things like directory path separators and filesystem
  65. semantics.
  66. (Although I would like the code to be more robust across platforms, this is not
  67. a problem I feel much urgency about solving at the moment, since I'm pretty
  68. sure I am the only user of this software. Patches would certainly be welcome.)
  69. To install the latest development version from the main repo:
  70. $ git clone https://code.p1k3.com/gitea/brennen/wrt.git
  71. $ cd wrt
  72. $ perl Build.PL
  73. $ ./Build installdeps
  74. $ ./Build test
  75. $ ./Build install
  76. To install the latest version released on CPAN:
  77. $ cpanm App::WRT
  78. Or:
  79. $ cpan -i App::WRT
  80. You will likely need to use C<sudo> or C<su> to get a systemwide install.
  81. =head1 DESCRIPTION
  82. This started life somewhere around 2001 as C<display.pl>, a CGI script to
  83. concatenate fragments of handwritten HTML by date. It has since accumulated
  84. several of the usual weblog features (lightweight markup, feed generation,
  85. embedded Perl, poetry tools, image galleries, and ill-advised dependencies),
  86. but the basic idea hasn't changed that much.
  87. The C<wrt> utility now generates static HTML files, instead of expecting to
  88. run as a CGI script. This is a better idea, for the most part.
  89. By default, entries are stored in a simple directory tree under C<entry_dir>.
  90. Like:
  91. archives/2001/1/1
  92. archives/2001/1/2/index
  93. archives/2001/1/2/sub_entry
  94. Which will publish files like so:
  95. public/index.html
  96. public/all/index.html
  97. public/2001/index.html
  98. public/2001/1/index.html
  99. public/2001/1/1/index.html
  100. public/2001/1/2/index.html
  101. public/2001/1/2/sub_entry/index.html
  102. Contents will be generated for each year and for the entire collection of dated
  103. entries. Month indices will consist of all entries for that month. A
  104. top-level index file will consist of the most recent month's entries.
  105. It's possible (although not as flexible as it ought to be) to redefine the
  106. directory layout. (See C<%default{entry_map}> below.)
  107. An entry may be either a plain UTF-8 text file, or a directory containing
  108. several such files. If it's a directory, a file named "index" will be treated
  109. as the text of the entry, and all other lower-case filenames without extensions
  110. will be treated as sub-entries or documents within that entry, and displayed
  111. accordingly. Links to certain other filetypes will be displayed as well.
  112. Directories may be nested to an arbitrary depth, although it's probably not a
  113. good idea to go very deep with the current display logic.
  114. A PNG or JPEG file with a name like
  115. 2001/1/1.icon.png
  116. 2001/1/1/index.icon.png
  117. 2001/1/1/whatever.icon.png
  118. 2001/1/1/whatever/index.icon.png
  119. will be treated as an icon for the corresponding entry file.
  120. =head2 MARKUP
  121. Entries may consist of hand-written HTML (to be passed along without further
  122. interpretation), a supported form of lightweight markup, or some combination
  123. thereof. Actually, an entry may consist of any darn thing you please, as long
  124. as Perl will agree that it is text, but presumably you're going to be feeding
  125. this to a browser.
  126. Header tags (<h1>, <h2>, etc.) will be used to display titles in feeds and
  127. other places.
  128. Other special markup is indicated by a variety of HTML-like container tags.
  129. B<Embedded Perl> - evaluated and replaced by whatever value you return
  130. (evaluated in a scalar context):
  131. <perl>my $dog = "Ralph."; return $dog;</perl>
  132. This code is evaluated before any other processing is done, so you can return
  133. any other markup understood by the script and have it handled appropriately.
  134. B<Interpolated variables> - actually keys to the hash underlying the App::WRT
  135. object, for the moment:
  136. <perl>$self->{title} = "About Ralph, My Dog"; return '';</perl>
  137. <p>The title is <em>${title}</em>.</p>
  138. This is likely to change at some point, so don't build anything too elaborate
  139. on it.
  140. Embedded code and variables are intended only for use in the F<template> file,
  141. where it's handy to drop in titles or conditionalize aspects of a layout. You
  142. want to be careful with this sort of thing - it's useful in small doses, but
  143. it's also a maintainability nightmare waiting to happen.
  144. B<Includes> - replaced by the contents of the enclosed file path, from the
  145. root of the current wrt project:
  146. <include>path/to/file</include>
  147. This is a bit constraining, since it doesn't currently allow for files outside
  148. of the current project, but is useful for including HTML generated by an
  149. external script in a page.
  150. B<Several forms of lightweight markup>:
  151. <markdown>John Gruber's Markdown, by way of
  152. Text::Markdown::Discount</markdown>
  153. <textile>Dean Allen's Textile, via Brad Choate's
  154. Text::Textile.</textile>
  155. <freeverse>An easy way to
  156. get properly broken lines
  157. plus -- em dashes --
  158. for poetry and such.</freeverse>
  159. B<And a couple of shortcuts>:
  160. <image>filename.ext
  161. alt text, if any</image>
  162. <list>
  163. one list item
  164. another list item
  165. </list>
  166. As it stands, freeverse, image, and list are not particularly robust.
  167. =head2 TEMPLATES
  168. A single template, specified by the C<template_dir> and C<template> config
  169. values, is used to render all pages. See F<example/templates/basic> for an
  170. example, or run C<wrt init> in an empty directory and look at
  171. F<templates/default>.
  172. Here's a short example:
  173. <!DOCTYPE html>
  174. <html>
  175. <head>
  176. <meta charset="UTF-8">
  177. <title>${title_prefix} - ${title}</title>
  178. </head>
  179. <body>
  180. ${content}
  181. </body>
  182. </html>
  183. Within templates, C<${foo}> will be replaced with the corresponding
  184. configuration value. C<${content}> will always be set to the content of the
  185. current entry.
  186. =cut
  187. =head2 CONFIGURATION
  188. Configuration is read from a F<wrt.json> in the directory where the C<wrt>
  189. utility is invoked, or can (usually) be specified with the C<--config> option.
  190. See F<example/wrt.json> for a sample configuration.
  191. Under the hood, configuration is done by combining a hash called C<%default>
  192. with values pulled out of the JSON file. Most defaults can be overwritten
  193. from the config file, but changing some would require writing Perl, since
  194. they contain things like subroutine references.
  195. =cut
  196. =over
  197. =item %default
  198. Here's a verbatim copy of C<%default>, with some commentary about values.
  199. my %default = (
  200. root_dir => '.', # dir for wrt repository
  201. entry_dir => 'archives', # dir for entry files
  202. publish_dir => 'public', # dir to publish site to
  203. url_root => "/", # root URL for building links
  204. image_url_root => '', # same for images
  205. template_dir => 'templates', # dir for template files
  206. template => 'default', # template to use
  207. title => '', # current title (used in template)
  208. title_prefix => '', # a string to slap in front of titles
  209. stylesheet_url => undef, # path to a CSS file (used in template)
  210. favicon_url => undef, # path to a favicon (used in template)
  211. feed_alias => 'feed', # what entry path should correspond to feed?
  212. feed_length => 30, # how many entries should there be in the feed?
  213. author => undef, # author name (used in template, feed)
  214. description => undef, # site description (used in template)
  215. content => undef, # place to stash content for templates
  216. embedded_perl => 1, # evaluate embedded <perl> tags?
  217. default_entry => 'new', # what to display if no entry specified
  218. cache_includes => 0, # should included files be cached in memory?
  219. # A license string for site content:
  220. license => 'public domain',
  221. # A string value to replace all pages with (useful for occasional
  222. # situations where every page of a site should serve some other
  223. # content in-place, like Net Neutrality protest blackouts):
  224. overlay => undef,
  225. # What gets considered an entry _path_:
  226. entrypath_expr => qr/^ ([a-z0-9_\/-]+) $/x,
  227. # What gets considered a subentry file (slightly misleading
  228. # terminology here):
  229. subentry_expr => qr/^[0-9a-z_-]+(\.(tgz|zip|tar[.]gz|gz|txt))?$/,
  230. # We'll show links for these, but not display them inline:
  231. binfile_expr => qr/[.](tgz|zip|tar[.]gz|gz|txt|pdf)$/,
  232. );
  233. =cut
  234. my %default = (
  235. root_dir => '.', # dir for wrt repository
  236. root_dir_abs => undef, # for stashing absolute path to wrt repo
  237. entry_dir => 'archives', # dir for entry files
  238. publish_dir => 'public', # dir to publish site to
  239. url_root => "/", # root URL for building links
  240. image_url_root => '', # same for images
  241. template_dir => 'templates', # dir for template files
  242. template => 'default', # template to use
  243. title => '', # current title (used in template)
  244. title_prefix => '', # a string to slap in front of titles
  245. stylesheet_url => undef, # path to a CSS file (used in template)
  246. favicon_url => undef, # path to a favicon (used in template)
  247. feed_alias => 'feed', # what entry path should correspond to feed?
  248. feed_length => 30, # how many entries should there be in the feed?
  249. author => undef, # author name (used in template, feed)
  250. description => undef, # site description (used in template)
  251. content => undef, # place to stash content for templates
  252. embedded_perl => 1, # evaluate embedded <perl> tags?
  253. default_entry => 'new', # what to display if no entry specified
  254. cache_includes => 0, # should included files be cached in memory?
  255. # A license string for site content:
  256. license => 'public domain',
  257. # A string value to replace all pages with (useful for occasional
  258. # situations where every page of a site should serve some other
  259. # content in-place, like Net Neutrality protest blackouts):
  260. overlay => undef,
  261. # What gets considered an entry _path_:
  262. entrypath_expr => qr/^ ([a-z0-9_\/-]+) $/x,
  263. # What gets considered a subentry file (slightly misleading
  264. # terminology here):
  265. subentry_expr => qr/^[0-9a-z_-]+(\.(tgz|zip|tar[.]gz|gz|txt))?$/,
  266. # We'll show links for these, but not display them inline:
  267. binfile_expr => qr/[.](tgz|zip|tar[.]gz|gz|txt|pdf)$/,
  268. );
  269. =item $default{entry_map}
  270. A hashref which will dispatch entries matching various regexen to the
  271. appropriate output methods. The default looks something like this:
  272. nnnn/[nn/nn/]doc_name - a document within a day.
  273. nnnn/nn/nn - a specific day.
  274. nnnn/nn - a month.
  275. nnnn - a year.
  276. doc_name - a document in the root directory.
  277. You can re-map things to an arbitrary archive layout.
  278. Since the entry map is a hash, and handle() simply loops over its keys, there
  279. is no guaranteed precedence of patterns. Be extremely careful that no entry
  280. will match more than one pattern, or you will wind up with unexpected behavior.
  281. A good way to ensure that this does not happen is to use patterns like:
  282. qr(
  283. ^ # start of string
  284. [0-9/]{4}/ # year
  285. [0-9]{1,2}/ # month
  286. [0-9]{1,2] # day
  287. $ # end of string
  288. )x
  289. ...always marking the start and end of the string explicitly.
  290. This may eventually be rewritten to use an array so that the order can be
  291. explicitly specified.
  292. =cut
  293. $default{entry_map} = {
  294. qr'^[0-9/]{5,11}[a-z_/]+$' => sub { entry_stamped (@_, 'index') },
  295. qr'^[0-9]{4}/[0-9]{1,2}/
  296. [0-9]{1,2}$'x => sub { entry_stamped (@_, 'all' ) },
  297. qr'^[0-9]{4}/[0-9]{1,2}$' => sub { month (@_ ) },
  298. qr'^[0-9]{4}$' => sub { year (@_ ) },
  299. qr'^[a-z_]' => sub { entry_stamped (@_, 'all' ) },
  300. };
  301. =item $default{entry_descriptions}
  302. A hashref which contains a map of entry titles to entry descriptions.
  303. =cut
  304. # TODO: this has gotten more than a little silly.
  305. $default{entry_descriptions} = {
  306. new => 'newest entries',
  307. all => 'all entries',
  308. };
  309. =item $default{title_cache}
  310. A hashref which contains a cache of entry titles, populated by the renderer.
  311. =cut
  312. $default{title_cache} = { };
  313. =back
  314. =head2 METHODS AND INTERNALS
  315. For no bigger than this thing is, the internals are convoluted. (This is
  316. because it's spaghetti code originally written in a now-archaic language by a
  317. teenager who didn't know how to program.)
  318. =over
  319. =item new_from_file($config_file)
  320. Takes a filename to pull JSON config data out of, and returns a new App::WRT
  321. instance with the parameters set in that file.
  322. =cut
  323. sub new_from_file {
  324. my ($config_file) = @_;
  325. my $JSON = JSON->new->utf8->pretty;
  326. # Grab configuration from wrt.json or other file:
  327. my $config_hashref = $JSON->decode(file_get_contents($config_file));
  328. # decode() returns a hashref; this needs to be dereferenced:
  329. return App::WRT->new(%{ $config_hashref });
  330. }
  331. =item new(%params)
  332. Get a new WRT object with the specified parameters set.
  333. =cut
  334. sub new {
  335. my $class = shift;
  336. my %params = @_;
  337. # Stash absolute path to root directory.
  338. # TODO: This is bad. It's here because imgsize() winds up calling getcwd()
  339. # a ton of times if you don't give it absolute paths, which is actually super
  340. # inefficient. See icon_markup() and image_markup() for usage. image_markup()
  341. # in particular is awful and should be rewritten anyway.
  342. $params{root_dir_abs} = abs_path($params{root_dir});
  343. my %copy_of_default = %default;
  344. my $self = \%copy_of_default;
  345. bless $self, $class;
  346. # Configure from passed-in values, overwriting defaults:
  347. for my $p (keys %params) {
  348. $self->{$p} = $params{$p};
  349. }
  350. $self->{entries} = App::WRT::EntryStore->new( $self->{entry_dir} );
  351. # Check and set up template path for later use:
  352. $self->{template_path} = File::Spec->catfile(
  353. $self->{template_dir},
  354. $self->{template}
  355. );
  356. unless (-f $self->{template_path}) {
  357. croak($self->{template_path} . ' does not exist or is not a plain file');
  358. }
  359. return $self;
  360. }
  361. =item display($entry1, $entry2, ...)
  362. Return a string containing the given entries, which are in the form of
  363. date/entry strings. If no parameters are given, default to default_entry().
  364. display() expands aliases ("new" and "all", for example) as necessary, collects
  365. output from handle($entry), and wraps the whole thing in a template file.
  366. If C<overlay> is set, will return the value of overlay regardless of options.
  367. (This is useful for hackily replacing every page in a site with a single blob
  368. of HTML, for example if you're participating in some sort of blackout or
  369. something.)
  370. =cut
  371. sub display {
  372. my $self = shift;
  373. my (@entries) = @_;
  374. return $self->{overlay} if defined $self->{overlay};
  375. # If no entries are defined, fall back to the default:
  376. $entries[0] //= $self->{default_entry};
  377. # Title for template:
  378. $self->{title} = join ' ', map { encode_entities($_) } @entries;
  379. # Expand on any aliases:
  380. @entries = map { $self->expand_alias($_) } @entries;
  381. # Hacky special case for printing the feed:
  382. if ($entries[0] eq $self->{feed_alias}) {
  383. return $self->feed_print(
  384. $self->{entries}->recent_days( $self->{feed_length} )
  385. );
  386. }
  387. # To be accessed as ${content} in the template below:
  388. $self->{content} = join '', map { $self->handle($_) } @entries;
  389. return $self->fragment_slurp($self->{template_path});
  390. }
  391. =item handle($entry)
  392. Return the text of an individual entry.
  393. =cut
  394. sub handle {
  395. my ($self, $entry) = @_;
  396. # Hashref:
  397. my $map = $self->{entry_map};
  398. # Find the first pattern in entry_map that matches this entry...
  399. my ($pattern) = grep { $entry =~ $_ } keys %{ $map };
  400. return unless defined $pattern;
  401. # ...and use the corresponding coderef to handle the entry:
  402. return $map->{$pattern}->($self, $entry);
  403. }
  404. =item expand_alias($option)
  405. Expands/converts 'all', 'new', and 'fulltext' to appropriate values.
  406. Removes trailing slashes.
  407. =cut
  408. sub expand_alias {
  409. my ($self, $alias) = @_;
  410. # Take care of trailing slashes:
  411. chop $alias if $alias =~ m{/$};
  412. return reverse $self->{entries}->all_years() if $alias eq 'all';
  413. return $self->{entries}->recent_days(5) if $alias eq 'new';
  414. return $self->{entries}->all_days() if $alias eq 'fulltext';
  415. # No expansion, just give back our original value:
  416. return $alias;
  417. }
  418. =item link_bar(@extra_links)
  419. Returns a little context-sensitive navigation bar.
  420. =cut
  421. sub link_bar {
  422. my $self = shift;
  423. my (@extra_links) = @_;
  424. my $output;
  425. my (%description) = %{ $self->{entry_descriptions} };
  426. my @linklist = ( qw(new all), @extra_links );
  427. foreach my $link (@linklist) {
  428. my $link_title;
  429. if (exists $description{$link}) {
  430. $link_title = $description{$link};
  431. } else {
  432. $link_title = 'entries for ' . $link;
  433. }
  434. my $href = $self->{url_root} . $link . '/';
  435. if ($link eq 'new') {
  436. $href = $self->{url_root};
  437. }
  438. my $link_html = a({href => $href, title => $link_title}, $link) . "\n";
  439. if ($self->{title} eq $link) {
  440. $link_html = qq{<strong>$link_html</strong>};
  441. }
  442. $output .= $link_html;
  443. }
  444. return $output;
  445. }
  446. =item year($year)
  447. List out the updates for a year.
  448. =cut
  449. sub year {
  450. my $self = shift;
  451. my ($year) = @_;
  452. # Year is a text file:
  453. return entry_markup($self->entry($year))
  454. if $self->{entries}->is_file($year);
  455. # If it's not a directory, we can't do anything further. Bail out:
  456. return p('No such year.')
  457. unless $self->{entries}->is_dir($year);
  458. my $result;
  459. # Handle year directories with index files:
  460. $result .= $self->entry($year)
  461. if $self->{entries}->has_index($year);
  462. my $header_text = $self->icon_markup($year, $year);
  463. $header_text ||= q{};
  464. $result .= heading("${header_text}${year}", 3);
  465. my @months = reverse $self->{entries}->months_for($year);
  466. my $year_text;
  467. my $count = 0; # explicitly defined for later printing.
  468. foreach my $month (@months) {
  469. my $month_text = '';
  470. my @days = $self->{entries}->days_for($month);
  471. $count += @days;
  472. foreach my $day (@days) {
  473. my ($day_file, $day_url) = $self->root_locations($day);
  474. $month_text .= a(
  475. { href => "${day_url}/" },
  476. $self->{entries}->basename($day)
  477. ) . "\n";
  478. }
  479. $month_text = small("( $month_text )");
  480. my ($month_file, $month_url) = $self->root_locations($month);
  481. my $link = a(
  482. { href => "${month_url}/" },
  483. App::WRT::Date::month_name($self->{entries}->basename($month))
  484. );
  485. $year_text .= table_row(
  486. table_cell({class => 'datelink'}, $link),
  487. table_cell({class => 'datelink'}, $month_text)
  488. ) . "\n\n";
  489. }
  490. if ($count > 1) {
  491. $year_text .= table_row(
  492. table_cell(scalar(@months) . ' months'),
  493. table_cell("$count entries")
  494. );
  495. }
  496. elsif ($count == 0) { $year_text .= table_row(table_cell('No entries')); }
  497. elsif ($count == 1) { $year_text .= table_row(table_cell("$count entry")); }
  498. $result .= "\n\n" . table($year_text) . "\n";
  499. return entry_markup($result);
  500. }
  501. =item month($month)
  502. Prints the entries in a given month (nnnn/nn).
  503. =cut
  504. sub month {
  505. my ($self, $month) = @_;
  506. my ($month_file, $month_url) = $self->root_locations($month);
  507. # If $month is a directory, render those of its children with day-like names:
  508. if ($self->{entries}->is_dir($month)) {
  509. my $result;
  510. $result = $self->entry($month)
  511. if $self->{entries}->has_index($month);
  512. my @days = reverse $self->{entries}->days_for($month);
  513. foreach my $day (@days) {
  514. $result .= $self->entry_stamped($day);
  515. }
  516. return $result;
  517. } elsif ($self->{entries}->is_file($month)) {
  518. # If $month is a file, it should just be rendered as a regular entry, more
  519. # or less:
  520. return $self->entry($month);
  521. }
  522. }
  523. =item entry_stamped($entry, $level)
  524. Wraps entry() + a datestamp in entry_markup().
  525. =cut
  526. sub entry_stamped {
  527. my $self = shift;
  528. my ($entry, $level) = @_;
  529. return entry_markup(
  530. $self->entry($entry, $level)
  531. . $self->datestamp($entry)
  532. );
  533. }
  534. =item entry_topic_list($entry)
  535. Get a list of topics (by tag-* files) for the entry. This hardcodes part of a
  536. p1k3-specific thing which should be moved into wrt entirely.
  537. =cut
  538. sub entry_topic_list {
  539. my $self = shift;
  540. my ($entry) = @_;
  541. my @tags = sort grep { m/^tag-.*/ } $self->{entries}->props_for($entry);
  542. return '' unless @tags;
  543. return join ', ', map {
  544. s/^tag-(.*)$/$1/;
  545. a($_, { href => $self->{url_root} . 'topics/' . $_ })
  546. } @tags;
  547. }
  548. =item entry($entry)
  549. Returns the contents of a given entry. May recurse, slightly.
  550. =cut
  551. sub entry {
  552. my ($self, $entry, $level) = @_;
  553. $level ||= 'index';
  554. # Location of entry on local filesystem, and its URL:
  555. my ($entry_loc, $entry_url) = $self->root_locations($entry);
  556. my $result;
  557. # Display an icon, if we have one:
  558. if ( my $ico_markup = $self->icon_markup($entry) ) {
  559. $result .= heading($ico_markup, 2) . "\n\n";
  560. }
  561. # For text files:
  562. if ($self->{entries}->is_file($entry)) {
  563. return $result . $self->fragment_slurp($entry_loc);
  564. }
  565. # Past this point, we're assuming a directory.
  566. # Print index as head, if extant and a normal file:
  567. if ($self->{entries}->has_index($entry)) {
  568. $result .= $self->fragment_slurp("$entry_loc/index");
  569. }
  570. # Followed by any sub-entries:
  571. my @sub_entries = $self->get_sub_entries($entry_loc);
  572. if (@sub_entries >= 1) {
  573. # If the wrt-noexpand property is present, then don't expand sub-entries.
  574. # A hack.
  575. if ($level eq 'index' || $self->{entries}->has_prop($entry, 'wrt-noexpand')) {
  576. # Icons or text links:
  577. $result .= $self->list_contents($entry, @sub_entries);
  578. }
  579. elsif ($level eq 'all') {
  580. # Everything displayable in the directory:
  581. foreach my $se (@sub_entries) {
  582. next if ($se =~ $self->{binfile_expr});
  583. $result .= p({class => 'centerpiece'}, '+')
  584. . $self->entry("$entry/$se");
  585. }
  586. # Handle links to any remaining files that match binfile_expr:
  587. $result .= $self->list_contents(
  588. $entry,
  589. grep { $self->{binfile_expr} } @sub_entries
  590. );
  591. }
  592. }
  593. return $result;
  594. }
  595. =item get_sub_entries($entry_loc)
  596. Returns "sub entries" based on the C<subentry_expr> regexp.
  597. =cut
  598. sub get_sub_entries {
  599. my ($self, $entry_loc) = @_;
  600. # index gets special treatment as the text body of an entry, rather
  601. # than as a sub-entry:
  602. my %ignore = ('index' => 1);
  603. return grep { ! $ignore{$_} }
  604. dir_list($entry_loc, 'alpha', $self->{subentry_expr});
  605. }
  606. =item list_contents($entry, @entries)
  607. Returns links (maybe with icons) for a set of sub-entries within an entry.
  608. =cut
  609. sub list_contents {
  610. my $self = shift;
  611. my ($entry) = shift;
  612. my (@entries) = @_;
  613. my $contents;
  614. foreach my $se (@entries) {
  615. my $linktext = $self->icon_markup("$entry/$se", $se);
  616. $linktext ||= $se;
  617. $contents .= q{ }
  618. . a({ href => $self->{url_root} . "$entry/$se",
  619. title => $se },
  620. $linktext);
  621. }
  622. return p( em('more:') . " $contents" ) . "\n";
  623. }
  624. =item icon_markup($entry, $alt)
  625. Check if an icon exists for a given entry if so, return markup to include it.
  626. Icons are PNG or JPEG image files following a specific naming convention:
  627. index.icon.[png|jp(e)g] for directories
  628. [filename].icon.[png|jp(e)g] for flat text files
  629. Calls image_size, uses filename to determine type.
  630. =cut
  631. { my %cache;
  632. sub icon_markup {
  633. my ($self, $entry, $alt) = @_;
  634. return $cache{$entry . $alt}
  635. if defined $cache{$entry . $alt};
  636. my $icon_basepath;
  637. if ($self->{entries}->is_file($entry)) {
  638. $icon_basepath = "$entry.icon";
  639. }
  640. elsif ($self->{entries}->is_dir($entry)) {
  641. $icon_basepath = "$entry/index.icon";
  642. }
  643. # First suffix found will be used:
  644. my $suffix;
  645. for (qw(png jpg gif jpeg)) {
  646. if ($self->{entries}->is_extant( "$icon_basepath.$_")) {
  647. $suffix = $_;
  648. last;
  649. }
  650. }
  651. # Fail unless there's a file with one of the above suffixes:
  652. return 0 unless $suffix;
  653. my ($icon_loc, $icon_url) = $self->root_locations($icon_basepath);
  654. # Slurp width & height from the image file:
  655. my ($width, $height) = image_size(
  656. $self->{root_dir_abs} . '/' . "$icon_loc.$suffix"
  657. );
  658. return $cache{$entry . $alt} =
  659. qq{<img src="$icon_url.$suffix"\n width="$width" }
  660. . qq{height="$height"\n alt="$alt" />};
  661. }
  662. }
  663. =item datestamp($entry)
  664. Returns a nice html datestamp / breadcrumbs for a given entry.
  665. =cut
  666. sub datestamp {
  667. my $self = shift;
  668. my ($entry) = @_;
  669. my @fragment_stack;
  670. my @fragment_stamps = (
  671. a({ href => $self->{url_root} }, $self->{title_prefix}),
  672. );
  673. # Chop up by directory separator:
  674. my @pieces = split '/', $entry;
  675. foreach my $fragment (@pieces) {
  676. push @fragment_stack, $fragment;
  677. push @fragment_stamps,
  678. a({ href => $self->{url_root} . (join '/', @fragment_stack) . '/',
  679. title => $fragment }, $fragment);
  680. }
  681. my $stamp = $self->entry_topic_list($entry)
  682. . " :: "
  683. . join(" /\n", @fragment_stamps);
  684. return p({class => 'datelink'}, "\n$stamp\n");
  685. }
  686. =item fragment_slurp($file)
  687. Read a text fragment, call line_parse() and eval_perl() to take care of
  688. lightweight markup sections and interpret embedded code, and then return it as
  689. a string. Takes one parameter, the name of the file.
  690. =cut
  691. sub fragment_slurp {
  692. my $self = shift;
  693. my ($file) = @_;
  694. my $everything = file_get_contents($file);
  695. return $self->line_parse(
  696. # Handle embedded perl first
  697. ($self->{embedded_perl} ? $self->eval_perl($everything) : $everything),
  698. $file # some context to work with
  699. );
  700. }
  701. =item root_locations($file)
  702. Given an entry, return the appropriate concatenations with entry_dir and
  703. url_root.
  704. =cut
  705. sub root_locations {
  706. return (
  707. $_[0]->{entry_dir} . '/' . $_[1], # location on filesystem
  708. $_[0]->{url_root} . $_[1] # URL
  709. );
  710. }
  711. =item feed_print(@entries)
  712. Return an Atom feed for the given list of entries.
  713. Requires XML::Atom::SimpleFeed.
  714. XML::Atom::SimpleFeed will give bogus results with input that's just a string
  715. of octets (I think) if it contains characters outside of US-ASCII. In order to
  716. spit out clean UTF-8 output, we need to use Encode::decode() to flag entry
  717. content as UTF-8 / represent it internally as a string of characters. There's
  718. a whole lot I don't really understand about how this is handled in Perl, and it
  719. may be a locus of bugs elsewhere in wrt, but for now I'm just dealing with it
  720. here.
  721. Some references on that:
  722. =over
  723. =item * L<https://github.com/ap/XML-Atom-SimpleFeed/issues/2>
  724. =item * L<https://rt.cpan.org/Public/Bug/Display.html?id=19722>
  725. =item * L<https://cpanratings.perl.org/dist/XML-Atom-SimpleFeed>
  726. =item * L<perlunitut>
  727. =back
  728. =cut
  729. sub feed_print {
  730. my $self = shift;
  731. my (@entries) = @_;
  732. my $feed_url = $self->{url_root} . $self->{feed_alias};
  733. my ($first_entry_file, $first_entry_url) = $self->root_locations($entries[0]);
  734. # TODO: Probably ought to consider utf-8 in titles, authors, etc., as well as
  735. # entry content.
  736. my $feed = XML::Atom::SimpleFeed->new(
  737. -encoding => 'UTF-8',
  738. title => $self->{title_prefix} . '::' . $self->{title},
  739. subtitle => $self->{description},
  740. link => $self->{url_root},
  741. link => { rel => 'self', href => $feed_url, },
  742. icon => $self->{favicon_url},
  743. author => $self->{author},
  744. id => $self->{url_root},
  745. generator => 'App::WRT.pm / XML::Atom::SimpleFeed',
  746. updated => App::WRT::Date::iso_date(App::WRT::Date::get_mtime($first_entry_file)),
  747. );
  748. foreach my $entry (@entries) {
  749. my $content = $self->entry($entry) . "\n" . $self->datestamp($entry);
  750. my $utf8_content = decode('UTF-8', $content, Encode::FB_CROAK);
  751. my $title = $entry;
  752. my ($entry_file, $entry_url) = $self->root_locations($entry);
  753. # Try to pull out a header:
  754. my ($extracted_title) = $utf8_content =~ m{<h1.*?>(.*?)</h1>}s;
  755. my (@subtitles) = $utf8_content =~ m{<h2.*?>(.*?)</h2>}sg;
  756. if ($extracted_title) {
  757. $title = $extracted_title;
  758. if (@subtitles) {
  759. $title .= ' - ' . join ' - ', @subtitles;
  760. }
  761. }
  762. $feed->add_entry(
  763. title => $title,
  764. link => $entry_url,
  765. id => $entry_url,
  766. content => $utf8_content,
  767. updated => App::WRT::Date::iso_date(App::WRT::Date::get_mtime($entry_file)),
  768. );
  769. }
  770. # return "Content-type: application/atom+xml\n\n" . $feed->as_string;
  771. return $feed->as_string;
  772. }
  773. =back
  774. =head1 SEE ALSO
  775. walawiki.org, Blosxom, rassmalog, Text::Textile, XML::Atom::SimpleFeed,
  776. Image::Size, and about a gazillion static site generators.
  777. =head1 AUTHOR
  778. Copyright 2001-2019 Brennen Bearnes
  779. =head1 LICENSE
  780. wrt is free software; you can redistribute it and/or modify
  781. it under the terms of the GNU General Public License as published by
  782. the Free Software Foundation; either version 2 of the License, or
  783. (at your option) any later version.
  784. This program is distributed in the hope that it will be useful,
  785. but WITHOUT ANY WARRANTY; without even the implied warranty of
  786. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  787. GNU General Public License for more details.
  788. You should have received a copy of the GNU General Public License
  789. along with this program. If not, see <http://www.gnu.org/licenses/>.
  790. =cut
  791. 1;