File Coverage

blib/lib/Dancer2/Plugin/MarkdownFilesToHTML.pm

Criterion	Covered	Total	%
statement	152	162	93.8
branch	37	52	71.1
condition	16	19	84.2
subroutine	19	19	100.0
pod	1	2	50.0
total	225	254	88.5

package Dancer2::Plugin::MarkdownFilesToHTML ;
$Dancer2::Plugin::MarkdownFilesToHTML::VERSION = '0.015';
use 5.010; use strict; use warnings;

use Carp;
use Encode                qw( decode );
use Storable;
use File::Path            qw(make_path);
use Data::Dumper          'Dumper';
use File::Basename;
use Dancer2::Plugin;
use HTML::TreeBuilder;
use File::Spec::Functions qw(catfile);
use Text::Markdown::Hoedown;

plugin_keywords qw( md2html );

has options             => (is => 'rw', default => sub { {} });
has cache               => (is => 'ro', from_config => 'defaults.cache',               default => sub { 1 } );
has layout              => (is => 'ro', from_config => 'defaults.layout',              default => sub { 'main.tt' } );
has template            => (is => 'ro', from_config => 'defaults.template',            default => sub { 'index.tt' } );
has file_root           => (is => 'ro', from_config => 'defaults.file_root',           default => sub { 'lib/data/markdown_files' } );
has route_root          => (is => 'ro', from_config => 'defaults.route_root',          default => sub { '' } );
has header_class        => (is => 'ro', from_config => 'defaults.header_class',        default => sub { '' } );
has generate_toc        => (is => 'ro', from_config => 'defaults.generate_toc',        default => sub { 0  } );
has exclude_files       => (is => 'ro', from_config => 'defaults.exclude_files',       default => sub { [] } );
has include_files       => (is => 'ro', from_config => 'defaults.include_files',       default => sub { [] } );
has linkable_headers    => (is => 'ro', from_config => 'defaults.linkable_headers',    default => sub { 0  } );
has markdown_extensions => (is => 'ro', from_config => 'defaults.markdown_extensions', default => sub { [] } );

# Builds the routes from config file
sub BUILD {
  my $s      = shift;
  my $app    = $s->app;
  my $config = $s->config;

  # add routes from config file
  foreach my $route (@{$config->{routes}}) {

    # validate arguments supplied from config file
    if ((ref $route) ne 'HASH') {
      die 'Config file misconfigured. Check syntax or consult documentation.';
    }

    $s->_set_options($route);

    # Do the route addin'

    my %options = %{$s->options};
    $s->app->add_route(
      method => 'get',
      regexp => '/' . $options{route_root} . $options{path},
      code => sub {
        my $app = shift;
        my ($html, $toc) = $s->md2html($options{resource}, \%options);
        $app->template($options{template},
                      { html => $html, toc => $toc },
                      { layout => $options{layout} });
      },
    );
  }
}

sub _set_options {
  my $s = shift;
  my $options = shift;

  my @settings = qw(
    cache layout template file_root route_root header_class generate_toc
    exclude_files include_files linkable_headers markdown_extensions );

  my ($path) = keys %$options;
  my $defaults = $s->config->{defaults};
  my $local_options = (ref $options->{$path}) ? $options->{$path} : $options;
  my %options = (%$defaults, %$local_options);

  foreach my $setting (@settings) {
    $options{$setting} = $options->{$setting} //= $s->$setting;
  }

  $options{set} = 1;
  $options{path}             = $path;
  $options{route_root}       .= '/' if $options{route_root};
  $options{linkable_headers} = 1   if  $options{generate_toc};

  my $is_abs = File::Spec->file_name_is_absolute($options{resource});
  if (!$is_abs) {
    $options{resource} = File::Spec->catfile($options{file_root}, $options{resource});
  }

  $s->options(\%options);

}

# Keyword for generating HTML from a markdown resource (file or directory)
# either through cache retrieval or parsing of the resource
sub md2html {
  my ($s, $resource, $options) = @_;

  # If keyword called directly, options won't be set yet
  if (!$options->{set}) {
    $options->{resource} = $resource;
    $s->_set_options($options);
  } else {
    $s->options($options);
  }

  if (!-e $s->options->{resource}) {
    my $return = 'This route is not properly configured. Resource: '
                  . $s->options->{resource} . ' does not exist on the server.';
    $s->options({});
    return wantarray ?  ($return, '') : $return;
  }

  my $html = '';
  my $toc = '';

  my @files = ();
  if (-f $s->options->{resource}) {
    push @files, $s->options->{resource};
  } else {
    my $dir = $s->options->{resource};
    # gather the files according the options supplied
    if (@{$s->options->{include_files}}) {
      my @files = @{$s->options->{include_files}};
    } else {
      opendir my $d, $dir or die "Cannot open directory: $!";
      @files = grep { $_ !~ /^\./ } readdir $d;
      closedir $d;
      my @matching_files = ();
      foreach my $md_ext (@{$s->options->{markdown_extensions}}) {
        push @matching_files, grep { $_ =~ /\.$md_ext$/ } @files;
      }
      @files = @matching_files if @matching_files;
    }

    foreach my $excluded_file (@{$s->options->{exclude_files}}) {
      @files = grep { $_ ne $excluded_file } @files;
    }

    @files = map { File::Spec->catfile($dir, $_) } @files;
  }

  # concatenate html and toc into two strings
  foreach my $file (sort @files) {
    my ($file_html, $file_toc)  = $s->_mdfile_2html($file);
    $html                      .= $file_html;
    $toc                       .= $file_toc || '';
  }
  return wantarray ? ($html, $toc) : $html;
}

# Sends the markdown file to get parsed or retrieves html version from cache,
# if available. Also generates the table of contents.
sub _mdfile_2html {
  my $s = shift;
  my $file = shift;

  # chop off extension
  my ($base)   = fileparse($file, qr/\.[^.]*/);

  # generate the cache directory if it doesn't exist
  my $cache_dir = File::Spec->catfile(dirname($s->options->{'file_root'}), 'md_file_cache');
  if (!-d $cache_dir) {
    make_path $cache_dir or die "Cannot make cache directory $!";
  }

  # generate unique cache file name appended with values of two options
  my $cache_file = dirname($file);
  my $sep = File::Spec->catfile('', '');
  $cache_file =~ s/\Q$sep\E//g;
  $cache_file = File::Spec->catfile($cache_dir,
                 $cache_file . $base . $s->options->{linkable_headers} . $s->options->{generate_toc}
                             . $s->options->{header_class} =~ s/ //gr);

  # check for cache hit
  # TODO: Save options in separate file so they can be compared
  if (-f $cache_file && $s->options->{cache}) {
    if (-M $cache_file eq -M $file) {
      print Dumper 'cache hit: '. $file if $ENV{DANCER_ENVIRONMENT} && $ENV{DANCER_ENVIRONMENT} eq 'testing';
      my $data = retrieve $cache_file;
      return ($data->{html}, $data->{toc});
    }
  }

  # no cache hit so we parse the file
  # slurp the file and parse it with Hoedown's markdown function
  my $markdown = '';
  {
    local $/;
    open my $md, '<:encoding(UTF-8)', $file or die "Can't open $file: $!";
    $markdown = <$md>;
    close $md;
  }
  my $out  = markdown($markdown, extensions => HOEDOWN_EXT_FENCED_CODE, toc_nesting_lvl => 0);
  my $tree = HTML::TreeBuilder->new_from_content($out);

  my @code_els = $tree->find_by_tag_name('code');
  foreach my $code_el (@code_els) {
    if (!$code_el->left && !$code_el->right) {
      $code_el->attr('class' => 'single-line');
    }
  }

  # See if we can cache and return the output without further processing
  # generate_toc makes linkable_headers true so we just need to test linkable_headers option
  if (!$s->options->{linkable_headers} && !$s->options->{header_class}) {
    my $html = $tree->guts->as_HTML;
    _cache_data($cache_file, $file, $html) if $s->options->{cache};
    return ($html, '');
  }

  # generate linkable headers along with toc if option for it is set
  my @elements = $tree->look_down(_tag => qr/^h\d$/);
  my $toc      = HTML::TreeBuilder->new() if $s->options->{generate_toc};
  my $hdr_ct   = 0;
  foreach my $element (@elements) {
    my $id = 'header_' . ${hdr_ct};
    $hdr_ct++;
    $element->attr('id', $id . '_' . $base);
    $element->attr('class' => $s->options->{header_class}) if $s->options->{header_class};
    if ($s->options->{generate_toc}) {
      my ($level) = $element->tag =~ /(\d)/;
      my $toc_link = HTML::Element->new('a', href=> "#${id}_${base}", class => 'header_' . $level);
      $toc_link->push_content($element->as_text);
      $toc->push_content($toc_link);
      $toc->push_content(HTML::Element->new('br'));
    }
  }

  # Generate the final HTML from trees and cache
  # "guts" method gets rid of  and  tags added by TreeBuilder
  my ($html, $toc_out) = ($tree->guts->as_HTML, $toc ? $toc->guts->as_HTML : '');
  _cache_data($cache_file, $file, $html, $toc_out);
  return ($html, $toc_out);
}

sub _cache_data {
  my ($cache_file, $file, $content, $toc) = @_;
  $toc //= '';

  store { html => $content, toc => $toc }, $cache_file;
  my ($read, $write) = (stat($file))[8,9];
  utime($read, $write, $cache_file);
}

1;

__END__