view release on metacpan or  search on metacpan

inc/Pod/Snippets.pm  view on Meta::CPAN

=head2 as_data ()

Returns the snippets in "data" format: that is, the return value is
ragged to the left by suppressing a constant number of space
characters at the beginning of each snippet.  (If tabs are present in
the POD, they are treated as being of infinite length; that is, the
ragging algorithm does not eat them or replace them with spaces.)

A snippet is defined as a series of subsequent verbatim POD paragraphs
with only B<Pod::Snippets> markup, if anything, intervening in
between.  That is, I<as_data()>, given the following POD in input:

=for metatests "as_data multiple blocks input" begin

    my $a = new The::Brain;

  =begin test

      # Just kidding. We can't do that, it's too dangerous.
      $a = new Pinky;

  =end test

  =for test ignore

    system("/sbin/reboot");

  and all of a sudden, we have:

  =for test

        if ($a->has_enough_cookies()) {
          $a->conquer_world();
        }

=for metatests "as_data multiple blocks input" end

would return (in list context)

=for metatests "as_data multiple blocks return" begin

  (<<'FIRST_SNIPPET', <<'SECOND_SNIPPET');
  my $a = new The::Brain;



    # Just kidding. We can't do that, it's too dangerous.
    $a = new Pinky;
  FIRST_SNIPPET
  if ($a->has_enough_cookies()) {
    $a->conquer_world();
  }
  SECOND_SNIPPET

=for metatests "as_data multiple blocks return" end

Notice how the indentation is respected snippet-by-snippet; also,
notice that the FIRST_SNIPPET has been padded with an appropriate
number of carriage returns to replace the B<Pod::Snippets> markup, so
that the return value is line-synchronized with the original POD.
However, leading and trailing whitespace is trimmed, leaving only
strings that starts with a nonblank line and end with a single
newline.

In scalar context, returns the blocks joined with a single newline
character ("\n"), thus resulting in a single piece of text where the
blocks are joined by exactly one empty line (and which as a whole is
no longer line-synchronized with the source code, of course).

=cut

sub as_data {
    my ($self) = @_;
    $self->_block_access_if_errors();

    my @retval = map {
        # This may be a pedestrian and sub-optimal way of doing the
        # ragging, but it sure is concise:
        until (m/^\S/m) { s/^ //gm or last; };
        "$_";
    } ($self->_merged_snippets);

    return wantarray ? @retval : join("\n", @retval);
}

=head2 as_code ()

Returns the snippets formatted as code, that is, like L</as_data>,
except that each block is prepended with an appropriate C<#line>
statement that Perl can interpret to renumber lines.  For instance,
these statements would cause Perl to Do The Right Thing if one
compiles the snippets as code with L<perlfunc/eval> and then runs it
under the Perl debugger.

=cut

sub as_code {
    my ($self) = @_;
    $self->_block_access_if_errors();
    my @retval = $self->as_data;

    foreach my $i (0..$#retval) {
        my $file = $self->filename;
        my $line = ($self->_merged_snippets)[$i]->line() +
            $self->{start_line} - 1;
        $retval[$i] = <<"LINE_MARKUP" . $retval[$i];
#line $line "$file"
LINE_MARKUP
    }
    return wantarray ? @retval : join("\n", @retval);
}

=head2 named ($name)

Returns a clone of this B<Pod::Snippet> object, except that it only
knows about the snippet (or snippets) that are named $name.  In the
most lax settings for the parser, this means: any and all snippets
where an C<=for test "$name" begin> (or C<=begin test "$name">) had
been open, but not yet closed with C<=for test "$name" end> (or C<=end
test "$name">).  Returns undef if no snippet named $name was seen at
all.

=cut

sub named {
    my ($self, $name) = @_;
    $self->_block_access_if_errors();
    my @snippets_with_this_name = grep {

inc/Pod/Snippets.pm  view on Meta::CPAN

         } (@{$self->{unmerged_snippets}});
    return if ! grep { defined } @snippets_with_this_name;
    return bless
        {
         unmerged_snippets => \@snippets_with_this_name,
         map { exists $self->{$_} ? ($_ => $self->{$_}) : () }
         (qw(warnings errors filename start_line) )
         # Purposefully do not transfer other fields such as
         # ->{merged_snippets}
        }, ref($self);
}

=begin internals

=head2 _block_access_if_errors ()

Throws an exception if L</errors> returns a nonzero value.  Called by
every read accessor except L</warnings> and I<errors()>.

=cut

sub _block_access_if_errors {
    die <<"MESSAGE" if shift->errors;
Cannot fetch parse results from Pod::Snippets with errors.
MESSAGE
}

=head2 _merged_snippets ()

Returns roughly the same thing as L</pod_snippets> in
L</Pod::Snippets::_Parser>, except that leading and trailing
whitespace is trimmed (updating the line counters appropriately),
names are discarded and snippets are merged together (with appropriate
padding using $/) according to the semantics set forth in L</as_data>.
This method has a cache.

=cut

sub _merged_snippets {
    my ($self) = @_;

    $self->{merged_snippets} ||= do {
        my @snippets;
        foreach my $snip (@{$self->{unmerged_snippets}}) {
            if (! defined($snip)) {
                push @snippets, undef if defined $snippets[-1];
            } elsif (! @snippets) {
                push @snippets, $snip;
            } elsif (! defined($snippets[-1])) {
                $snippets[-1] = $snip;
            } else {
                # The merger case.
                my $prevstartline = $snippets[-1]->line();
                my $newlines_to_add = $snip->line - $prevstartline
                    - _number_of_newlines_in($snippets[-1]);
                if ($newlines_to_add < 0) {
                    my $filename = $self->filename();
                    warn <<"ASSERTION_FAILED" ;
Pod::Snippets: problem counting newlines at $filename
near line $prevstartline (trying to skip $newlines_to_add lines)
Output will be desynchronized.
ASSERTION_FAILED
                    $newlines_to_add = 0;
                }
                $snippets[-1] = $snippets[-1] . $/ x $newlines_to_add .
                    $snip;
            }
        }

        pop @snippets if ! defined $snippets[-1];

        # Trim leading and trailing whitespace.
        foreach my $i (0..$#snippets) {
            my $text = "$snippets[$i]";
            my $line = $snippets[$i]->line();
            my $nl = $/; # Foils smarter-than-thou regex parser
            while($text =~ s|^\s*$nl||) { $line++ };
            # This is disturbingly asymetric.
            $text =~ s|(^\s*$nl)*\Z||m;
            $snippets[$i] = Pod::Snippets::_Snippet->new
                ($line, $text, $snippets[$i]->names_set);
        }

        \@snippets;
    };

    return @{$self->{merged_snippets}};
}

=head2 _number_of_newlines_in($string)

This function (B<not> a method) returns the number of times $/ is
found in $string.

=cut

sub _number_of_newlines_in {
    my @occurences = shift =~ m|($/)|gs;
    return scalar @occurences;
}

=head1 Pod::Snippets::_Parser

This class is a subclass to L<Pod::Parser>, that builds appropriate
state on behalf of a I<Pod::Snippets> object.

=cut

package Pod::Snippets::_Parser;

use base "Pod::Parser";

=head2 new_for_pod_snippets (-opt1 => $val1, ...)

An alternate constructor with a different syntax suited for calling
from I<Pod::Snippets>.  Available named options are:

=over

=item B<< -markup => $string >>