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

use IMPL::Const qw(:prop :access);
use Scalar::Util qw(looks_like_number);

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 => '$this->$get(@_);',
    CodeCustomSetAccessor => '$this->$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 $spec if ref($spec);
	
	if (looks_like_number($spec)) {
		return {
            get => $spec & PROP_GET,
            set => $spec & PROP_SET,
            isList => $spec & PROP_LIST,
            ownerSet => (($spec & PROP_OWNERSET) == PROP_OWNERSET),
            direct => $spec & PROP_DIRECT
        };
	} elsif ($spec =~ /^(\*)?(ro?)?(w)?$/) {
		return {
			get => $2 ? 1 : 0,
			set => 1,
			ownerSet => not($3),
			direct => $1 ? 1 : 0
		};
	} else {
		die IMPL::Exception->new("Invalid property specification","$spec");
	}	    
}

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

sub _isCustom {
	ref($_[0]) eq 'CODE' || not(ref($_[0]) || looks_like_number($_[0]));
}

sub CreateFactory {
	my ($self,$spec) = @_;
	
	return $self->CreateFactoryImpl(
        ($spec->{get}
            ? ( _isCustom($spec->{get})
                ? $self->CodeCustomGetAccessor
                : ($spec->{isList}
                    ? $self->CodeGetListAccessor
                    : $self->CodeGetAccessor
                  )
              )
            : $self->CodeNoGetAccessor
        ),
        ($spec->{set}
            ? ( _isCustom($spec->{set})
                ? $self->CodeCustomSetAccessor
                : ($spec->{isList}
                    ? $self->CodeSetListAccessor
                    : $self->CodeSetAccessor
                  )
              )
            : $self->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) = \@_;
    return 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