/src/tutorial/build-tutorial.pod
Perl | 225 lines | 171 code | 51 blank | 3 comment | 10 complexity | aa3523262a3fe25114b8f283b1b3a5a3 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'>> 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>
- </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->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;
- }