build-tutorial.pod | searchcode

/src/tutorial/build-tutorial.pod

https://github.com/dinomite/dzil.org
Perl | 230 lines | 176 code | 51 blank | 3 comment | 10 complexity | 3c1979df71d0a95723769b6aa60ea48c MD5 | raw file

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

=head1 How the Tutorial Gets Built

The Dist::Zilla tutorial is modeled after the L<Choose Your Own
Adventure|http://en.wikipedia.org/wiki/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 build using L<Pod::Elemental>,
including the L<Pod::Elemental::Transformer::SynHi>-based transformers.
The resultant Pod is transformed into XHTML by L<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 C<Nonpod>.)

=cut

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;
}