package Rope::Object;

use strict;
use warnings;

sub TIEHASH {
        my ($class, $obj) = @_;
        my $self = bless $obj || {}, $class;
	$self->set_value(
		$_,
		$self->{properties}->{$_}->{value},
		$self->{properties}->{$_}
	) for keys %{$self->{properties}};
	$self->compile();
	return $self;
}

sub compile {
	my ($self) = @_;
	$self->{keys} = scalar keys %{$self->{properties}};
	$self->{sort_keys} = [sort {
		$self->{properties}->{$a}->{index} <=> $self->{properties}->{$b}->{index}
	} grep { $self->{properties}->{$_}->{enumerable} } keys %{$self->{properties}}];
	if ($self->{requires}) {
		for (keys %{$self->{requires}}) {
			die sprintf "Failed to instantiate %s object requires property %s", $self->{name}, $_
				unless $self->{properties}->{$_} 
					&& defined $self->{properties}->{$_}->{value};
		}
	}
	return $self;
}

sub set_value {
	my ($self, $key, $value, $spec) = @_;
	if (defined $value) {
		if ($spec->{type}) {
			$value = eval {
				 $spec->{type}->($value);
			};
			if ($@ || ! defined $value) {
				my @caller = caller(1);
				if ($caller[0] eq 'Rope::Object') {
					die sprintf("Failed to instantiate object (%s) property (%s) failed type validation. %s", $self->{name}, $key, $@);
				}
				die sprintf("Cannot set property (%s) in object (%s) failed type validation on line %s file %s: %s", $key, $self->{name}, $caller[2], $caller[1], $@);
			}
		}
		$spec->{value} = $value;
	}
	if ($spec->{required} && ! defined $spec->{value}) {
		die sprintf "Required property (%s) in object (%s) not set", $key, $self->{name};
	}
	return $spec->{value};
}
 
sub STORE {
        my ($self, $key, $value) = @_;

	my $k = $self->{properties}->{$key};
	if ($k) {
		if ($k->{writeable}) {
			$self->set_value($key, $value, $k);
		} elsif ($k->{configurable}) {
			if ((ref($value) || "") eq (ref($k->{value}) || "")) {
				$self->set_value($key, $value, $k);
			} else {
				die "Cannot change Object ($self->{name}) property ($key) type";
			}
		} else {
			die "Cannot set Object ($self->{name}) property ($key) it is only readable";
		}
        } elsif (! $self->{locked}) {
                $self->{properties}->{$key} = {
                        value => $value,
			initable => 1,
			writable => 1,
			configurable => 1,
			enumerable => 1,
			index => ++$self->{keys}
                };
		push @{$self->{sort_keys}}, $key;
        } else {
		die "Object ($self->{name}) is locked you cannot extend with new properties";
	}
        return $self;
}
 
sub FETCH {
        my ($self, $key) = @_;
        my $k = $self->{properties}->{$key};
        return $k ? $k->{value} : undef;
}
 
sub FIRSTKEY {
	goto &NEXTKEY;
}
 
sub NEXTKEY {
	return (each @{$_[0]->{sort_keys}})[1];
}
 
sub EXISTS {
       	exists $_[0]->{properties}->{$_[1]};
}
 
sub DELETE { 
        my $k = $_[0]->{properties}->{$_[1]};
        my $del = !$_[0]->{locked} && $k->{writeable} ? delete $_[0]->{properties}->{$_[1]} : undef;
	$_[0]->compile() if $del;
	return $del;
}
 
sub CLEAR {
	return;
        #%{$_[0]->{properties}} = () 
}
 
sub SCALAR { 
        scalar keys %{$_[0]->{properties}}
}

1;

__END__ 
