> dzil

Choose Your Own Tutorial

#!/usr/bin/env perl # vim:ft=perl:

How the Tutorial Gets Built

The Dist::Zilla tutorial is modeled after the Choose Your Own Adventure books that I read when I was a kid. Each page is written as a simple Pod-like document and transformed into standard Perl 5 Pod with tools built using Pod::Elemental, including the Pod::Elemental::Transformer::SynHi-based transformers. The resultant Pod is transformed into XHTML by Pod::Simple::XHTML.

The program that I run to rebuild the site when I update the source documents (or the libraries that perform the conversion) is seen below. In fact, this HTML page is generated from the very program itself; it transforms non-Pod sections into Perl-highlighted code listings, as you can see in the source below. (You want to look for Nonpod.)

use 5.12.0; use warnings;

use autodie; use Encode; use File::Copy qw(copy); use Path::Class; use Pod::Elemental; use Pod::Elemental::Transformer::Pod5; use Pod::Elemental::Transformer::SynMux; use Pod::Elemental::Transformer::Codebox; use Pod::Elemental::Transformer::PPIHTML; use Pod::Elemental::Transformer::VimHTML; use Pod::Elemental::Transformer::List;

use Pod::CYOA::Transformer; use Pod::CYOA::XHTML;

use HTML::TreeBuilder;

my $src_dir = dir( $ARGV[0] || die "$0 src dest" ); my $dest_dir = dir( $ARGV[1] || die "$0 src dest" );

# ensure that dest_dir and needed subpath exist $dest_dir->subdir('src')->mkpath;

my $header = <<'END_HEADER'; <html> <head> <title>Dist::Zilla - Tutorial</title> <link rel='stylesheet' type='text/css' href='../style.css' /> <link rel='stylesheet' type='text/css' href='../ppi-html.css' /> <link rel='stylesheet' type='text/css' href='../vim-html.css' /> </head>

<body> <h1><a href='../index.html'>&gt; dzil</a></h1> <div id='content'> <h2>Choose Your Own Tutorial</h2> <div class='nav'> <a href='SOURCE'>page source</a> | <a href='contents.html'>index</a> | page NUM </div> END_HEADER

my $footer = <<'END_FOOTER'; <div> You can fork and improve <a href='https://github.com/rjbs/dzil.org'>this documentation on GitHub</a>! </div> </div> </body> END_FOOTER

my %number_of = (start => 1); my %title_of; my $i = 2; sub number_of { my ($name) = @_; return($number_of{ $name } ||= $i++); }

my $pod5 = Pod::Elemental::Transformer::Pod5->new; my $cyoa = Pod::CYOA::Transformer->new; my $list = Pod::Elemental::Transformer::List->new;

for my $podfile (sort { $a cmp $b } grep { /\.pod$/ } $src_dir->children) { my ($short_name) = $podfile->basename =~ /(.+)\.pod\z/; my $pod = `cat $podfile`;

  say "processing $short_name.pod...";

  my $pod_doc = Pod::Elemental->read_string($pod);

  $pod5->transform_node($pod_doc);
  $cyoa->transform_node($pod_doc);
  $list->transform_node($pod_doc);

  for my $i (0 .. $#{ $pod_doc->children }) {
    my $para = $pod_doc->children->[ $i ];
    next unless $para->isa('Pod::Elemental::Element::Pod5::Nonpod');
    next if $para->content !~ /\S/ or $para->content =~ /\A#!/;

    my $new_content = "#!perl\n" . $para->content;
    chomp $new_content;

    my $new = Pod::Elemental::Element::Pod5::Verbatim->new({
      content => $new_content,
    });

    $pod_doc->children->[ $i ] = $new;
  }

  Pod::Elemental::Transformer::List->new->transform_node($pod_doc);

  my $html = pod_to_html($pod_doc);

  my $header = $header;
  $header =~ s/NUM/number_of($short_name)/e;
  $header =~ s{SOURCE}{src/$short_name.pod};

  $html = join qq{\n}, $header, $html, $footer;

  my $root = HTML::TreeBuilder->new;
  $root->no_space_compacting(1);
  $root->parse_content($html);
  $root->eof;

  for my $link ($root->look_down(_tag => 'h3')) {
    $title_of{ $short_name } = $link->as_text;
    last;
  }

  if ($title_of{ $short_name }) {
    my $title   = $root->look_down(_tag => 'title');
    my $content = $title->as_text;
    $title->delete_content;
    $title->push_content("$content - $title_of{ $short_name }");
  }

  for my $link (
    $root->look_down(class => 'pod')
         ->look_down(href => qr{\A[-a-z0-9]+\.html\z})
  ) {
    next unless $link->look_up(class => 'cyoa');
    my ($name) = $link->attr('href') =~ m{\A(.+)\.html\z};
    my $num  = number_of($name);
    my $text = $link->as_text;
    $link->delete_content;
    $link->push_content("$text, turn to page $num");
  }

  copy($podfile, $dest_dir->subdir('src'));

  open my $out_fh, '>', $dest_dir->file("$short_name.html");
  print { $out_fh } $root->as_HTML;
}

number_of('build-tutorial');

my %is_missing; for (grep { ! exists $title_of{ $_ } } keys %number_of) { $is_missing{ $_ } = 1; $title_of{ $_ } = $_; }

{ $title_of{contents} = 'Table of Contents / Index';

  my $header = $header;
  $header =~ s/NUM/number_of('contents')/e;
  $header =~ s/^.+SOURCE.+$//m;
  $header =~ s/^.+contents.+$//m;

  open my $cheat_fh, '>', $dest_dir->file('contents.html');
  print { $cheat_fh } $header, "<h3>Index</h3>\n";

  print { $cheat_fh } join "\n",
    "<h4>Index of Topics</h4>",
    "<table class='index'>",
    (map {; "<tr><td><a href='$_.html'>$title_of{$_}</a></td><td>$number_of{$_}</td></tr>" }
      sort { $a cmp $b } keys %number_of),
    "</table>";


  print { $cheat_fh } join "\n",
    "<h4>Index of Pages</h4>",
    "<table class='index'>",
    (map {; "<tr><td>$number_of{$_}</td><td><a href='$_.html'>$title_of{$_}</a></td></tr>" }
      sort { $number_of{$a} <=> $number_of{$b} } keys %number_of),
    "</table>";

  print { $cheat_fh } $footer;
}

sub pod_to_html { my ($doc) = @_;

  my $mux = Pod::Elemental::Transformer::SynMux->new({
    transformers => [
      Pod::Elemental::Transformer::Codebox->new,
      Pod::Elemental::Transformer::PPIHTML->new,
      Pod::Elemental::Transformer::VimHTML->new,
    ],
  });

  $mux->transform_node($doc);

  my $pod = $doc->as_pod_string;

  my $parser = Pod::CYOA::XHTML->new;
  $parser->output_string(\my $html);
  $parser->html_h_level(3);
  $parser->html_header('');
  $parser->html_footer('');
  $parser->perldoc_url_prefix("https://metacpan.org/module/");
  $parser->parse_string_document( Encode::encode('utf-8', $pod) );

  $html = "<div class='pod'>$html</div>";

  $html =~ s{
    \s*(<pre>)\s*
    (<table\sclass='code-listing'>.+?
    \s*</table>)\s*(?:<!--\shack\s-->)?\s*(</pre>)\s*
  }{my $str = $2; $str =~ s/\G^\s\s[^\$]*$//gm; $str}gesmx;

  return $html;
}
You can fork and improve this documentation on GitHub!