package IMPL::DOM::Property;
use strict;
use warnings;

use IMPL::Class::Property;
require IMPL::Exception;

use base qw(Exporter);
our @EXPORT_OK = qw(_dom);

sub _dom($) {
    my ($prop_info) = @_;
    $prop_info->Implementor( 'IMPL::DOM::Property' );
    return $prop_info;
}

sub Make {
    my ($self,$propInfo) = @_;
    
    my ($class,$name,$virt,$access,$mutators) = $propInfo->get qw(Class Name Virtual Access Mutators);
    
    die new IMPL::InvalidOperationException("DOM properties can be declared only for the DOM objects") unless $class->isa('IMPL::DOM::Node');
    
    no strict 'refs';
    die new IMPL::InvalidOperationException("Custom mutators are not allowed","${class}::$name") if ref $mutators;
    if (($mutators & prop_all) == prop_all) {
        *{"${class}::$name"} = sub {
            $_[0]->nodeProperty($name,@_[1..$#_]);
        };
        $propInfo->canGet(1);
        $propInfo->canSet(1);
    } elsif( $mutators & prop_get ) {
        *{"${class}::$name"} = sub {
            die new IMPL::InvalidOperationException("This is a readonly property", "${class}::$name") if @_>1;
            $_[0]->nodeProperty($name);
        };
        $propInfo->canGet(1);
        $propInfo->canSet(0);
    } elsif( $mutators & prop_set ) {
        *{"${class}::$name"} = sub {
            die new IMPL::InvalidOperationException("This is a writeonly property", "${class}::$name") if @_<2;
            $_[0]->nodeProperty($name,@_[1..$#_]);
        };
        $propInfo->canGet(0);
        $propInfo->canSet(1);
    } else {
        die new IMPL::InvalidOperationException("Invalid value for the property mutators","${class}::$name",$mutators);
    }
}

1;
__END__
=pod

=head1 SYNOPSIS

package TypedNode;

use base qw(IMPL::DOM::Node);
use IMPL::DOM::Property qw(_dom);

BEGIN {
    public _dom property Age => prop_all;
    public _dom property Address => prop_all;
    public property ServiceData => prop_all;
}

=head1 DESCRIPTION

Позволяет объявлять свойства, которые будут храниться в списке динамических
свойств.

=cut