view release on metacpan or  search on metacpan

lib/Resource/Silo/Metadata.pm  view on Meta::CPAN

            $spec{preload} = [undef]; # a dummy argument so that preload itself has unified code
        }
    };

    if (!defined $spec{argument}) {
        $spec{orig_argument} = '';
        $spec{argument} = \&_is_empty;
    } elsif (ref $spec{argument} eq $REGEXP) {
        my $rex = qr(^(?:$spec{argument})$);
        $spec{orig_argument} = $spec{argument};
        $spec{argument} = sub { $_[0] =~ $rex };
    } elsif ((reftype $spec{argument} // '') eq $CODE) {
        # do nothing, we're fine
    } else {
        croak "resource '$name': 'argument' must be a regexp or a function";
    }

    $spec{cleanup_order} //= 0;
    croak "resource '$name': 'cleanup_order' must be a number"
        unless looks_like_number($spec{cleanup_order});

    croak "resource '$name': 'check' must be a function"
        if defined $spec{check} and (reftype $spec{check} // '') ne $CODE;
    croak "resource '$name': 'coerce' must be a function"
        if defined $spec{coerce} and (reftype $spec{coerce} // '') ne $CODE;
    croak "resource '$name': 'cleanup' must be a function"
        if defined $spec{cleanup} and (reftype $spec{cleanup} // '') ne $CODE;
    croak "resource '$name': 'fork_cleanup' must be a function"
        if defined $spec{fork_cleanup} and (reftype $spec{fork_cleanup} // '') ne $CODE;
    croak "resource '$name': 'fork_cleanup' and 'fork_safe' are mutually exclusive"
        if $spec{fork_cleanup} and $spec{fork_safe};

    $spec{fork_cleanup} //= $spec{cleanup};

    $spec{origin} = Carp::shortmess("declared");
    $spec{origin} =~ s/\D+$//s;

    my @forward_deps = grep { !$self->{resource}{$_} || $self->{pending_deps}->contains($_) }
        keys %{ $spec{allowdeps} || {} };
    if (@forward_deps) {
        my $loop = $self->{pending_deps}->find_loop($name, \@forward_deps);
        if ($loop) {
            my $msg = "resource '$name': circular dependency detected: ".
                join " -> ", map { $self->elaborate_name($_) } @$loop;
            croak $msg;
        }
    }

    # Move code generation into Resource::Silo::Container
    # so that exceptions via croak() are attributed correctly.
    {
        no strict 'refs'; ## no critic Strictures
        *{"${target}::$name"} =
            Resource::Silo::Container::_silo_make_accessor($name, \%spec);
    }

    if (@forward_deps) {
        $self->{pending_deps}->add_edges([$name], \@forward_deps);
    } else {
        # resource is independent, notify dependents if any
        $self->{pending_deps}->drop_sink_cascade($name);
    };
    $self->{resource}{$name} = \%spec;
    push @{ $self->{preload} }, $name if $spec{preload};

    return $self;
};

sub _make_init_class {
    my ($self, $name, $spec) = @_;

    my $class = $spec->{class};
    $spec->{dependencies} //= {};

    croak "resource '$name': 'class' doesn't look like a package name: '$class'"
        unless $class =~ $MOD_REX;
    defined $spec->{$_} and croak "resource '$name': 'class' is incompatible with '$_'"
        for qw(init argument);
    croak "resource '$name': 'class' requires 'dependencies' to be a hash"
        unless ref $spec->{dependencies} eq 'HASH';

    my %deps = %{ $spec->{dependencies} };

    push @{ $spec->{require} }, $class;

    my %pass_args;
    my @realdeps;
    my @body = ("my \$c = shift;", "$class->new(" );

    # format: constructor_arg => [ resource_name, resource_arg ]
    foreach my $key (keys %deps) {
        my $entry = $deps{$key};

        if (ref $entry eq 'SCALAR') {
            # pass a literal value to the constructor
            $pass_args{$key} = $$entry;
            next;
        };

        if (defined $entry and !ref $entry) {
            # allow bareword, and alias `foo => 1` to `foo => ['foo']
            $entry = $key if $entry eq '1';
            $entry = [ $entry ];
        };
        croak "resource '$name': dependency '$key' has wrong format"
            unless (
                    ref $entry eq 'ARRAY'
                and @$entry <= 2
                and ($entry->[0] // '') =~ $ID_REX
            );
        push @realdeps, $entry->[0];

        push @body, length ($entry->[1] // '')
            ? sprintf( "\t'%s' => \$c->%s('%s'),",
                quotemeta $key, $entry->[0], quotemeta $entry->[1] )
            : sprintf( "\t'%s' => \$c->%s,", quotemeta $key, $entry->[0] );
    };
    push @body, "\t\%pass_args"
        if %pass_args;
    push @body, ");";