view release on metacpan or  search on metacpan

lib/App/DocKnot/Generate.pm  view on Meta::CPAN

                (?: \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.
#
# $para        - A paragraph of text to wrap
# $options_ref - Options to controll the wrapping
#   ignore_indent - Ignore indentation when choosing whether to wrap
#
# Returns: The wrapped paragraph
sub _wrap_paragraph {
    my ($self, $para, $options_ref) = @_;
    $options_ref //= {};
    my ($indent) = ($para =~ m{ \A ([ ]*) \S }xms);

    # If the indent is longer than five characters and the ignore indent
    # option is not set, leave it alone.  Allow an indent of five characters
    # since it may be a continuation of a numbered list entry.
    if (length($indent) > 5 && !$options_ref->{ignore_indent}) {
        return $para;
    }

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

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

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

    # If this looks like a Markdown block quote, strip trailing whitespace,
    # remove the leading indentation marks, wrap the paragraph, and then put
    # them back.
    ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
    if ($para =~ m{ \A (\s*) > \s }xms) {
        $para =~ s{ [ ]+ \n }{\n}xmsg;
        $para =~ s{ ^ (\s*) > (\s) }{$1 $2}xmsg;
        my $offset = length($1);
        $para = $self->_wrap_paragraph($para, { ignore_indent => 1 });
        $para =~ s{ ^ (\s{$offset}) \s }{$1>}xmsg;
        return $para;
    }
    ## use critic

    # If this looks like a bunch of short lines, leave it alone.
    if ($para =~ m{ \A (?: \Q$indent\E [^\n]{1,45} \n ){3,} }xms) {
        return $para;
    }

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

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

    # Remove any existing newlines, preserving two spaces after periods.
    $para =~ s{ [.] ([)\"]?) \n (\S) }{.$1  $2}xmsg;
    $para =~ 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.
    $para = wrap($indent, $indent, $para);

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

    # All done.
    return $para;
}

# 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.
#
# $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;