File Coverage

blib/lib/Resource/Silo.pm

Criterion	Covered	Total	%
statement	60	61	98.3
branch	10	10	100.0
condition	10	13	76.9
subroutine	14	14	100.0
pod	1	1	100.0
total	95	99	95.9

package Resource::Silo;

use 5.010;
use strict;
use warnings;

our $VERSION = '0.1703';

use Carp;
use Scalar::Util qw( set_prototype );

use Resource::Silo::Metadata;
use Resource::Silo::Container;

# This is a dummy block to hint IDEs.
# see 'import' below for _real_ resource & silo implementation
use parent 'Exporter';
our @EXPORT = qw( resource silo );
#@returns Resource::Silo::Container
sub silo     ();  ## no critic 'prototypes'
sub resource (@); ## no critic 'prototypes'

# We'll need a global metadata storage
#     to allow extending container classes
our %metadata;

sub import {
    my ($self, @param) = @_;
    my $caller = caller;
    my $target;
    my $shortcut;

    while (@param) {
        my $flag = shift @param;
        if ($flag eq '-class') {
            $target = $caller;
        } elsif ($flag eq '-shortcut') {
            $shortcut = shift @param;
            croak "-shortcut must be an identifier"
                unless $shortcut and !ref $shortcut and $shortcut =~ /^[a-z_][a-z_0-9]*$/i;
        } else {
            # TODO if there's more than 3 elsifs, use jump table instead
            croak "Unexpected parameter to 'use $self': '$flag'";
        };
    };

    if (!defined $target) {
        # we're not in class mode, create a one-off package
        $target = __PACKAGE__ . "::container::" . $caller;
        $shortcut //= 'silo';
    }

    my $spec = Resource::Silo::Metadata->new($target);
    $metadata{$target} = $spec;

    my $instance;
    my $shortcut_sub = set_prototype {
            # cannot instantiate target until the package is fully defined,
            # thus go lazy
            $instance //= $target->new;
        } '';

    if (!defined $shortcut) {
        # TODO remove deprecation after 2027-01-01 and just let it die
        my $orig = $shortcut_sub;
        $shortcut_sub = sub {
            carp "'silo' is deprecated when -class is in action, use explicit -shortcut instead";
            goto &$orig;
        }
    }

    $shortcut //= 'silo'; # only for deprecation

    no strict 'refs'; ## no critic
    no warnings 'redefine', 'once'; ## no critic

    push @{"${target}::ISA"}, 'Resource::Silo::Container';

    *{"${caller}::resource"}  = $spec->_make_dsl;
    *{"${caller}::$shortcut"} = $shortcut_sub;
};

sub get_meta {
    my ($self, $target) = @_;

    return $metadata{$target};
}

1; # End of Resource::Silo

__END__