package MObject;
use strict;
use vars qw(@ISA %AttributeInfo %StaleObjects %BuiltinMethods %VisInstanceMethods);
use MCoreTools;
use MInitializable;
@ISA = qw(MInitializable);

use MFreezer;
use MModules;
use File::Path qw();

$AttributeInfo{'prototype'} = {noinherit => 1};

### Initialization ############################################################

sub _initialize {
  require MDefList;    initialize MDefList;

  MDefList->new(
    source => 'CORE',
    name => 'Fields',
    type => 'HASH',
    multiple => 0,
    mirror => \%AttributeInfo,
    validator => sub {
      my ($source, $key) = @_;
      $key =~ /^_/ and croak "'$key': Attribute names may not start with underscores";
      $AttributeInfo{$key} and croak "Attribute declaration '$key' already exists";
    },
  );
  
  require MFreezer;    initialize MFreezer;
  require MObjectDB;   initialize MObjectDB;
  require MConnection; initialize MConnection;
  require MObjectRef;  initialize MObjectRef;
}


### methods - creation/destruction ############################################

$BuiltinMethods{new} = 1;
sub new {
  my $class = shift;

  my $self = bless {}, $class;
  print "$self CREATED\n" if ::GC_DEBUG;

  MObjectDB->OI_register_object($self);

  # Initialize fields
  my $key;
  $self->setAttr($key, shift) while $key = shift;

  my $ref = $self->as_ref;
  
  call_hooks('object_creation', $ref);
  return $ref;
}

$BuiltinMethods{destroy} = $VisInstanceMethods{destroy} = 1;
sub destroy {
  my ($self) = @_;
  $self->{_id} or croak "weird: ->destroy called on unregistered object";
  $self->{_locked} and croak "Can't destroy locked object #$self->{_id}";

  call_hooks('object_destruction', $self->as_ref); 

  MScheduler->remove_owned($self);
  MConnection->invoke_for_object('detach', $self, $self);

  $StaleObjects{$self->{_id}} = 1;
  MObjectDB->OI_unregister_object($self);
  %$self = (__UNSTALE => $self->{_id});
  return;
}

$BuiltinMethods{DESTROY} = 1;
sub DESTROY {
  my ($self) = @_;
  print "$self DESTROYING\n" if ::GC_DEBUG;
  if ($self->{_id} and not ($::Quit and $::Quit eq 'no_cleanup')) {
    mudlog "ERROR/CORE: Registered object being DESTROYed: #$self->{_id}";
  }
  delete $StaleObjects{$self->{__UNSTALE}} if defined $self->{__UNSTALE};
  print "$self DESTROYED\n" if ::GC_DEBUG;
  1;
}


### Object methods - miscellaneous ############################################

$BuiltinMethods{id} = $VisInstanceMethods{id} = 1;
sub id {$_[0]->{_id}}

$BuiltinMethods{as_ref} = 1;
# this is not a vis method because modules should never get their hands on a real MObject and therefore need this method.
sub as_ref {MObjectRef->ref_new($_[0]->{_id}, $_[0]->{_creation_time})}

$BuiltinMethods{send} = $VisInstanceMethods{send} = 1;
sub send {MConnection->invoke_for_object('send', @_)}

$BuiltinMethods{uses_output} = $VisInstanceMethods{uses_output} = 1;
sub uses_output {!!MConnection->obj_connections($_[0])}

### Object methods - names ####################################################

=item getNames

In list context, returns all names of this object. In scalar context, returns
one of the names of this object.

=cut

$BuiltinMethods{getNames} = $VisInstanceMethods{getNames} = 1;
sub getNames {return keys %{$_[0]->{_names} || {}}}

=item addName NAME

Adds the string NAME as a name for this object. Returns self.

=cut

$BuiltinMethods{addName} = $VisInstanceMethods{addName} = 1;
sub addName {MObjectDB->OI_set_name($_[0], $_[1]); return $_[0]}

=item delName NAME

Removes the string NAME as a name for this object.

=cut

$BuiltinMethods{delName} = $VisInstanceMethods{delName} = 1;
sub delName {MObjectDB->OI_clear_name($_[0], $_[1]); return}

### Object methods - locking ##################################################

# Locking an object prevents changes to its fields until it
# is unlocked. This is _NOT_ a security feature; it is intended to prevent
# accidental modification of prototype objects.

$BuiltinMethods{lock}   = $VisInstanceMethods{lock}   = 1; sub lock   {       $_[0]{_locked} = 1; return}
$BuiltinMethods{unlock} = $VisInstanceMethods{unlock} = 1; sub unlock {delete $_[0]{_locked};     return}
$BuiltinMethods{locked} = $VisInstanceMethods{locked} = 1; sub locked {return $_[0]{_locked}            }

### Object methods - attributes and inheritance ###############################

$BuiltinMethods{getPrototype} = $VisInstanceMethods{getPrototype} = 1;
sub getPrototype {
  my ($self) = @_;
  if (not defined $self->{'prototype'}) {
    return undef;
  } elsif (ref $self->{'prototype'} and ref $self->{'prototype'} eq 'MObjectRef') {
    return $self->{'prototype'};
  } else {
    return (MObjectDB->get_name($self->{'prototype'}) or do {
      mudlog qq!ERROR/WORLD: NONEXISTENT PROTOTYPE "$self->{'prototype'}" for object #$self->{_id}!;
      delete $self->{'prototype'};
      return undef;
    });    
  }
}

$BuiltinMethods{attributes} = $VisInstanceMethods{attributes} = 1;
sub attributes {return grep !/^_/, keys %{$_[0]}}

$BuiltinMethods{getAttr} = $VisInstanceMethods{getAttr} = 1;
sub getAttr {
  my ($self, $f, $prev) = @_;
  
  defined $f or carp("Use of uninitialized value at MObject::getAttr"), return undef;
  substr($f, 0, 1) eq '_' and croak "Attempt to getAttr on attribute name starting with underscore"; 

  # this object's field if it exists
  return MFreezer::clone($self->{$f}) if exists $self->{$f};

  # the default unless there's a prototype
  goto DEFAULT unless defined $self->{'prototype'};

  # the default if the field is defined as non-inheritable
  return MFreezer::clone($AttributeInfo{$f}{default}) if $AttributeInfo{$f} and $AttributeInfo{$f}{noinherit};
  
  # find the prototype object
  my $proto;
  if (ref $self->{'prototype'}) {
    $proto = MObjectDB->get_real(eval {$self->{'prototype'}->id} || 0);
  } else {
    $proto = MObjectDB->get_name_real($self->{'prototype'});    
  }
  
  if (not $proto) {
    mudlog 
        "ERROR/WORLD: NONEXISTENT PROTOTYPE "
      . (ref $self->{'prototype'} ? '#' . $self->{'prototype'}->id
                                  : "'$self->{'prototype'}'")
      . " for object #$self->{_id}";
    delete $self->{'prototype'}; # so we don't spam the log
    goto DEFAULT;
  }

  # make sure we don't get into an infinite recursion
  my $protoid = $proto->id;
  $prev ||= {};
  if ($prev->{$protoid}) {
    mudlog qq!ERROR/WORLD: PROTOTYPE LOOP FOR "$self->{'prototype'}"!;
    delete $self->{'prototype'};
    goto DEFAULT;
  }
  $prev->{$protoid} = 1;

  # and finally, ask the prototype for its value
  # consider: should we skip the method call and examine the object directly?
  return $proto->getAttr($f, $prev);
  
  # "fall-through" for the default value
  DEFAULT: return $AttributeInfo{$f} ? MFreezer::clone($AttributeInfo{$f}{default}) : undef;
}

$BuiltinMethods{setAttr} = $VisInstanceMethods{setAttr} = 1;
sub setAttr {
  my ($self, $field, $value) = @_;

  $self->{_locked} and croak "Can't modify locked object #$self->{_id}";
  
  substr($field, 0, 1) eq '_' and croak "Attempt to setAttr on field starting with underscore"; 
  my $old = $self->{$field};
  $self->{$field} = $value;

  MObjectDB->OI_changed($self) unless (defined $old and defined $value and $old eq $value);
  $value;
}

$BuiltinMethods{resetAttr} = $VisInstanceMethods{resetAttr} = 1;
sub resetAttr {
  my ($self, $field) = @_;

  my $e = exists $self->{$field};
  delete $self->{$field};
  MObjectDB->OI_changed($self) if $e;
}

### Object methods - other stuff ###############################################

use UNIVERSAL;

# methods we don't want lib code to be able to override
$BuiltinMethods{AUTOLOAD} = 1;
$BuiltinMethods{isa} = 1;
$BuiltinMethods{can} = 1;

1;
