Browse Source

v6.0.0: expand EntryStore, test more, cache harder

This commit is something of a hairball, the result of evenings-and-weekends
hacking building up a set of changes that got out of hand in parallel.
If I had the energy to spare, I would break it apart into
semantically-related changes, but I don't - and I suppose all this crap
being rolled together is at least reflective of how the code was
written.

These changes are really half-finished, at best.  Eventual goals:

  - App::WRT shouldn't directly touch the filesystem
  - App::WRT::EntryStore should model the entry archive completely
  - App::WRT::Renderer should say what to write to the publication
    directory
  - This one's a maybe: Filesystem interaction should pass through
    App::WRT::FileIO or something like it so that EntryStore and Renderer
    can be more usefully tested, with mocked writes (maybe)

I do think this represents an inflection point in the long, silly life of
this program:  It includes a handful of new tests, and a number of the
code changes were in turn easy to make because the test suite begins to
model the code in a useful way.  It's less and less necessary to run wrt
against the p1k3.com archives to be sure that I haven't trashed something.

Breaking changes to note:

  - Will no longer render HTML for nonexistent entries
  - Months and years which are flatfiles or contain an index are handled
    differently, albeit less brokenly
  - EntryStore includes index files in its overall list of entries
    (this seems to break less than I thought), which trickles out to
    bin/wrt-ls

Overall changes herein:

  - App::WRT::Date
    - Move month_name() in here from App::WRT, add tests.

  - App::WRT::EntryStore
    - Hash file types for entries (directory or flatfile)
    - Use keys of file type hash for complete list of entries.
    - has_prop($entry, $property)
    - is_dir($entry), is_file($entry), is_extant($entry)
    - parent_of($entry)
    - has_index($entry)
    - Make EntryStore cache whether a file is a flatfile or a directory, as
      well as its existence, in a single hash.
    - Include index flatfiles in @source_files for use by has_index()
    - Various tests.

  - App::WRT::FileIO
    - Still duplicates a bunch of shit from Util, so that needs sorted.

  - App::WRT::Renderer
    - Convert to a proper class.
    - Add experimental FileIO class to use in Renderer (imperfect,
      tricky, still thinking about this).  The idea is to separate out the
      concerns of reading and writing the filesystem.

  - App::WRT
    - Refactor display() and improve tests
      - Use "@entries" instead of "@options" for clarity
      - Handle entry names that might evaluate as false
      - Test running display() without any params
    - Rename expand_option() -> expand_alias(), refactor
    - Use EntryStore::has_prop() to detect wrt-noexpand.prop
    - year(), month(), entry() partially rewritten to use EntryStore
    - year() should handle months which are a flatfile
    - Refactor icon_markup() to use is_file() / is_dir() / is_extant(),
      add tests.
    - Add subtitle to feeds

  - bin/wrt-ls is now a "modulino" with tests

  - bin/display errors on non-existent entries

  - Build.PL
    - Remove bogus XML::Feed dependency
Brennen Bearnes 5 months ago
parent
commit
be13fadb7c

+ 0
- 1
Build.PL View File

@@ -21,7 +21,6 @@ my $build = Module::Build->new(
21 21
     'Text::Textile'            => 0,
22 22
     'Time::HiRes'              => 0,
23 23
     'XML::Atom::SimpleFeed'    => '0.900',
24
-    'XML::Feed'                => 0,
25 24
     'perl'                     => '5.10.0',
26 25
   },
27 26
 

+ 37
- 0
Changes View File

@@ -1,5 +1,42 @@
1 1
 Revision history for App::WRT
2 2
 
3
+v6.0.0 2019-05-06
4
+
5
+  - App::WRT::Date
6
+    - Move month_name() in here from App::WRT, add tests.
7
+  - App::WRT::EntryStore:
8
+    - Hash file types for entries (directory or flatfile)
9
+    - Use keys of file type hash for complete list of entries.
10
+    - has_prop($entry, $property)
11
+    - is_dir($entry), is_file($entry), is_extant($entry)
12
+    - parent_of($entry)
13
+    - has_index($entry)
14
+    - Make EntryStore cache whether a file is a flatfile or a directory, as
15
+      well as its existence, in a single hash.
16
+    - Include index flatfiles in @source_files for use by has_index()
17
+    - Various tests.
18
+  - App::WRT::FileIO
19
+    - Still duplicates a bunch of shit from Util, so that needs sorted.
20
+  - App::WRT::Renderer
21
+    - Convert to a proper class.
22
+    - Add experimental FileIO class to use in Renderer (imperfect,
23
+      tricky, still thinking about this).  The idea is to separate out the
24
+      concerns of reading and writing the filesystem.
25
+  - App::WRT
26
+    - Refactor display() and improve tests
27
+      - Use "@entries" instead of "@options" for clarity
28
+      - Handle entry names that might evaluate as false
29
+      - Test running display() without any params
30
+    - Rename expand_option() -> expand_alias(), refactor
31
+    - Use EntryStore::has_prop() to detect wrt-noexpand.prop
32
+    - year(), month(), entry() partially rewritten to use EntryStore
33
+    - year() should handle months which are a flatfile
34
+    - Refactor icon_markup() to use is_file() / is_dir() / is_extant(),
35
+      add tests.
36
+    - Add subtitle to feeds
37
+  - bin/wrt-ls is now a "modulino" with tests
38
+  - bin/display errors on non-existent entries
39
+
3 40
 v5.0.0 2019-04-14
4 41
 
5 42
   - Add bin/wrt-ls for listing entries in current archive

+ 9
- 7
README.pod View File

@@ -141,7 +141,7 @@ any other markup understood by the script and have it handled appropriately.
141 141
 B<Interpolated variables> - actually keys to the hash underlying the App::WRT
142 142
 object, for the moment:
143 143
 
144
-     <perl>$self->title("About Ralph, My Dog"); return '';</perl>
144
+     <perl>$self->{title} = "About Ralph, My Dog"; return '';</perl>
145 145
 
146 146
      <p>The title is <em>${title}</em>.</p>
147 147
 
@@ -307,6 +307,10 @@ explicitly specified.
307 307
 
308 308
 A hashref which contains a map of entry titles to entry descriptions.
309 309
 
310
+=item $default{title_cache}
311
+
312
+A hashref which contains a cache of entry titles, populated by the renderer.
313
+
310 314
 =back
311 315
 
312 316
 =head2 METHODS AND INTERNALS
@@ -343,10 +347,12 @@ something.)
343 347
 
344 348
 Return the text of an individual entry.
345 349
 
346
-=item expand_option($option)
350
+=item expand_alias($option)
347 351
 
348 352
 Expands/converts 'all', 'new', and 'fulltext' to appropriate values.
349 353
 
354
+Removes trailing slashes.
355
+
350 356
 =item link_bar(@extra_links)
351 357
 
352 358
 Returns a little context-sensitive navigation bar.
@@ -366,7 +372,7 @@ Wraps entry() + a datestamp in entry_markup().
366 372
 =item entry_topic_list($entry)
367 373
 
368 374
 Get a list of topics (by tag-* files) for the entry.  This hardcodes part of a
369
-p1k3-specific thing which should probably be moved into wrt entirely.
375
+p1k3-specific thing which should be moved into wrt entirely.
370 376
 
371 377
 =item entry($entry)
372 378
 
@@ -401,10 +407,6 @@ Read a text fragment, call line_parse() and eval_perl() to take care of
401 407
 lightweight markup sections and interpret embedded code, and then return it as
402 408
 a string. Takes one parameter, the name of the file.
403 409
 
404
-=item month_name($number)
405
-
406
-Turn numeric dates into English.
407
-
408 410
 =item root_locations($file)
409 411
 
410 412
 Given a file/entry, return the appropriate concatenations with entry_dir and

+ 7
- 0
bin/wrt-display View File

@@ -104,5 +104,12 @@ if ($from_stdin) {
104 104
   (@to_display) = @ARGV;
105 105
 }
106 106
 
107
+# TODO: Better error reporting strategy, print this on stderr:
108
+foreach my $entry (@to_display) {
109
+  unless ($w->{entries}->is_extant($entry)) {
110
+    say("No such entry: $entry");
111
+    exit(1);
112
+  }
113
+}
107 114
 print $w->display(@to_display);
108 115
 exit(0);

+ 77
- 52
bin/wrt-ls View File

@@ -29,6 +29,7 @@ wrt-ls - list
29 29
     wrt ls --days   # entries for individual days
30 30
     wrt ls --months # entries for individual months 
31 31
     wrt ls --years  # entries for years
32
+    wrt ls --props  # all properties
32 33
 
33 34
     # Display help:
34 35
     wrt ls --help
@@ -62,62 +63,86 @@ use 5.10.0;
62 63
 
63 64
 use strict;
64 65
 use warnings;
65
-no  warnings 'uninitialized';
66 66
 
67
-use Getopt::Long;
67
+use Getopt::Long qw(GetOptionsFromArray);
68 68
 use Pod::Usage;
69 69
 use App::WRT;
70
-
71
-# Handle options, including help generated from the POD above.  See:
72
-# - http://perldoc.perl.org/Getopt/Long.html#User-defined-subroutines-to-handle-options
73
-# - https://metacpan.org/pod/Pod::Usage
74
-# - http://michael.thegrebs.com/2014/06/08/Pod-Usage/
75
-my $config_file = 'wrt.json';
76
-my $list_days = 0;
77
-my $list_months = 0;
78
-my $list_years = 0;
79
-my $list_all = 1;
80
-GetOptions(
81
-  'config=s' => \$config_file,
82
-  help       => sub { pod2usage(0) },
83
-  days       => \$list_days,
84
-  months     => \$list_months,
85
-  years      => \$list_years,
86
-) or pod2usage(2);
87
-
88
-# Allow only one of --days, --months, --years.  Default to listing all entries
89
-# if none of these are specified.
90
-my $option_count = 0;
91
-foreach ($list_days, $list_months, $list_years) {
92
-  $option_count += $_;
93
-}
94
-if ($option_count > 1) {
95
-  die "Please specify at most one of --days, --months, or --years.";
96
-} elsif ($option_count == 1) {
97
-  $list_all = 0;
98
-}
99
-
100
-unless (-e $config_file) {
101
-  die "No wrt config file found.  Tried: $config_file";
102
-}
103
-
104
-my $w = App::WRT::new_from_file($config_file);
105
-
106
-# Define the function that'll return the base list of entries to match
107
-# against:
108
-my $base_list;
109
-if ($list_days) {
110
-  $base_list = sub { $w->{entries}->all_days(); };
111
-} elsif ($list_months) {
112
-  $base_list = sub { $w->{entries}->all_months(); };
113
-} elsif ($list_years) {
114
-  $base_list = sub { $w->{entries}->all_years(); };
115
-} elsif ($list_all) {
116
-  $base_list = sub { $w->{entries}->all(); };
70
+use Carp;
71
+
72
+# If invoked directly from the command-line, caller() will return undef.
73
+# Execute main() with a callback to print output directly, and a copy of
74
+# our real @ARGV:
75
+if (not caller()) {
76
+  my $output = sub { say @_; };
77
+  main($output, @ARGV);
78
+  exit(0);
117 79
 }
118 80
 
119
-foreach my $entry ($base_list->()) {
120
-  say $entry;
81
+# main() takes an output callback and an @ARGV to pass in to
82
+# GetOptionsFromArray().  This allows relatively simple integration
83
+# tests to be written.  See also: t/bin-wrt-ls.t
84
+sub main {
85
+  my ($output, @local_argv) = @_;
86
+
87
+  # Handle options, including help generated from the POD above.  See:
88
+  # - http://perldoc.perl.org/Getopt/Long.html#User-defined-subroutines-to-handle-options
89
+  # - https://metacpan.org/pod/Pod::Usage
90
+  # - http://michael.thegrebs.com/2014/06/08/Pod-Usage/
91
+  my $config_file = 'wrt.json';
92
+  my $list_days = 0;
93
+  my $list_months = 0;
94
+  my $list_years = 0;
95
+  my $list_props = 0;
96
+  my $list_all = 1;
97
+  GetOptionsFromArray(
98
+    \@local_argv,
99
+    'config=s' => \$config_file,
100
+    help       => sub { pod2usage(0) },
101
+    days       => \$list_days,
102
+    months     => \$list_months,
103
+    years      => \$list_years,
104
+    props      => \$list_props,
105
+  ) or pod2usage(2);
106
+
107
+  # Allow only one of --days, --months, --years, --props.  Default to listing
108
+  # all entries if none of these are specified.
109
+  my $option_count = 0;
110
+  foreach ($list_days, $list_months, $list_years, $list_props) {
111
+    $option_count += $_;
112
+  }
113
+  if ($option_count > 1) {
114
+    croak("Please specify at most one of --days, --months, --years, --props.");
115
+  } elsif ($option_count == 1) {
116
+    $list_all = 0;
117
+  }
118
+
119
+  unless (-e $config_file) {
120
+    croak("No wrt config file found.  Tried: $config_file");
121
+  }
122
+
123
+  my $w = App::WRT::new_from_file($config_file);
124
+
125
+  # Define the function that'll return the base list of entries to match
126
+  # against:
127
+  my $base_list;
128
+  if ($list_days) {
129
+    $base_list = sub { $w->{entries}->all_days(); };
130
+  } elsif ($list_months) {
131
+    $base_list = sub { $w->{entries}->all_months(); };
132
+  } elsif ($list_years) {
133
+    $base_list = sub { $w->{entries}->all_years(); };
134
+  } elsif ($list_props) {
135
+    $base_list = sub { $w->{entries}->all_props(); };
136
+  } elsif ($list_all) {
137
+    $base_list = sub { $w->{entries}->all(); };
138
+  }
139
+
140
+  foreach my $entry ($base_list->()) {
141
+    # When invoked from command line, this will normally be a simple
142
+    # routine that does `say $entry`.  Under testing, it may instead
143
+    # accumulate output for checking elsewhere.
144
+    $output->($entry);
145
+  }
121 146
 }
122 147
 
123
-exit(0);
148
+1;

+ 14
- 3
bin/wrt-render-all View File

@@ -43,6 +43,9 @@ no  warnings 'uninitialized';
43 43
 use Getopt::Long;
44 44
 use Pod::Usage;
45 45
 use App::WRT;
46
+use App::WRT::Renderer;
47
+
48
+use App::WRT::Util qw(file_put_contents);
46 49
 
47 50
 # Handle options, including help generated from the POD above.  See:
48 51
 # - http://perldoc.perl.org/Getopt/Long.html#User-defined-subroutines-to-handle-options
@@ -58,9 +61,17 @@ unless (-e $config_file) {
58 61
   die "No wrt config file found.  Tried: $config_file";
59 62
 }
60 63
 
61
-my $w = App::WRT::new_from_file($config_file);
64
+my $wrt = App::WRT::new_from_file($config_file);
65
+
66
+# This expects a callback to handle logging output and a callback to handle
67
+# file writing:
68
+
69
+my $renderer = App::WRT::Renderer->new(
70
+  $wrt,
71
+  sub { say $_[0]; },
72
+  sub { file_put_contents($_[0], $_[1]); },
73
+);
62 74
 
63
-# This expects a callback to handle logging output:
64
-$w->render(sub { say $_[0]; });
75
+$renderer->render();
65 76
 
66 77
 exit(0);

+ 1
- 0
example/archives/2012 View File

@@ -0,0 +1 @@
1
+<p>I'm a year which is just a flatfile.</p>

+ 1
- 0
example/archives/2013/1/index View File

@@ -0,0 +1 @@
1
+<p>I'm a month which has an index file.</p>

+ 1
- 0
example/archives/2013/2 View File

@@ -0,0 +1 @@
1
+<p>I'm a month which is just a flatfile.</p>

+ 1
- 0
example/archives/2013/index View File

@@ -0,0 +1 @@
1
+<p>I'm an index file for an entire year.</p>

+ 1
- 0
example/archives/noexpand_test/do_not_expand_me View File

@@ -0,0 +1 @@
1
+<p>SHOULD NOT DISPLAY</p>

+ 1
- 0
example/archives/noexpand_test/index View File

@@ -0,0 +1 @@
1
+<p>SHOULD DISPLAY</p>

+ 0
- 0
example/archives/noexpand_test/wrt-noexpand.prop View File


+ 2
- 2
example/wrt.json View File

@@ -1,7 +1,7 @@
1 1
 {
2 2
    "entry_dir": "./archives",
3 3
    "publish_dir": "./public",
4
-   "title_prefix": "p1k3",
4
+   "title_prefix": "wrt",
5 5
    "template": "basic",
6 6
    "description": "a test wrt site",
7 7
    "url_root": "https://example.com/",
@@ -9,7 +9,7 @@
9 9
    "favicon_url": "https://example.com/favicon.png",
10 10
    "template_dir": "./templates",
11 11
    "stylesheet_url": "https://example.com/css/p1k3.css",
12
-   "author": "Brennen Bearnes",
12
+   "author": "Example Author",
13 13
    "entry_descriptions": {
14 14
      "new": "newest entries",
15 15
      "all": "all entries"

+ 93
- 109
lib/App/WRT.pm View File

@@ -1,6 +1,6 @@
1 1
 package App::WRT;
2 2
 
3
-use version; our $VERSION = version->declare("v5.0.0");
3
+use version; our $VERSION = version->declare("v6.0.0");
4 4
 
5 5
 use strict;
6 6
 use warnings;
@@ -10,9 +10,7 @@ use utf8;
10 10
 
11 11
 use Carp;
12 12
 use Cwd qw(getcwd abs_path);
13
-use Data::Dumper;
14 13
 use Encode qw(decode encode);
15
-use File::Find;
16 14
 use File::Spec;
17 15
 use HTML::Entities;
18 16
 use JSON;
@@ -20,12 +18,12 @@ use XML::Atom::SimpleFeed;
20 18
 
21 19
 use App::WRT::Date;
22 20
 use App::WRT::EntryStore;
21
+use App::WRT::FileIO;
23 22
 
24
-use App::WRT::HTML     qw(:all);
25
-use App::WRT::Image    qw(image_size);
26
-use App::WRT::Markup   qw(line_parse image_markup eval_perl);
27
-use App::WRT::Renderer qw(render);
28
-use App::WRT::Util     qw(dir_list get_date file_get_contents);
23
+use App::WRT::HTML   qw(:all);
24
+use App::WRT::Image  qw(image_size);
25
+use App::WRT::Markup qw(line_parse image_markup eval_perl);
26
+use App::WRT::Util   qw(dir_list get_date file_get_contents);
29 27
 
30 28
 =pod
31 29
 
@@ -170,7 +168,7 @@ any other markup understood by the script and have it handled appropriately.
170 168
 B<Interpolated variables> - actually keys to the hash underlying the App::WRT
171 169
 object, for the moment:
172 170
 
173
-     <perl>$self->title("About Ralph, My Dog"); return '';</perl>
171
+     <perl>$self->{title} = "About Ralph, My Dog"; return '';</perl>
174 172
 
175 173
      <p>The title is <em>${title}</em>.</p>
176 174
 
@@ -405,6 +403,14 @@ $default{entry_descriptions} = {
405 403
   all => 'all entries',
406 404
 };
407 405
 
406
+=item $default{title_cache}
407
+
408
+A hashref which contains a cache of entry titles, populated by the renderer.
409
+
410
+=cut
411
+
412
+$default{title_cache} = { };
413
+
408 414
 =back
409 415
 
410 416
 =head2 METHODS AND INTERNALS
@@ -491,27 +497,28 @@ something.)
491 497
 
492 498
 sub display {
493 499
   my $self = shift;
494
-  my (@options) = @_;
500
+  my (@entries) = @_;
495 501
 
496 502
   return $self->{overlay} if defined $self->{overlay};
497 503
 
498
-  $options[0] ||= $self->{default_entry};
504
+  # If no entries are defined, fall back to the default:
505
+  $entries[0] //= $self->{default_entry};
499 506
 
500
-  # Title for template head/foot:
501
-  $self->{title} = join ' ', map { encode_entities($_) } @options;
507
+  # Title for template:
508
+  $self->{title} = join ' ', map { encode_entities($_) } @entries;
502 509
 
503 510
   # Expand on any aliases:
504
-  @options = map { $self->expand_option($_) } @options;
511
+  @entries = map { $self->expand_alias($_) } @entries;
505 512
 
506 513
   # Hacky special case for printing the feed:
507
-  if ($options[0] eq $self->{feed_alias}) {
514
+  if ($entries[0] eq $self->{feed_alias}) {
508 515
     return $self->feed_print(
509 516
       $self->{entries}->recent_days( $self->{feed_length} )
510 517
     );
511 518
   }
512 519
 
513 520
   # To be accessed as ${content} in the template below:
514
-  $self->{content} = join '', map { $self->handle($_) } @options;
521
+  $self->{content} = join '', map { $self->handle($_) } @entries;
515 522
   return $self->fragment_slurp($self->{template_path});
516 523
 }
517 524
 
@@ -522,8 +529,7 @@ Return the text of an individual entry.
522 529
 =cut
523 530
 
524 531
 sub handle {
525
-  my $self = shift;
526
-  my ($entry) = @_;
532
+  my ($self, $entry) = @_;
527 533
 
528 534
   # Hashref:
529 535
   my $map = $self->{entry_map};
@@ -537,27 +543,26 @@ sub handle {
537 543
   return $map->{$pattern}->($self, $entry);
538 544
 }
539 545
 
540
-=item expand_option($option)
546
+=item expand_alias($option)
541 547
 
542 548
 Expands/converts 'all', 'new', and 'fulltext' to appropriate values.
543 549
 
550
+Removes trailing slashes.
551
+
544 552
 =cut
545 553
 
546
-sub expand_option {
547
-  my ($self, $option) = @_;
554
+sub expand_alias {
555
+  my ($self, $alias) = @_;
548 556
 
549 557
   # Take care of trailing slashes:
550
-  chop $option if $option =~ m{/$};
551
-
552
-  if ($option eq 'all') {
553
-    return reverse $self->{entries}->all_years();
554
-  } elsif ($option eq 'new') {
555
-    return $self->{entries}->recent_days(5);
556
-  } elsif ($option eq 'fulltext') {
557
-    return $self->{entries}->all_days();
558
-  }
558
+  chop $alias if $alias =~ m{/$};
559
+
560
+  return reverse $self->{entries}->all_years() if $alias eq 'all';
561
+  return $self->{entries}->recent_days(5)      if $alias eq 'new';
562
+  return $self->{entries}->all_days()          if $alias eq 'fulltext';
559 563
 
560
-  return $option;
564
+  # No expansion, just give back our original value:
565
+  return $alias;
561 566
 }
562 567
 
563 568
 =item link_bar(@extra_links)
@@ -610,19 +615,20 @@ sub year {
610 615
   my $self = shift;
611 616
   my ($year) = @_;
612 617
 
613
-  my ($year_file, $year_url) = $self->root_locations($year);
614
-
615 618
   # Year is a text file:
616
-  return entry_markup($self->entry($year)) if -f $year_file;
619
+  return entry_markup($self->entry($year))
620
+    if $self->{entries}->is_file($year);
617 621
 
618
-  # If it's not a directory, we can't do anything. Bail out:
619
-  return p('No such year.') if (! -d $year_file);
622
+  # If it's not a directory, we can't do anything further. Bail out:
623
+  return p('No such year.')
624
+    unless $self->{entries}->is_dir($year);
620 625
 
626
+  my ($year_file, $year_url) = $self->root_locations($year);
621 627
   my $result;
622 628
 
623
-  # Handle year directories with index files.
629
+  # Handle year directories with index files:
624 630
   $result .= $self->entry($year)
625
-    if -f "$year_file/index";
631
+    if $self->{entries}->has_index($year);
626 632
 
627 633
   my $header_text = $self->icon_markup($year, $year);
628 634
   $header_text ||= q{};
@@ -635,19 +641,23 @@ sub year {
635 641
   my $count = 0; # explicitly defined for later printing.
636 642
 
637 643
   foreach my $month (@months) {
638
-    my @entries = dir_list(
639
-      "$year_file/$month", 'low_to_high', qr/^[0-9]{1,2}$/
640
-    );
641
-    $count += @entries;
642
-
643
-    my $month_text;
644
-    foreach my $entry (@entries) {
645
-      $month_text .= a({href => "$year_url/$month/$entry/"}, $entry) . "\n";
644
+    my $month_text = '';
645
+    if ($self->{entries}->is_dir("$year/$month")) {
646
+      my @entries = dir_list(
647
+        "$year_file/$month", 'low_to_high', qr/^[0-9]{1,2}$/
648
+      );
649
+      $count += @entries;
650
+      foreach my $entry (@entries) {
651
+        $month_text .= a({href => "$year_url/$month/$entry/"}, $entry) . "\n";
652
+      }
646 653
     }
647 654
 
648 655
     $month_text = small("( $month_text )");
649 656
 
650
-    my $link = a({href => "$year_url/$month/"}, month_name($month));
657
+    my $link = a(
658
+      {href => "$year_url/$month/"},
659
+      App::WRT::Date::month_name($month)
660
+    );
651 661
 
652 662
     $year_text .= table_row(
653 663
       table_cell({class => 'datelink'}, $link),
@@ -676,32 +686,27 @@ Prints the entries in a given month (nnnn/nn).
676 686
 =cut
677 687
 
678 688
 sub month {
679
-  my $self = shift;
680
-  my ($month) = @_;
689
+  my ($self, $month) = @_;
681 690
 
682 691
   my ($month_file, $month_url) = $self->root_locations($month);
683 692
 
684
-  my $result;
685
-
686 693
   # If a directory exists for $month, use dir_list to slurp the entry files it
687 694
   # contains into @entry_files, sorted numerically.  Then send each entry to
688 695
   # entry_markup().
689
-  if (-d $month_file) {
690
-
696
+  if ($self->{entries}->is_dir($month)) {
697
+    my $result;
691 698
     $result .= $self->entry($month)
692
-      if -f "$month_file/index";
699
+      if $self->{entries}->has_index($month);
693 700
 
694 701
     my @entry_files = dir_list($month_file, 'high_to_low', qr/^[0-9]{1,2}$/);
695
-
696 702
     foreach my $entry_file (@entry_files) {
697 703
       $result .= $self->entry_stamped("$month/$entry_file");
698 704
     }
699 705
 
700
-  } elsif (-f $month_file) {
701
-    $result .= $self->entry($month);
706
+    return $result;
707
+  } elsif ($self->{entries}->is_file($month)) {
708
+    return $self->entry($month);
702 709
   }
703
-
704
-  return $result;
705 710
 }
706 711
 
707 712
 =item entry_stamped($entry, $level)
@@ -723,7 +728,7 @@ sub entry_stamped {
723 728
 =item entry_topic_list($entry)
724 729
 
725 730
 Get a list of topics (by tag-* files) for the entry.  This hardcodes part of a
726
-p1k3-specific thing which should probably be moved into wrt entirely.
731
+p1k3-specific thing which should be moved into wrt entirely.
727 732
 
728 733
 =cut
729 734
 
@@ -749,8 +754,7 @@ Recursively calls itself.
749 754
 =cut
750 755
 
751 756
 sub entry {
752
-  my $self = shift;
753
-  my ($entry, $level) = @_;
757
+  my ($self, $entry, $level) = @_;
754 758
   $level ||= 'index';
755 759
 
756 760
   # Location of entry on local filesystem, and its URL:
@@ -764,14 +768,14 @@ sub entry {
764 768
   }
765 769
 
766 770
   # For text files:
767
-  if (-f $entry_loc) {
771
+  if ($self->{entries}->is_file($entry)) {
768 772
     return $result . $self->fragment_slurp($entry_loc);
769 773
   }
770 774
 
771
-  return $result if ! -d $entry_loc;
775
+  # Past this point, we're assuming a directory.
772 776
 
773 777
   # Print index as head, if extant and a normal file:
774
-  if (-f "$entry_loc/index") {
778
+  if ($self->{entries}->has_index($entry)) {
775 779
     $result .= $self->fragment_slurp("$entry_loc/index");
776 780
   }
777 781
 
@@ -782,7 +786,7 @@ sub entry {
782 786
     # If the wrt-noexpand property is present, then don't expand sub-entries.
783 787
     # A hack.
784 788
 
785
-    if ($level eq 'index' || -f "$entry_loc/wrt-noexpand.prop") {
789
+    if ($level eq 'index' || $self->{entries}->has_prop($entry, 'wrt-noexpand')) {
786 790
       # Icons or text links:
787 791
       $result .= $self->list_contents($entry, @sub_entries);
788 792
     }
@@ -792,7 +796,6 @@ sub entry {
792 796
         next if ($se =~ $self->{binfile_expr});
793 797
         $result .= p({class => 'centerpiece'}, '+')
794 798
                  . $self->entry("$entry/$se");
795
-
796 799
       }
797 800
 
798 801
       # Handle links to any remaining files that match binfile_expr:
@@ -813,9 +816,10 @@ Returns "sub entries" based on the C<subentry_expr> regexp.
813 816
 =cut
814 817
 
815 818
 sub get_sub_entries {
816
-  my $self = shift;
817
-  my ($entry_loc) = @_;
819
+  my ($self, $entry_loc) = @_;
818 820
 
821
+  # index gets special treatment as the text body of an entry, rather
822
+  # than as a sub-entry:
819 823
   my %ignore = ('index' => 1);
820 824
 
821 825
   return grep { ! $ignore{$_} }
@@ -861,45 +865,41 @@ Calls image_size, uses filename to determine type.
861 865
 
862 866
 { my %cache;
863 867
 sub icon_markup {
864
-  my $self = shift;
865
-  my ($entry, $alt) = @_;
866
-
867
-  if ($cache{$entry . $alt}) {
868
-    return $cache{$entry . $alt};
869
-  }
870
-
871
-  my ($entry_loc, $entry_url) = $self->root_locations($entry);
868
+  my ($self, $entry, $alt) = @_;
872 869
 
873
-  my ($icon_loc, $icon_url);
870
+  return $cache{$entry . $alt}
871
+    if defined $cache{$entry . $alt};
874 872
 
875
-  if (-f $entry_loc) {
876
-    $icon_loc = "$entry_loc.icon";
877
-    $icon_url = "$entry_url.icon";
873
+  my $icon_basepath;
874
+  if ($self->{entries}->is_file($entry)) {
875
+    $icon_basepath = "$entry.icon";
878 876
   }
879
-  elsif (-d $entry_loc) {
880
-    $icon_loc = "$entry_loc/index.icon";
881
-    $icon_url = "$entry_url/index.icon";
877
+  elsif ($self->{entries}->is_dir($entry)) {
878
+    $icon_basepath = "$entry/index.icon";
882 879
   }
883 880
 
884 881
   # First suffix found will be used:
885
-  my (@suffixes) = qw(png jpg gif jpeg);
886 882
   my $suffix;
887
-  for (@suffixes) {
888
-    if (-e "$icon_loc.$_") {
883
+  for (qw(png jpg gif jpeg)) {
884
+    if ($self->{entries}->is_extant( "$icon_basepath.$_")) {
889 885
         $suffix = $_;
890 886
         last;
891 887
     }
892 888
   }
893 889
 
894
-  # fail unless there's a file with one of the above suffixes
890
+  # Fail unless there's a file with one of the above suffixes:
895 891
   return 0 unless $suffix;
896 892
 
897
-  # call image_size to slurp width & height from the image file
898
-  my ($width, $height) = image_size($self->{root_dir_abs} . '/' . "$icon_loc.$suffix");
893
+  my ($icon_loc, $icon_url) = $self->root_locations($icon_basepath);
894
+
895
+  # Slurp width & height from the image file:
896
+  my ($width, $height) = image_size(
897
+    $self->{root_dir_abs} . '/' . "$icon_loc.$suffix"
898
+  );
899 899
 
900 900
   return $cache{$entry . $alt} =
901
-       qq{<img src="$icon_url.$suffix"\n width="$width" }
902
-       . qq{height="$height"\n alt="$alt" />};
901
+      qq{<img src="$icon_url.$suffix"\n width="$width" }
902
+    . qq{height="$height"\n alt="$alt" />};
903 903
 }
904 904
 }
905 905
 
@@ -956,22 +956,6 @@ sub fragment_slurp {
956 956
   );
957 957
 }
958 958
 
959
-=item month_name($number)
960
-
961
-Turn numeric dates into English.
962
-
963
-=cut
964
-
965
-sub month_name {
966
-  my ($number) = @_;
967
-
968
-  # "Null" is here so that $month_name[1] corresponds to January, etc.
969
-  my @months = qw(Null January February March April May June
970
-                  July August September October November December);
971
-
972
-  return $months[$number];
973
-}
974
-
975 959
 =item root_locations($file)
976 960
 
977 961
 Given a file/entry, return the appropriate concatenations with entry_dir and
@@ -1030,6 +1014,7 @@ sub feed_print {
1030 1014
   my $feed = XML::Atom::SimpleFeed->new(
1031 1015
     -encoding => 'UTF-8',
1032 1016
     title     => $self->{title_prefix} . '::' . $self->{title},
1017
+    subtitle  => $self->{description},
1033 1018
     link      => $self->{url_root},
1034 1019
     link      => { rel => 'self', href => $feed_url, },
1035 1020
     icon      => $self->{favicon_url},
@@ -1050,7 +1035,6 @@ sub feed_print {
1050 1035
     my ($extracted_title) = $utf8_content =~ m{<h1.*?>(.*?)</h1>}s;
1051 1036
     my (@subtitles)       = $utf8_content =~ m{<h2.*?>(.*?)</h2>}sg;
1052 1037
 
1053
-
1054 1038
     if ($extracted_title) {
1055 1039
       $title = $extracted_title;
1056 1040
       if (@subtitles) {

+ 43
- 4
lib/App/WRT/Date.pm View File

@@ -4,18 +4,36 @@ use strict;
4 4
 use warnings;
5 5
 
6 6
 use base qw(Exporter);
7
-our @EXPORT_OK = qw(iso_date get_mtime);
7
+our @EXPORT_OK = qw(iso_date get_mtime month_name);
8 8
 
9 9
 use POSIX qw(strftime);
10 10
 
11
-# Return an ISO 8601 date string for the given epoch time.
11
+=head1 NAME
12
+
13
+App::WRT::Date - a small collection of date utility functions
14
+
15
+=head2 FUNCTIONS
16
+
17
+=over
18
+
19
+=item iso_date($time)
20
+
21
+Return an ISO 8601 date string for the given epoch time.
22
+
23
+=cut
24
+
12 25
 sub iso_date {
13 26
   my ($time) = @_;
14 27
   return strftime("%Y-%m-%dT%H:%M:%SZ", localtime($time));
15 28
 }
16 29
 
17
-sub get_mtime
18
-{
30
+=item get_mtime(@filenames)
31
+
32
+Return one or more mtimes for a given list of files.
33
+
34
+=cut
35
+
36
+sub get_mtime {
19 37
   my (@filenames) = @_;
20 38
 
21 39
   my @mtimes; 
@@ -36,4 +54,25 @@ sub get_mtime
36 54
   }
37 55
 }
38 56
 
57
+=item month_name($number)
58
+
59
+Turn numeric months into English names.
60
+
61
+=cut
62
+
63
+{
64
+  # "Null" is here so that $month_name[1] corresponds to January, etc.
65
+  my @months = qw(Null January February March April May June
66
+                  July August September October November December);
67
+
68
+  sub month_name {
69
+    my ($number) = @_;
70
+    return $months[$number];
71
+  }
72
+}
73
+
74
+=back
75
+
76
+=cut
77
+
39 78
 1;

+ 121
- 30
lib/App/WRT/EntryStore.pm View File

@@ -52,6 +52,9 @@ entry.
52 52
 
53 53
 =cut
54 54
 
55
+my $ENTRYTYPE_FILE = 0;
56
+my $ENTRYTYPE_DIR = 1;
57
+
55 58
 sub new {
56 59
   my $class = shift;
57 60
   my ($entry_dir) = @_;
@@ -64,38 +67,44 @@ sub new {
64 67
 
65 68
   bless $self, $class;
66 69
 
67
-  my @source_files;
70
+  my %source_files;
68 71
   my %entry_properties;
69 72
   my %property_entries;
73
+
70 74
   find(
71 75
     sub {
72 76
       # We skip index files, because they'll be rendered from the dir path:
73
-      return if /index$/;
74
-      if ($File::Find::name =~ m{^ \Q$entry_dir\E / (.*) $}x) {
75
-        my $target = $1;
76
-        push @source_files, $target;
77
-
78
-        # Build hashes of all properties of entries, and all entries of properties:
79
-        if ($target =~ m{(.*) / (.*) [.]prop $}x) {
80
-          my ($entry, $property) = ($1, $2);
81
-
82
-          $entry_properties{$entry} = []
83
-            unless defined $entry_properties{$entry};
84
-          push @{ $entry_properties{$entry} }, $property;
85
-
86
-          $property_entries{$property} = []
87
-            unless defined $property_entries{$property};
88
-          push @{ $property_entries{$property} }, $entry;
89
-        }
77
+      return unless $File::Find::name =~ m{^ \Q$entry_dir\E / (.*) $}x;
78
+
79
+      my $target = $1;
80
+
81
+      # Build a hash indicating:
82
+      #   a. that a file exists
83
+      #   b. whether it's a flatfile or a directory
84
+      if (-f $_) {
85
+        $source_files{$target} = $ENTRYTYPE_FILE;
86
+      } elsif (-d $_) {
87
+        $source_files{$target} = $ENTRYTYPE_DIR;
88
+      }
89
+
90
+      # Build hashes of all properties of entries, and all entries of properties:
91
+      if ($target =~ m{(.*) / (.*) [.]prop $}x) {
92
+        my ($entry, $property) = ($1, $2);
93
+
94
+        $entry_properties{$entry} //= [];
95
+        push @{ $entry_properties{$entry} }, $property;
96
+
97
+        $property_entries{$property} //= [];
98
+        push @{ $property_entries{$property} }, $entry;
90 99
       }
91 100
     },
92 101
     $entry_dir
93 102
   );
94 103
 
95 104
   # Stash arrayref for future use:
96
-  $self->{source_files} = \@source_files;
97
-  $self->{property_entries}   = \%property_entries;
98
-  $self->{entry_properties}   = \%entry_properties;
105
+  $self->{source_files}     = \%source_files;
106
+  $self->{property_entries} = \%property_entries;
107
+  $self->{entry_properties} = \%entry_properties;
99 108
 
100 109
   $self->generate_date_hashes();
101 110
 
@@ -113,7 +122,7 @@ This was originally in App::WRT::Renderer, so there may be some pitfalls here.
113 122
 
114 123
 sub all {
115 124
   my ($self) = shift;
116
-  return @{ $self->{source_files} };
125
+  return keys %{ $self->{source_files} };
117 126
 }
118 127
 
119 128
 =item dates_by_depth($depth)
@@ -156,7 +165,7 @@ sub dates_by_depth {
156 165
   my @by_depth = map  { $_->[0] }
157 166
                  sort { $a->[1] cmp $b->[1] }
158 167
                  map  { [$_, sortable_date_from_entry($_)] }
159
-                 grep m{^ $pattern $}x, @{ $self->{source_files} };
168
+                 grep m{^ $pattern $}x, $self->all();
160 169
 
161 170
   # Stash arrayref for future use:
162 171
   $self->{by_depth}->{$depth} = \@by_depth;
@@ -254,6 +263,29 @@ sub generate_date_hashes {
254 263
   $self->{next_dates} = { reverse %prev };
255 264
 }
256 265
 
266
+=item parent_of($entry)
267
+
268
+Return an entry's parent, or undef if it's at the top level.
269
+
270
+=cut
271
+
272
+sub parent_of {
273
+  my $self = shift;
274
+  my ($entry) = @_;
275
+
276
+  # Explode unless an entry actually exists in the archives:
277
+  unless (grep { $_ eq $entry } $self->all()) {
278
+    croak("No such entry: $entry");
279
+  }
280
+
281
+  my (@components) = split '/', $entry;
282
+  pop @components;
283
+  if (@components) {
284
+    return join '/', @components;
285
+  }
286
+  return undef;
287
+}
288
+
257 289
 =item previous($entry)
258 290
 
259 291
 Return the previous entry at the same depth for the given entry.
@@ -264,7 +296,7 @@ sub previous {
264 296
   return $_[0]->{prev_dates}->{ $_[1] };
265 297
 }
266 298
 
267
-=item previous($entry)
299
+=item next($entry)
268 300
 
269 301
 Return the next entry at the same depth for the given entry.
270 302
 
@@ -281,8 +313,7 @@ Return an array of any entries for the given property.
281 313
 =cut
282 314
 
283 315
 sub by_prop {
284
-  my $self = shift;
285
-  my ($property) = @_;
316
+  my ($self, $property) = @_;
286 317
 
287 318
   my @entries;
288 319
   if (defined $self->{property_entries}{$property}) {
@@ -292,7 +323,6 @@ sub by_prop {
292 323
   return @entries;
293 324
 }
294 325
 
295
-
296 326
 =item props_for($entry)
297 327
 
298 328
 Return an array of any properties for the given entry.
@@ -300,8 +330,7 @@ Return an array of any properties for the given entry.
300 330
 =cut
301 331
 
302 332
 sub props_for {
303
-  my $self = shift;
304
-  my ($entry) = @_;
333
+  my ($self, $entry) = @_;
305 334
 
306 335
   my @props;
307 336
   if (defined $self->{entry_properties}{$entry}) {
@@ -311,6 +340,18 @@ sub props_for {
311 340
   return @props;
312 341
 }
313 342
 
343
+=item has_prop($entry, $prop)
344
+
345
+Return 1 if the given entry has the given property.
346
+
347
+=cut
348
+
349
+sub has_prop {
350
+  my ($self, $entry, $prop) = @_;
351
+  my @props = grep { $_ eq $prop } $self->props_for($entry);
352
+  return (@props == 1);
353
+}
354
+
314 355
 =item all_props()
315 356
 
316 357
 Return an array of all properties.
@@ -319,7 +360,57 @@ Return an array of all properties.
319 360
 
320 361
 sub all_props {
321 362
   my $self = shift;
322
-  return keys %{ $self->{property_entries} };
363
+  return sort keys %{ $self->{property_entries} };
364
+}
365
+
366
+=item is_extant($entry)
367
+
368
+Check if a given entry exists.
369
+
370
+=cut
371
+
372
+sub is_extant {
373
+  my ($self, $entry) = @_;
374
+  return exists($self->{source_files}{$entry});
375
+}
376
+
377
+=item is_dir($entry)
378
+
379
+Check if an entry is a directory.
380
+
381
+=cut
382
+
383
+sub is_dir {
384
+  my ($self, $entry) = @_;
385
+  croak("No such entry: $entry") unless $self->is_extant($entry);
386
+  return ($self->{source_files}{$entry} == $ENTRYTYPE_DIR);
387
+}
388
+
389
+=item is_file($entry)
390
+
391
+Check if an entry is a flatfile.
392
+
393
+=cut
394
+
395
+sub is_file {
396
+  my ($self, $entry) = @_;
397
+  croak("No such entry: $entry") unless $self->is_extant($entry);
398
+  return ($self->{source_files}{$entry} == $ENTRYTYPE_FILE);
399
+}
400
+
401
+=item has_index($entry)
402
+
403
+Check if an entry contains an index file.
404
+
405
+TODO: Should this care about the pathological(?) case where index is a
406
+directory?
407
+
408
+=cut
409
+
410
+sub has_index {
411
+  my ($self, $entry) = @_;
412
+  croak("No such entry: $entry") unless $self->is_extant($entry);
413
+  return $self->is_extant($entry . '/index');
323 414
 }
324 415
 
325 416
 =back

+ 159
- 0
lib/App/WRT/FileIO.pm View File

@@ -0,0 +1,159 @@
1
+package App::WRT::FileIO;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use Carp;
7
+use Encode;
8
+use File::Copy;
9
+use File::Path qw(make_path);
10
+use Data::Dumper;
11
+
12
+=pod
13
+
14
+=head1 NAME
15
+
16
+App::WRT::FileIO - read and write directories and files
17
+
18
+=head1 SYNOPSIS
19
+
20
+    use App::WRT::FileIO;
21
+    my $io = App::WRT::FileIO->new();
22
+
23
+=head1 METHODS
24
+
25
+=over
26
+
27
+=item new($class)
28
+
29
+Get a new FileIO object.
30
+
31
+=cut
32
+
33
+sub new {
34
+  my $class = shift;
35
+
36
+  my %params = (
37
+    last_error => '',
38
+  );
39
+
40
+  my $self = \%params;
41
+  bless $self, $class;
42
+}
43
+
44
+=item dir_list($dir, $sort_order, $pattern)
45
+
46
+Return a $sort_order sorted list of files matching regex $pattern in a
47
+directory.
48
+
49
+Calls $sort_order, which can be one of:
50
+
51
+         alpha - alphabetical
52
+ reverse_alpha - alphabetical, reversed
53
+   high_to_low - numeric, high to low
54
+   low_to_high - numeric, low to high
55
+
56
+=cut
57
+
58
+sub dir_list {
59
+  my ($self, $dir, $sort_order, $pattern) = @_;
60
+
61
+  $pattern    ||= qr/^[0-9]{1,2}$/;
62
+  $sort_order ||= 'high_to_low';
63
+
64
+  opendir my $list_dir, $dir
65
+    or die "Couldn't open $dir: $!";
66
+
67
+  my @files = sort $sort_order
68
+              grep { m/$pattern/ }
69
+              readdir $list_dir;
70
+
71
+  closedir $list_dir;
72
+
73
+  return @files;
74
+}
75
+
76
+# Various named sorts for dir_list:
77
+sub alpha         { $a cmp $b; } # alphabetical
78
+sub high_to_low   { $b <=> $a; } # numeric, high to low
79
+sub low_to_high   { $a <=> $b; } # numberic, low to high
80
+sub reverse_alpha { $b cmp $a; } # alphabetical, reversed
81
+
82
+
83
+=item file_put_contents($file, $contents)
84
+
85
+Write $contents string to $file path.  Because:
86
+
87
+L<https://secure.php.net/manual/en/function.file-put-contents.php>
88
+
89
+=cut
90
+
91
+sub file_put_contents {
92
+  my ($self, $file, $contents) = @_;
93
+  open(my $fh, '>', $file)
94
+    or die "Unable to open $file for writing: $!";
95
+  print $fh $contents;
96
+  close $fh;
97
+}
98
+
99
+
100
+=item file_get_contents($file)
101
+
102
+Get contents string of $file path.  Because:
103
+
104
+L<https://secure.php.net/manual/en/function.file-get-contents.php>
105
+
106
+=cut
107
+
108
+sub file_get_contents {
109
+  my ($self, $file) = @_;
110
+
111
+  open my $fh, '<', $file
112
+    or croak "Couldn't open $file: $!\n";
113
+
114
+  my $contents;
115
+  {
116
+    # line separator:
117
+    local $/ = undef;
118
+    $contents = <$fh>;
119
+  }
120
+
121
+  close $fh or croak "Couldn't close $file: $!";
122
+
123
+  # TODO: _May_ want to assume here that any file is UTF-8 text.
124
+  # http://perldoc.perl.org/perlunitut.html
125
+  # return decode('UTF-8', $contents);
126
+  return $contents;
127
+}
128
+
129
+
130
+=item file_copy($source, $dest)
131
+
132
+=cut
133
+
134
+sub file_copy {
135
+  my ($self, $source, $dest) = @_;
136
+  copy($source, $dest);
137
+}
138
+
139
+
140
+=item dir_make($source, $dest)
141
+
142
+=cut
143
+
144
+sub dir_make {
145
+  my ($self, $path) = @_;
146
+  my $path_err;
147
+  make_path($path, { error => \$path_err });
148
+  if (@{ $path_err }) {
149
+    $self->{last_error} = Dumper($path_err);
150
+    return 0;
151
+  }
152
+  return 1;
153
+}
154
+
155
+=back
156
+
157
+=cut
158
+
159
+1;

+ 133
- 46
lib/App/WRT/Renderer.pm View File

@@ -4,29 +4,85 @@ use strict;
4 4
 use warnings;
5 5
 use 5.10.0;
6 6
 
7
-use base qw(Exporter);
8
-our @EXPORT_OK = qw(render);
9
-
10
-use App::WRT::Util qw(file_put_contents);
11
-
12 7
 use Carp;
13
-use Data::Dumper;
14 8
 use File::Basename;
15
-use File::Copy;
16
-use File::Path qw(make_path);
17 9
 use Time::HiRes;
18 10
 
19
-sub render {
20
-  # This is invoked off of an App::WRT object, so it's passing in $self:
21
-  my ($wrt) = shift;
11
+=pod
12
+
13
+=head1 NAME
14
+
15
+App::WRT::Renderer - render a wrt repo to publishable HTML
16
+
17
+=head1 SYNOPSIS
18
+
19
+    use App::WRT;
20
+    use App::WRT::Renderer;
21
+
22
+    my $wrt = App::WRT::new_from_file($config_file);
23
+    my $renderer = App::WRT::Renderer->new(
24
+      $wrt,
25
+      sub { say $_[0]; }
26
+    );
27
+
28
+    $renderer->render();
29
+
30
+=head1 METHODS
31
+
32
+=over
33
+
34
+=item new($class, $entry_dir, $logger, $io)
35
+
36
+Get a new Renderer.  Takes an instance of App::WRT, a logging callback, and a
37
+App::WRT::FileIO or similar object to be used for the actual intake and
38
+mangling of things on the filesystem.
39
+
40
+=cut
41
+
42
+sub new {
43
+  my $class = shift;
44
+  my ($wrt, $logger) = @_;
22 45
 
23
-  # Expects a callback to be used to log (or print) rendering diagnostics:
24
-  my ($logger) = @_;
25 46
   ref($logger) eq 'CODE' or
26
-    croak("Error: render() expects an anonymous function");
47
+    croak("Error: Renderer expects an anonymous function for logging");
48
+
49
+  my %params = (
50
+    wrt    => $wrt,
51
+    logger => $logger,
52
+
53
+    # Overwrite this for testing purposes:
54
+    io => App::WRT::FileIO->new(),
55
+  );
27 56
 
28
-  my $entry_dir = $wrt->{entry_dir};
29
-  my $publish_dir = $wrt->{publish_dir};
57
+  my $self = \%params;
58
+  bless $self, $class;
59
+}
60
+
61
+
62
+=item write($path, $contents)
63
+
64
+Write $contents to $path, using the FileIO object passed into the constructor
65
+above.
66
+
67
+=cut
68
+
69
+sub write {
70
+  my ($self, $file, $contents) = @_;
71
+  $self->{io}->file_put_contents($file, $contents)
72
+}
73
+
74
+
75
+=item render($class, $entry_dir)
76
+
77
+Render entries to F<publish_dir>.
78
+
79
+=cut
80
+
81
+sub render {
82
+  my $self = shift;
83
+
84
+  my $entry_dir = $self->{wrt}->{entry_dir};
85
+  my $publish_dir = $self->{wrt}->{publish_dir};
30 86
 
31 87
   # Use this to log elapsed render time:
32 88
   my $start_time = [Time::HiRes::gettimeofday()];
@@ -37,64 +93,61 @@ sub render {
37 93
       croak("$publish_dir exists but is not a directory");
38 94
     }
39 95
   } else {
40
-    my $path_err;
41
-    make_path($publish_dir, { error => \$path_err });
42
-    $logger->("Attempting to create $publish_dir");
43
-    if (@{ $path_err }) {
44
-      $logger->(Dumper($path_err));
45
-      croak("Could not create $publish_dir: " . Dumper($path_err));
96
+    $self->log("Attempting to create $publish_dir");
97
+    unless ($self->dir_make_logged($publish_dir)) {
98
+      croak("Could not create $publish_dir");
46 99
     }
47 100
   }
48 101
 
49 102
   # Handle the front page and Atom feed:
50
-  file_put_contents("${publish_dir}/index.html", $wrt->display('new'));
103
+  $self->write("${publish_dir}/index.html", $self->{wrt}->display('new'));
51 104
 
52
-  my $feed_alias = $wrt->{feed_alias};
53
-  my $feed_content = $wrt->display($feed_alias);
54
-  file_put_contents("${publish_dir}/${feed_alias}", $feed_content);
55
-  file_put_contents("${publish_dir}/${feed_alias}.xml", $feed_content);
105
+  my $feed_alias = $self->{wrt}->{feed_alias};
106
+  my $feed_content = $self->{wrt}->display($feed_alias);
107
+  $self->write("${publish_dir}/${feed_alias}", $feed_content);
108
+  $self->write("${publish_dir}/${feed_alias}.xml", $feed_content);
56 109
 
57
-  # Handle any other paths that aren't derived direct from files:
110
+  # Handle any other paths that aren't derived directly from files:
58 111
   my @meta_paths = qw(all);
59 112
 
60 113
   my $rendered_count = 0;
61 114
   my $copied_count   = 0;
62
-  for my $target ($wrt->{entries}->all(), @meta_paths)
115
+  for my $target ($self->{wrt}->{entries}->all(), @meta_paths)
63 116
   {
64
-    my $path_err;
117
+    # Skip index files - these are the text content of an entry, not
118
+    # a sub-entry:
119
+    next if $target =~ m{/index$};
65 120
 
66
-    # Lowercase and alpanumeric + underscores + dashes, no dots - an entry:
67
-    if ($target =~ $wrt->{entrypath_expr}) {
68
-      make_path("${publish_dir}/$target", { error => \$path_err });
69
-      $logger->(Dumper($path_err)) if @{ $path_err };
121
+    # Lowercase and alphanumeric + underscores + dashes, no dots - an entry:
122
+    if ($target =~ $self->{wrt}->{entrypath_expr}) {
123
+      $self->dir_make_logged("$publish_dir/$target");
70 124
 
71
-      my $rendered = $wrt->display($target);
125
+      my $rendered = $self->{wrt}->display($target);
72 126
 
73
-      my $target_file = "${publish_dir}/$target/index.html";
74
-      $logger->("[write] $target_file " . length($rendered));
75
-      file_put_contents($target_file, $rendered);
127
+      my $target_file = "$publish_dir/$target/index.html";
128
+      $self->log("[write] $target_file " . length($rendered));
129
+      $self->write($target_file, $rendered);
76 130
       $rendered_count++;
77 131
       next;
78 132
     }
79 133
 
80 134
     # A directory - no-op:
81 135
     if (-d "$entry_dir/$target") {
82
-      $logger->("[directory] $entry_dir/$target");
136
+      $self->log("[directory] $entry_dir/$target");
83 137
       next;
84 138
     }
85 139
 
86 140
     # Some other file - a static asset of some kind:
87 141
     my $dirname = dirname($target);
88
-    $logger->("[copy] archives/$target -> ${publish_dir}/$target");
89
-    make_path("$publish_dir/$dirname", { error => \$path_err });
90
-    $logger->(Dumper($path_err)) if @{ $path_err };
91
-    copy("$entry_dir/$target", "${publish_dir}/$target");
142
+    $self->log("[copy] archives/$target -> $publish_dir/$target");
143
+    $self->dir_make_logged("$publish_dir/$dirname");
144
+    $self->{io}->file_copy("$entry_dir/$target", "$publish_dir/$target");
92 145
     $copied_count++;
93 146
   }
94 147
 
95
-  $logger->("rendered $rendered_count entries");
96
-  $logger->("copied $copied_count static files");
97
-  $logger->(
148
+  $self->log("rendered $rendered_count entries");
149
+  $self->log("copied $copied_count static files");
150
+  $self->log(
98 151
     "  in "
99 152
     . Time::HiRes::tv_interval($start_time)
100 153
     . " seconds"
@@ -103,3 +156,37 @@ sub render {
103 156
   # Presumed success:
104 157
   return 1;
105 158
 }
159
+
160
+
161
+=item dir_make_logged($path)
162
+
163
+Make a directory path or log an error.
164
+
165
+=cut
166
+
167
+sub dir_make_logged {
168
+  my ($self, $path) = @_;
169
+  my $path_err;
170
+  $self->log("[create] $path");
171
+  $self->{io}->dir_make($path);
172
+  # XXX: surface these somehow
173
+  # $self->log(Dumper($path_err)) if @{ $path_err };
174
+}
175
+
176
+
177
+=item log(@log_items)
178
+
179
+Call logging callback with passed parameters.
180
+
181
+=cut
182
+
183
+sub log {
184
+  my ($self) = shift;
185
+  $self->{logger}->(@_);
186
+}
187
+
188
+=back
189
+
190
+=cut
191
+
192
+1;

+ 61
- 0
t/bin-wrt-ls.t View File

@@ -0,0 +1,61 @@
1
+#!/usr/bin/perl
2
+
3
+use strict;
4
+use warnings;
5
+use utf8;
6
+use 5.10.0;
7
+
8
+use lib 'lib';
9
+
10
+use Encode;
11
+use Test::More tests => 6;
12
+
13
+chdir 'example';
14
+require_ok('../bin/wrt-ls');
15
+
16
+my $output_string;
17
+my $output = sub {
18
+  $output_string .= $_[0] . "\n";
19
+};
20
+
21
+my @local_argv = qw(--years);
22
+main($output, @local_argv);
23
+ok(
24
+  $output_string eq "2012\n2013\n2014\n",
25
+  "Correctly listed years."
26
+);
27
+
28
+@local_argv = qw(--months);
29
+$output_string = '';
30
+main($output, @local_argv);
31
+ok(
32
+  $output_string eq "2013/1\n2013/2\n2014/1\n",
33
+  "Correctly listed months."
34
+);
35
+
36
+@local_argv = qw(--days);
37
+$output_string = '';
38
+main($output, @local_argv);
39
+ok(
40
+  $output_string eq "2014/1/1\n2014/1/2\n",
41
+  "Correctly listed days."
42
+);
43
+
44
+@local_argv = qw(--props);
45
+$output_string = '';
46
+main($output, @local_argv);
47
+ok(
48
+  $output_string eq "tag-something\nwrt-noexpand\n",
49
+  "Correctly listed properties."
50
+);
51
+diag($output_string);
52
+
53
+@local_argv = qw(--days --months);
54
+$output_string = '';
55
+eval {
56
+  main($output, @local_argv);
57
+};
58
+ok(
59
+  $@,
60
+  "Croaked on trying to combine multiple entry-type options."
61
+);

+ 63
- 7
t/wrt.t View File

@@ -7,8 +7,11 @@ use utf8;
7 7
 use lib 'lib';
8 8
 
9 9
 use Encode;
10
-use Test::More tests => 4;
11
-use App::WRT;
10
+use Test::More tests => 12;
11
+
12
+# Does the module load?
13
+
14
+require_ok('App::WRT');
12 15
 
13 16
 chdir 'example';
14 17
 
@@ -39,7 +42,35 @@ chdir 'example';
39 42
     'icon_test has an image in it'
40 43
   );
41 44
 
45
+  my $icon_textfile = $w->icon_markup('icon_test/textfile', 'alt');
46
+  # diag($icon_textfile);
47
+  ok(
48
+    $icon_textfile eq q{<img src="https://example.com/icon_test/textfile.icon.png"
49
+ width="48" height="58"
50
+ alt="alt" />},
51
+    'got expected icon for icon_test/textfile'
52
+  );
53
+
54
+  my $icon_dir = $w->icon_markup('icon_test/dir', 'alt');
55
+  # diag($icon_dir);
56
+  ok(
57
+    $icon_dir eq q{<img src="https://example.com/icon_test/dir/index.icon.png"
58
+ width="48" height="58"
59
+ alt="alt" />},
60
+    'got expected icon for icon_test/dir'
61
+  );
62
+
63
+  my $icon_subentry = $w->icon_markup('icon_test/dir/subentry', 'alt');
64
+  # diag($icon_subentry);
65
+  ok(
66
+    $icon_subentry eq q{<img src="https://example.com/icon_test/dir/subentry.icon.png"
67
+ width="48" height="58"
68
+ alt="alt" />},
69
+    'got expected icon for icon_test/dir/subentry'
70
+  );
71
+
42 72
 # feed rendering
73
+
43 74
   my $feed = decode('UTF-8', $w->display($w->{feed_alias}));
44 75
   # diag($feed);
45 76
 
@@ -49,9 +80,34 @@ chdir 'example';
49 80
     'feed contains some stars'
50 81
   );
51 82
 
52
-# rendering static html files
83
+# not expanding entries with wrt-noexpand
53 84
 
54
-# ok(
55
-#   $w->render(sub { diag($_[0]); }),
56
-#   'render stuff'
57
-# );
85
+  my $with_noexpand = $w->display('noexpand_test');
86
+  # diag($with_noexpand);
87
+  ok(
88
+    $with_noexpand !~ m/SHOULD NOT DISPLAY/,
89
+    'noexpand_test does not contain text of sub-entry do_not_expand_me'
90
+  );
91
+
92
+# displaying default entry when no entries are given:
93
+
94
+  my $with_no_entries = $w->display();
95
+  # diag($with_no_entries);
96
+  ok(
97
+    $with_no_entries =~ m{\Q<title>wrt::new</title>\E},
98
+    'display the default entry (new) when no entries are given'
99
+  );
100
+
101
+# contents of year index files:
102
+
103
+  my $plaintext_year = $w->display('2012');
104
+  ok(
105
+    $plaintext_year =~ m/\QI'm a year which is just a flatfile.\E/,
106
+    "2012 as plaintext year comes through."
107
+  );
108
+
109
+  my $plaintext_year_index = $w->display('2013');
110
+  ok(
111
+    $plaintext_year_index =~ m/\QI'm an index file for an entire year.\E/,
112
+    "2013's plaintext year index comes through."
113
+  );

+ 13
- 5
t/wrt_date.t View File

@@ -4,14 +4,22 @@ use warnings;
4 4
 
5 5
 use lib 'lib';
6 6
 
7
-use App::WRT::Date;
7
+use Test::More tests => 4;
8 8
 
9
-use Test::More tests => 1;
9
+require_ok('App::WRT::Date');
10 10
 
11 11
 ok(
12 12
   App::WRT::Date::get_mtime('t/wrt.t') =~ m/\d+/,
13
-  'get_mtime returns digits.'
13
+  'get_mtime on a real file returns digits.'
14 14
 );
15 15
 
16
-# TODO: this:
17
-# my $iso_date = WRT::Date::iso_date(0);
16
+my $iso_date = App::WRT::Date::iso_date(0);
17
+ok(
18
+  $iso_date eq '1969-12-31T17:00:00Z',
19
+  'ISO date for epoch'
20
+);
21
+
22
+ok(
23
+  App::WRT::Date::month_name(1) eq 'January',
24
+  'month_name(1) is January'
25
+);

+ 83
- 13
t/wrt_entrystore.t View File

@@ -6,26 +6,35 @@ use warnings;
6 6
 use lib 'lib';
7 7
 
8 8
 use Data::Dumper;
9
-use Test::More tests => 11;
9
+use Test::More tests => 21;
10 10
 use App::WRT;
11 11
 
12 12
 chdir 'example';
13 13
 
14
-# 'configuration';
14
+# configuration
15 15
 
16 16
   ok(
17 17
     my $w = App::WRT::new_from_file('wrt.json'),
18
-    "Got parent WRT object."
18
+    "got parent WRT object"
19 19
   );
20 20
 
21
-# 'individual method tests';
21
+# individual method tests
22 22
 
23
-# listing out of all source files
23
+# listing out of all source files:
24 24
 
25 25
   my (@all_source_files) = $w->{entries}->all();
26
+  my $expected_count = 31;
27
+  diag("got " . scalar @all_source_files . " source files.");
26 28
   ok(
27
-    scalar @all_source_files == 16,
28
-    'got 16 source files from example archive, as expected'
29
+    scalar @all_source_files == $expected_count,
30
+    "got $expected_count source files from example archive, as expected"
31
+  );
32
+
33
+# checking an entry exists:
34
+
35
+  ok(
36
+    $w->{entries}->is_extant('2014'),
37
+    '2014 exists'
29 38
   );
30 39
 
31 40
 # listing entries like 2014/1/1 for an individual day:
@@ -40,16 +49,16 @@ chdir 'example';
40 49
 
41 50
   my (@all_month_entries) = $w->{entries}->all_months();
42 51
   ok(
43
-    scalar @all_month_entries == 1,
44
-    'got 2 month entries from example archive, as expected'
52
+    scalar @all_month_entries == 3,
53
+    'got 3 month entries from example archive, as expected'
45 54
   );
46 55
 
47 56
 # listing entries like 2014 for a year:
48 57
 
49 58
   my (@all_year_entries) = $w->{entries}->all_years();
50 59
   ok(
51
-    scalar @all_year_entries == 1,
52
-    'got 1 year entry from example archive, as expected'
60
+    scalar @all_year_entries == 3,
61
+    'got 3 year entries from example archive, as expected'
53 62
   );
54 63
 
55 64
 # next / previous
@@ -65,11 +74,17 @@ chdir 'example';
65 74
   );
66 75
 
67 76
 # property finding by entry / entry finding by property
77
+
68 78
   ok(
69 79
     ($w->{entries}->by_prop('tag-something'))[0] eq '2014/1/2',
70 80
     'found 2014/1/2 for tag-something.prop'
71 81
   );
72 82
 
83
+  ok(
84
+    $w->{entries}->has_prop('2014/1/2', 'tag-something'),
85
+    '2014/1/2 has tag-something.prop'
86
+  );
87
+
73 88
   # diag(Dumper($w->{entries}->by_prop('something')));
74 89
   # diag(scalar($w->{entries}->by_prop('something')));
75 90
   ok(
@@ -82,9 +97,64 @@ chdir 'example';
82 97
     'found tag-something for 2014/1/2'
83 98
   );
84 99
 
100
+  my @all_props = $w->{entries}->all_props();
101
+  ok(
102
+    scalar(@all_props) == 2,
103
+    'found 2 properties for example repo'
104
+  );
105
+  # diag(join ', ', @all_props);
106
+
107
+# finding parents of entries:
108
+
109
+  my $date_parent = $w->{entries}->parent_of('2014/1/2');
110
+  ok(
111
+    $date_parent eq '2014/1',
112
+    'found correct parent for 2014/1/2'
113
+  );
114
+  # diag($date_parent);
115
+
116
+  my $icon_parent = $w->{entries}->parent_of('icon_test');
117
+  ok(
118
+    ! defined $icon_parent,
119
+    'found no parent for icon_test'
120
+  );
121
+  # diag($icon_parent);
122
+
123
+  eval {
124
+    $w->{entries}->parent_of('i_do_not_exist');
125
+  };
126
+  ok(
127
+    $@,
128
+    "croaked on trying to find parent of a nonexistent entry"
129
+  );
130
+
131
+# checking whether entries are directories, flatfiles, etc.
132
+
133
+  ok(
134
+    $w->{entries}->is_dir('2014'),
135
+    '2014 is a directory, as expected'
136
+  );
137
+
138
+  ok(
139
+    ! $w->{entries}->is_dir('2014/1/1/test_entry'),
140
+    '2014/1/1/test_entry is not a directory, as expected'
141
+  );
142
+
143
+  ok(
144
+    $w->{entries}->is_file('2014/1/1/test_entry'),
145
+    '2014/1/1/test_entry is a flatfile, as expected'
146
+  );
147
+
148
+# checking whether an entry is a directory with an index:
149
+
150
+  ok(
151
+    $w->{entries}->has_index('2014/1/1'),
152
+    '2014/1/1 has an index file'
153
+  );
154
+
85 155
   ok(
86
-    scalar($w->{entries}->all_props()) == 1,
87
-    'found 1 property for example repo'
156
+    ! $w->{entries}->has_index('icon_test/textfile'),
157
+    'icon_test/textfile does not have an index'
88 158
   );
89 159
 
90 160
   # diag(Dumper($w->{entries}->{entry_properties}));

+ 24
- 0
t/wrt_fileio.t View File

@@ -0,0 +1,24 @@
1
+#!/usr/bin/perl
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use lib 'lib';
7
+
8
+use Test::More tests => 2;
9
+use App::WRT::FileIO;
10
+
11
+my $io = App::WRT::FileIO->new();
12
+
13
+my @dir_list = $io->dir_list('example', 'alpha', '^wrt[.]json$');
14
+diag(@dir_list);
15
+ok(
16
+  $dir_list[0] eq 'wrt.json',
17
+  'got wrt.json from dir_list'
18
+);
19
+
20
+my $get_contents = $io->file_get_contents('example/wrt.json');
21
+ok(
22
+  $get_contents =~ m/entry_dir/,
23
+  'got an expected string in wrt.json'
24
+);

Loading…
Cancel
Save