package MObjectRef;
use strict;
use MCoreTools;

use vars qw($AUTOLOAD @ISA %ModuleMethods $MethodCode);

use MInitializable;
@ISA = qw(MInitializable);

sub _initialize {
  require MDefList; initialize MDefList;

  MDefList->new(
    source => 'CORE',
    name => 'Methods',
    type => 'CODE',
    multiple => 0,
    mirror => \%ModuleMethods,
    validator => sub {
      my ($source, $key) = @_;
      $key =~ /^_/ and croak "Method names may not start with underscores";
      $key !~ /[a-z]/ and croak "Method names must contain a lowercase letter";
      $MObject::BuiltinMethods{$key} and croak "Built-in method '$key' may not be overridden";
    },
  );

  # okay, deliberate design here. modmethods override
  # implicit attribute accessors, this could be useful for
  # say, code-generated object descriptions. -- KPR
  $MethodCode = <<'  EOC'
  #line 1 MObjectRef--MethodAutoloadCode--~~NAME~~
  sub ~~NAME~~ {
    my $self = shift;
    my $real = MObjectDB->get_real($self->[0], $self->[1]) or croak "Object #$self->[0] from ".gmtime($self->[1])." no longer exists";
  
    if ($MObject::VisInstanceMethods{'~~NAME~~'}) {
      return $real->~~NAME~~(@_);
  
    } elsif ($ModuleMethods{'~~NAME~~'}) {
      return $ModuleMethods{'~~NAME~~'}->($self, @_);
  
    } elsif ($MObject::AttributeInfo{'~~NAME~~'}) {
      return $real->setAttr('~~NAME~~', @_) if @_;
      return $real->getAttr('~~NAME~~');
  
    } else {
      croak "'~~NAME~~' is not an attribute, method, or builtin method of object $self->[0]";
    }
  }
  EOC
}

sub ref_new {
  my ($class, $id, $ctime) = @_;
  #defined $id or croak "MObjectRef->ref_new() called with undefined ID";
  return bless [$id, ($ctime ? $ctime : ())], $class;
}

sub AUTOLOAD {
  my ($method) = $AUTOLOAD =~ /::([^:]+)$/;

  $method =~ /^[\w]+$/ and $method =~ /[a-z]/
    or croak "Invalid method name '$method' called on ".__PACKAGE__;

  (my $code = $MethodCode) =~ s/~~NAME~~/$method/g;
  eval $code; print($code), die $@ if $@;
  goto &$AUTOLOAD;
}

# shortcuts
sub id {$_[0][0]}

sub ref_exists {MObjectDB->get_real($_[0][0], $_[0][1]) ? 1 : 0}
sub ref_as_string {"#$_[0][0]"}

sub DESTROY {}

1;
