File Coverage

lib/UR/Object/Type/Initializer.pm

Criterion	Covered	Total	%
statement	1031	1128	91.4
branch	641	734	87.3
condition	436	744	58.6
subroutine	332	332	100.0
pod	77	77	100.0
total	2517	3015	83.4

# This line forces correct deployment by some tools.
package UR::Object::Type::Initializer;

package UR::Object::Type;

use strict;
use warnings;
require UR;

use UR::Util;

BEGIN {
    # Perl 5.10 did not require mro in order to call get_mro but it looks
    # like that was "fixed" in newer version.
    if ($^V ge v5.9.5) {
        eval "require mro";
    }
};

our $VERSION = "0.46"; # UR $VERSION;

use Carp ();
use Sub::Name ();
use Sub::Install ();

# keys are class property names (like er_role, is_final, etc) and values are
# the default value to use if it's not specified in the class definition
#
# For most classes, this kind of thing is handled by the default_value attribute on
# a class' property.  For bootstrapping reasons, the default values for the
# properties of UR::Object::Type' class need to be listed here as well.  If
# any of these change, or new default valued items are added, be sure to also
# update the class definition for UR::Object::Type (which really lives in UR.pm
# for the moment)
%UR::Object::Type::defaults = (
    er_role            => 'entity',
    is_final           => 0,
    is_singleton       => 0,
    is_transactional   => 1,
    is_mutable         => 1,
    is_many            => 0,
    is_abstract        => 0,
    subclassify_by_version => 0,
);

# All those same comments also apply to UR::Object::Property's properties
%UR::Object::Property::defaults = (
    is_optional      => 0,
    is_transient     => 0,
    is_constant      => 0,
    is_volatile      => 0,
    is_classwide    => 0,
    is_delegated     => 0,
    is_calculated    => 0,
    is_mutable       => undef,
    is_transactional => 1,
    is_many          => 0,
    is_numeric       => 0,
    is_specified_in_module_header => 0,
    is_deprecated    => 0,
    position_in_module_header => -1,
    doc_position    => -1,
    is_undocumented => 0,
);

@UR::Object::Type::meta_id_ref_shared_properties = (
    qw/
        is_optional
        is_transient
        is_constant
        is_volatile
        is_classwide
        is_transactional
        is_abstract
        is_concrete
        is_final
        is_many
        is_deprecated
        is_undocumented
    /
);

%UR::Object::Type::converse = (
    required => 'optional',
    abstract => 'concrete',
    one => 'many',
);

# These classes are used to define an object class.
# As such, they get special handling to bootstrap the system.

our %meta_classes = map { $_ => 1 }
    qw/
        UR::Object
        UR::Object::Type
        UR::Object::Property
    /;

our $bootstrapping = 1;
our @partially_defined_classes;

# When copying the object hash to create its db_committed, these keys should be removed because
# they contain things like coderefs
our @keys_to_delete_from_db_committed = qw( id db_committed _id_property_sorter get_composite_id_resolver get_composite_id_decomposer );

# Stages of Class Initialization
#
# define() is called to indicate the class structure (create() may also be called by the db sync command to make new classes)
#
# the parameters to define()/create() are normalized by _normalize_class_description()
#
# a basic functional class meta object is created by _define_minimal_class_from_normalized_class_description()
#
#  accessors are created
#
# if we're still bootstrapping:
#
#  the class is stashed in an array so the post-bootstrapping stages can be done in bulk
#
#  we exit define()
#
# if we're done bootstrapping:
#
# _inform_all_parent_classes_of_newly_loaded_subclass() sets up an internal map of known subclasses of each base class
#
# _complete_class_meta_object_definitions() decomposes the definition into normalized objects
#

sub __define__ {
    my $class = shift;
    my $desc = $class->_normalize_class_description(@_);

    my $class_name = $desc->{class_name} ||= (caller(0))[0];
    $desc->{class_name} = $class_name;

    my $self;

    my %params = $class->_construction_params_for_desc($desc);
    my $meta_class_name;
    if (%params) {
        $self = __PACKAGE__->__define__(%params);
        return unless $self;
        $meta_class_name = $params{class_name};
    }
    else {
        $meta_class_name = __PACKAGE__;
    }

    $self = $UR::Context::all_objects_loaded->{$meta_class_name}{$class_name};
    if ($self) {
        #$DB::single = 1;
        #Carp::cluck("Re-defining class $class_name?  Found $meta_class_name with id '$class_name'");
        return $self;
    }

    $self = $class->_make_minimal_class_from_normalized_class_description($desc);
    Carp::confess("Failed to define class $class_name!") unless $self;

    # we do this for define() but not create()
    my %db_committed = %$self;
    delete @db_committed{@keys_to_delete_from_db_committed};
    $self->{'db_committed'} = \%db_committed;

    $self->_initialize_accessors_and_inheritance
        or Carp::confess("Error initializing accessors for $class_name!");

    if ($bootstrapping) {
        push @partially_defined_classes, $self;
    }
    else {
        unless ($self->_inform_all_parent_classes_of_newly_loaded_subclass()) {
            Carp::confess(
                "Failed to link to parent classes to complete definition of class $class_name!"
                . $class->error_message
            );
        }
        unless ($self->_complete_class_meta_object_definitions()) {
            #$DB::single = 1;
            $self->_complete_class_meta_object_definitions();
            Carp::confess(
                "Failed to complete definition of class $class_name!"
                . $class->error_message
            );
        }
    }

    $self->_inform_roles_of_new_class();

    return $self;
}


sub create {
    # this is typically only used by code which intendes to autogenerate source code
    # it will lead to the writing of a Perl module upon commit.
    my $class = shift;
    my $desc = $class->_normalize_class_description(@_);

    my $class_name = $desc->{class_name} ||= (caller(0))[0];
    my $meta_class_name = $desc->{meta_class_name};

    no strict 'refs';
    unless (
        $meta_class_name eq __PACKAGE__
        or
        # in newer Perl interpreters the ->isa() call can return true
        # even if @ISA has been emptied (OS X) ???
        (scalar(@{$meta_class_name . '::ISA'}) and $meta_class_name->isa(__PACKAGE__))
    ) {
        if (__PACKAGE__->get(class_name => $meta_class_name)) {
            warn "class $meta_class_name already exists when creating class meta for $class_name?!";
        }
        else {
            __PACKAGE__->create(
                __PACKAGE__->_construction_params_for_desc($desc)
            );
        }
    }

    my $self = $class->_make_minimal_class_from_normalized_class_description($desc);
    Carp::confess("Failed to define class $class_name!") unless $self;

    $self->_initialize_accessors_and_inheritance
        or Carp::confess("Failed to define class $class_name!");

    $self->_inform_all_parent_classes_of_newly_loaded_subclass()
        or Carp::confess(
            "Failed to link to parent classes to complete definition of class $class_name!"
            . $class->error_message
        );

    $self->generated(0);

    $self->__signal_change__("create");

    return $self;
}

sub _preprocess_subclass_description {
    # allow a class to modify the description of any subclass before it instantiates
    # this filtering allows a base class to specify policy, add meta properties, etc.
    my ($self,$prev_desc) = @_;

    my $current_desc = $prev_desc;

    if (my $preprocessor = $self->subclass_description_preprocessor) {
        # the preprocessor must me a method name in the class being adjusted
        no strict 'refs';
        unless ($self->class_name->can($preprocessor)) {
            die "Class " . $self->class_name
                . " specifies a pre-processor for subclass descriptions "
                . $preprocessor . " which is not defined in the "
                . $self->class_name . " package!";
        }
        $current_desc = $self->class_name->$preprocessor($current_desc);
        $current_desc = $self->_normalize_class_description_impl(%$current_desc);
    }

    # only call it on the direct parent classes, let recursion walk the tree
    my @parent_class_names =
        grep { $_->can('__meta__') }
        $self->parent_class_names();

    for my $parent_class_name (@parent_class_names) {
        my $parent_class = $parent_class_name->__meta__;
        $current_desc = $parent_class->_preprocess_subclass_description($current_desc);
    }

    return $current_desc;
}

sub _construction_params_for_desc {
    my $class = shift;
    my $desc = shift;

    my $class_name = $desc->{class_name};
    my $meta_class_name = $desc->{meta_class_name};
    my @extended_metadata;
    if ($desc->{type_has}) {
        @extended_metadata = ( has => [ @{ $desc->{type_has} } ] );
    }

    if (
        $meta_class_name eq __PACKAGE__
    ) {
        if (@extended_metadata) {
            die "Cannot extend class metadata of $class_name because it is a class involved in UR bootstrapping.";
        }
        return();
    }
    else {
        if ($bootstrapping) {
            return (
                class_name => $meta_class_name,
                is => __PACKAGE__,
                @extended_metadata,
            );
        }
        else {
            my $parent_classes = $desc->{is};
            my @meta_parent_classes = map { $_ . '::Type' } @$parent_classes;
            for (@$parent_classes) {
                __PACKAGE__->use_module_with_namespace_constraints($_);
                eval {$_->class};
                if ($@) {
                    die "Error with parent class $_ when defining $class_name! $@";
                }
            }
            return (
                class_name => $meta_class_name,
                is => \@meta_parent_classes,
                @extended_metadata,
            );
        }
    }

}



sub initialize_bootstrap_classes
{
    # This is called once at the end of compiling the UR module set to handle
    # classes which did incomplete initialization while bootstrapping.
    # Until bootstrapping occurs is done,
    my $class = shift;

    for my $class_meta (@partially_defined_classes) {
        unless ($class_meta->_inform_all_parent_classes_of_newly_loaded_subclass) {
            my $class_name = $class_meta->{class_name};
            Carp::confess (
                "Failed to complete inheritance linkage definition of class $class_name!"
                . $class_meta->error_message
            );
        }

    }
    while (my $class_meta = shift @partially_defined_classes) {
        unless ($class_meta->_complete_class_meta_object_definitions()) {
            my $class_name = $class_meta->{class_name};
            Carp::confess(
                "Failed to complete definition of class $class_name!"
                . $class_meta->error_message
            );
        }
    }
    $bootstrapping = 0;

    # It should be safe to set up callbacks now.  register_callback() instead
    # of create() so a subsequent rollback won't remove the observer.
    UR::Observer->register_callback(
        subject_class_name => 'UR::Object::Property',
        subject_id => '',
        aspect => '',
        priority => 1,
        note => '',
        once => 0,
        callback => \&UR::Object::Type::_property_change_callback,
    );
}

sub _normalize_class_description {
    my $class = shift;
    my $desc = $class->_normalize_class_description_impl(@_);

    $class->compose_roles($desc) unless $bootstrapping;

    unless ($bootstrapping) {
        for my $parent_class_name (@{ $desc->{is} }) {
            my $parent_class = $parent_class_name->__meta__;
            $desc = $parent_class->_preprocess_subclass_description($desc);
        }
    }

    # we previously handled property meta extensions when normalizing the property
    # now we merely save unrecognized things
    # this is now done afterward so that parent classes can preprocess their subclasses descriptions before extending
    # normalize the data behind the property descriptions
    my @property_names = keys %{$desc->{has}};
    for my $property_name (@property_names) {
        Carp::croak("Invalid property name in class ".$desc->{class_name}.": '$property_name'")
            unless UR::Util::is_valid_property_name($property_name);

        my $pdesc = $desc->{has}->{$property_name};
        my $unknown_ma = delete $pdesc->{unrecognized_meta_attributes};
        next unless $unknown_ma;
        for my $name (keys %$unknown_ma) {
            if (exists $desc->{attributes_have}->{$name}) {
                $pdesc->{$name} = delete $unknown_ma->{$name};
            }
        }
        if (%$unknown_ma) {
            my $class_name = $desc->{class_name};
            my @unknown_ma = sort keys %$unknown_ma;
            Carp::confess("unknown meta-attributes present for $class_name $property_name: @unknown_ma\n");
        }
    }

    return $desc;
}

sub _canonicalize_class_params {
    my($params, $mappings) = @_;

    my %canon_params;

    for my $mapping ( @$mappings ) {
        my ($primary_field_name, @alternate_field_names) = @$mapping;
        my @all_fields = ($primary_field_name, @alternate_field_names);
        my @values = grep { defined($_) } delete @$params{@all_fields};
        if (@values > 1) {
            Carp::confess(
                "Multiple values in for field "
                . join("/", @all_fields)
            );
        }
        elsif (@values == 1) {
            $canon_params{$primary_field_name} = $values[0];
        }
    }

    return %canon_params;
}

our @CLASS_DESCRIPTION_KEY_MAPPINGS_COMMON_TO_CLASSES_AND_ROLES = (
        [ roles                 => qw//],
        [ is_abstract           => qw/abstract/],
        [ is_final              => qw/final/],
        [ is_singleton          => qw//],
        [ is_transactional      => qw//],
        [ id_by                 => qw/id_properties/],
        [ has                   => qw/properties/],
        [ type_has              => qw//],
        [ attributes_have       => qw//],
        [ er_role               => qw/er_type/],
        [ doc                   => qw/description/],
        [ relationships         => qw//],
        [ constraints           => qw/unique_constraints/],
        [ namespace             => qw//],
        [ schema_name           => qw//],
        [ data_source_id        => qw/data_source instance/],
        [ select_hint            => qw/query_hint/],
        [ join_hint             => qw//],
        [ subclassify_by        => qw/sub_classification_property_name/],
        [ sub_classification_meta_class_name    => qw//],
        [ sub_classification_method_name        => qw//],
        [ first_sub_classification_method_name  => qw//],
        [ composite_id_separator                => qw//],
        [ generate               => qw//],
        [ generated              => qw//],
        [ subclass_description_preprocessor => qw//],
        [ id_generator           => qw/id_sequence_generator_name/],
        [ subclassify_by_version => qw//],
        [ meta_class_name        => qw//],
        [ valid_signals          => qw//],
);

my @CLASS_DESCRIPTION_KEY_MAPPINGS = (
        @CLASS_DESCRIPTION_KEY_MAPPINGS_COMMON_TO_CLASSES_AND_ROLES,
        [ class_name            => qw//],
        [ type_name             => qw/english_name/],
        [ is                    => qw/inheritance extends isa is_a/],
        [ table_name            => qw/sql dsmap/],
);

sub _normalize_class_description_impl {
    my $class = shift;
    my %old_class = @_;

    if (exists $old_class{extra}) {
        %old_class = (%{delete $old_class{extra}}, %old_class);
    }

    my $class_name = delete $old_class{class_name};

    my %new_class = (
        class_name      => $class_name,
        is_singleton    => $UR::Object::Type::defaults{'is_singleton'},
        is_final        => $UR::Object::Type::defaults{'is_final'},
        is_abstract     => $UR::Object::Type::defaults{'is_abstract'},
        _canonicalize_class_params(\%old_class, \@CLASS_DESCRIPTION_KEY_MAPPINGS),
    );

    if (my $pp = $new_class{subclass_description_preprocessor}) {
        if (!ref($pp)) {
            unless ($pp =~ /::/) {
                # a method name, not fully qualified
                $new_class{subclass_description_preprocessor} =
                    $new_class{class_name}
                        . '::'
                            . $new_class{subclass_description_preprocessor};
            } else {
                $new_class{subclass_description_preprocessor} = $pp;
            }
        }
        elsif (ref($pp) ne 'CODE') {
            die "unexpected " . ref($pp) . " reference for subclass_description_preprocessor for $class_name!";
        }
    }

    unless ($new_class{er_role}) {
        $new_class{er_role} = $UR::Object::Type::defaults{'er_role'};
    }

    my @crap = qw/source/;
    delete @old_class{@crap};

    if ($class_name =~ /^(.*?)::/) {
        $new_class{namespace} = $1;
    }
    else {
        $new_class{namespace} = $new_class{class_name};
    }

    if (not exists $new_class{is_transactional}
        and not $meta_classes{$class_name}
    ) {
        $new_class{is_transactional} = $UR::Object::Type::defaults{'is_transactional'};
    }

    unless ($new_class{is}) {
        no warnings;
        no strict 'refs';
        if (my @isa = @{ $class_name . "::ISA" }) {
            $new_class{is} = \@isa;
        }
    }

    unless ($new_class{is}) {
        if ($new_class{table_name}) {
            $new_class{is} = ['UR::Entity']
        }
        else {
            $new_class{is} = ['UR::Object']
        }
    }

    unless ($new_class{'doc'}) {
        $new_class{'doc'} = undef;
    }

    foreach my $key ( qw(valid_signals roles) ) {
        unless (UR::Util::ensure_arrayref(\%new_class, $key)) {
            Carp::croak("The '$key' metadata for class $class_name must be an arrayref");
        }
    }

    # Later code expects these to be listrefs
    for my $field (qw/is id_by has relationships constraints/) {
        _massage_field_into_arrayref(\%new_class, $field);
    }


    # These may have been found and moved over.  Restore.
    $old_class{has}             = delete $new_class{has};
    $old_class{attributes_have} = delete $new_class{attributes_have};

    # Install structures to track fully formatted property data.
    my $instance_properties = $new_class{has} = {};
    my $meta_properties     = $new_class{attributes_have} = {};

    # The id might be a single value, or not specified at all.
    my $id_properties;
    if (not exists $new_class{id_by}) {
        if ($new_class{is}) {
            $id_properties = $new_class{id_by} = [];
        }
        else {
            $id_properties = $new_class{id_by} = [ id => { is_optional => 0 } ];
        }
    }
    elsif ( (not ref($new_class{id_by})) or (ref($new_class{id_by}) ne 'ARRAY') ) {
        $id_properties = $new_class{id_by} = [ $new_class{id_by} ];
    }
    else {
        $id_properties = $new_class{id_by};
    }

    _normalize_id_property_data(\%old_class, \%new_class);

    if (@$id_properties > 1
        and grep {$_ eq 'id'} @$id_properties)
    {
        Carp::croak("Cannot initialize class $class_name: "
                    . "Cannot have an ID property named 'id' when the class has multiple ID properties ("
                    . join(', ', map { "'$_'" } @$id_properties)
                    . ")");
    }

    _process_class_definition_property_keys(\%old_class, \%new_class);

    # NOT ENABLED YET
    if (0) {
        # done processing direct properties of this process
        # extend %$instance_properties with properties of the parent classes
        my @parent_class_names = @{ $new_class{is} };
        for my $parent_class_name (@parent_class_names) {
            my $parent_class_meta = $parent_class_name->__meta__;
            die "no meta for $parent_class_name while initializing $class_name?" unless $parent_class_meta;
            my $parent_normalized_properties = $parent_class_meta->{has};
            for my $parent_property_name (keys %$parent_normalized_properties) {
                my $parent_property_data = $parent_normalized_properties->{$parent_property_name};
                my $inherited_copy = $instance_properties->{$parent_property_name};
                unless ($inherited_copy) {
                    $inherited_copy = UR::Util::deep_copy($parent_property_data);
                }
                $inherited_copy->{class_name} = $class_name;
                my $override = $inherited_copy->{overrides_class_names} ||= [];
                push @$override, $parent_property_data->{class_name};
            }
        }
    }

    if (($new_class{data_source_id} and not ref($new_class{data_source_id})) and not $new_class{schema_name}) {
        my $s = $new_class{data_source_id};
        $s =~ s/^.*::DataSource:://;
        $new_class{schema_name} = $s;
    }

    if (%old_class) {
        # this should have all been deleted above
        # we actually process it later, since these may be related to parent classes extending
        # the class definition
        $new_class{extra} = \%old_class;
    };

    # ensure parent classes are loaded
    unless ($bootstrapping) {
        my @base_classes = map { ref($_) ? @$_ : $_ } $new_class{is};
        for my $parent_class_name (@base_classes) {
            # ensure the parent classes are fully processed
            no warnings;
            unless ($parent_class_name->can("__meta__")) {
                __PACKAGE__->use_module_with_namespace_constraints($parent_class_name);
                Carp::croak("Class $class_name cannot initialize because of errors using parent class $parent_class_name: $@") if $@;
            }
            unless ($parent_class_name->can("__meta__")) {
                if ($ENV{'HARNESS_ACTIVE'}) {
                    Carp::confess("Class $class_name cannot initialize because of errors using parent class $parent_class_name.  Failed to find static method '__meta__' on $parent_class_name.  Does class $parent_class_name exist, and is it loaded?\n  The entire list of base classes was ".join(', ', @base_classes));
                }
                Carp::croak("Class $class_name cannot initialize because of errors using parent class $parent_class_name.  Failed to find static method '__meta__' on $parent_class_name.  Does class $parent_class_name exist, and is it loaded?");
            }
            my $parent_class = $parent_class_name->__meta__;
            unless ($parent_class) {
                Carp::carp("No class metadata object for $parent_class_name");
                next;
            }

            # the the parent classes indicate version, if needed
            if ($parent_class->{'subclassify_by_version'} and not $parent_class_name =~ /::Ghost/) {
                unless ($class_name =~ /^${parent_class_name}::V\d+/) {
                    my $ns = $parent_class_name;
                    $ns =~ s/::.*//;
                    my $version;
                    if ($ns and $ns->can("component_version")) {
                        $version = $ns->component_version($class);
                    }
                    unless ($version) {
                        $version = '1';
                    }
                    $parent_class_name = $parent_class_name . '::V' . $version;
                    eval "use $parent_class_name";
                    Carp::confess("Error using versioned module $parent_class_name!:\n$@") if $@;
                    redo;
                }
            }
        }
        $new_class{is} = \@base_classes;
    }

    # allow parent classes to adjust the description in systematic ways
    my @additional_property_meta_attributes;
    unless ($bootstrapping) {
        for my $parent_class_name (@{ $new_class{is} }) {
            my $parent_class = $parent_class_name->__meta__;
            if (my $parent_meta_properties = $parent_class->{attributes_have}) {
                push @additional_property_meta_attributes, %$parent_meta_properties;
            }
        }
    }

    __PACKAGE__->_normalize_property_descriptions_during_normalize_class_description(\%new_class);

    unless ($bootstrapping) {
        %$meta_properties = (%$meta_properties, @additional_property_meta_attributes);

        # Inheriting from an abstract class that subclasses with a subclassify_by means that
        # this class' property named by that subclassify_by is actually a constant equal to this
        # class' class name
        PARENT_CLASS:
        foreach my $parent_class_name ( @{ $new_class{'is'} }) {
            my $parent_class_meta = $parent_class_name->__meta__();
            foreach my $ancestor_class_meta ( $parent_class_meta->all_class_metas ) {
                if (my $subclassify_by = $ancestor_class_meta->subclassify_by) {
                    if (not $instance_properties->{$subclassify_by}) {
                        my %old_property = (
                            property_name => $subclassify_by,
                            default_value => $class_name,
                            is_constant => 1,
                            is_classwide => 1,
                            is_specified_in_module_header => 0,
                            column_name => '',
                            implied_by => $parent_class_meta->class_name . '::subclassify_by',
                        );
                        my %new_property = $class->_normalize_property_description1($subclassify_by, \%old_property, \%new_class);
                        my %new_property2 = $class->_normalize_property_description2(\%new_property, \%new_class);
                        $instance_properties->{$subclassify_by} = \%new_property2;
                        last PARENT_CLASS;
                    }
                }
            }
        }
    }

    my $meta_class_name = __PACKAGE__->_resolve_meta_class_name_for_class_name($class_name);
    $new_class{meta_class_name} ||= $meta_class_name;
    return \%new_class;
}

# Transform the id properties into a list of raw ids,
# and move the property definitions into "id_implied"
# where present so they can be processed below.
sub _normalize_id_property_data {
    my($old_class_desc, $new_class_desc) = @_;

    my $id_properties = $new_class_desc->{id_by};
    my $property_rank = 0;
    my @replacement;
    my $pos = 0;

    for(my $n = 0; $n < @$id_properties; $n++) {
        my $name = $id_properties->[$n];

        my $data = $id_properties->[$n+1];
        if (ref($data)) {
            $old_class_desc->{id_implied}->{$name} ||= $data;
            if (my $obj_ids = $data->{id_by}) {
                push @replacement, (ref($obj_ids) ? @$obj_ids : ($obj_ids));
            }
            else {
                push @replacement, $name;
            }
            $n++;
        }
        else {
            $old_class_desc->{id_implied}->{$name} ||= {};
            push @replacement, $name;
        }
        $old_class_desc->{id_implied}->{$name}->{'position_in_module_header'} = $pos++;
    }
    @$id_properties = @replacement;
}

# Given several different kinds of input, convert it into an arrayref
sub _massage_field_into_arrayref {
    my($class_desc, $field_name) = @_;

    my $value = $class_desc->{$field_name};
    my $reftype = ref $value;
    if (! exists $class_desc->{$field_name}) {
        $class_desc->{$field_name} = [];

    } elsif (! $reftype) {
        # It's a plain string, wrap it in an arrayref
        $class_desc->{$field_name} = [ $value ];

    } elsif ($reftype eq 'HASH') {
        # Later code expects it to be a listref - convert it
        $class_desc->{$field_name} = [ %$value ];

    } elsif ($reftype ne 'ARRAY') {
        my $class_name = $class_desc->{class_name};
        Carp::croak "$class_name cannot initialize because its $field_name section is not a string, arrayref or hashref";

    }
}

sub _normalize_property_descriptions_during_normalize_class_description {
    my($class, $new_class) = @_;

    my $instance_properties = $new_class->{has};

    # normalize the data behind the property descriptions
    my @property_names = keys %$instance_properties;
    for my $property_name (@property_names) {
        my %old_property = %{ $instance_properties->{$property_name} };
        my %new_property = $class->_normalize_property_description1($property_name, \%old_property, $new_class);
        %new_property = $class->_normalize_property_description2(\%new_property, $new_class);
        $instance_properties->{$property_name} = \%new_property;
    }

    # Find 'via' properties where the to is '-filter' and rewrite them to
    # copy some attributes from the source property
    # This feels like a hack, but it makes other parts of the system easier by
    # not having to deal with -filter
    foreach my $property_name ( @property_names ) {
        my $property_data = $instance_properties->{$property_name};
        if ($property_data->{'to'} && $property_data->{'to'} eq '-filter') {
            my $via = $property_data->{'via'};
            my $via_property_data = $instance_properties->{$via};
            unless ($via_property_data) {
                my $class_name = $new_class->{class_name};
                Carp::croak "Cannot initialize class $class_name: Property '$property_name' filters '$via', but there is no property '$via'.";
            }

            $property_data->{'data_type'} = $via_property_data->{'data_type'};
            $property_data->{'reverse_as'} = $via_property_data->{'reverse_as'};
            if ($via_property_data->{'where'}) {
                unshift @{$property_data->{'where'}}, @{$via_property_data->{'where'}};
            }
        }
    }

    # Catch a mistake in the class definition where a property is 'via'
    # something, and its 'to' is the same as the via's reverse_as.  This
    # ends up being a circular definition and generates junk SQL
    foreach my $property_name ( @property_names ) {
        my $property_data = $instance_properties->{$property_name};
        my $via = $property_data->{'via'};
        my $to  = $property_data->{'to'};
        if (defined($via) and defined($to)) {
            my $via_property_data = $instance_properties->{$via};
            next unless ($via_property_data and $via_property_data->{'reverse_as'});
            if ($via_property_data->{'reverse_as'} eq $to) {
                my $class_name = $new_class->{class_name};
                Carp::croak("Cannot initialize class $class_name: Property '$property_name' defines "
                            . "an incompatible relationship.  Its 'to' is the same as reverse_as for property '$via'");
            }
        }
    }
}

sub _process_class_definition_property_keys {
    my($old_class, $new_class) = @_;

    my($class_name, $instance_properties, $meta_properties) = @$new_class{'class_name', 'has','attributes_have'};
    $class_name ||= $new_class->{role_name};  # This is used by role construction, too

    # Flatten and format the property list(s) in the class description.
    # NOTE: we normalize the details at the end of normalizing the class description.
    my @keys = _class_definition_property_keys_in_processing_order($old_class);
    foreach my $key ( @keys ) {
        # parse the key to see if we're looking at instance or meta attributes,
        # and take the extra words as additional attribute meta-data.
        my @added_property_meta;
        my $properties;
        if ($key =~ /has/) {
            @added_property_meta =
                grep { $_ ne 'has' } split(/[_-]/,$key);
            $properties = $instance_properties;
        }
        elsif ($key =~ /attributes_have/) {
            @added_property_meta =
                grep { $_ ne 'attributes' and $_ ne 'have' } split(/[_-]/,$key);
            $properties = $meta_properties;
        }
        elsif ($key eq 'id_implied') {
            # these are additions to the regular "has" list from complex identity properties
            $properties = $instance_properties;
        }
        else {
            die "Odd key $key?";
        }
        @added_property_meta = map { 'is_' . $_ => 1 } @added_property_meta;

        # the property data can be a string, array, or hash as they come in
        # convert string, hash and () into an array
        my $property_data = delete $old_class->{$key};

        my @tmp;
        if (!ref($property_data)) {
            if (defined($property_data)) {
                @tmp  = split(/\s+/, $property_data);
            }
            else {
                @tmp = ();
            }
        }
        elsif (ref($property_data) eq 'HASH') {
            @tmp = map {
                    ($_ => $property_data->{$_})
                } sort keys %$property_data;
        }
        elsif (ref($property_data) eq 'ARRAY') {
            @tmp = @$property_data;
        }
        else {
            die "Unrecognized data $property_data appearing as property list!";
        }

        # process the array of property specs
        my $pos = 0;
        while (my $name = shift @tmp) {
            my $params;
            if (ref($tmp[0])) {
                $params = shift @tmp;
                unless (ref($params) eq 'HASH') {
                    my $seen_type = ref($params);
                    Carp::confess("class $class_name property $name has a $seen_type reference instead of a hashref describing its meta-attributes!");
                }
                %$params = (@added_property_meta, %$params) if @added_property_meta;
            }
            else {
                $params = { @added_property_meta };
            }

            unless (exists $params->{'position_in_module_header'}) {
                $params->{'position_in_module_header'} = $pos++;
            }
            unless (exists $params->{is_specified_in_module_header}) {
                $params->{is_specified_in_module_header} = $class_name . '::' . $key;
            }

            # Indirect properties can mention the same property name more than once.  To
            # avoid stomping over existing property data with this other property data,
            # merge the new info into the existing hash.  Otherwise, the new property name
            # gets an empty hash of info
            if ($properties->{$name}) {
                # this property already exists, but is also implied by some other property which added it to the end of the listed
                # extend the existing definition
                foreach my $key ( keys %$params ) {
                    next if ($key eq 'is_specified_in_module_header' || $key eq 'position_in_module_header');
                    # once a property gets set to is_optional => 0, it stays there, even if it's later set to 1
                    next if ($key eq 'is_optional'
                             and
                             exists($properties->{$name}->{'is_optional'})
                             and
                             defined($properties->{$name}->{'is_optional'})
                             and
                             $properties->{$name}->{'is_optional'} == 0);
                    $properties->{$name}->{$key} = $params->{$key};
                }
                $params = $properties->{$name};
            } else {
                $properties->{$name} = $params;
            }

            # a single calculate_from can be a simple string, convert to a listref
            if (my $calculate_from = $params->{'calculate_from'}) {
                $params->{'calculate_from'} = [ $calculate_from ] unless (ref($calculate_from) eq 'ARRAY');
            }

            if (my $id_by = $params->{id_by}) {
                $id_by = [ $id_by ] unless ref($id_by) eq 'ARRAY';
                my @id_by_names;
                while (@$id_by) {
                    my $id_name = shift @$id_by;
                    my $params2;
                    if (ref($id_by->[0])) {
                        $params2 = shift @$id_by;
                    }
                    else {
                        $params2 = {};
                    }
                    for my $p (@UR::Object::Type::meta_id_ref_shared_properties) {
                        if (exists $params->{$p}) {
                            $params2->{$p} = $params->{$p};
                        }
                    }
                    $params2->{implied_by} = $name;
                    $params2->{is_specified_in_module_header} = 0;

                    push @id_by_names, $id_name;
                    push @tmp, $id_name, $params2;
                }
                $params->{id_by} = \@id_by_names;
            }

            if (my $id_class_by = $params->{'id_class_by'}) {
                if (ref $id_class_by) {
                    Carp::croak("Cannot initialize class $class_name: "
                                . "Property $name has an 'id_class_by' that is not a plain string");
                }
                push @tmp, $id_class_by, { implied_by => $name, is_specified_in_module_header => 0 };
            }

        } # next property in group

        # id-by properties' metadata can influence the id-ed-by property metadata
        for my $pdata (values %$properties) {
            next unless $pdata->{id_by};
            for my $id_property (@{ $pdata->{id_by} }) {
                my $id_pdata = $properties->{$id_property};
                for my $p (@UR::Object::Type::meta_id_ref_shared_properties) {
                    if (exists $id_pdata->{$p} xor exists $pdata->{$p}) {
                        # if one or the other specifies a value, copy it to the one that's missing
                        $id_pdata->{$p} = $pdata->{$p} = $id_pdata->{$p} || $pdata->{$p};
                    } elsif (!exists $id_pdata->{$p} and !exists $pdata->{$p} and exists $UR::Object::Property::defaults{$p}) {
                        # if neither has a value, use the default for both
                        $id_pdata->{$p} = $pdata->{$p} = $UR::Object::Property::defaults{$p};
                    }
                }
            }
        }

    }
}

sub compose_roles {
    my($class, $desc) = @_;

    UR::Role::Prototype->_apply_roles_to_class_desc($desc);
    $class->_normalize_property_descriptions_during_normalize_class_description($desc);
}

# Return the order to process the has, has_optional, has_constant, etc keys
sub _class_definition_property_keys_in_processing_order {
    my $class_hashref = shift;

    my @order;

    # we want to hit 'id_implied' first to preserve position_ and is_specified_ keys
    push(@order, 'id_implied') if exists $class_hashref->{id_implied};

    # 'has' next so is_optional can get set to 0 in case the same property also appears in has_optional
    push(@order, 'has') if exists $class_hashref->{has};

    # everything else
    push @order, grep { /has_|attributes_have/ } keys %$class_hashref;

    return @order;
}



sub _normalize_property_description1 {
    my $class = shift;
    my $property_name = shift;
    my $property_data = shift;
    my $class_data = shift || $class;
    my $class_name = $class_data->{class_name};
    my %old_property = %$property_data;
    my %new_class = %$class_data;

    if (exists $old_property{unrecognized_meta_attributes}) {
        %old_property = (%{delete $old_property{unrecognized_meta_attributes}}, %old_property);
    }

    delete $old_property{source};

    if ($old_property{implied_by} and $old_property{implied_by} eq $property_name) {
        $class->warning_message("Cleaning up odd self-referential 'implied_by' on $class_name $property_name");
        delete $old_property{implied_by};
    }

    # Only 1 of is_abstract, is_concrete or is_final may be set
    {
        no warnings 'uninitialized';
        my $modifier_sum = $old_property{is_abstract}
            + $old_property{is_concrete}
            + $old_property{is_final};

        if ($modifier_sum > 1) {
            Carp::confess("abstract/concrete/final are mutually exclusive.  Error in class definition for $class_name property $property_name!");
        } elsif ($modifier_sum == 0) {
            $old_property{is_concrete} = 1;
        }
    }

    my %new_property = (
        class_name => $class_name,
        property_name => $property_name,
    );

    for my $mapping (
        [ property_type                   => qw/resolution/],
        [ class_name                      => qw//],
        [ property_name                   => qw//],
        [ column_name                     => qw/sql/],
        [ constraint_name                 => qw//],
        [ data_length                     => qw/len/],
        [ data_type                       => qw/type is isa is_a/],
        [ calculated_default              => qw//],
        [ default_value                   => qw/default value/],
        [ valid_values                    => qw//],
        [ example_values                  => qw//],
        [ doc                             => qw/description/],
        [ is_optional                     => qw/is_nullable nullable optional/],
        [ is_transient                    => qw//],
        [ is_volatile                     => qw//],
        [ is_constant                     => qw//],
        [ is_classwide                    => qw/is_class_wide/],
        [ is_delegated                    => qw//],
        [ is_calculated                   => qw//],
        [ is_mutable                      => qw//],
        [ is_transactional                => qw//],
        [ is_abstract                     => qw//],
        [ is_concrete                     => qw//],
        [ is_final                        => qw//],
        [ is_many                         => qw//],
        [ is_deprecated                   => qw//],
        [ is_undocumented                 => qw//],
        [ is_numeric                      => qw//],
        [ is_id                           => qw//],
        [ id_by                           => qw//],
        [ id_class_by                     => qw//],
        [ specify_by                      => qw//],
        [ order_by                        => qw//],
        [ access_as                       => qw//],
        [ via                             => qw//],
        [ to                              => qw//],
        [ where                           => qw/restrict filter/],
        [ implied_by                      => qw//],
        [ calculate                       => qw//],
        [ calculate_from                  => qw//],
        [ calculate_perl                  => qw/calc_perl/],
        [ calculate_sql                   => qw/calc_sql/],
        [ calculate_js                    => qw//],
        [ reverse_as                      => qw/reverse_id_by im_its/],
        [ is_legacy_eav                   => qw//],
        [ is_dimension                    => qw//],
        [ is_specified_in_module_header   => qw//],
        [ position_in_module_header       => qw//],
        [ singular_name                   => qw//],
        [ plural_name                     => qw//],
    ) {
        my $primary_field_name = $mapping->[0];

        my $found_key;
        foreach my $key ( @$mapping ) {
            if (exists $old_property{$key}) {
                if ($found_key) {
                    my @keys = grep { exists $old_property{$_} }  @$mapping;
                    Carp::croak("Invalid class definition for $class_name in property '$property_name'.  The keys "
                                . join(', ',$found_key,@keys) . " are all synonyms for $primary_field_name");
                }
                $found_key = $key;
            }
        }

        if ($found_key) {
            $new_property{$primary_field_name} = delete $old_property{$found_key};
        } elsif (exists $UR::Object::Property::defaults{$primary_field_name}) {
            $new_property{$primary_field_name} = $UR::Object::Property::defaults{$primary_field_name};
        }
    }

    if (my $data = delete $old_property{delegate}) {
        if ($data->{via} =~ /^eav_/ and $data->{to} eq 'value') {
            $new_property{is_legacy_eav} = 1;
        }
        else {
            die "Odd delegation for $property_name: "
                . Data::Dumper::Dumper($data);
        }
    }

    if ($new_property{default_value} && $new_property{calculated_default}) {
        die qq(Can't initialize class $class_name: Property '$new_property{property_name}' has both default_value and calculated_default specified.);
    }

    if ($new_property{calculated_default}) {
        if ($new_property{calculated_default} eq 1) {
            $new_property{calculated_default} = '__default_' . $new_property{property_name} . '__';
        }

        my $ref = ref $new_property{calculated_default};
        if ($ref and $ref ne 'CODE') {
            die qq(Can't initialize class $class_name: Property '$new_property{property_name}' has calculated_default specified as a $ref ref but it must be a method name or coderef.);
        }

        unless ($ref) {
            my $method = $class_name->can($new_property{calculated_default});
            unless ($method) {
                die qq(Can't initialize class $class_name: Property '$new_property{property_name}' has calculated_default specified as '$new_property{calculated_default}' but method does not exist.);
            }
            $new_property{calculated_default} = $method;
        }
    }

    if ($new_property{id_by} && $new_property{reverse_as}) {
        die qq(Can't initialize class $class_name: Property '$new_property{property_name}' has both id_by and reverse_as specified.);
    }

    if ($new_property{data_type}) {
        if (my (undef, $length) = $new_property{data_type} =~ m/(\s*)\((\d+)\)$/) {
            $new_property{data_length} = $length;
        }
        if ($new_property{data_type} =~ m/[^\w:]/
            and
            (!ref($new_property{data_type}) or !$new_property{data_type}->isa('UR::Role::Param'))
        ) {
            Carp::croak("Can't initialize class $class_name: Property '" . $new_property{property_name}
                        . "' has metadata for is/data_type that does not look like a class name ($new_property{data_type})");
        }
    }

    if (%old_property) {
        $new_property{unrecognized_meta_attributes} = \%old_property;
        %new_property = (%old_property, %new_property);
    }

    return %new_property;
}

sub _normalize_property_description2 {
    my $class = shift;
    my $property_data = shift;
    my $class_data = shift || $class;

    my $property_name = $property_data->{property_name};
    my $class_name = $property_data->{class_name};

    my %new_property = %$property_data;
    my %new_class = %$class_data;

    if (grep { $_ ne 'is_calculated' && $_ ne 'calculated_default' && /calc/ } keys %new_property) {
        $new_property{is_calculated} = 1;
    }

    if ($new_property{via}
        || $new_property{to}
        || $new_property{id_by}
        || $new_property{reverse_as}
    ) {
        $new_property{is_delegated} = 1;
        if (defined $new_property{via} and not defined $new_property{to}) {
            $new_property{to} = $property_name;
        }
    }

    if (!defined($new_property{is_mutable})) {
        if ($new_property{is_delegated}
               or
             (defined $class_data->{'subclassify_by'} and $class_data->{'subclassify_by'} eq $property_name)
        ) {
            $new_property{is_mutable} = 0;
        }
        else {
            $new_property{is_mutable} = 1;
        }
    }

    # For classes that have (or pretend to have) tables, the Property objects
    # should get their column_name property automatically filled in
    my $the_data_source;
    if (ref($new_class{'data_source_id'}) eq 'HASH') {
        # This is an inline-defined data source
        $the_data_source = $new_class{'data_source_id'}->{'is'};
    } elsif ($new_class{'data_source_id'}) {
        $the_data_source = $new_class{'data_source_id'};
        # using local() here to save $@ doesn't work.  You end up with the
        # error "Unknown error" if one of the parent classes of the data source has
        # some kind of problem
        my $dollarat = $@;
        $@ = '';
        $the_data_source = UR::DataSource->get($the_data_source) || eval { $the_data_source->get() };
        unless ($the_data_source) {
            my $error = "Can't resolve data source from value '"
                        . $new_class{'data_source_id'}
                        . "' in class definition for $class_name";
            if ($@) {
                $error .= "\n$@";
            }
            Carp::croak($error);
        }
        $@ = $dollarat;
    }
    # UR::DataSource::File-backed classes don't have table_names, but for querying/saving to
    # work property, their properties still have to have column_name filled in
    if (($new_class{table_name} or ($the_data_source and ($the_data_source->initializer_should_create_column_name_for_class_properties())))
        and not exists($new_property{column_name})    # They didn't supply a column_name
        and not $new_property{is_transient}
        and not $new_property{is_delegated}
        and not $new_property{is_calculated}
        and not $new_property{is_legacy_eav}
    ) {
        $new_property{column_name} = $new_property{property_name};
        if ($the_data_source and $the_data_source->table_and_column_names_are_upper_case) {
            $new_property{column_name} = uc($new_property{column_name});
        }
    }

    if ($new_property{order_by} and not $new_property{is_many}) {
        die "Cannot use order_by except on is_many properties!";
    }

    if ($new_property{specify_by} and not $new_property{is_many}) {
        die "Cannot use specify_by except on is_many properties!";
    }

    if ($new_property{implied_by} and $new_property{implied_by} eq $property_name) {
        $class->warnings_message("New data has odd self-referential 'implied_by' on $class_name $property_name!");
        delete $new_property{implied_by};
    }

    return %new_property;
}


sub _make_minimal_class_from_normalized_class_description {
    my $class = shift;
    my $desc = shift;

    my $class_name = $desc->{class_name};
    unless ($class_name) {
        Carp::confess("No class name specified?");
    }

    my $meta_class_name = $desc->{meta_class_name};
    die unless $meta_class_name;
    if ($meta_class_name ne __PACKAGE__) {
        unless (
            $meta_class_name->isa(__PACKAGE__)
        ) {
            warn "Bogus meta class $meta_class_name doesn't inherit from UR::Object::Type?"
        }
    }

    # only do this when the classes match
    # when they do not match, the super-class has already called this by delegating to the correct subclass
    $class_name::VERSION = 2.0; # No BumpVersion

    my $self =  bless { id => $class_name, %$desc }, $meta_class_name;

    $UR::Context::all_objects_loaded->{$meta_class_name}{$class_name} = $self;
    my $full_name = join( '::', $class_name, '__meta__' );
    Sub::Install::reinstall_sub({
        into => $class_name,
        as   => '__meta__',
        code => Sub::Name::subname $full_name => sub {$self},
    });

    return $self;
}

sub _initialize_accessors_and_inheritance {
    my $self = shift;

    $self->initialize_direct_accessors;

    my $class_name = $self->{class_name};

    my @is = @{ $self->{is} };
    unless (@is) {
        @is = ('UR::ModuleBase')
    }
    eval "\@${class_name}::ISA = (" . join(',', map { "'$_'" } @is) . ")\n";
    Carp::croak("Can't initialize \@ISA for class_name '$class_name': $@\nMaybe the class_name or one of the parent classes are not valid class names") if $@;

    my $namespace_mro;
    my $namespace_name = $self->{namespace};
    if (
        !$bootstrapping
        && !$class_name->isa('UR::Namespace')
        && $namespace_name
        && $namespace_name->isa('UR::Namespace')
        && $namespace_name->can('get')
        && (my $namespace = $namespace_name->get())
    ) {
        $namespace_mro = $namespace->method_resolution_order;
    }

    if ($^V lt v5.9.5 && $namespace_mro && $namespace_mro eq 'c3') {
        warn "C3 method resolution order is not supported on Perl < 5.9.5. Reverting $namespace_name namespace to DFS.";
        my $namespace = $namespace_name->get();
        $namespace_mro = $namespace->method_resolution_order('dfs');
    }

    if ($^V ge v5.9.5 && $namespace_mro && mro::get_mro($class_name) ne $namespace_mro) {
        mro::set_mro($class_name, $namespace_mro);
    }

    return $self;
}

our %_init_subclasses_loaded;
sub subclasses_loaded {
    return @{ $_init_subclasses_loaded{shift->class_name}};
}

our %_inform_all_parent_classes_of_newly_loaded_subclass;
sub _inform_all_parent_classes_of_newly_loaded_subclass {
    my $self = shift;
    my $class_name = $self->class_name;

    Carp::confess("re-initializing class $class_name") if $_inform_all_parent_classes_of_newly_loaded_subclass{$class_name};
    $_inform_all_parent_classes_of_newly_loaded_subclass{$class_name} = 1;

    no strict 'refs';
    no warnings;
    my @parent_classes = @{ $class_name . "::ISA" };
    for my $parent_class (@parent_classes) {
        unless ($parent_class->can("id")) {
            __PACKAGE__->use_module_with_namespace_constraints($parent_class);
            if ($@) {
                die "Failed to find parent_class $parent_class for $class_name!";
            }
        }
    }

    my @i = sort $class_name->inheritance;
    $_init_subclasses_loaded{$class_name} ||= [];
    my $last_parent_class = "";
    for my $parent_class (@i) {
        next if $parent_class eq $last_parent_class;

        $last_parent_class = $parent_class;
        $_init_subclasses_loaded{$parent_class} ||= [];
        push @{ $_init_subclasses_loaded{$parent_class} }, $class_name;
        push @{ $parent_class . "::_init_subclasses_loaded" }, $class_name;

        # any index on a parent class must move to the child class
        # if the child class were loaded before the index is made, it is pushed down at index creation time
        if (my $parent_index_hashrefs = $UR::Object::Index::all_by_class_name_and_property_name{$parent_class}) {
            #print "PUSHING INDEXES FOR $parent_class to $class_name\n";
            for my $parent_property (keys %$parent_index_hashrefs) {
                my $parent_indexes = $parent_index_hashrefs->{$parent_property};
                my $indexes = $UR::Object::Index::all_by_class_name_and_property_name{$class_name}{$parent_property} ||= [];
                push @$indexes, @$parent_indexes;
            }
        }
    }

    return 1;
}

sub _inform_roles_of_new_class {
    my $self = shift;

    foreach my $role_obj ( @{ $self->{roles} } ) {
        my $package = $role_obj->role_name;
        next unless my $import = $package->can('__import__');
        $import->($package, $self);
    }
}

sub _complete_class_meta_object_definitions {
    my $self = shift;

    # track related objects
    my @subordinate_objects;

    # grab some data from the object
    my $class_name = $self->{class_name};
    my $table_name = $self->{table_name};

    # decompose the embedded complex data structures into normalized objects
    my $inheritance = $self->{is};
    my $properties = $self->{has};
    my $relationships = $self->{relationships} || [];
    my $constraints = $self->{constraints};
    my $data_source = $self->{'data_source_id'};

    my $id_properties = $self->{id_by};
    my %id_property_rank;
    for (my $i = '0 but true'; $i < @$id_properties; $i++) {
        $id_property_rank{$id_properties->[$i]} = $i;
    }

    # mark id/non-id properites
    foreach my $pinfo ( values %$properties ) {
        $pinfo->{'is_id'} = $id_property_rank{$pinfo->{'property_name'}};
    }

    # handle inheritance
    unless ($class_name eq "UR::Object") {
        no strict 'refs';

        # sanity check
        my @expected = @$inheritance;
        my @actual =  @{ $class_name . "::ISA" };

        if (@actual and "@actual" ne "@expected") {
            Carp::confess("for $class_name: expected '@expected' actual '@actual'\n");
        }

        # set
        @{ $class_name . "::ISA" } = @$inheritance;
    }

    if (not $data_source and $class_name->can("__load__")) {
        # $data_source = UR::DataSource::Default->__define__;
        $data_source = $self->{data_source_id} = $self->{db_committed}->{data_source_id} = 'UR::DataSource::Default';
    }

    # Create inline data source
    if ($data_source and ref($data_source) eq 'HASH') {
        $self->{'__inline_data_source_data'} = $data_source;
        my $ds_class = $data_source->{'is'};
        my $inline_ds = $ds_class->create_from_inline_class_data($self, $data_source);
        $self->{'data_source_id'} = $self->{'db_committed'}->{'data_source_id'} = $inline_ds->id;
    }


    if ($self->{'data_source_id'} and !defined($self->{table_name})) {
        my $data_source_obj = UR::DataSource->get($self->{'data_source_id'}) || eval { $self->{'data_source_id'}->get() };
        if ($data_source_obj and $data_source_obj->initializer_should_create_column_name_for_class_properties() ) {
            $self->{table_name} = '__default__';
        }
    }

    for my $parent_class_name (@$inheritance) {
        my $parent_class = $parent_class_name->__meta__;
        unless ($parent_class) {
            #$DB::single = 1;
            $parent_class = $parent_class_name->__meta__;
            $self->error_message("Failed to find parent class $parent_class_name\n");
            return;
        }

        # These class meta values get propogated from parent to child
        foreach my $inh_property ( qw(schema_name data_source_id) ) {
            if (not defined ($self->$inh_property)) {
                if (my $inh_value = $parent_class->$inh_property) {
                    $self->{$inh_property} = $self->{'db_committed'}->{$inh_property} = $inh_value;
                }
            }
        }

        # For classes with no data source, the default for id_generator is -urinternal
        # For classes with a data source, autogenerate_new_object_id_for_class_name_and_rule gets called
        # on that data source which can use id_generator as it sees fit
        if (! defined $self->{id_generator}) {
            my $id_generator;
            if ($self->{data_source_id}) {
                if ($parent_class->data_source_id
                    and
                    $parent_class->data_source_id eq $self->data_source_id
                ) {
                    $id_generator = $parent_class->id_generator;
                }
            } else {
                $id_generator = $parent_class->id_generator;
            }
            $self->{id_generator} = $self->{'db_committed'}->{id_generator} = $id_generator;
        }


        # If a parent is declared as a singleton, we are too.
        # This only works for abstract singletons.
        if ($parent_class->is_singleton and not $self->is_singleton) {
            $self->is_singleton($parent_class->is_singleton);
        }
    }

    # when we "have" an object reference, add it to the list of old-style references
    # also ensure the old-style property definition is complete
    for my $pinfo (grep { $_->{id_by} } values %$properties) {
        push @$relationships, $pinfo->{property_name}, $pinfo;

        my $id_properties = $pinfo->{id_by};
        my $r_class_name = $pinfo->{data_type};
        unless($r_class_name) {
            die sprintf("Object accessor property definition for %s::%s has an 'id_by' but no 'data_type'",
                                  $pinfo->{'class_name'}, $pinfo->{'property_name'});
        }
        my $r_class;
        my @r_id_properties;

        for (my $n=0; $n<@$id_properties; $n++) {
            my $id_property_name = $id_properties->[$n];
            my $id_property_detail = $properties->{$id_property_name};
            unless ($id_property_detail) {
                #$DB::single = 1;
                1;
            }

            # No data_type specified, first try parent classes for the same property name
            # and use their type
            if (!$bootstrapping and !exists($id_property_detail->{data_type})) {
                if (my $inh_prop = ($self->ancestry_property_metas(property_name => $id_property_name))[0]) {
                    $id_property_detail->{data_type} = $inh_prop->data_type;
                }
            }

            # Didn't find one - use the data type of the ID property(s) in the class we point to
            unless ($id_property_detail->{data_type}) {
                unless ($r_class) {
                    # FIXME - it'd be nice if we didn't have to load the remote class here, and
                    # instead put off loading until it's necessary
                    $r_class ||= UR::Object::Type->get($r_class_name);
                    unless ($r_class) {
                        Carp::confess("Unable to load $r_class_name while defining relationship ".$pinfo->{'property_name'}. " in class $class_name");
                    }
                    @r_id_properties = $r_class->id_property_names;
                }
                my ($r_property) =
                    map {
                        my $r_class_ancestor = UR::Object::Type->get($_);
                        my $data = $r_class_ancestor->{has}{$r_id_properties[$n]};
                        ($data ? ($data) : ());
                    }
                    ($r_class_name, $r_class_name->__meta__->ancestry_class_names);
                unless ($r_property) {
                    #$DB::single = 1;
                    my $property_name = $pinfo->{'property_name'};
                    if (@$id_properties != @r_id_properties) {
                        Carp::croak("Can't resolve relationship for class $class_name property '$property_name': "
                                    . "id_by metadata has " . scalar(@$id_properties) . " items, but remote class "
                                    . "$r_class_name only has " . scalar(@r_id_properties) . " ID properties\n");
                    } else {
                        my $r_id_property = $r_id_properties[$n] ? "'$r_id_properties[$n]'" : '(undef)';
                        Carp::croak("Can't resolve relationship for class $class_name property '$property_name': "
                                    . "Class $r_class_name does not have an ID property named $r_id_property, "
                                    . "which would be linked to the local property '".$id_properties->[$n]."'\n");
                    }
                }
                $id_property_detail->{data_type} = $r_property->{data_type};
            }
        }
        next;
    }

    # make old-style (bc4nf) property objects in the default way
    my %property_objects;

    for my $pinfo (values %$properties) {
        my $property_name       = $pinfo->{property_name};
        my $property_subclass   = $pinfo->{property_subclass};

        # Acme::Employee::Attribute::Name is a bc6nf attribute
        # extends Acme::Employee::Attribute
        # extends UR::Object::Attribute
        # extends UR::Object
        my @words = map { ucfirst($_) } split(/_/,$property_name);
        #@words = $self->namespace->get_vocabulary->convert_to_title_case(@words);
        my $bridge_class_name =
            $class_name
            . "::Attribute::"
            . join('', @words);

        # Acme::Employee::Attribute::Name::Type is both the class definition for the bridge,
        # and also the attribute/property metadata for
        my $property_meta_class_name = $bridge_class_name . "::Type";

        # define a new class for the above, inheriting from UR::Object::Property
        # all of the "attributes_have" get put into the class definition
        # call the constructor below on that new class
        #UR::Object::Type->__define__(
        ##    class_name => $property_meta_class_name,
        #    is => 'UR::Object::Property', # TODO: go through the inheritance
        #    has => [
        #        @{ $class_name->__meta__->{attributes_have} }
        #    ]
        #)

        my ($singular_name,$plural_name);
        unless ($pinfo->{plural_name} and $pinfo->{singular_name}) {
            require Lingua::EN::Inflect;
            if ($pinfo->{is_many}) {
                $plural_name = $pinfo->{plural_name} ||= $pinfo->{property_name};
                $pinfo->{singular_name} = Lingua::EN::Inflect::PL_V($plural_name);
            }
            else {
                $singular_name = $pinfo->{singular_name} ||= $pinfo->{property_name};
                $pinfo->{plural_name} = Lingua::EN::Inflect::PL($singular_name);
            }
        }

        my $property_object = UR::Object::Property->__define__(%$pinfo, id => $class_name . "\t" . $property_name);

        unless ($property_object) {
            $self->error_message("Error creating property $property_name for class " . $self->class_name . ": " . $class_name->error_message);
            for $property_object (@subordinate_objects) { $property_object->unload }
            $self->unload;
            return;
        }

        $property_objects{$property_name} =  $property_object;
        push @subordinate_objects, $property_object;
    }

    if ($constraints) {
        my $property_rule_template = UR::BoolExpr::Template->resolve('UR::Object::Property','class_name','property_name');

        my $n = 1;
        for my $unique_set (sort { $a->{sql} cmp $b->{sql} } @$constraints) {
            my ($name,$properties,$group,$sql);
            if (ref($unique_set) eq "HASH") {
                $name = $unique_set->{name};
                $properties = $unique_set->{properties};
                $sql = $unique_set->{sql};
                $name ||= $sql;
            }
            else {
                $properties = @$unique_set;
                $name = '(unnamed)';
                $n++;
            }
            for my $property_name (sort @$properties) {
                my $prop_rule = $property_rule_template->get_rule_for_values($class_name,$property_name);
                my $property = $UR::Context::current->get_objects_for_class_and_rule('UR::Object::Property', $prop_rule);
                unless ($property) {
                    Carp::croak("Constraint '$name' on class $class_name requires unknown property '$property_name'");
                }
            }
        }
    }

    for my $obj ($self,@subordinate_objects) {
        #use Data::Dumper;
        no strict;
        my %db_committed = %$obj;
        delete @db_committed{@keys_to_delete_from_db_committed};
        $obj->{'db_committed'} = \%db_committed;

    };

    unless ($self->generate) {
        $self->error_message("Error generating class " . $self->class_name . " as part of creation : " . $self->error_message);
        for my $property_object (@subordinate_objects) { $property_object->unload }
        $self->unload;
        return;
    }

    if (my $extra = $self->{extra}) {
        $self->_apply_extra_attrs_to_class_or_role($extra);
    }

    $self->__signal_change__("load");


    my @i = $class_name->inheritance;

    for my $parent_class_name (@i) {
        if ($parent_class_name->can('__signal_observers__')) {
            $parent_class_name->__signal_observers__('subclass_loaded', $class_name);
        }
    }

    # The inheritance method is high overhead because of the number of times it is called.
    # Cache on a per-class basis.
    if (grep { $_ eq '' } @i) {
        print "$class_name! @{ $self->{is} }";
        $class_name->inheritance;
    }
    Carp::confess("Odd inheritance @i for $class_name") unless $class_name->isa('UR::Object');
    my $src1 = " return shift->SUPER::inheritance(\@_) if ( (ref(\$_[0])||\$_[0]) ne '$class_name');  return (" . join(", ", map { "'$_'" } (@i)) . ")";
    my $src2 = qq|sub ${class_name}::inheritance { $src1 }|;
    eval $src2  unless $class_name eq 'UR::Object';
    die $@ if $@;

    $self->{'_property_meta_for_name'} = \%property_objects;

    # return the new class object
    return $self;
}

sub _apply_extra_attrs_to_class_or_role {
    my($self, $extra) = @_;

    if ($extra) {
        # some class characteristics may be only present in subclasses of UR::Object
        # we handle these at this point, since the above is needed for bootstrapping
        my %still_not_found;
        for my $key (sort keys %$extra) {
            if ($self->can($key)) {
                $self->$key($extra->{$key});
            }
            else {
                $still_not_found{$key} = $extra->{$key};
            }
        }
        if (%still_not_found) {
            my $kind = $self->isa('UR::Object::Type')
                        ? 'Class'
                        : 'Role';
            my $name = $self->id;

            $DB::single = 1;
            Carp::croak("Bad $kind defninition for $name.  Unrecognized properties:\n\t"
                            . join("\n\t", join(' => ', map { ($_, $still_not_found{$_}) } keys %still_not_found)));
        }
    }


}

# write the module from the existing data in the class object
sub generate {
    my $self = shift;
    return 1 if $self->{'generated'};

    #my %params = @_;   # Doesn't seem to be used below...


    # The follwing code will override a lot intentionally.
    # Supress the warning messages.
    no warnings;

    # the class that this object represents
    # the class that we're going to generate
    # the "new class"
    my $class_name = $self->class_name;

    # this is done earlier in the class definition process in _make_minimal_class_from_normalized_class_description()
    my $full_name = join( '::', $class_name, '__meta__' );
    Sub::Install::reinstall_sub({
        into => $class_name,
        as   => '__meta__',
        code => Sub::Name::subname $full_name => sub {$self},
    });

    my @parent_class_names = $self->parent_class_names;

    do {
        no strict 'refs';
        if (@{ $class_name . '::ISA' }) {
            #print "already have isa for class_name $class_name: " . join(",",@{ $class_name . '::ISA' }) . "\n";
        }
        else {
            no strict 'refs';
            @{ $class_name . '::ISA' } = @parent_class_names;
            #print "setting isa for class_name $class_name: " . join(",",@{ $class_name . '::ISA' }) . "\n";
        };
    };


    my ($props, $cols) = ([], []);  # for _all_properties_columns()
    $self->{_all_properties_columns} = [$props, $cols];

    my $id_props = [];              # for _all_id_properties()
    $self->{_all_id_properties} = $id_props;

    # build the supplemental classes
    for my $parent_class_name (@parent_class_names) {
        next if $parent_class_name eq "UR::Object";

        if ($parent_class_name eq $class_name) {
            Carp::confess("$class_name has parent class list which includes itself?: @parent_class_names\n");
        }

        my $parent_class_meta = UR::Object::Type->get(class_name => $parent_class_name);

        unless ($parent_class_meta) {
            #$DB::single = 1;
            $parent_class_meta = UR::Object::Type->get(class_name => $parent_class_name);
            Carp::confess("Cannot generate $class_name: Failed to find class meta-data for base class $parent_class_name.");
        }

        unless ($parent_class_meta->generated()) {
            $parent_class_meta->generate();
        }

        unless ($parent_class_meta->{_all_properties_columns}) {
            Carp::confess("No _all_properties_columns for $parent_class_name?");
        }

        # inherit properties and columns
        my ($p, $c) = @{ $parent_class_meta->{_all_properties_columns} };
        push @$props, @$p if $p;
        push @$cols, @$c if $c;
        my $id_p = $parent_class_meta->{_all_id_properties};
        push @$id_props, @$id_p if $id_p;
    }


    # set up accessors/mutators for properties
    my @property_objects =
        UR::Object::Property->get(class_name => $self->class_name);

    my @id_property_objects = $self->direct_id_property_metas;
    my %id_property;
    for my $ipo (@id_property_objects) {
        $id_property{$ipo->property_name} = 1;
    }

    if (@id_property_objects) {
        $id_props = [];
        for my $ipo (@id_property_objects) {
            push @$id_props, $ipo->property_name;
        }
    }

    my $has_table;
    my @parent_classes = map { UR::Object::Type->get(class_name => $_) } @parent_class_names;
    for my $co ($self, @parent_classes) {
        if ($co->table_name) {
            $has_table = 1;
            last;
        }
    }

    my $data_source_obj = $self->data_source;
    my $columns_are_upper_case;
    if ($data_source_obj) {
        $columns_are_upper_case = $data_source_obj->table_and_column_names_are_upper_case;
    }

    my @sort_list = map { [$_->property_name, $_] } @property_objects;
    for my $sorted_item ( sort { $a->[0] cmp $b->[0] } @sort_list ) {
        my $property_object = $sorted_item->[1];
        if ($property_object->column_name) {
            push @$props, $property_object->property_name;
            push @$cols, $columns_are_upper_case ? uc($property_object->column_name) : $property_object->column_name;
        }
    }

    # set the flag to prevent this from occurring multiple times.
    $self->generated(1);

    # read in filesystem package if there is one
    #$self->use_filesystem_package($class_name);

    # Let each class in the inheritance hierarchy do any initialization
    # required for this class.  Note that the _init_subclass method does
    # not call SUPER::, but relies on this code to find its parents.  This
    # is the only way around a sparsely-filled multiple inheritance tree.

    # TODO: Replace with $class_name->EVERY::LAST::_init_subclass()

    #unless (
    #    $bootstrapping
    #    and
    #    $UR::Object::_init_subclass->{$class_name}
    #)
    {
        my @inheritance = $class_name->inheritance;
        my %done;
        for my $parent (reverse @inheritance) {
            my $initializer = $parent->can("_init_subclass");
            next unless $initializer;
            next if $done{$initializer};
            $initializer->($class_name,$class_name)
                    or die "Parent class $parent failed to initialize subclass "
                        . "$class_name :" . $parent->error_message;
            $done{$initializer} = 1;
        }
    }

    unless ($class_name->isa("UR::Object")) {
        print Data::Dumper::Dumper('@C::ISA',\@C::ISA,'@B::ISA',\@B::ISA);
    }

    # ensure the class is generated
    die "Error in module for $class_name.  Resulting class does not appear to be generated!" unless $self->generated;

    # ensure the class inherits from UR::Object
    die "$class_name does not inherit from UR::Object!" unless $class_name->isa("UR::Object");

    return 1;
}


1;