package IMPL::Code::BasePropertyImplementor;
use strict;

use IMPL::Const qw(:prop :access);

use constant {
	CodeNoGetAccessor => 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;',
    CodeNoSetAccessor => 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;',
    CodeCustomGetAccessor => 'unshift @_, $this and goto &$get;',
    CodeCustomSetAccessor => 'unshift @_, $this and goto &$set;',
    CodeValidator => '$this->$validator(@_);',
    CodeOwnerCheck => "die new IMPL::Exception('Set accessor is restricted to the owner',\$name,\$class,scalar caller) unless caller eq \$class;"
};

sub CodeSetAccessor {
    die new IMPL::Exception("Standard accessors not supported",'Set');
}
    
sub CodeGetAccessor {
    die new IMPL::Exception("Standard accessors not supported",'Get');
}

sub CodeGetListAccessor {
    die new IMPL::Exception("Standard accessors not supported",'GetList');
}

sub CodeSetListAccessor {
    die new IMPL::Exception("Standard accessors not supported",'SetList');
}

sub factoryParams { qw($class $name $set $get $validator) };

our %ACCESS_CODE = (
    ACCESS_PUBLIC , "",
    ACCESS_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);",
    ACCESS_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;" 
);

sub NormalizeSpecification {
	my ($this,$spec) = @_;
	
	return ref $spec
        ? $spec
        : {
            get => $spec & PROP_GET,
            set => $spec & PROP_SET,
            isList => $spec & PROP_LIST,
            ownerSet => $spec & PROP_OWNERSET
        };	    
}

sub CreateFactoryId {
	my ($self, $spec) = @_;
	
	join( '',
        map(
            $_
                ? ref $_ eq 'CODE'
                    ? 'x'
                    : 's'
                : '_',
            @$spec{qw(get set)}
        ),
        $spec->{access},
        $spec->{validator} ? 'v' : '_',
        $spec->{isList} ? 'l' : '_',
        $spec->{ownerSet} ? 'o' : '_'
    );
}

sub CreateFactory {
	my ($self,$spec) = @_;
	
	return $self->CreateFactoryImpl(
        $spec->{get}
            ? ref $spec->{get} eq 'CODE'
                ? $self->CodeCustomGetAccessor
                : $spec->{isList}
                    ? $spec->CodeGetListAccessor
                    : $spec->CodeGetAccessor
            : $spec->CodeNoGetAccessor,
        $spec->{set}
            ? ref $spec->{set} eq 'CODE'
                ? $self->CodeCustomSetAccessor
                : $spec->{isList}
                    ? $spec->CodeSetListAccessor
                    : $spec->CodeSetAccessor
            : $spec->CodeNoSetAccessor,
        $ACCESS_CODE{$spec->{access} || ACCESS_PUBLIC} || '',
        $spec->{validator} ? $self->CodeValidator : '',
        $spec->{ownerSet} ? $self->CodeOwnerCheck : ''
	);
}

sub CreateFactoryImpl {
    my ($self,$codeGet,$codeSet,$codeAccessCheck,$codeValidator,$codeOwnerCheck) = @_;
    
    my $strParams = join(',',$self->factoryParams);
    
    my $factory = <<FACTORY;
    
sub {
    my ($strParams) = \@_;
    my \$accessor;
    \$accessor = sub {
        my \$this = shift;
        $codeAccessCheck
        if (\@_) {
            $codeOwnerCheck
            $codeValidator
            $codeSet
        } else {
            $codeGet
        }
    }
}
FACTORY

    return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") );
}


1;

__END__

=pod

=head1 NAME

C<IMPL::Code::BasePropertyImplementor> набор впомогательныйх статических методов
для генерации свойств.

=cut