gen_manual

#!/usr/bin/env perl

use v5.10;
use strict;
use warnings;
use File::Spec::Functions qw(catdir catfile updir);
use File::Basename;

my $dir = shift || catdir updir, 'sqitch';
die "Source directory `$dir` does not exist\n\nUsage: $0 path/to/sqitch\n\n"
    unless -e $dir;
die "Path `$dir` is not a directory\n\nUsage: $0 path/to/sqitch\n\n"
    unless -d $dir;

my $src = catdir $dir, 'lib';
my $dst = catdir qw(content docs manual);

my %skip = map { $_ => 1 } qw(sqitch-passwords sqitchguides sqitchusage sqitchcommands);

for my $pod (glob "$src/sqitch*.pod") {
    next if $pod =~ /-usage[.]pod$/;
    (my $name = basename $pod) =~ s/[.]pod$//;
    next if $skip{$name};
    my $md = catfile $dst, "$name.md";
    say "📗 Generating $md";
    my $parser = Sqitch::Markdown->new;
    my $markdown = '';
    $parser->output_string(\$markdown);
    $parser->parse_file($pod);
    open my $out, '>:utf8', $md or die "Cannot open $md: $\n";
    print {$out} join "\n", (
        qq{---},
        qq{title: $name},
        qq{headTitle: "Sqitch: $name Documentation"},
        qq{description: $parser->{abstract}},
        qq{toc: true},
        qq{---},
        qq{},
        $markdown
    );
    close $out or die "Cannot close $md: $!\n";
}

package Sqitch::Markdown;
use strict;
use warnings;
use Pod::Markdown;
use parent 'Pod::Markdown';

sub new {
    my $self = shift->SUPER::new(
        local_module_url_prefix => '/docs/manual/',
        local_module_re         => qr/^sqitch/,
    );
    $self->strip_verbatim_indent(sub {
        my $lines = shift;
        (my $indent = $lines->[0]) =~ s/\S.*//;
        return $indent;
    });
    $self->{head_level} = 0;
    $self->{abstract}   = '';
    return $self;
}

# Make each header one greater (=head1 => ##, =head2 => ###, etc.).
sub _start_head { $_[0]->{head_level} = $_[1]; $_[0]->SUPER::_start_head( $_[1] + 1 ) }
sub _end_head   { $_[0]->{head_level} = 0;     $_[0]->SUPER::_end_head(   $_[1] + 1 ) }

sub handle_text {
    my $self = shift;
    if ($self->{head_level} == 1) {
        # Are we in the Name header?
        $self->{in_name} = $_[0] =~ /^name$/i;
    } elsif ($self->{in_name}) {
        # Get the abstract from the Name header.
        ($self->{abstract} = $_[0]) =~ s/^\S+\s+-\s+//;
        $self->{in_name} = 0;
    }
    return $self->SUPER::handle_text(@_);
}

sub end_Verbatim {
    my ($self) = shift;
    my $text = $self->_pop_stack_text;
    $self->_private->{no_escape} = 0;
    my $lang = guess_lang($text);
    $self->_save_block("```$lang\n$text\n```");
}

sub guess_lang {
    $_ = shift;
    return ' diff' if /^@@ /ms;
    return ' abnf' if /^[[]%\s*\w+/ms; # Not exact, but close enough.
    return ' sql'  if /^(?:BEGIN|CREATE|UPDATE|DROP|SELECT|DO)\b/ms;
    return ' ini'  if /^[[]\w+[]]/ms;
    return '';
}