# Copyright (c) 1999-2006 bivio Software, Inc.  All rights reserved.
#
# Visit http://www.bivio.biz for more info.
# 
# This library is free software; you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation; either version 2.1 of the
# License, or (at your option) any later version.
# 
# This library is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public
# License along with this library;  If not, you may get a copy from:
# http://www.opensource.org/licenses/lgpl-license.html
# 
# $Id: Model.pm,v 2.21 2006/11/24 22:57:12 nagler Exp $
package Bivio::Biz::Model;
use strict;
use Bivio::Base 'Bivio::Collection::Attributes';
use Bivio::Die;
use Bivio::HTML;
use Bivio::IO::ClassLoader;
use Bivio::IO::Trace;
use Bivio::SQL::Statement;

# C<Bivio::Biz::Model> is more interface than implementation, it provides
# a common set of methods for L<Bivio::Biz::PropertyModel>,
# L<Bivio::Biz::ListModel>, L<Bivio::Biz::FormModel>.

our($VERSION) = sprintf('%d.%02d', q$Revision: 0.0$ =~ /\d+/g);
our($_TRACE);
my($_IDI) = __PACKAGE__->instance_data_index;
#my(%_CLASS_INFO);
my($_LOADED_ALL_PROPERTY_MODELS);

sub OPTIONS {
    # : hash_ref
    # Adds the I<-checkout> and I<-package_dir> options.
    my($proto) = @_;
    my($res) = $proto->SUPER::OPTIONS;
    $res->{package_dir} = ['Line', undef];
    $res->{checkout} = ['Boolean', 0];
    return $res;
}

sub as_string {
    # (self) : string
    # Pretty prints an identifier for this model.
    my($self) = @_;
    my($ci) = $self->[$_IDI]->{class_info};
    # All primary keys must be defined or just return ref($self).
    return ref($self) . '(' . join(',', map {
	return ref($self) unless defined($_);
	$_;
    } $self->unsafe_get(@{$ci->{as_string_fields}})) . ')';
}

sub assert_not_singleton {
    # (self) : undef
    # Throws an exception if this is the singleton instance.
    my($fields) = shift->[$_IDI];
    die("can't create, update, read, or delete singleton instance")
	if $fields->{is_singleton};
    return;
}

sub clone {
    # (self) : undef
    # Not supported.
    die('not supported');
}

sub delete {
    # (self) : undef
    # Not supported.
    die('not supported');
}

sub delete_from_request {
    # (self) : undef
    # Deletes I<self> from request.  Reverses L<put_on_request|"put_on_request">.
    my($self) = @_;
    my($req) = $self->unsafe_get_request;
    return unless $req;

    # ref($self) for backward compatibility
    foreach my $key ('Model.'.$self->simple_package_name, ref($self)) {
	$req->delete($key => $self);
    }
    return;
}

sub die {
    # (self, string, ...) : undef
    # Calls L<throw_die|"throw_die"> with code DIE and message as (safe) concat
    # of args.
    my($self, @args) = @_;
    $self->throw_die('DIE', {
#TODO: format, not die
	message => Bivio::Die->die(@args),
	program_error => 1,
    },
	    caller);
    # DOES NOT RETURN
}

sub do_iterate {
    # (self, code_ref, any, ...) : self
    # (self, code_ref, string, any, ...) : self
    # Like L<map_iterate|"map_iterate"> but does not return anything.  For each row,
    # calls L<iterate_next_and_load|"iterate_next_and_load"> followed by
    # L<do_iterate_handler|"do_iterate_handler">.  Terminates the iteration with
    # L<iterate_end|"iterate_end"> when there are no more rows or if
    # I<do_iterate_handler> returns false.
    my($self, $do_iterate_handler) = (shift, shift);
    my($iterate_start) = $_[0] && !ref($_[0]) && $_[0] =~ /iterate_start/
	&& $self->can($_[0]) ? shift : 'iterate_start';
    $self->$iterate_start(@_);
    0 while $self->iterate_next_and_load && $do_iterate_handler->($self);
    $self->iterate_end;
    return $self;
}

sub format_uri_for_this_property_model {
    # (self, any, string) : string
    # Formats a uri for I<task> and model I<name> of I<self>.  Blows up if not all
    # the primary keys are available for I<model_name>.  Doesn't load the I<model>.
    # I<task> can be a name or L<Bivio::Agent::TaskId|Bivio::Agent::TaskId>.
    my($self, $task, $name) = @_;
    $task = Bivio::Agent::TaskId->from_name($task) unless ref($task);
    my($query, $mi) = _get_model_query($self, $name);
    $self->throw_die('MODEL_NOT_FOUND', {
	message => 'missing primary keys in self for model', entity => $name})
	unless $query;
    return $self->get_request->format_uri(
	$task, $mi->format_query_for_this($query), undef, undef);
}

sub get_as {
    # (self, string, string) : undef
    # Returns I<field> using the I<converter> (to_xml, to_string).
    my($self, $field, $format) = @_;
    return $self->get_field_info($field, 'type')->$format($self->get($field));
}

sub get_field_constraint {
    # (self, string) : SQL.Constraint
    # Returns the constraint for this field.
    #
    # Calls L<get_field_info|"get_field_info">, so subclasses only need
    # to override C<get_field_info>.
    return shift->get_field_info(shift, 'constraint');
}

sub get_field_info {
    # (self, string, string) : any
    # Returns I<attr> for I<field>.
    return shift->[$_IDI]->{class_info}->{sql_support}
	    ->get_column_info(@_);
}

sub get_field_type {
    # (self, string) : Bivio.Type
    # Returns the type of this field.
    #
    # Calls L<get_field_info|"get_field_info">, so subclasses only need
    # to override C<get_field_info>.
    return shift->get_field_info(shift, 'type');
}

sub get_info {
    # (self, string) : any
    # Returns meta information about the model.
    #
    # B<Do not modify references returned by this method.>
    return shift->[$_IDI]->{class_info}->{sql_support}->get(shift);
}

sub get_instance {
    # (proto) : Biz.Model
    # (proto, any) : Biz.Model
    # Returns the singleton for I<class>.  If I<class> is supplied, it may be just
    # the simple name or a fully qualified class name.  It will be loaded with
    # L<Bivio::IO::ClassLoader|Bivio::IO::ClassLoader> using the I<Model> map.
    # I<class> may also be an instance of a model.
    #
    # May not be called on anonymous Models without I<class> argument.
    my($proto, $class) = @_;
    if (defined($class)) {
	$class = Bivio::IO::ClassLoader->map_require('Model', $class)
		unless ref($class);
	$class = ref($class) if ref($class);
    }
    else {
	$class = ref($proto) || $proto;
    }
#     _initialize_class_info($class) unless $_CLASS_INFO{$class};
#     return $_CLASS_INFO{$class}->{singleton};
    return _get_class_info($class)->{singleton};
}

sub get_model {
    # (self, string) : Biz.PropertyModel
    # Same as L<unsafe_get_model|"unsafe_get_model">, but dies if
    # the model could not be loaded.
    my($self) = @_;
    my($model) = shift->unsafe_get_model(@_);
    $self->throw_die('MODEL_NOT_FOUND', {
	message => 'unable to load model', entity => $model})
	    unless $model->is_loaded;
    return $model;
}

sub get_qualified {
    # (self, string) : any
    # Returns the qualified field value if it exists or strips the model from
    # I<field> and tries to get unqualified.
    my($self, $field) = @_;
    return $self->has_keys($field) ? $self->get($field)
	: $self->get(($field =~ /(?<=\.)(\w+)$/)[0]
	    || $self->die($field, ': not a qualified name'));
}

sub get_request {
    # (proto) : Agent.Request
    # Returns the request associated with this model.
    # If not set, returns the current request.
    # If neither set, throws an exception.
    my($self) = @_;
    my($req) = $self->unsafe_get_request;
    Bivio::Die->die($self, ": request not set") unless $req;
    return $req;
}

sub has_fields {
    # (self, string, ...) : boolean
    # Does the model have these fields?
    return shift->[$_IDI]->{class_info}->{sql_support}
	    ->has_columns(@_);
}

sub has_iterator {
    # (self) : boolean
    # Returns true if there is an iterator started on this model.
    my($self) = @_;
    my($fields) = $self->[$_IDI];
    return $fields->{iterator} ? 1 : 0;
}

sub internal_clear_model_cache {
    # (self) : undef
    # Called to clear the cache of models.  Necessary
    # when a reload occurs.
    my($self) = @_;
    my($fields) = $self->[$_IDI];
    delete($fields->{models});
    return;
}

sub internal_get_iterator {
    # (self) : DBI.st
    # Returns the iterator.
    my($self) = @_;
    return $self->[$_IDI]->{iterator} || $self->die('iteration not started');
}

sub internal_get_sql_support {
    # (self) : SQL.Support
    # Returns L<Bivio::SQL::Support|Bivio::SQL::Support> for this instance
    # only if this is not the singleton.  If it is the singleton, dies.
    my($self) = @_;
    my($fields) = $self->[$_IDI];
    $self->assert_not_singleton if $fields->{is_singleton};
    return $fields->{class_info}->{sql_support};
}

sub internal_get_statement {
    # (self) : SQL.Statement
    # Returns L<Bivio::SQL::Statement|Bivio::SQL::Statement> for this instance.
    my($self) = @_;
    my($fields) = $self->[$_IDI];
    $self->assert_not_singleton if $fields->{is_singleton};
    return $fields->{class_info}->{statement};
}

sub internal_initialize {
    # (proto) : hash_ref
    # B<FOR INTERNAL USE ONLY.>
    #
    # Returns an hash_ref describing the model suitable for passing
    # to L<Bivio::SQL::PropertySupport::new|Bivio::SQL::PropertySupport/"new">
    # or L<Bivio::SQL::ListSupport::new|Bivio::SQL::ListSupport/"new">.
    return (caller(1))[3] =~ /::internal_initialize$/ ? {}
	: Bivio::Die->die(
	    shift, ': abstract method; internal_initialize must be defined');
}

sub internal_initialize_local_fields {
    # (proto, array_ref, any, any) : array_ref
    # (proto, string, array_ref, string, array_ref, ..., any, any) : array_ref
    # Provides positional shortcut for generating field declarations to pass return
    # from L<internal_initialize|"internal_initialize">.  I<decls> is a array of
    # arrays.  Each element is a field declaration that is a tuple of (name, type,
    # constraint).  If type or constraint is undef, will be initialized with default
    # values.  If both type or constraint is missing, element may be a string.
    # I<default_type> and <default_constraint> must be defined if I<decls>
    # requires default values.
    #
    # In the second form, you may specify the class as an argument.  This also allows
    # you to declare multiple (class, decl) tuples which can be convenient for
    # forms with all local fields.
    #
    # Examples:
    #
    #     $self->internal_initialize_local_fields([
    #         'first_name',
    #         'middle_name',
    #         'last_name',
    #         [qw(gender Gender)],
    #     ], 'Line', 'NOT_NULL');
    #
    #     $self->internal_initialize_local_fields([
    #         ['count', 'Integer', 'NOT_NULL'],
    #     ]);
    #
    #     $self->internal_initialize_local_fields(
    #         visible => [
    # 	    'first_name',
    # 	    'middle_name',
    # 	    'last_name',
    # 	    [qw(gender Gender)],
    # 	],
    #         hidden => [
    #             ['count', 'Integer', 'NOT_NULL'],
    #         ],
    #         'Line', 'NOT_NULL');
    my($proto, $decls, $default_type, $default_constraint) = @_;
    return [
	map({
	    $_ = [$_]
	    unless ref($_);
	    {
		name => $_->[0],
		type => $_->[1] || $default_type
		    || $proto->die('default_type must be defined'),
		constraint => $_->[2] || $default_constraint
		    || $proto->die('default_constraint must be defined'),
	    };
	} @$decls)
    ] if ref($decls) eq 'ARRAY';
    my($aux) = [];
    unshift(@$aux, pop(@_))
	while !ref($_[$#_]);
    Bivio::Die->die('expecting class and declarations')
	unless @_ > 1;
    shift(@_);
    Bivio::Die->die('uneven (class, declarations) tuples')
        if @_ % 2;
    return [
	map({
	    (shift(@_) => $proto->internal_initialize_local_fields(
		shift(@_), @$aux));
	} 1 .. @_ / 2),
    ];
}

sub internal_initialize_sql_support {
    # (proto, SQL.Statement) : SQL.Support
    # (proto, SQL.Statement, hash_ref) : SQL.Support
    # B<FOR INTERNAL USE ONLY>.
    #
    # Returns the L<Bivio::SQL::Support|Bivio::SQL::Support> object
    # for this model.
    Bivio::Die->die(shift, ': abstract method');
}

sub internal_iterate_next {
    # (self, hash_ref, string) : array
    # Returns (I<self>, I<row>) on success or () if no more.
    my($self, $it, $row, $converter) = @_;
    if (ref($it) eq 'HASH') {
	$converter = $row;
	$row = $it;
	$it = $self->internal_get_iterator;
    }
    else {
	# deprecated form
    }
    return $self->internal_get_sql_support->iterate_next(
	$self, $it, $row, $converter) ? ($self, $row) : ();
}

sub internal_put_iterator {
    # (self, DBI.st) : DBI.st
    # Sets the iterator and returns its argument.
    my($self, $it) = @_;
    return $self->[$_IDI]->{iterator} = $it;
}

sub is_instance {
    # (proto) : undef
    # Returns true if is a normal instance and not singleton or class.
    my($self) = @_;
    return !ref($self) || $self->[$_IDI]->{is_singleton} ? 0 : 1;
}

sub iterate_end {
    # (self) : undef
    # Terminates the iterator.  See L<iterate_start|"iterate_start">.
    # Does not modify model state, i.e. if loaded, stays loaded.
    #
    # B<Deprecated form accepts an iterator as the first argument.>
    my($self, $it) = @_;
    my($fields) = $self->[$_IDI];
    $self->internal_get_sql_support->iterate_end(
       $it || $self->internal_get_iterator);
    # Deprecated form passes in an iterator, which can only clear
    # if the caller hasn't "changed" iterators.
    $fields->{iterator} = undef
	if !$it || $fields->{iterator} && $it == $fields->{iterator};
    return;
}

sub iterate_next {
    # (self, hash_ref) : boolean
    # (self, hash_ref, string) : boolean
    # I<row> is the resultant values by field name.
    # I<converter> is optional and is the name of a
    # L<Bivio::Type|Bivio::Type> method, e.g. C<to_html>.
    #
    # Returns false if there is no next.
    #
    # B<Deprecated form accepts an iterator as the first argument.>
    return shift->internal_iterate_next(@_) ? 1 : 0;
}

sub map_iterate {
    # (self, code_ref, any, ...) : array_ref
    # (self, code_ref, string, any, ...) : array_ref
    # Calls L<iterate_start|"iterate_start"> or I<iterate_start> (if supplied)
    # to start the iteration with I<iterate_args>.  For each row, calls
    # L<iterate_next_and_load|"iterate_next_and_load"> followed by
    # L<map_iterate_handler|"map_iterate_handler">.  Terminates the iteration with
    # L<iterate_end|"iterate_end">.
    #
    # Returns the aggregated result of L<map_iterate_handler|"map_iterate_handler">
    # as an array_ref, calling L<get_shallow_copy|"get_shallow_copy"> to get each
    # row's values.
    #
    # If I<map_iterate_handler> is C<undef>, the default handler simply returns all
    # the rows.
    my($self, $map_iterate_handler) = (shift, shift);
    my($iterate_start) = $_[0] && !ref($_[0]) && $_[0] =~ /iterate_start/
	&& $self->can($_[0]) ? shift : 'iterate_start';
    my($res) = [];
    $self->$iterate_start(@_);
    $map_iterate_handler ||= sub {
	return shift->get_shallow_copy;
    };
    while ($self->iterate_next_and_load) {
	push(@$res, $map_iterate_handler->($self));
    }
    $self->iterate_end;
    return $res;
}

sub merge_initialize_info {
    # (proto, hash_ref, hash_ref) : hash_ref
    # Merges two model field definitions (I<child> into I<parent>) into a new
    # hash_ref.
    my($proto, $parent, $child) = @_;
    my($res) = {%$child};
    foreach my $k (keys(%$parent)) {
	if (
	    ref($parent->{$k}) ne 'ARRAY'
	    || $k =~ /^(auth_id|date|primary_id|primary_key)$/,
        ) {
	    $res->{$k} = $parent->{$k}
		unless exists($res->{$k});
	}
	else {
	    # Parent takes precedence on arrays
	    unshift(@{$res->{$k} ||= []}, @{$parent->{$k}});
	}
    }
    return $res;
}

sub new {
    # (proto) : Biz.Model
    # (proto, string) : Biz.Model
    # (proto, Agent.Request) : Biz.Model
    # (proto, Agent.Request, string) : Biz.Model
    # Creates a Model with I<req>, if supplied.  The class of the model is defined by
    # C<$proto>.  If I<class> is supplied, L<get_instance|"get_instance"> is called
    # with I<class> as its argument and the resultant class is instantiated.
    my($proto, $req, $class) = _new_args(@_);
    return $proto->get_instance($class)->new($req)
	if defined($class);
    $class = ref($proto) || $proto;
#     _initialize_class_info($class)
#         unless $_CLASS_INFO{$class};
#     my($ci) = $_CLASS_INFO{$class};
    my($ci) = _get_class_info($class);

    # Make a copy of the properties for this instance.  properties
    # is an array_ref for efficiency
    my($self) = Bivio::Collection::Attributes::new($class,
	    {@{$ci->{properties}}});
    $self->[$_IDI] = {
	class_info => $ci,
        request => $req || (ref($proto) ? $proto->unsafe_get_request : undef),
    };
    return $self;
}

sub new_anonymous {
    # (proto, hash_ref) : Biz.Model
    # (proto, hash_ref, Agent.Request) : Biz.Model
    # Creates an "anonymous" Model.  There are two modes: initialization
    # and creation from existing.  To initialize, you must supply
    # I<config>.  This will create the first anonymous instance.
    # I<proto> must be a class name, not a reference.
    #
    # To create an instance from an existing instance, I<proto> must
    # be an instance, not a class name.  I<config> is ignored.
    my($proto, $config, $req) = @_;
    my($ci) = ref($proto) ? $proto->[$_IDI]->{class_info}
	    : _initialize_class_info($proto, $config);
    # Make a copy of the properties for this instance.  properties
    # is an array_ref for efficiency.
    my($self) = Bivio::Collection::Attributes::new($proto,
	    {@{$ci->{properties}}});
    $self->[$_IDI] = {
	class_info => $ci,
	# Never save the request for first time anonymous classes
        request => ref($proto) ? $req : undef,
	anonymous => 1,
    };
    return $self;
}

sub new_other {
    # (self, string) : Biz.Model
    # Creates a model instance of the specified class.
    my($self, $class) = @_;
    return $self->get_instance($class)->new($self->get_request);
}

sub put {
    # (self) : undef
    # Not supported.
    CORE::die('put: not supported');
}

sub put_on_request {
    # (self) : undef
    # (self, boolean) : undef
    # Adds this instance to the request, stored with the key
    # 'Model.<simple package name>'.
    #
    #
    # Adds the model to the request as a durable attribute. The model will
    # survive server redirects.
    my($self, $durable) = @_;
    my($req) = $self->unsafe_get_request;
    return unless $req;

    # ref($self) for backward compatibility
    foreach my $key ('Model.'.$self->simple_package_name, ref($self)) {
	if ($durable) {
	    $req->put_durable($key => $self);
	}
	else {
	    $req->put($key => $self);
	}
    }
    return;
}

sub throw_die {
    # (proto, Type.Enum, hash_ref, string, string, int) : undef
    # (proto, Type.Enum, string, string, string, int) : undef
    # Terminate the I<model> as entity and request in I<attrs> with a specific code.
    #
    # I<package>, I<file>, and I<line> need not be defined
    my($self, $code, $attrs, $package, $file, $line) = @_;
    $package ||= (caller)[0];
    $file ||= (caller)[1];
    $line ||= (caller)[2];
    $attrs ||= {};
    ref($attrs) eq 'HASH' || ($attrs = {message => $attrs});
    $attrs->{model} = $self;
    Bivio::Die->throw($code, $attrs, $package, $file, $line);
    # DOES NOT RETURN
}

sub unsafe_get_model {
    # (self, string) : Biz.PropertyModel
    # Returns the named PropertyModel associated with this instance.
    # If it can be loaded, it will be.  See
    # L<Bivio::Biz::PropertyModel::is_loaded|Bivio::Biz::PropertyModel/"is_loaded">.
    my($self, $name) = @_;
    my($fields) = $self->[$_IDI];
    return ($fields->{models} ||= {})->{$name}
	||= _load_other_model($self, $name);
}

sub unsafe_get_request {
    # (proto) : Agent.Request
    # Returns the request associated with this model (if defined).
    # Otherwise, returns the current request, if any.
    my($self) = @_;
    my($req);
    $req = $self->[$_IDI]->{request} if ref($self);
    # DON'T SET the request for future calls, because this may
    # be an anonymous model or a singleton.
    Bivio::IO::ClassLoader->simple_require('Bivio::Agent::Request');
    return $req ? $req : Bivio::Agent::Request->get_current;
}

sub _as_string_fields {
    # (SQL.Support) : array_ref
    # Returns as_string_fields.
    my($sql_support) = @_;
    return $sql_support->get('as_string_fields')
	if $sql_support->has_keys('as_string_fields');
    my($res) = [@{$sql_support->get('primary_key_names')}];
    unshift(@$res, 'name')
	if $sql_support->has_columns('name') && !grep($_ eq 'name', @$res);
    return $res;
}

sub _assert_class_name {
    # (string) : undef
    # Ensures that the class conforms to the naming conventions.
    my($class) = @_;
    Bivio::Die->die($class, ': is a base class; it cannot be initialized'
	    .' as a model')
		if $class =~ /Base$/;
    my($super) = 'Bivio::Biz::'
	    .($class =~ /(ListForm|Form|List)$/ ? $1 : 'Property')
	    .'Model';
    Bivio::Die->die($class, ': must be a ', $super)
	    unless UNIVERSAL::isa($class, $super);
    return;
}

sub _get_class_info {
    # () : undef
    my($class) = @_;
    no strict qw(refs);
    _initialize_class_info($class)
	unless defined *{$class . '::'}{HASH}->{_CLASS_INFO};
    return *{$class . '::'}{HASH}->{_CLASS_INFO};
}

sub _get_model_query {
    # (self, string) : array
    # Returns the model (query, instance) by looking for the model.
    my($self, $name) = @_;
    # Asserts operation is valid
    my($sql_support) = $self->internal_get_sql_support;
    my($models) = $sql_support->get('models');
    $self->die("$name: no such model")
	unless defined($models->{$name});
    my($m) = $models->{$name};
    my($properties) = $self->internal_get;
    my($req) = $self->unsafe_get_request;
    # Always store the model.
    my($mi) = $m->{instance}->new($req);
    my($query) = {};
    my($map) = $m->{primary_key_map};
    foreach my $pk (keys(%$map)) {
	my($v);
	unless (defined($v = $properties->{$map->{$pk}->{name}})) {
	    # If there is an auth_id, use it if this is the missing
	    # primary key.
	    my($auth_id) = $mi->get_info('auth_id');
	    unless ($auth_id && $pk eq $auth_id->{name}) {
		Bivio::IO::Alert->warn(
		    $self,
		    ': loading ', $m->{instance}, ' missing key ',
		    $map->{$pk}->{name});
		return (undef, $mi);
	    }
	    $v = $req->get('auth_id');
	}
	$query->{$pk} = $v;
    }
    return ($query, $mi);
}

sub _initialize_class_info {
    # (string) : undef
    # (string, hash_ref) : hash_ref
    # Initializes from class or from config.  config is supplied for
    # anonymous models (currently, only ListModels).
    my($class, $config) = @_;
    # This may load the models and we'll try to get the class_info
    # again after the models are loaded.
    _load_all_property_models();

    # Have here for safety to avoid infinite recursion if called badly.
#    return if !$config && $_CLASS_INFO{$class};
    {
	no strict qw(refs);
        return if !$config && defined *{$class . '::'}{HASH}->{_CLASS_INFO};
    }

    _assert_class_name($class) unless $config;

    my($stmt) = Bivio::SQL::Statement->new();
    my($sql_support) = $class->internal_initialize_sql_support($stmt, $config);
    my($ci) = {
	sql_support => $sql_support,
        statement => $stmt,
	as_string_fields => _as_string_fields($sql_support),
	# Is an array, because faster than a hash_ref for our purposes
	properties => [map {
		($_, undef);
	    } @{$sql_support->get('column_names')},
	],
    };
    return $ci if $config;
    # $_CLASS_INFO{$class} is sentinel to stop recursion
#    $_CLASS_INFO{$class} = $ci;
    {
	no strict qw(refs);
        *{$class . '::'}{HASH}->{_CLASS_INFO} = $ci;
    }
    $ci->{singleton} = $class->new;
    delete($ci->{singleton}->[$_IDI]->{request});
    $ci->{singleton}->[$_IDI]->{is_singleton} = 1;
    return;
}

sub _load_all_property_models {
    # () : undef
    # Loads the property models, if not already loaded.
    return if $_LOADED_ALL_PROPERTY_MODELS;
    # Avoid recursion and don't want redo in any event
    $_LOADED_ALL_PROPERTY_MODELS = 1;
    my($models) = Bivio::IO::ClassLoader->map_require_all('Model',
	    sub {
		my($class, $file) = @_;
		# We don't load classes which end in List, Form, or Base.
		return $class =~ /(Form|List|Base)$/ ? 0 : 1;
	    });

    # Force class initialization
    foreach my $class (@$models) {
	$class->get_instance;
    }
    return;
}

sub _load_other_model {
    # (self, string) : Bivio:Biz.PropertyModel
    my($self, $name) = @_;
    # Does a bunch of asssertion checking
    my($query, $mi) = _get_model_query($self, $name);
    return $mi
	unless $query;
    my($aliases) = $self->get_info('column_aliases');
    my($values) = $self->internal_get;
    return $mi->internal_load_properties({
	map({
	    my($k) = $aliases->{"$name.$_"};
	    unless ($k && exists($values->{$k})) {
		$mi->unauth_load($query);
		return $mi;
	    }
	    ($k => $values->{$k});
	 } @{$mi->get_info('column_names')}),
    });
}

sub _new_args {
    # (proto, Agent.Request, any) : array
    # (proto, any) : array
    # Returns (proto, req, class).  Figures out calling form and returns
    # the correct parameter values.
    my($proto, $req, $class) = @_;
    if (defined($req) && !ref($req)) {
	Bivio::Die->die($req,
	    ': bad parameter, expecting a Bivio::Agent::Request',
	) if defined($class);
	$class = $req;
	$req = undef;
    }
    return ($proto, $req || $proto->unsafe_get_request, $class);
}

1;