view release on metacpan or  search on metacpan

lib/Morpheus/Plugin/Content.pm  view on Meta::CPAN

    my @eval = eval qq{
no strict;
no warnings;
package $package;
$pragma
$content
};
    die if $@;

    $self->{cache}->{$token} = $self->_get($token);
    unless (defined $self->{cache}->{$token}) {
        if (@eval == 1) {
            ($self->{cache}->{$token}) = @eval;
        } else {
            $self->{cache}->{$token} = {@eval};
        }
        $self->{cache}->{$token} = normalize($self->{cache}->{$token});
    }
    die "'$token': config block should return or define something" unless defined $self->{cache}->{$token};
}

# get a value from the stash or from cache
sub _get ($$) {
    my ($self, $token) = @_;
    return $self->{cache}->{$token} if defined $self->{cache}->{$token};

    # maybe a partially evaluated config block
    my $package = $self->_package($token);
    my $stash = do { no strict 'refs'; \%{"${package}::"} };
    my $value;
    for (keys %$stash) {
        next unless $_;
        my $glob = \$stash->{$_};
        if (defined *{$glob}{HASH}) {
            # warn "\%$_ defined at $token\n";
            *{$glob} = normalize(*{$glob}{HASH});
            $value->{$_} = $glob;
        } elsif (defined *{$glob}{ARRAY}) {
            # warn "\@$_ defined at $token\n";
            $value->{$_} = $glob;
        } elsif (defined ${*{$glob}}) {
            $value->{$_} = normalize(${*{$glob}});
        }
    }
    return $value;
}

sub list ($$) {
    return (); # override it
}

sub get ($$) {
    my ($self, $token) = @_;
    $self->_process($token);
    return $self->_get($token);
}

sub new {
    my $class = shift;
    bless { cache => {} } => $class;
}

1;

__END__
=pod

=head1 NAME

Morpheus::Plugin::Content - base class for plugins that evaluate user defined perl configs

=head1 VERSION

version 0.46

=head1 CONFIGURATION BLOCKS

Some morpheus plugins, such as L<Morpheus::Plugin::File>, L<Morpheus::Plugin::DB> and L<Morpheus::Plugin::Env>, provide configuration data by evaluating a custom user defined pieces of a perl code. These code fragments are refered as I<Configuration ...

=head2 Imperative style

Example:

    $FOO = "foo";
    $BAR = 42;
    my $x = 1;
    $BAZ = { x => $x };

The blocks of this style are interpreted as follows. The code is evaluated inside of an autogenerated sandbox package, then the values stored in the stash (a hash of global variables) of this package are gathered into a hash and it is considered a re...

    {
        'BAZ' => {
            'x' => 1
        },
        'BAR' => 42,
        'FOO' => 'foo'
    }

Arrays (@) and hashes (%) are also currently supported and result in globrefs as configuration values. For example a block like

    $X = "x";
    @X = (1,2,3);
    %Y = ( a => "b" );

will lead to a configuration

    {
        'X' => \*GLOB1 # ${...} of this glob is "x" while @{...} of it is (1,2,3)
        'Y' => \*GLOB2 # %{...} of this glob is (a => "b")
    }

Arrays (@) and hashes (%) are wrapped into globrefs even when they do not collide with a scalar ($) value. It is done to distinguish between

    $X = [1,2,3];

and

    @X = (1,2,3);

In fact this feature about globrefs is believed to be deprecated and may be removed in the future. Try to use only scalars ($) while providing your configuration values and wrap the arrays and hashes you require into arrayrefs and hashrefs.