view release on metacpan or  search on metacpan

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

=head2 verbatim ()

Overloaded so as to catch and store the verbatim sections.

=cut

sub verbatim {
    my ($self, $paragraph, $line_num) = @_;

    $self->pod_snippets_source_line_number($line_num);

    return if $self->ignoring_pod_snippets;
    push(@{$self->{pod_snippets}},
         Pod::Snippets::_Snippet->new($line_num, $paragraph,
                                      $self->pod_snippets_names()));
}

=head2 textblock ()

=head2 interior_sequence ()

These methods are overloaded so as discard the corresponding pieces of
POD and to call L</break_current_pod_snippet> instead.

=cut

sub textblock {
    my ($self, $paragraph, $line_num) = @_;
    $self->pod_snippets_source_line_number($line_num);
    $self->break_current_pod_snippet;
}

sub interior_sequence { shift->break_current_pod_snippet }

=head2 break_current_pod_snippet ()

Called by L</command>, L</textblock> and L</interior_sequence>
whenever a piece of POD that is ignored by B<Pod::Snippets> is seen in
the parse stream.  Causes the parser to record the break, pursuant to
the snippet aggregation feature set forth in L</as_data>.

=cut

sub break_current_pod_snippet {
    my ($self) = @_;
    $self->maybe_raise_pod_snippets_impure() if
        $self->in_named_pod_snippet;
    push(@{$self->{pod_snippets}}, undef)
         unless (! defined $self->{pod_snippets}->[-1]);
}

=head2 pod_snippets_source_line_number ()

=head2 pod_snippets_source_line_number ($value)

Gets or sets the line number that the parser reached, to be used in
error messages (after offsetting it by the appropriate amount
depending on the setting of the C<-line> named option to
L</new_for_pod_snippets>).  The setter form is to be called as soon as
possible by parser callbacks L</command>, L</verbatim>, L</textblock>
so as to keep in sync with the POD flow.

=cut

sub pod_snippets_source_line_number {
    my ($self, @value) = @_;
    $self->{pod_snippets_source_line_number} = $value[0] if @value;
    return $self->{pod_snippets_source_line_number};
}

=head3 maybe_raise_pod_snippets_multiple ($name)

=head3 maybe_raise_pod_snippets_overlap ($name)

=head3 maybe_raise_pod_snippets_impure ()

=head3 maybe_raise_pod_snippets_bad_pairing ($name)

Maybe passes an error of the respective class to the user-supplied C<<
-report_errors >> sub (see L</load>), if the warning and error
settings so dictate (as described in the documentation for the C<<
-named_snippets >> constructor argument).  The $name argument is the
name of the snippet that is in scope at the point of error.

All these methods are implemented in terms of exactly one call to
L</maybe_raise_named_pod_snippets_incident>.

=cut

sub maybe_raise_pod_snippets_multiple {
    my ($self, $name) = @_;
    $self->maybe_raise_named_pod_snippets_incident
        ("multiple", <<"MESSAGE");
Snippet "$name" is defined multiple times.
MESSAGE
}

sub maybe_raise_pod_snippets_overlap {
    my ($self, $name) = @_;
    $self->maybe_raise_named_pod_snippets_incident
        ("overlap", <<"MESSAGE");
Snippet "$name" is defined multiple times.
MESSAGE
}

sub maybe_raise_pod_snippets_impure {
    my ($self) = @_;
    my @names_in_scope = map { qq'"$_"' }
        ($self->in_named_pod_snippet);
    if (@names_in_scope > 1) {
        my $names_in_scope = join(", ", @names_in_scope);
        $self->maybe_raise_named_pod_snippets_incident
        ("impure", <<"MESSAGE");
Snippets $names_in_scope are impure (ie they
contain intervening non-verbatim POD)
MESSAGE
    } else {
        $self->maybe_raise_named_pod_snippets_incident
        ("impure", <<"MESSAGE");
Snippet $names_in_scope[0] is impure (ie it