File Coverage

blib/lib/Sub/Meta/Library.pm

Criterion	Covered	Total	%
statement	58	58	100.0
branch	16	16	100.0
condition	15	15	100.0
subroutine	14	14	100.0
pod	7	7	100.0
total	110	110	100.0

package Sub::Meta::Library;
use 5.010;
use strict;
use warnings;

our $VERSION = "0.13";

use Scalar::Util ();
use Sub::Meta;
use Sub::Identify;

my %INFO;
my %INDEX;

sub _croak { require Carp; goto &Carp::croak }

sub register {
    my ($class, $sub, $meta) = @_;
    unless ($sub && $meta) {
        _croak "arguments required coderef and submeta.";
    }

    unless (ref $sub && ref $sub eq 'CODE') {
        _croak "required coderef: $sub";
    }

    unless (Scalar::Util::blessed($meta) && $meta->isa('Sub::Meta')) {
        _croak "required an instance of Sub::Meta: $meta";
    }

    my $id = Scalar::Util::refaddr $sub;
    my ($stash, $subname) = Sub::Identify::get_code_info($sub);
    $INDEX{$stash}{$subname} = $id;
    $INFO{$id} = $meta;
    return;
}

sub register_list {
    my ($class, @list) = @_;

    for (@list) {
        $class->register(@$_)
    }
    return;
}

sub get {
    my ($class, $sub) = @_;

    unless (ref $sub && ref $sub eq 'CODE') {
        _croak "required coderef: $sub";
    }

    my $id = Scalar::Util::refaddr $sub;
    return $INFO{$id}
}

sub get_by_stash_subname {
    my ($class, $stash, $subname) = @_;

    my $id = $INDEX{$stash}{$subname};
    return $INFO{$id} if $id;
    return;
}

sub get_all_subnames_by_stash {
    my ($class, $stash) = @_;

    my $data = $INDEX{$stash};
    return [ sort keys %$data ] if $data;
    return [ ]
}

sub get_all_submeta_by_stash {
    my ($class, $stash) = @_;

    my $data = $INDEX{$stash};
    return [ map { $INFO{$data->{$_}} } sort keys %$data ] if $data;
    return [ ]
}

sub remove {
    my ($class, $sub) = @_;

    unless (ref $sub && ref $sub eq 'CODE') {
        _croak "required coderef: $sub";
    }

    my $id = Scalar::Util::refaddr $sub;
    return delete $INFO{$id}
}

1;
__END__