view release on metacpan or  search on metacpan

lib/Minions/Implementation.pm  view on Meta::CPAN

package Minions::Implementation;

use strict;
use Minions::_Guts;
use Package::Stash;
use Readonly;

sub import {
    my ($class, %arg) = @_;

    strict->import();

    $arg{-caller} = (caller)[0];
    $class->define(%arg);
}

sub define {
    my ($class, %arg) = @_;

    my $caller_pkg = delete $arg{-caller} || (caller)[0];
    my $stash = Package::Stash->new($caller_pkg);

    $class->update_args(\%arg);
    $class->add_attribute_syms(\%arg, $stash);

    $stash->add_symbol('%__meta__', \%arg);
}

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

    my @slots = (
        keys %{ $arg->{has} },
        @{ $arg->{requires}{attributes} || [] },
        '', # semiprivate pkg
    );
    foreach my $slot ( @slots ) {
        $class->add_obfu_name($arg, $stash, $slot);
    }
}

sub add_obfu_name {
    my ($class, $arg, $stash, $slot) = @_;

    my $data_version = $stash->get_symbol('$DATA_VERSION');
    Readonly my $sym_val => sprintf(
        "%s-$slot",
       Minions::_Guts::attribute_sym($data_version),
    );
    $Minions::_Guts::obfu_name{$slot} = $sym_val;

    my $prefix = '';
    if($slot eq '' || $arg->{attr_style} eq '_2') {
        $prefix = '__';
    }
    elsif($arg->{attr_style} eq 'uc' || ! $arg->{attr_style}) {
        $slot = uc $slot;
    }
    $stash->add_symbol(
        sprintf('$%s%s', $prefix, $slot),
        \ $sym_val
    );
}

sub update_args {}

1;

__END__

=head1 NAME