The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Pod::Weaver::Plugin::Perinci;

use 5.010001;
use Moose;
with 'Pod::Weaver::Role::Section';

use List::Util qw(first);
use Perinci::Access::Perl;
use Perinci::To::POD;
use Pod::Elemental;
use Pod::Elemental::Element::Nested;

our $VERSION = '0.14'; # VERSION

our $pa = Perinci::Access::Perl->new;

# regex
has exclude_modules => (
    is => 'rw',
    isa => 'Str',
);
has exclude_files => (
    is => 'rw',
    isa => 'Str',
);

sub weave_section {
    my ($self, $document, $input) = @_;

    my $filename = $input->{filename} || 'file';

    # guess package name from filename
    my $package;
    if ($filename =~ m!^lib/(.+)\.pm$!) {
        $package = $1;
        $package =~ s!/!::!g;
    } else {
        $self->log_debug(["skipped file %s (not a Perl module)", $filename]);
        return;
    }

    if (defined $self->exclude_files) {
        my $re = $self->exclude_files;
        eval { $re = qr/$re/ };
        $@ and die "Invalid regex in exclude_files: $re";
        if ($filename =~ $re) {
            $self->log_debug(["skipped file %s (matched exclude_files)", $filename]);
            return;
        }
    }
    if (defined $self->exclude_modules) {
        my $re = $self->exclude_modules;
        eval { $re = qr/$re/ };
        $@ and die "Invalid regex in exclude_modules: $re";
        if ($package =~ $re) {
            $self->log (["skipped package %s (matched exclude_modules)", $package]);
            return;
        }
    }

    local @INC = ("lib", @INC);

    $self->log(["generating POD for %s ...", $filename]);

    # generate the POD and insert it to FUNCTIONS section
    my $url = $package; $url =~ s!::!/!g; $url = "pl:/$url/";
    my $res;

    $res = $pa->request(meta => $url);
    die "Can't meta $url: $res->[0] - $res->[1]" unless $res->[0] == 200;
    my $meta = $res->[2];
    my $ometa = $res->[3]{orig_meta} // {};
    # document original metadata's args_as & result_naked, not the wrapped one.
    for (qw/args_as result_naked/) {
        $meta->{$_} = $ometa->{$_} if defined $ometa->{$_};
    }
    $res = $pa->request(child_metas => $url);
    die "Can't child_metas $url: $res->[0] - $res->[1]" unless $res->[0] == 200;
    my $cmetas = $res->[2];
    my $ometas = $res->[3]{orig_metas} // {};
    # document original metadata's args_as & result_naked, not the wrapped one.
    for my $uri (keys %$cmetas) {
        for (qw/args_as result_naked/) {
            $cmetas->{$uri}{$_} = $ometas->{$uri}{$_}
                if defined $ometas->{$uri}{$_};
        }
    }

    my $doc = Perinci::To::POD->new(
        name=>$package, meta=>$meta, child_metas=>$cmetas);
    $doc->delete_doc_section('summary'); # already handled by other plugins
    $doc->delete_doc_section('version'); # ditto
    my $pod_text = $doc->gen_doc;

    my $found;
    while ($pod_text =~ /^=head1 ([^\n]+)\n(.+?)(?=^=head1|\z)/msg) {
        my ($sectname, $sectcontent) = ($1, $2);

        # skip inserting section if there is no text
        next unless $sectcontent =~ /\S/;

        # skip inserting FUNCTIONS if there are no functions
        next if $sectname =~ /functions/i && $sectcontent !~ /^=head2/m;

        $found++;
        #$self->log(["generated POD section %s", $1]);
        my $elem = Pod::Elemental::Element::Nested->new({
            command  => 'head1',
            content  => $sectname,
            children => Pod::Elemental->read_string($sectcontent)->children,
        });
        my $sect = first {
            $_->can('command') && $_->command eq 'head1' &&
                uc($_->{content}) eq uc($sectname) }
            @{ $document->children }, @{ $input->{pod_document}->children };
        # if existing section exists, append it
        #$self->log(["sect=%s", $sect]);
        if ($sect) {
            # sometimes we get a Pod::Elemental::Element::Pod5::Command (e.g.
            # empty "=head1 DESCRIPTION") instead of a
            # Pod::Elemental::Element::Nested. in that case, just ignore it.
            if ($sect->can('children')) {
                push @{ $sect->children }, @{ $elem->children };
            }
        } else {
            push @{ $document->children }, $elem;
        }
    }
    if ($found) {
        $self->log(["added POD sections from Rinci metadata for %s", $filename]);
    }
}

1;
# ABSTRACT: Insert POD from Rinci metadata

__END__

=pod

=encoding utf-8

=head1 NAME

Pod::Weaver::Plugin::Perinci - Insert POD from Rinci metadata

=head1 VERSION

version 0.14

=head1 SYNOPSIS

In your C<weaver.ini>:

 [-Perinci]
 ;exclude_modules = REGEX
 ;exclude_files = REGEX

=head1 DESCRIPTION

This plugin inserts POD documentation (generated by L<Perinci::To::POD>).

=for Pod::Coverage weave_section

=head1 TODO

=head1 SEE ALSO

L<Perinci::To::POD>

L<Pod::Weaver>

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Pod-Weaver-Plugin-Perinci>.

=head1 SOURCE

Source repository is at L<https://github.com/sharyanto/perl-Pod-Weaver-Plugin-Perinci>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
http://rt.cpan.org/Public/Dist/Display.html?Name=Pod-Weaver-Plugin-Perinci

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

Steven Haryanto <stevenharyanto@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Steven Haryanto.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut