File Coverage

blib/lib/Sub/Documentation.pm

Criterion	Covered	Total	%
statement	23	41	56.1
branch	4	22	18.1
condition			n/a
subroutine	6	7	85.7
pod	3	3	100.0
total	36	73	49.3

use 5.008;
use strict;
use warnings;

package Sub::Documentation;
our $VERSION = '1.100880';

# ABSTRACT: Collect documentation for subroutines
use Exporter qw(import);
our %EXPORT_TAGS =
  (util => [qw(add_documentation get_documentation search_documentation)],);
our @EXPORT_OK = @{ $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ] };

sub add_documentation {
    my %args = @_;
    my $had_errors;
    for (qw(package glob_type name type documentation)) {
        next if defined $args{$_};
        $had_errors++;
        warn "add_documentation() needs a '$_' key\n";
    }
    die "add_documentation() had errors, aborting\n" if $had_errors;
    my %interpolate = (
        p   => $args{package},
        '%' => '%',
    );
    $args{documentation} =~ s/%(.)/ $interpolate{$1} || "%$1" /ge;
    push our @doc, \%args;
}

sub get_documentation {
    our @doc;
    wantarray ? @doc : \@doc;
}

sub search_documentation {
    my %args = @_;
    my @found;
    for my $doc (our @doc) {
        my $match = 1;
        while (my ($key, $value) = each %args) {
            if (defined $doc->{$key}) {
                my $ref = ref $doc->{$key};
                if ($ref eq 'ARRAY') {
                    $match = 0 unless grep { $_ eq $value } @{ $doc->{$key} };
                } elsif ($ref eq '') {
                    $match = 0 unless $doc->{$key} eq $value;
                } else {
                    die "search_documentation(): key [$key] has unsupported value ref $ref\n";
                }
            } else {
                $match = 0;
            }
        }
        push @found, $doc if $match;
    }
    wantarray ? @found : \@found;
}
1;


__END__