package Mud::Obj::Attributed;
use strict;
use Mud::CoreTools;
use Mud::Obj;
use vars qw(@ISA $NSMARK);
@ISA = qw(Mud::Obj);

use Mud::Freezer;
use Mud::StorableSub;

$NSMARK = ".";

=head1 Description

Mud::Obj::Attributed implements objects with data consisting of 
attributes, which can inherit those attributes from other objects.

<more explanation>

Mud::Obj::Attributed is a subclass of Mud::Obj.

=head1 Methods

=item IM getAttribute(NS, KEY)

Returns the value of the attribute KEY in namespace NS. Returns undef
if the attribute doesn't exist.

=cut

sub getAttribute {
  my ($self, $ns, $key) = @_;
  
  defined $ns or carp("Use of uninitialized value in getAttribute namespace"), return;
  defined $key or carp("Use of uninitialized value in getAttribute key"), return;
  for ($ns, $key) { tr/\x20-\x7E//cd; }
  
  return Mud::Freezer::clone($self->{$NSMARK.$ns}{$key}) if exists $self->{$NSMARK.$ns} and exists $self->{$NSMARK.$ns}{$key};
  
  my $check_key = "_getAttribute_running_" . $ns . ")(*&^%#!}|_|{}>" . $key;
  $self->{$check_key} and do {
    # FIXME: tweak parents lists to prevent future occurences
    croak "Infinite recursion in getAttribute($ns, $key)!";
  };
  $self->{$check_key} = 1;
  foreach ($self->listParents) {
    my $val = $_->getAttribute($ns, $key);
    return $val if defined $val;
  }
  delete $self->{$check_key};
  
  return undef;
}

=item IM setAttribute(NS, KEY, VALUE)

Sets the value of the attribute KEY in namespace NS.

=cut

sub setAttribute {
  my ($self, $ns, $key, $value) = @_;
  $self->{_locked} and croak "Can't modify locked object ".$self->identity_text;
  
  defined $ns or carp("Use of uninitialized value in setAttribute namespace"), return;
  defined $key or carp("Use of uninitialized value in setAttribute key"), return;
  for ($ns, $key) { tr/\x20-\x7E//cd; }
   
  $self->changed;
  if (@_ > 3) {
    $self->{$NSMARK.$ns}{$key} = $value;
    return;
  } else {
    return delete $self->{$NSMARK.$ns}{$key};
  }
}

=item IM deleteAttribute(NS, KEY)

Deletes the attribute and returns the old value.

=cut

sub deleteAttribute { goto &setAttribute; }

=item IM listAttributes(NS[, INHERIT])

Returns a list of the attributes of this object in the specified namespace.
If INHERIT is true, includes inherited attributes.

In scalar context, returns a count.

=cut

sub listAttributes {
  my ($self, $ns, $inherit) = @_;

  my @out = (
    keys %{$self->{$NSMARK.$ns}},
    ($inherit ? map $_->listAttributes($ns, 1), $self->listParents : ()),
  );
  # temp array to get proper scalar context behavior
  return @out;
}

=item IM getAttr(NAME)

=item IM setAttr(NAME, VALUE)

=item IM deleteAttr(NAME)

=item IM listAttrs([INHERIT])

Same as the above four methods, but assume a namespace of C<""> (empty string).

=cut

sub getAttr    { shift()->getAttribute('', @_); }
sub setAttr    { shift()->setAttribute('', @_); }
sub deleteAttr { shift()->deleteAttribute('', @_); }
sub listAttrs  { shift()->listAttributes('', @_); }

=item IM listNamespaces([INHERIT])

Returns a list of the namespaces for which this object (and its parents,
if INHERIT is true) has one or more attributes.

In scalar context, returns a count.

=cut

sub listNamespaces {
  my ($self, $inherit) = @_;

  my @out = (
    (map +(/^$NSMARK(.*)$/ ? $1 : ()), keys %$self),
    ($inherit ? map $_->listNamespaces(1), $self->listParents : ()),
  );
  return @out;
}

# FIXME: need methods for modifying parent list

=item IM listParents()

Returns a list of the object's parents.

=cut

sub listParents {
  my ($self) = @_;
  return @{$self->{_parents} || []};
}

=item IM addParent(OBJ)

Adds a parent to the object.

=cut

sub addParent {
  my ($self, $par) = @_;
  $self->{_locked} and croak "Can't modify locked object ".$self->identity_text;
  
  $self->changed;
  push @{$self->{_parents}}, $par;
}

### Storage interface ###############################################

sub storage_get_data {
  my ($self, $type) = @_;
  if (not defined $type) {
    return $self->SUPER::storage_get_data;
  } else {
    die;
  }
}

sub storage_create_from_data {
  my ($data, $type) = @_;
  if (not defined $type) {
    return $data->SUPER::storage_create_from_data;
  } else {
    my $self = bless {}, ref $data;
    my @data = split /\n/, $$data;
    my $dot = 0;
    while (local $_ = shift @data) {
      $dot++;
      /^
          ("*)(.*?)\1
        \s+
          ("*)(.*?)\3
        \s*
          =
        \s*
          (\w+)
        \s*
          <<(.*)
        \s*
      $/x or die "In text format data, badly formed attribute header '$_' at line $dot. Died";
      my ($ns, $key, $type, $end_marker) = ($2, $4, $5, $6);
      my $val = '';
      $val .= shift(@data)."\n" while $data[0] ne $end_marker;
      shift @data;
      chop $val;
      if ($type eq 'sub') {
        $val = Mud::StorableSub->new($val, file => $key, init => 'Mud::CoreTools::init_sub_package');
      } elsif ($type eq 'text') {
        # same
      } elsif ($type eq 'frozen') {
        $val = Mud::Freezer->thaw($val);
      } else {
        die "In text format data, bad attribute type '$type' at line $dot. Died";
      }
      
      $self->setAttribute($ns, $key, $val);
    }
    return $self;
  }
}

1;
__END__
