# -*- perl -*-
# DO NOT EDIT - This file is generated by UML2CODE.
# From template: $Id: PerlTemplate.txt,v 1.12 2003/05/11 06:16:02 stephens Exp $

package UML::MetaModel::__ObjectBase;

# This package provides base class support for generated Classifiers.

use 5.6.1;
use strict;
use warnings;

#################################################################
# Dependencies
#

use Carp qw(croak confess);

#################################################################
# Dynamic loading
#


my %__use;

=head2 __use

  my $pkg = $self->__use('Some::Package');
  my $new_obj = $pkg->new(...);

Dynamically "use" a package.

=cut
sub __use
{
  my ($self, $cls) = @_;

  $cls ||= $self;

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

  $cls;
}


#################################################################
# Introspection
#

=head2 __factory

Returns the factory object for this Classifier's Model.

=cut
# 'emacs
sub __factory 
{ 
  __use('UML::MetaModel')->factory;
}

=head2 __metamodel

Returns the Model for this Classifier.

=cut
sub __metamodel 
{
  __use('UML::MetaModel')->model;
}


my %__classifier;
=head2 __classifier

  my $classifier = $obj_or_package->__classifier;

Returns the UML meta-model Classifier for an object or package.

=cut
sub __classifier 
{ 
  my ($self) = @_;
  
  my $name = ref($self) || $self;

  my $cls;
  unless ( $cls = $__classifier{$name} ) {
    use UML::MetaMetaModel::Util qw(Namespace_ownedElement_name_);
    $cls = $__classifier{$name} = 
    Namespace_ownedElement_name_($self->__metamodel, $self->__model_name);
  }
  
  $cls;
}


#################################################################
# Validation.
#

=head2 __validate_type

  Some::Package->__validate_type($value);

Returns true if a value is a valid representation of this Classifier.

=cut
sub __validate_type { 1 }


=head2 __typecheck

  Some::Package->__typecheck($value, $msg);

Generates an exception with C<$msg> if C<$value> is not a valid representaion of this Classifier.

=cut
sub __typecheck { $_[1] }


#################################################################
# Initialization.
#


=head2 _initialize

Initialize all slots in an instance with initial values.

=cut
sub _initialize { shift }


=head2 __initialize

Initialize all slots of a particular Classifier's Attributes and AssociationEnds.

=cut
#'emacs
sub __initialize { shift }


#################################################################
# Instantiation.
#

my $_id = 0;

=head2 __new_instance

Returns a new instance, without initializing.

=cut
sub __new_instance
{
  my ($self, %attrs) = @_;
  $attrs{'_id'} ||= ++ $_id;
  bless(\%attrs, ref($self) || $self);
}

=head2 new

Returns a new instance, initializing the associations.

=cut
sub new
{
  my ($self, @opts) = @_;

  # $DB::single = 1;

  # Allow _initialize method to delegate instantation.
  $self->__new_instance(@opts)->_initialize;
}


=head2 __clone

Returns a new cloned instance.

=cut
sub __clone
{
  my ($self) = @_;

  $self = bless({ %$self }, ref($self));

  $self->{'_id'} .= '.' . ++ $_id;

  # Clone all attributes.
  for my $key ( keys %$self ) {
    my $v = $self->{$key};
    if ( ref($v) eq 'ARRAY' ) {
      $self->{$key} = [ @$v ];
    } elsif ( ref($v) eq 'HASH' ) {
      $self->{$key} = { %$v };
    }
  }

  $self->__clone_deepen;
}


sub __clone_deepen
{
  my ($self) = @_;

  # Clone all the aggegrated Associations.

  $self;
}



#################################################################


use vars qw($AUTOLOAD);

our $AUTOLOAD_verbose = 0;


sub __true { 1 };
sub __false { 1 };


my %__isa;


=head2 AUTOLOAD

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

=cut
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!!
  if ( $operation =~ /^isa[A-Z]/ ) {
    my $ref = ref($self) || $self;

    # Install true method in $self class, not any superclass.
    $AUTOLOAD = "${ref}::${operation}";

    # Check a false cache.
    my $method = $__isa{$AUTOLOAD};
    unless ( defined $method ) {
      my @x = @{"${ref}::ISA"};
      while ( @x ) {
	my $x = pop @x;
	if ( UNIVERSAL::can($x, $operation) && $x->$operation ) {
	  $method = \&__true;
	  last;
	}
	push(@x, @{"${x}::ISA"});
      }
      $__isa{"$ref\t$operation"} = 0;
    }

    # Do not install false method, so multiple-inheritance will work.
    # print STDERR "$ref \t $operation \t = $method->()\n";
    return undef unless $method;
  }
  
  # Install 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!!!

