File Coverage

blib/lib/MOP/Slot.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	13	14	92.8
condition	7	9	77.7
subroutine	12	12	100.0
pod	6	6	100.0
total	78	81	96.3

package MOP::Slot;
# ABSTRACT: A representation of a class slot

use strict;
use warnings;

use Carp ();

use UNIVERSAL::Object::Immutable;

use MOP::Internal::Util;

our $VERSION   = '0.12';
our $AUTHORITY = 'cpan:STEVAN';

our @ISA; BEGIN { @ISA = 'UNIVERSAL::Object::Immutable' }

sub BUILDARGS {
    my $class = shift;
    my $args;

    if ( scalar( @_ ) eq 2 && !(ref $_[0]) && ref $_[1] eq 'CODE' ) {
        $args = +{ name => $_[0], initializer => $_[1] };
    }
    else {
        $args = $class->SUPER::BUILDARGS( @_ );
    }

    Carp::confess('[ARGS] You must specify a slot name')
        unless $args->{name};
    Carp::confess('[ARGS] You must specify a slot initializer')
        unless $args->{initializer};
    Carp::confess('[ARGS] The initializer specified must be a CODE reference')
        unless ref $args->{initializer} eq 'CODE'
            || MOP::Internal::Util::CAN_COERCE_TO_CODE_REF( $args->{initializer} );

    return $args;
}

sub CREATE {
    my ($class, $args) = @_;
    # NOTE:
    # Ideally this instance would actually just be
    # a reference to an HE (C-level hash entry struct)
    # but that is not something that is exposed at
    # the language level. Instead we use an ARRAY
    # ref to both 1) save space and 2) retain an
    # illusion of opacity regarding these instances.
    # - SL
    return +[ $args->{name}, $args->{initializer} ]
}

sub name {
    my ($self) = @_;
    return $self->[0];
}

sub initializer {
    my ($self) = @_;
    return MOP::Internal::Util::CAN_COERCE_TO_CODE_REF( $self->[1] )
        ? \&{ $self->[1] }
        : $self->[1];
}

sub origin_stash {
    my ($self) = @_;
    # NOTE:
    # for the time being we are going to stick with
    # the COMP_STASH as the indicator for the initalizers
    # instead of the glob ref, which might be trickier
    # however I really don't know, so time will tell.
    # - SL
    return MOP::Internal::Util::GET_STASH_NAME( $self->initializer );
}

sub was_aliased_from {
    my ($self, @classnames) = @_;

    Carp::confess('[ARGS] You must specify at least one classname')
        if scalar( @classnames ) == 0;

    my $class = $self->origin_stash;
    foreach my $candidate ( @classnames ) {
        return 1 if $candidate eq $class;
    }
    return 0;
}

1;

__END__