brennen
/
wrt
1
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 27 Wiki Activity
Browse Source

v3.0.0: support for includes, change root_dir semantics, add entry_dir 

- adds include_process() in WRT::Markup
- moves eval_perl() into WRT::Markup.  The way object instances are
  composed (and instance methods called) here still feels pretty janky,
  and this does nothing to help the situation.
- changes all existing $root_dir instances to $entry_dir; adds a $root_dir
  which represents the root of the archive (top-level folder containing
  the wrt.json file)

I'd be worried about the $root_dir change if I thought this module had a
single other user in the wild, but I strongly doubt that it does.  If I
am wrong and you are that user, I apologize sincerely in advance.

The include feature still has fairly unsettled semantics, but it gets the
whole thing much closer to a usable site generator.
main
Brennen Bearnes 8 years ago
parent
62d376038f
commit
a069a79628
8 changed files with 168 additions and 93 deletions
Split View
  1. +11
    -16
      README.pod
  2. +3
    -0
      example/archives/include_test/index
  3. +1
    -1
      example/templates/basic
  4. +1
    -1
      example/wrt.json
  5. +22
    -53
      lib/WRT.pm
  6. +111
    -11
      lib/WRT/Markup.pm
  7. +8
    -8
      lib/WRT/Renderer.pm
  8. +11
    -3
      t/wrt_markup.t

+ 11
- 16
README.pod View File

@ -8,17 +8,20 @@ WRT - WRiting Tool
=head1 SYNOPSIS
wrt 2016 > 2016.html
wrt --render
$ wrt display 2016 > 2016.html
Or:
#!/usr/bin/perl
$ wrt render
Or:
#!/usr/bin/env perl
use WRT;
my $w = WRT->new(
root_dir => 'archives',
url_root => '/',
entry_dir => 'archives',
url_root => '/',
# etc.
);
print $w->display(@ARGV);
@ -43,7 +46,7 @@ run as a CGI script. This is a better idea, for the most part.
The C<WRT> module will work with FastCGI, if called from the appropriate
wrapper script, such as C<wrt-fcgi>.
By default, entries are stored in a simple directory tree under C<root_dir>.
By default, entries are stored in a simple directory tree under C<entry_dir>.
Like:
@ -166,7 +169,7 @@ A good way to ensure that this does not happen is to use patterns like:
...always marking the start and end of the string explicitly.
This will probably be rewritten to use an array so that the order can be
This may eventually be rewritten to use an array so that the order can be
explicitly specified.
=item entry_descriptions(\%descriptions)
@ -291,14 +294,6 @@ This might be the place to implement an in-memory cache for FastCGI or mod_perl
environments. The trick is that the results for certain files shouldn't be
cached because they contain embedded code.
=item eval_perl
Evaluate embedded Perl in a string, replacing blocks enclosed with <perl> tags
with whatever they return (well, evaluated in a scalar context). Returns the
modified string.
Also handles simple ${variables}, replacing them from the keys to $self.
=item month_name
Turn numeric dates into English.
@ -306,7 +301,7 @@ Turn numeric dates into English.
=item root_locations($file)
Given a file/entry, return the appropriate concatenations with
root_dir and url_root.
entry_dir and url_root.
=item local_path


+ 3
- 0
example/archives/include_test/index View File

@ -0,0 +1,3 @@
<h1>wrt include test</h1>
<include>files/include_me</include>

+ 1
- 1
example/templates/basic View File

@ -3,7 +3,7 @@
<head>
<title>${title_prefix}::${title}</title>
<meta name="keywords" content="${keywords}" />
<meta name="keywords" content="some test stuff" />
<meta name="description" content="${description}" />


+ 1
- 1
example/wrt.json View File

@ -1,6 +1,6 @@
{
"feed_url": "https://p1k3.com/feed",
"root_dir": "./archives",
"entry_dir": "./archives",
"title_prefix": "p1k3",
"template": "basic",
"description": "a test wrt site",


+ 22
- 53
lib/WRT.pm View File

@ -8,17 +8,20 @@ WRT - WRiting Tool
=head1 SYNOPSIS
wrt 2016 > 2016.html
wrt --render
$ wrt display 2016 > 2016.html
Or:
#!/usr/bin/perl
$ wrt render
Or:
#!/usr/bin/env perl
use WRT;
my $w = WRT->new(
root_dir => 'archives',
url_root => '/',
entry_dir => 'archives',
url_root => '/',
# etc.
);
print $w->display(@ARGV);
@ -43,7 +46,7 @@ run as a CGI script. This is a better idea, for the most part.
The C<WRT> module will work with FastCGI, if called from the appropriate
wrapper script, such as C<wrt-fcgi>.
By default, entries are stored in a simple directory tree under C<root_dir>.
By default, entries are stored in a simple directory tree under C<entry_dir>.
Like:
@ -134,7 +137,7 @@ As it stands, freeverse, image, and list are not particularly robust.
package WRT;
our ($VERSION) = '2.0.1';
our ($VERSION) = '3.0.0';
use strict;
use warnings;
@ -142,6 +145,7 @@ no warnings 'uninitialized';
use base 'WRT::MethodSpit';
use Cwd;
use HTML::Entities;
use JSON;
use XML::Atom::SimpleFeed;
@ -149,7 +153,7 @@ use XML::Atom::SimpleFeed;
use WRT::Date;
use WRT::HTML qw(:all);
use WRT::Image qw(image_size);
use WRT::Markup qw(line_parse image_markup);
use WRT::Markup qw(line_parse image_markup eval_perl);
use WRT::Renderer qw(render);
use WRT::Util qw(dir_list get_date);
@ -164,7 +168,8 @@ See F<conf.pl> for a sample configuration.
=cut
my %default = (
root_dir => 'archives', # root dir for archived files
root_dir => '.', # dir for wrt repository
entry_dir => 'archives', # dir for entry files
url_root => "$0?", # root URL for building links
image_url_root => '', # same for images
template_dir => 'templates', # dir for template files
@ -219,7 +224,7 @@ A good way to ensure that this does not happen is to use patterns like:
...always marking the start and end of the string explicitly.
This will probably be rewritten to use an array so that the order can be
This may eventually be rewritten to use an array so that the order can be
explicitly specified.
=cut
@ -405,7 +410,7 @@ sub expand_option {
chop $option if $option =~ m{/$};
if ($option eq 'all') {
return dir_list($self->root_dir, 'high_to_low', qr/^[0-9]{1,4}$/);
return dir_list($self->entry_dir, 'high_to_low', qr/^[0-9]{1,4}$/);
} elsif ($option eq 'new') {
return $self->recent_month();
} elsif ($option eq 'fulltext') {
@ -426,7 +431,7 @@ If a year file is text, returns that instead.
sub recent_month {
my $self = shift;
my ($dir) = $self->root_dir;
my ($dir) = $self->entry_dir;
my ($mon, $year) = get_date('mon', 'year');
@ -459,11 +464,11 @@ sub fulltext {
my @individual_entries;
my @years = dir_list($self->root_dir, 'low_to_high', qr/^[0-9]{1,4}$/);
my @years = dir_list($self->entry_dir, 'low_to_high', qr/^[0-9]{1,4}$/);
foreach my $year (@years) {
my @months = dir_list($self->root_dir . '/' . $year, 'low_to_high', qr/^[0-9]+$/);
my @months = dir_list($self->entry_dir . '/' . $year, 'low_to_high', qr/^[0-9]+$/);
foreach my $month (@months) {
my @days = dir_list($self->root_dir . '/' . $year . '/' . $month, 'low_to_high', qr/^[0-9]+$/);
my @days = dir_list($self->entry_dir . '/' . $year . '/' . $month, 'low_to_high', qr/^[0-9]+$/);
foreach my $day (@days) {
push @individual_entries, "$year/$month/$day";
}
@ -960,42 +965,6 @@ sub fragment_slurp {
}
=item eval_perl
Evaluate embedded Perl in a string, replacing blocks enclosed with <perl> tags
with whatever they return (well, evaluated in a scalar context). Returns the
modified string.
Also handles simple ${variables}, replacing them from the keys to $self.
=cut
sub eval_perl {
my $self = shift;
my ($text) = @_;
while ($text =~ m{<perl>(.*?)</perl>}s) {
my $block = $1;
# Run the $block, and include anything returned:
my $output = eval $block;
if ($@) {
# Errors - log and return an empty string:
print STDERR $@;
$output = '';
}
$text =~ s{<perl>\Q$block\E</perl>}{$output}s;
}
# Interpolate variables:
$text =~ s/\$\{([a-zA-Z_]+)\}/$self->{$1}/ge;
return $text;
}
=item month_name
Turn numeric dates into English.
@ -1015,7 +984,7 @@ sub month_name {
=item root_locations($file)
Given a file/entry, return the appropriate concatenations with
root_dir and url_root.
entry_dir and url_root.
=cut
@ -1035,7 +1004,7 @@ Arguably this is stupid and inefficient.
=cut
sub local_path {
return $_[0]->root_dir . '/' . $_[1];
return $_[0]->entry_dir . '/' . $_[1];
}
=item feed_print


+ 111
- 11
lib/WRT/Markup.pm View File

@ -5,7 +5,7 @@ use warnings;
use feature "state";
use base qw(Exporter);
our @EXPORT_OK = qw(line_parse image_markup);
our @EXPORT_OK = qw(line_parse image_markup eval_perl);
use File::Basename;
use Text::Textile;
@ -49,7 +49,6 @@ Returns string.
Parses some special markup, specifically:
${variable} interpolation from %DISPLAY_CONF
<textile></textile> - Text::Textile to HTML
<markdown></markdown> - Text::Markdown::Discount to HTML
<freeverse></freeverse>
@ -60,11 +59,9 @@ Parses some special markup, specifically:
optional alt tag
optional title text</image>
There's also:
${variable} interpolation from the WRT object
<perl>print "hello world";</perl>
...but that's handled in WRT.pm.
<include>path/to/file/from/project/root</include>
=cut
@ -72,7 +69,8 @@ sub line_parse {
my $self = shift;
my ($everything, $file) = (@_);
# Take care of <textile>, <markdown>, and <image> tags:
# Take care of <include>, <textile>, <markdown>, and <image> tags:
include_process($self, $everything);
textile_process($everything);
markdown_process($everything);
$everything =~ s!<image>(.*?)</image>!$self->image_markup($file, $1)!seg;
@ -108,6 +106,50 @@ sub line_parse {
return $everything;
}
=item eval_perl
Evaluate embedded Perl in a string, replacing blocks enclosed with <perl> tags
with whatever they return (well, evaluated in a scalar context). Returns the
modified string.
Also handles simple ${variables}, replacing them from the keys to $self.
=cut
sub eval_perl {
my $self = shift;
my ($text) = @_;
while ($text =~ m{<perl>(.*?)</perl>}s) {
my $block = $1;
# Run the $block, and include anything returned:
my $output = eval $block;
if ($@) {
# Errors - log and return an empty string:
print STDERR $@;
$output = '';
}
$text =~ s{<perl>\Q$block\E</perl>}{$output}s;
}
# Interpolate variables:
$text =~ s{
\$\{ ([a-zA-Z_]+) \}
}{
if (defined $self->{$1}) {
$self->{$1};
} else {
# TODO: Possibly this should be fatal.
"UNDEFINED: $1";
}
}gex;
return $text;
}
sub newlines {
my ($replacement, $block) = @_;
@ -140,6 +182,64 @@ sub dashes {
return $block;
}
=item include_process
Inline replace <include>filename</include> tags, replacing them with the
contents of files.
=cut
sub include_process {
my $wrt = shift;
$_[0] =~ s{
<include> # start tag
(.*?) # anything (non-greedy)
</include> # end tag
}{
retrieve_include($wrt, $1);
}xesg;
}
=item retrieve_include
Get the contents of an included file. This probably needs a great
deal more thought than I am presently giving it.
=cut
sub retrieve_include {
my $wrt = shift;
my ($file) = @_;
# Trim leading and trailing spaces:
$file =~ s/^\s+//;
$file =~ s/\s+$//;
if ($file =~ m{^ (/ | [.]/) }x) {
# TODO: Leads with a slash or a ./
} else {
# Use the archive root as path.
$file = $wrt->root_dir . '/' . $file;
}
open my $fh, '<', $file
or warn "Couldn't open $file: $!\n";
my $file_contents;
{
# line separator:
local $/ = undef;
$file_contents = <$fh>;
}
close $fh or warn "Couldn't close $file: $!";
return $file_contents;
}
=item textile_process
Inline replace <textile> markup in a string.
@ -249,8 +349,8 @@ sub image_markup {
if (-e "$dir/$image_url" ) {
$image_file = "$dir/$image_url";
$image_url = "${file_date}${image_url}";
} elsif (-e $self->root_dir . "/$image_url") {
$image_file = $self->root_dir . "/$image_url";
} elsif (-e $self->entry_dir . "/$image_url") {
$image_file = $self->entry_dir . "/$image_url";
}
# Get width & height in pixels for known filetypes:
@ -278,8 +378,8 @@ sub resolve_file {
#if (-e "$dir/$image_url" ) {
#$image_file = "$dir/$image_url";
#$image_url = "${file_date}${image_url}";
#} elsif (-e $self->root_dir . "/$image_url") {
#$image_file = $self->root_dir . "/$image_url";
#} elsif (-e $self->entry_dir . "/$image_url") {
#$image_file = $self->entry_dir . "/$image_url";
#}
}


+ 8
- 8
lib/WRT/Renderer.pm View File

@ -20,12 +20,12 @@ use File::Path qw(make_path);
sub render {
# this is invoked off of $w, so it's passing in $self there:
my ($wrt) = shift;
my $root_dir = $wrt->root_dir;
my $entry_dir = $wrt->entry_dir;
my $rendered_count = 0;
my $copied_count = 0;
for my $file (get_source_files($root_dir)) {
next unless $file =~ m{^ \Q$root_dir\E / (.*) $}x;
for my $file (get_source_files($entry_dir)) {
next unless $file =~ m{^ \Q$entry_dir\E / (.*) $}x;
my $target = $1;
my $path_err;
@ -45,8 +45,8 @@ sub render {
}
# A directory - no-op:
if (-d "$root_dir/$target") {
say "[directory] $root_dir/$target";
if (-d "$entry_dir/$target") {
say "[directory] $entry_dir/$target";
next;
}
@ -55,7 +55,7 @@ sub render {
say "[copy] archives/$target -> public/$target";
make_path("public/$dirname", { error => \$path_err });
print Dumper($path_err) if (@{ $path_err });
copy("$root_dir/$target", "public/$target");
copy("$entry_dir/$target", "public/$target");
$copied_count++;
}
@ -72,7 +72,7 @@ sub file_put_contents {
# Collect a list of things to render:
sub get_source_files {
my ($root_dir) = @_;
my ($entry_dir) = @_;
my @source_files;
find(
@ -82,7 +82,7 @@ sub get_source_files {
push @source_files, $File::Find::name;
}
},
$root_dir
$entry_dir
);
return @source_files;
}

+ 11
- 3
t/wrt_markup.t View File

@ -7,7 +7,9 @@ use lib 'lib';
use Test::More tests => 2;
use WRT;
ok (my $w = WRT::new_from_file('example/wrt.json'), "Got WRT object.");
chdir 'example';
ok (my $w = WRT::new_from_file('wrt.json'), "Got WRT object.");
my $testlines = <<'LINES';
<textile>h1. Hello
@ -30,6 +32,9 @@ one
two
</list>
<include>files/include_me</include>
<include>files/include_me</include>
LINES
my $expectedlines = <<'LINES';
@ -49,6 +54,11 @@ frolic in</p>
<li>two</li>
</ul>
<p>This content included from elsewhere.</p>
<p>This content included from elsewhere.</p>
LINES
my $result = $w->line_parse($testlines, undef);
@ -62,6 +72,4 @@ if ($result ne $expectedlines) {
diag($result);
}
# diag($result);
1;

Write Preview
|||||||
​x
 
​
000:0
Loading…
Cancel
Save