UMMF::UML_1_5::__ObjectBase - base class package for Model UML 1.5 final/03-03-01;

  use base qw(UMMF::UML_1_5::__ObjectBase);

  use UMMF::UML_1_5::__ObjectBase qw(:__ummf_array);

  __ummf_array_index
  __ummf_array_delete
  __ummf_array_delete_once
  __ummf_array_delete_each
  __ummf_array_delete_each_once

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

  my $classifier = $obj_or_package->__classifier;

  $package->__isAbstract;

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

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

  my $extent = UMMF::Object::Extent->new();
  UMMF::UML_1_5::__ObjectBase->add___extent($extent);

  my $extent = ...;
  UMMF::UML_1_5::__ObjectBase->remove__extent($extent);

  $obj = $package->__extent_add_object($obj, @args)

  my $obj = $package->__new_instance(%attrs);

  my $obj = $package->new(%attrs);

  my $obj = $package->new_(@opts);

  my $clone = $obj->__clone();

  my $i = __ummf_array_index(\@a, $elem);

  __ummf_array_delete(\@a, $elem);

  __ummf_array_delete_once(\@a, $elem);

  __ummf_array_delete_each(\@a, \@elem);

  __ummf_array_delete_each(\@a, \@elem);

# -*- perl -*-
# DO NOT EDIT - This file is generated by UMMF; http://ummf.sourceforge.net 
# From template: $Id: Perl.txt,v 1.77 2006/05/14 01:40:03 kstephens Exp $

package UMMF::UML_1_5::__ObjectBase;

# This package provides base class support for generated Classifiers.

#use 5.6.1;
use strict;
use warnings;

#################################################################
# Version
#

our $VERSION = do { my @r = (q$Revision: 1.77 $ =~ /\d+/g); sprintf "%d." . "%03d" x $#r, @r };

#################################################################
# Supers
#

use base qw(Exporter);
our @EXPORT_OK = 
  qw(
     __ummf_array_index
     __ummf_array_delete
     __ummf_array_delete_once
     __ummf_array_delete_each
     __ummf_array_delete_each_once
    );
our %EXPORT_TAGS = (
		   '__ummf_array' => \@EXPORT_OK,
		   );

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

use Carp qw(croak confess);
use Set::Object;

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


my %__use;

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 '$cls':\n$@" if $@;
      ${"${cls}::VERSION"} ||= -1;
    }
    $__use{$cls} = 1;
  }

  $cls;
}


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

# 'emacs
sub __factory 
{ 
  __use('UMMF::UML_1_5')->factory;
}

sub __metamodel 
{
  __use('UMMF::UML_1_5')->model;
}


my %__classifier;

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

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

sub __isAbstract { 1 }


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

sub __validate_type { 1 }

sub __typecheck { $_[1] }


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

sub __initialize { shift }

#'emacs
sub ___initialize { shift }

sub __create { shift }

sub ___create { shift }

sub ____create { shift }


#################################################################
# Extent.
#

our $_id = 0;

our $__new_instance_event;


my @__extent;

sub add___extent
{
  my ($self, $extent) = @_;

  push(@__extent, $extent);
  $extent->add_classifier($self);
}

sub remove___extent
{
  my ($self, $extent) = @_;

  @__extent = grep($_ ne $extent, @__extent);
  $extent->remove_classifier($self);
}

sub __extent_add_object
{
  my ($self, $obj, @args) = @_;

  # Deprecated: use add___extent.
  $__new_instance_event->($self, @args) if $__new_instance_event;

  for my $extent ( @__extent ) {
    $extent->add_object($self, @args);
  }

  $obj;
}


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

sub __new_instance
{
  my ($self, %attrs) = @_;

  $attrs{'_id'} ||= ++ $_id;
  $self->__extent_add_object(bless(\%attrs, ref($self) || $self), '__new_instance');
}

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

  # $DB::single = 1;

  # Abstract Classifiers are not instantitable.
  confess("$self isAbstract") if $self->__isAbstract;

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

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

  # $DB::single = 1;

  # Abstract Classifiers are not instantitable.
  confess("$self isAbstract") if $self->__isAbstract;

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

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

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

  $self->{'_id'} .= '.' . ++ $_id; # Fix me!!!

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

  $self->__clone_deepen;

  $self->__extent_add_object($self, '__clone');
}

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

  # Clone all the aggegrated Associations.

  $self;
}

sub __ummf_disassemble ($)
{
  no warnings;

  my ($self) = @_;

  # untie(%$self); # Dont allow Tangram OnDemand start pulling things in.

  # print STDERR "__ummf_disassemble $self\n";

  # Get list of objects to traverse.
  my @x;
  for my $k ( keys %$self ) {
    untie $self->{$k}; # Dont allow Tangram::*OnDemand start pulling things in.
    my $v = $self->{$k};

    if ( my $ref = ref($v) ) {
      if ( $ref eq 'Set::Object' ) {
	push(@x, $v->members);
      }
      elsif ( $ref eq 'ARRAY' ) {
	push(@x, @$v);
      }
      elsif ( $ref eq 'HASH' ) {
	push(@x, values %$v);
      }
      else {
	push(@x, $v);
      }
    }
  }

  # Only objects that can disassemble.
  @x = grep(UNIVERSAL::can($_, '__ummf_disassemble'), @x);

  # Empty $self; avoids recursion.
  %$self = ();

  # Process.
  for $self ( @x ) {
    $self->__ummf_disassemble;
  }
}



############################################################################
# Exported Helpers
#

sub __ummf_array_index
{
  my ($a, $e) = @_;

  my $i = 0;
  for my $ae ( @$a ) {
    return $i if $ae eq $e;
    ++ $i;
  }
  undef; # Not found.
}

sub __ummf_array_delete
{
  my ($a, $e) = @_;

  my $i = 0;
  while ( $i < @$a ) {
    if ( $a->[$i] eq $e ) {
      splice(@$a, $i, 1);
      next;
    }
    ++ $i;
  }
}

sub __ummf_array_delete_once
{
  my ($a, $e) = @_;

  my $i = 0;
  while ( $i < @$a ) {
    if ( $a->[$i] eq $e ) {
      splice(@$a, $i, 1);
      last;
    }
    ++ $i;
  }
}

sub __ummf_array_delete_each
{
  my ($a, $es) = @_;
  for my $e ( @$es ) {
    __ummf_array_delete($a, $e);
  }
}

sub __ummf_array_delete_each_once
{
  my ($a, $es) = @_;
  for my $e ( @$es ) {
    __ummf_array_delete_once($a, $e);
  }
}


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


use vars qw($AUTOLOAD);

our $AUTOLOAD_verbose = 0;


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


my %__isa;

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 ( $self && $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 = 
    {
      'type'      => 'UndefinedMethod',
      'package'   => $package,
      'operation' => $operation,
      'receiver'  => "$self",
      'arguments' => [ map("$_", @args) ],
    };

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


1; # Is true!!!