view release on metacpan or  search on metacpan

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

sub load {
    my ($class, $source, @opts) = @_;

    my $self = bless {}, $class;
    $self->{start_line} = 1;
    $self->{filename} = "$source" unless (ref($source) eq "GLOB" ||
                                          eval { $source->can("getline") });
    undef $@;

    # Grind the syntactic sugar to dust:
    my %opts = (-line => 1, -filename => $self->filename,
                -report_errors => sub {
                    my ($severity, $text, $file, $line) = @_;
                    warn <<"MESSAGE";
$severity: $text
in $file line $line
MESSAGE
                }, -markup => "Pod::Snippets",
                -bad_pairing => "warning");
    while(my ($k, $v) = splice @opts, 0, 2) {
        if ($k eq "-named_snippets") {
            if ($v eq "strict") {
                $opts{"-$_"} = "error" foreach
                    (qw(overlap impure multiple bad_pairing));
            } elsif ($v =~ m|^ignore_(.*)|) {
                $opts{"-$1"} = "ignore";
            } elsif ($v =~ m|^error_(.*)|) {
                $opts{"-$1"} = "error";
            } elsif ($v =~ m|^warn(ing)?_(.*)|) {
                $opts{"-$2"} = "warning";
            }
        } elsif ($k eq "-line") {
            $self->{start_line} = $v;
            $opts{$k} = $v;
        } else {
            $opts{$k} = $v;
        }
    }

    # Run the parser:
    my $parser = "${class}::_Parser"->new_for_pod_snippets(%opts);
    if ($self->{filename}) {
        $parser->parse_from_file($self->{filename}, undef);
    } else {
        $parser->parse_from_filehandle($source, undef);
    }
    $parser->finalize_pod_snippets();

    # Extract the relevant bits from it:
    $self->{unmerged_snippets} = $parser->pod_snippets;
    $self->{warnings} = $parser->pod_snippets_warnings;
    $self->{errors} = $parser->pod_snippets_errors;
    return $self;
}

=head2 parse ($string, -opt1 => $val1, ...)

Same as L</load>, but works from a Perl string instead of a file
descriptor.  The named options are the same as in I<load()>, but
consider using C<< -filename >> as I<parse()> is in no position to
guess it.

=cut

sub parse {
    my ($class, $string, @args) = @_;
    return $class->load(Pod::Snippets::LineFeeder->new($string), @args);

    package Pod::Snippets::LineFeeder;

    sub new {
        my ($class, $string) = @_;
        my $nl = $/; # Foils smarter-than-thou regex parser
        return bless { lines => [ $string =~ m{(.*(?:$nl|$))}g ] };
    }
    sub getline { shift @{shift->{lines}} }
}

=head1 ACCESSORS

=head2 filename ()

Returns the name of the file to use for C<#line> lines in L</as_code>.
The default behavior is to use the filename passed as the $source
argument, or if it was not a filename, use the string "pod snippet"
instead.

=cut

sub filename { shift->{filename} || "pod snippet" }

=head2 warnings ()

Returns the number of warnings that occured during the parsing of the
POD.

=head2 errors ()

Returns the number of errors that occured during the parsing of the
POD.  If that number is non-zero, then all accessors described below
will throw an exception instead of performing.

=cut

sub warnings { shift->{warnings} }
sub errors { shift->{errors} }

=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