workings-book/render.pl

#!/usr/bin/env perl

use strict;
use warnings;
use 5.10.0;
use feature "state";

use Cwd;
use File::Basename;
use HTML::Entities;
use Text::Markdown::Discount;

# Enable html5 block-level tags:
Text::Markdown::Discount::with_html5_tags();
my $flags = Text::Markdown::Discount::MKD_EXTRA_FOOTNOTE() | Text::Markdown::Discount::MKD_AUTOLINK();
my $markdown = Text::Markdown::Discount->new;

my $cwd = Cwd::getcwd();

my $full_source = '';
my $context = slurp("$cwd/context.md");
while (my $source = get_input()) {

  # A simple preprocessor:
  my ($basename, $dir) = fileparse($ARGV); # get path of target file
  chdir $dir;
  $source =~ s{<!-- exec -->(.*?)<!-- end -->}{handle_block($1);}egs;
  chdir $cwd;

  # $context here is for stuff like links that should be available to any
  # markdown file that gets interpreted
  $full_source .= "\n\n<article>\n\n"
                . $markdown->markdown($context . $source, $flags)
                . "\n\n</article>\n\n";

}

print replace_some_stuff($full_source);

sub get_input {
  local $/ = undef;
  my $source = <>;
  return $source;
}

sub handle_block {
  my ($block) = @_;

  my $cmd;

  if ($block =~ m/\$ (.*?)$/m) {
    $cmd = $1;
  } else {
    die "bogus cmd";
  }

  my $result = `$cmd`;

  # indent 4 spaces so we get a code block:
  $result =~ s/^/    /gm;

  return "<!-- exec -->\n\n    \$ " . $cmd . "\n" . $result . "\n<!-- end -->";
}

# super cheeseball, man
sub replace_some_stuff {
  my ($markup) = @_;

  my @contents;
  my $a_name_prefix_for_h2;

  # insert anchors in headers, accumulate a table of contents
  $markup =~ s{<(h[12])(.*?)>(.*?)</h[12]>}{
    my ($tag, $attributes, $text) = ($1, $2, $3);

    my $a_name = $text;
    $a_name =~ s/[^a-z0-9]+/-/ig;
    $a_name =~ s/^-|-$//g;

    if ($tag eq 'h1') {
      $a_name_prefix_for_h2 = $a_name;
    } else {
      $a_name = $a_name_prefix_for_h2 . '-' . $a_name;
    }

    push @contents, make_contents_link($tag, $a_name, $text);
    "<$tag$attributes><a name=$a_name href=#$a_name>#</a> $text</$tag>";
  }iesg;

  my $contents_text = '<div class=contents>'
                    . $markdown->markdown((join "\n", @contents), $flags)
                    . '</div>';
  $markup =~ s/{{contents}}/$contents_text/g;

  return $markup;
}

# make an individual element of a markdown list
sub make_contents_link {
  my ($tag, $a_name, $text) = @_;
  if ($tag eq 'h2') {
    # indented bullet
    return "    * [$text](#$a_name)";
  } elsif ($tag eq 'h1') {
    # top-level ordered-list item
    return "1. [$text](#$a_name)";
  }
}

# Get contents of a file as a string, because a File::Slurp dependency seemed
# like overkill:
sub slurp {
  my ($file) = @_;
  my $everything;

  open my $fh, '<', $file
    or die "Couldn't open $file: $!\n";

  # line separator:
  local $/ = undef;
  $everything = <$fh>;

  close $fh
    or die "Couldn't close $file: $!";

  return $everything;
}