package UML::MetaModel::__ObjectBase;

use 5.6.1;
use strict;
# use warnings;

############################################################################
# See UML::Code::Perl for dependencies.
#

# Returns true if a value is a valid representation of
# this Class.
sub __validate { 1 }

# Generates an exception if a value is not a valid representaion
# of this class.
sub __typecheck { $_[1] }

# Initialize all slots in an instance with initial values.
sub __initialize { shift }

# Initialize all associations from values specified in the constructor.
sub __initialize_associations { shift }

my %__autouse;
sub __autouse
{
  my ($self, $cls) = @_;

  $cls ||= $self;

  unless ( $__autouse{$cls} ) {
    # $DB::single = 1;
    no strict 'refs';
    unless ( ${"${cls}::VERSION"} ) {
      use Carp qw(confess);
      # $DB::single = 1;
      eval "use $cls"; confess "Attempting autouse:\n$@" if $@;
      ${"${cls}::VERSION"} ||= 1;
    }
    $__autouse{$cls} = 1;
  }

  $cls;
}


# Return the metamodel for this model.
sub __metamodel 
{
  use UML::MetaModel; 
  UML::MetaModel->model;
}

# Returns a new instance, without initializing the associations.
sub __new_instance
{
  my ($self, %attrs) = @_;
  $self = bless(\%attrs, ref($self) || $self);
  $self->__initialize;
  $self;
}

# Returns a new instance, initializing the associations.
sub new
{
  my ($self, @opts) = @_;
  $self = $self->__new_instance(@opts);
  my $x = $self->__initialize;
  # Allow __initialize method to delegate instantation.
  if ( $x eq $self ) {
    $self->__initialize_associations;
  }
  $x;
}

####################################################################################
# Use autoloader to simplify isa<Classifier>() handling of disjoint types.
# This also prints a verbose stack trace for an unimplemented method.
#

use vars qw($AUTOLOAD);

our $AUTOLOAD_verbose = 0;


sub AUTOLOAD
{
  no strict 'refs';
  
  my ($self, @args) = @_;
  local ($1, $2);
  
  my ($package, $operation) = $AUTOLOAD =~ m/^(?:(.+)::)([^:]+)$/;
  return if $operation eq 'DESTROY';
  
  my ($method); # The autogenerated method.
  
  #$DB::single = 1;
  
  # warn __PACKAGE__ . ": package='$package' operation='$operation'";
  
  # Handle isa<Classifier> automagically.
  # better check your spelling!!
  # IMPLEMENT: Check the method name against the list of Classifiers
  # in the Model.
  if ( $operation =~ /^isa[A-Z]/ ) {
    # $DB::single = 1;
    $method = sub { undef };
  }
  
  # Save the generated method and invoke it.
  if ( $method ) {
    *{$AUTOLOAD} = $method;
    # Tail call.
    goto &$method;
  } else {
    use Carp qw(confess);
    use Data::Dumper;

    # Nice feature:
    # Print a stack trace if an undefined method is called.
    # Why doesn't Perl always do this?
    my $e = 
    [
     'UndefinedMethod',
     'package'   => $package,
     'operation' => $operation,
     'receiver'  => "$self",
     'arguments' => [ map("$_", @args) ],
     ];

    confess(Data::Dumper->new([$e],[qw(EXCEPTION)])->Dump);
  }
}  

1; # Is true!!!

