File Coverage

blib/lib/App/DocKnot/Generate.pm

Criterion	Covered	Total	%
statement	180	186	96.7
branch	24	30	80.0
condition	6	9	66.6
subroutine	24	24	100.0
pod	4	4	100.0
total	238	253	94.0

# Generate human-readable documentation from package metadata.
#
# This is the implementation of the docknot generate command, which uses
# templates to support generation of various documentation files based on
# package metadata.
#
# SPDX-License-Identifier: MIT

##############################################################################
# Modules and declarations
##############################################################################

package App::DocKnot::Generate 3.01;

use 5.024;
use autodie;
use parent qw(App::DocKnot);
use warnings;

use App::DocKnot::Config;
use Carp qw(croak);
use Template;
use Text::Wrap qw(wrap);

# Default output files for specific templates.
my %DEFAULT_OUTPUT = (
    'readme'    => 'README',
    'readme-md' => 'README.md',
);

##############################################################################
# Generator functions
##############################################################################

# The internal helper object methods in this section are generators.  They
# return code references intended to be passed into Template Toolkit as code
# references so that they can be called inside templates, incorporating data
# from the App::DocKnot configuration or the package metadata.

# Returns code to center a line in $self->{width} characters given the text of
# the line.  The returned code will take a line of text and return that line
# with leading whitespace added as required.
#
# $self - The App::DocKnot::Generate object
#
# Returns: Code reference to a closure that uses $self->{width} for width
sub _code_for_center {
    my ($self) = @_;
    my $center = sub {
        my ($text) = @_;
        my $space = $self->{width} - length($text);
        if ($space <= 0) {
            return $text;
        } else {
            return q{ } x int($space / 2) . $text;
        }
    };
    return $center;
}

# Returns code that formats the copyright notices for the package.  The
# resulting code reference takes two parameter, the indentation level and an
# optional prefix for each line, and wraps the copyright notices accordingly.
# They will be wrapped with a four-space outdent and kept within
# $self->{width} columns.
#
# $self           - The App::DocKnot::Generate object
# $copyrights_ref - A reference to a list of anonymous hashes, each with keys:
#   holder - The copyright holder for that copyright
#   years  - The years of that copyright
#
# Returns: Code reference to a closure taking an indent level and an optional
#          prefix and returning the formatted copyright notice
sub _code_for_copyright {
    my ($self, $copyrights_ref) = @_;
    my $copyright = sub {
        my ($indent, $lead) = @_;
        my $prefix = ($lead // q{}) . q{ } x $indent;
        my $notice;
        for my $copyright ($copyrights_ref->@*) {
            my $holder = $copyright->{holder};
            my $years  = $copyright->{years};

            # Build the initial notice with the word copyright and the years.
            my $text = 'Copyright ' . $copyright->{years};
            local $Text::Wrap::columns  = $self->{width} + 1;
            local $Text::Wrap::unexpand = 0;
            $text = wrap($prefix, $prefix . q{ } x 4, $text);

            # See if the holder fits on the last line.  If so, add it there;
            # otherwise, add another line.
            my $last_length;
            if (rindex($text, "\n") == -1) {
                $last_length = length($text);
            } else {
                $last_length = length($text) - rindex($text, "\n");
            }
            if ($last_length + length($holder) < $self->{width}) {
                $text .= " $holder";
            } else {
                $text .= "\n" . $prefix . q{ } x 4 . $holder;
            }
            $notice .= $text . "\n";
        }
        chomp($notice);
        return $notice;
    };
    return $copyright;
}

# Returns code to indent each line of a paragraph by a given number of spaces.
# This is constructed as a method returning a closure so that its behavior can
# be influenced by App::DocKnot configuration in the future, but it currently
# doesn't use any configuration.  It takes the indentation and an optional
# prefix to put at the start of each line.
#
# $self - The App::DocKnot::Generate object
#
# Returns: Code reference to a closure
sub _code_for_indent {
    my ($self) = @_;
    my $indent = sub {
        my ($text, $space, $lead) = @_;
        $lead //= q{};
        my @text = split(m{\n}xms, $text);
        return join("\n", map { $lead . q{ } x $space . $_ } @text);
    };
    return $indent;
}

# Returns code that converts metadata text (which is assumed to be in
# Markdown) to text.  This is not a complete Markdown formatter.  It only
# supports the bits of markup that I've had some reason to use.
#
# This is constructed as a method returning a closure so that its behavior can
# be influenced by App::DocKnot configuration in the future, but it currently
# doesn't use any configuration.
#
# $self - The App::DocKnot::Generate object
#
# Returns: Code reference to a closure that takes a block of text and returns
#          the coverted text
sub _code_for_to_text {
    my ($self) = @_;
    my $to_text = sub {
        my ($text) = @_;

        # Remove triple backticks but escape all backticks inside them.
        $text =~ s{ ``` \w* (\s .*?) ``` }{
            my $text = $1;
            $text =~ s{ [\`] }{``}xmsg;
            $text;
        }xmsge;

        # Remove backticks, but don't look at things starting with doubled
        # backticks.
        $text =~ s{ (?

        # Undo backtick escaping.
        $text =~ s{ `` }{\`}xmsg;

        # Rewrite quoted paragraphs to have four spaces of additional
        # indentation.
        $text =~ s{
            \n \n               # start of paragraph
            (                   # start of the text
              (> \s+)           #   quote mark on first line
              \S [^\n]* \n      #   first line
              (?:               #   all subsequent lines
                \2 \S [^\n]* \n #     start with the same prefix
              )*                #   any number of subsequent lines
            )                   # end of the text
        }{
            my ($text, $prefix) = ($1, $2);
            $text =~ s{ ^ \Q$prefix\E }{  }xmsg;
            "\n\n" . $text;
        }xmsge;

        # For each paragraph, remove URLs from all links, replacing them with
        # numeric references, and accumulate the mapping of numbers to URLs in
        # %urls.  Then, add to the end of the paragraph the references and
        # URLs.
        my $ref        = 1;
        my @paragraphs = split(m{ \n\n }xms, $text);
        for my $para (@paragraphs) {
            my %urls;
            while ($para =~ s{ \[ ([^\]]+) \] [(] (\S+) [)] }{$1 [$ref]}xms) {
                $urls{$ref} = $2;
                $ref++;
            }
            if (%urls) {
                my @refs = map { "[$_] $urls{$_}" } sort { $a <=> $b }
                  keys(%urls);
                $para .= "\n\n" . join("\n", q{}, @refs, q{});
            }
        }

        # Rejoin the paragraphs and return the result.
        return join("\n\n", @paragraphs);
    };
    return $to_text;
}

# Returns code that converts metadata text (which is assumed to be in
# Markdown) to thread.  This is not a complete Markdown formatter.  It only
# supports the bits of markup that I've had some reason to use.
#
# This is constructed as a method returning a closure so that its behavior can
# be influenced by App::DocKnot configuration in the future, but it currently
# doesn't use any configuration.
#
# $self - The App::DocKnot::Generate object
#
# Returns: Code reference to a closure that takes a block of text and returns
#          the coverted thread
sub _code_for_to_thread {
    my ($self) = @_;
    my $to_thread = sub {
        my ($text) = @_;

        # Escape all backslashes.
        $text =~ s{ \\ }{\\\\}xmsg;

        # Rewrite triple backticks to \pre blocks and escape backticks inside
        # them so that they're not turned into \code blocks.
        $text =~ s{ ``` \w* (\s .*?) ``` }{
            my $text = $1;
            $text =~ s{ [\`] }{``}xmsg;
            '\pre[' . $1 . ']';
        }xmsge;

        # Rewrite backticks to \code blocks.
        $text =~ s{ ` ([^\`]+) ` }{\\code[$1]}xmsg;

        # Undo backtick escaping.
        $text =~ s{ `` }{\`}xmsg;

        # Rewrite all Markdown links into thread syntax.
        $text =~ s{ \[ ([^\]]+) \] [(] (\S+) [)] }{\\link[$2][$1]}xmsg;

        # Rewrite long bullets.  This is quite tricky since we have to grab
        # every line from the first bulleted one to the point where the
        # indentation stops.
        $text =~ s{
            (                   # capture whole contents
                ^ (\s*)         #   indent before bullet
                [*] (\s+)       #   bullet and following indent
                [^\n]+ \n       #   rest of line
                (?: \s* \n )*   #   optional blank lines
                (\2 [ ] \3)     #   matching indent
                [^\n]+ \n       #   rest of line
                (?:             #   one or more of
                    \4          #       matching indent
                    [^\n]+ \n   #       rest of line
                |               #   or
                    \s* \n      #       blank lines
                )+              #   end of indented block
            )                   # full bullet with leading bullet
        }{
            my $text = $1;
            $text =~ s{ [*] }{ }xms;
            "\\bullet[\n\n" . $text . "\n]\n";
        }xmsge;

        # Do the same thing, but with numbered lists.  This doesn't handle
        # numbers larger than 9 currently, since that requires massaging the
        # spacing.
        $text =~ s{
            (                   # capture whole contents
                ^ (\s*)         #   indent before number
                \d [.] (\s+)    #   number and following indent
                [^\n]+ \n       #   rest of line
                (?: \s* \n )*   #   optional blank lines
                (\2 [ ][ ] \3)  #   matching indent
                [^\n]+ \n       #   rest of line
                (?:             #   one or more of
                    \4          #       matching indent
                    [^\n]+ \n   #       rest of line
                |               #   or
                    \s* \n      #       blank lines
                )+              #   end of indented block
            )                   # full bullet with leading bullet
        }{
            my $text = $1;
            $text =~ s{ \A (\s*) \d [.] }{$1  }xms;
            "\\number[\n\n" . $text . "\n]\n\n";
        }xmsge;

        # Rewrite compact bulleted lists.
        $text =~ s{ \n ( (?: \s* [*] \s+ [^\n]+ \s* \n ){2,} ) }{
            my $list = $1;
            $list =~ s{ \n [*] \s+ ([^\n]+) }{\n\\bullet(packed)[$1]}xmsg;
            "\n" . $list;
        }xmsge;

        # Done.  Return the results.
        return $text;
    };
    return $to_thread;
}

##############################################################################
# Helper methods
##############################################################################

# Word-wrap a paragraph of text.  This is a helper function for _wrap, mostly
# so that it can be invoked recursively to wrap bulleted paragraphs.
#
# If the paragraph looks like regular text, which means indented by two or
# four spaces and consistently on each line, remove the indentation and then
# add it back in while wrapping the text.
#
# $self      - The App::DocKnot::Generate object
# $paragraph - A paragraph of text to wrap
#
# Returns: The wrapped paragraph
sub _wrap_paragraph {
    my ($self, $paragraph) = @_;
    my ($indent) = ($paragraph =~ m{ \A ([ ]*) \S }xms);

    # If the indent is longer than four characters, leave it alone.
    if (length($indent) > 4) {
        return $paragraph;
    }

    # If this looks like thread commands or URLs, leave it alone.
    if ($paragraph =~ m{ \A \s* (?: \\ | \[\d+\] ) }xms) {
        return $paragraph;
    }

    # If this starts with a bullet, strip the bullet off, wrap the paragaraph,
    # and then add it back in.
    if ($paragraph =~ s{ \A (\s*) [*] (\s+) }{$1 $2}xms) {
        my $offset = length($1);
        $paragraph = $self->_wrap_paragraph($paragraph);
        substr($paragraph, $offset, 1, q{*});
        return $paragraph;
    }

    # If this looks like a Markdown block quote leave it alone, but strip
    # trailing whitespace.
    if ($paragraph =~ m{ \A \s* > \s }xms) {
        $paragraph =~ s{ [ ]+ \n }{\n}xmsg;
        return $paragraph;
    }

    # If this looks like a bunch of short lines, leave it alone.
    if ($paragraph =~ m{ \A [^\n]{1,40} \n [^\n]{1,40} \n }xms) {
        return $paragraph;
    }

    # If this paragraph is not consistently indented, leave it alone.
    if ($paragraph !~ m{ \A (?: \Q$indent\E \S[^\n]+ \n )+ \z }xms) {
        return $paragraph;
    }

    # Strip the indent from each line.
    $paragraph =~ s{ (?: \A | (?<=\n) ) \Q$indent\E }{}xmsg;

    # Remove any existing newlines, preserving two spaces after periods.
    $paragraph =~ s{ [.] ([)\"]?) \n (\S) }{.$1  $2}xmsg;
    $paragraph =~ s{ \n(\S) }{ $1}xmsg;

    # Force locally correct configuration of Text::Wrap.
    local $Text::Wrap::break    = qr{\s+}xms;
    local $Text::Wrap::columns  = $self->{width} + 1;
    local $Text::Wrap::huge     = 'overflow';
    local $Text::Wrap::unexpand = 0;

    # Do the wrapping.  This modifies @paragraphs in place.
    $paragraph = wrap($indent, $indent, $paragraph);

    # Strip any trailing whitespace, since some gets left behind after periods
    # by Text::Wrap.
    $paragraph =~ s{ [ ]+ \n }{\n}xmsg;

    # All done.
    return $paragraph;
}

# Word-wrap a block of text.  This requires some annoying heuristics, but the
# alternative is to try to get the template to always produce correctly
# wrapped results, which is far harder.
#
# $self - The App::DocKnot::Generate object
# $text - The text to wrap
#
# Returns: The wrapped text
sub _wrap {
    my ($self, $text) = @_;

    # First, break the text up into paragraphs.  (This will also turn more
    # than two consecutive newlines into just two newlines.)
    my @paragraphs = split(m{ \n(?:[ ]*\n)+ }xms, $text);

    # Add back the trailing newlines at the end of each paragraph.
    @paragraphs = map { $_ . "\n" } @paragraphs;

    # Wrap all of the paragraphs.  This modifies @paragraphs in place.
    for my $paragraph (@paragraphs) {
        $paragraph = $self->_wrap_paragraph($paragraph);
    }

    # Glue the paragraphs back together and return the result.  Because the
    # last newline won't get stripped by the split above, we have to strip an
    # extra newline from the end of the file.
    my $result = join("\n", @paragraphs);
    $result =~ s{ \n+ \z }{\n}xms;
    return $result;
}

##############################################################################
# Public interface
##############################################################################

# Create a new App::DocKnot::Generate object, which will be used for
# subsequent calls.
#
# $class - Class of object to create
# $args  - Anonymous hash of arguments with the following keys:
#   metadata - Path to the directory containing package metadata
#   width    - Line length at which to wrap output files
#
# Returns: Newly created object
#  Throws: Text exceptions on invalid metadata directory path
sub new {
    my ($class, $args_ref) = @_;

    # Create the config reader.
    my %config_args;
    if ($args_ref->{metadata}) {
        $config_args{metadata} = $args_ref->{metadata};
    }
    my $config = App::DocKnot::Config->new(\%config_args);

    # Create and return the object.
    my $self = {
        config => $config,
        width  => $args_ref->{width} // 74,
    };
    bless($self, $class);
    return $self;
}

# Generate a documentation file from the package metadata.
#
# $self     - The App::DocKnot::Generate object
# $template - Name of the documentation template (using Template Toolkit)
#
# Returns: The generated documentation as a string
#  Throws: autodie exception on failure to read metadata or write the output
#          Text exception on Template Toolkit failures
#          Text exception on inconsistencies in the package data
sub generate {
    my ($self, $template) = @_;

    # Load the package metadata.
    my $data_ref = $self->{config}->config();

    # Create the variable information for the template.  Start with all
    # metadata as loaded above.
    my %vars = %{$data_ref};

    # Add code references for our defined helper functions.
    $vars{center}    = $self->_code_for_center;
    $vars{copyright} = $self->_code_for_copyright($data_ref->{copyrights});
    $vars{indent}    = $self->_code_for_indent;
    $vars{to_text}   = $self->_code_for_to_text;
    $vars{to_thread} = $self->_code_for_to_thread;

    # Ensure we were given a valid template.
    $template = $self->appdata_path('templates', "${template}.tmpl");

    # Run Template Toolkit processing.
    my $tt = Template->new({ ABSOLUTE => 1 }) or croak(Template->error());
    my $result;
    $tt->process($template, \%vars, \$result) or croak($tt->error);

    # Word-wrap the results to our width and return them.
    return $self->_wrap($result);
}

# Generate all package documentation from the package metadata.  Only
# generates the output for templates with a default output file.
#
# $self - The App::DocKnot::Generate object
#
# Returns: undef
#  Throws: autodie exception on failure to read metadata or write the output
#          Text exception on Template Toolkit failures
#          Text exception on inconsistencies in the package data
sub generate_all {
    my ($self) = @_;
    for my $template (keys(%DEFAULT_OUTPUT)) {
        $self->generate_output($template);
    }
    return;
}

# Generate a documentation file from the package metadata.
#
# $self     - The App::DocKnot::Generate object
# $template - Name of the documentation template
# $output   - Output file name (undef to use the default)
#
# Returns: undef
#  Throws: autodie exception on failure to read metadata or write the output
#          Text exception on Template Toolkit failures
#          Text exception on inconsistencies in the package data
sub generate_output {
    my ($self, $template, $output) = @_;
    $output //= $DEFAULT_OUTPUT{$template};

    # If the template doesn't have a default output file, $output is required.
    if (!defined($output)) {
        croak('missing required output argument');
    }

    # Generate the output.
    open(my $outfh, '>', $output);
    print {$outfh} $self->generate($template)
      or croak("cannot write to $output: $!");
    close($outfh);
    return;
}

##############################################################################
# Module return value and documentation
##############################################################################

1;
__END__