File Coverage

blib/lib/RapidApp/DBIC/Component/TableSpec.pm

Criterion	Covered	Total	%
statement	323	456	70.8
branch	113	238	47.4
condition	85	205	41.4
subroutine	31	133	23.3
pod	0	24	0.0
total	552	1056	52.2

package RapidApp::DBIC::Component::TableSpec;
#use base 'DBIx::Class';
# this is for Attribute::Handlers:
require base; base->import('DBIx::Class');

use strict;
use warnings;

use Sub::Name qw/subname/;

# DBIx::Class Component: ties a RapidApp::TableSpec object to
# a Result class for use in configuring various modules that
# consume/use a DBIC Source

use RapidApp::Util qw(:all);

use RapidApp::TableSpec;
use RapidApp::Module::DbicCombo;
use Module::Runtime;

#__PACKAGE__->load_components(qw/IntrospectableM2M/);

__PACKAGE__->load_components('+RapidApp::DBIC::Component::VirtualColumnsExt');

__PACKAGE__->mk_classdata( 'TableSpec' );
__PACKAGE__->mk_classdata( 'TableSpec_rel_columns' );

__PACKAGE__->mk_classdata( 'TableSpec_cnf' );
__PACKAGE__->mk_classdata( 'TableSpec_built_cnf' );

# See default profile definitions in RapidApp::TableSpec::Column
my $default_data_type_profiles = {
  text        => [ 'bigtext' ],
  mediumtext  => [ 'bigtext' ],
  longtext    => [ 'bigtext' ],
  tinytext    => [ 'text' ],
  smalltext   => [ 'text' ],
  varchar     => [ 'text' ],
  char        => [ 'text' ],
  nvarchar    => [ 'text' ],
  nchar       => [ 'text' ],
  float       => [ 'number' ],
  integer     => [ 'number', 'int' ],
  tinyint     => [ 'number', 'int' ],
  smallint    => [ 'number', 'int' ],
  mediumint   => [ 'number', 'int' ],
  bigint      => [ 'number', 'int' ],
  decimal     => [ 'number' ],
  numeric     => [ 'number' ],
  double      => [ 'number' ],
  'double precision' => [ 'number' ],
  datetime    => [ 'datetime' ],
  timestamp   => [ 'datetime' ],
  date        => [ 'date' ],
  blob        => [ 'blob' ],
  longblob    => [ 'blob' ],
  mediumblob  => [ 'blob' ],
  tinyblob    => [ 'blob' ],
  smallblob   => [ 'blob' ],
  binary      => [ 'blob' ],
  varbinary   => [ 'blob' ],
  year        => [ 'otherdate' ],
  tsvector    => [ 'bigtext','unsearchable','virtual_source' ], #<-- postgres-specific
  boolean     => ['bool'],
  ipaddr      => ['unsearchable'] #<-- postgres-specific
};
__PACKAGE__->mk_classdata( 'TableSpec_data_type_profiles' );
__PACKAGE__->TableSpec_data_type_profiles({ %$default_data_type_profiles });


## Sets up many_to_many along with TableSpec m2m multi-relationship column
sub TableSpec_m2m {
	my $self = shift;
	my ($m2m,$local_rel,$remote_rel) = @_;

	$self->is_TableSpec_applied and
		die "TableSpec_m2m must be called before apply_TableSpec!";

	$self->has_column($m2m) and die "'$m2m' is already defined as a column.";
	$self->has_relationship($m2m) and die "'$m2m' is already defined as a relationship.";

	my $rinfo = $self->relationship_info($local_rel) or die "'$local_rel' relationship not found";
	eval('require ' . $rinfo->{class});

	die "m2m bridge relationship '$local_rel' is not a multi relationship"
		unless ($rinfo->{attrs}->{accessor} eq 'multi');

	my $rrinfo = $rinfo->{class}->relationship_info($remote_rel);
  unless($rrinfo) {
    # Note: we're not dying here because this is known to happen when called from Schema::Loader
    # and we don't want that to fail. It is not known to fail during normal operation. TODO/FIXME
    warn "TableSpec_m2m(): unable to resolve remote rel '$remote_rel' -- falling back to many_to_many\n";
    return $self->many_to_many($m2m,$local_rel,$remote_rel);
  }

  Module::Runtime::require_module($rrinfo->{class});

	$rinfo->{table} = &_table_name_safe($rinfo->{class}->table);
	$rrinfo->{table} = &_table_name_safe($rrinfo->{class}->table);

	$rinfo->{cond_info} = $self->parse_relationship_cond($rinfo->{cond});
	$rrinfo->{cond_info} = $self->parse_relationship_cond($rrinfo->{cond});

	#
	#my $sql = '(' .
	#	# SQLite Specific:
	#	#'SELECT(GROUP_CONCAT(flags.flag,", "))' .
	#
	#	# MySQL Sepcific:
	#	#'SELECT(GROUP_CONCAT(flags.flag SEPARATOR ", "))' .
	#
	#	# Generic (MySQL & SQLite):
	#	'SELECT(GROUP_CONCAT(`' . $rrinfo->{table} . '`.`' . $rrinfo->{cond_info}->{foreign} . '`))' .
	#
	#	' FROM `' . $rinfo->{table} . '`' .
	#	' JOIN `' . $rrinfo->{table} . '` `' . $rrinfo->{table} . '`' .
	#	'  ON `' . $rinfo->{table} . '`.`' . $rrinfo->{cond_info}->{self} . '`' .
	#	'   = `' . $rrinfo->{table} . '`.`' . $rrinfo->{cond_info}->{foreign} . '`' .
	#	#' ON customers_to_flags.flag = flags.flag' .
	#	' WHERE `' . $rinfo->{cond_info}->{foreign} . '` = ' . $rel . '.' . $cond_data->{self} .
	#')';

	# Create a relationship exactly like the the local bridge relationship, adding
	# the 'm2m_attrs' attribute which will be used later on to setup the special,
	# m2m-specific multi-relationship column properties (renderer, editor, and to
	# trigger proxy m2m updates in DbicLink2):
	$self->add_relationship(
		$m2m,
		$rinfo->{class},
		$rinfo->{cond},
		{%{$rinfo->{attrs}}, m2m_attrs => {
			remote_rel => $remote_rel,
			rinfo => $rinfo,
			rrinfo => $rrinfo
		}}
	);

	# -- Add a normal many_to_many bridge so we have the many_to_many sugar later on:
	# (we use 'set_$rel' in update_records in DbicLink2)
	local $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK} = 1
		unless (exists $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK});
	$self->many_to_many(@_);
	#$self->apply_m2m_sugar(@_);
	# --
}

## sugar copied from many_to_many (DBIx::Class::Relationship::ManyToMany),
## but only sets up add_$rel and set_$rel and won't overwrite existing subs (safer)
#sub apply_m2m_sugar {
#	my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_;
#
#	my $set_meth = "set_${meth}";
#	my $add_meth = "add_${meth}";
#
#	$class->can($set_meth) and
#		die "m2m: set method '$set_meth' is already defined in (" . ref($class) . ")";
#
#	$class->can($add_meth) and
#		die "m2m: add method '$add_meth' is already defined in (" . ref($class) . ")";
#
#    my $add_meth_name = join '::', $class, $add_meth;
#    *$add_meth_name = subname $add_meth_name, sub {
#      my $self = shift;
#      @_ > 0 or $self->throw_exception(
#        "${add_meth} needs an object or hashref"
#      );
#      my $source = $self->result_source;
#      my $schema = $source->schema;
#      my $rel_source_name = $source->relationship_info($rel)->{source};
#      my $rel_source = $schema->resultset($rel_source_name)->result_source;
#      my $f_rel_source_name = $rel_source->relationship_info($f_rel)->{source};
#      my $f_rel_rs = $schema->resultset($f_rel_source_name)->search({}, $rel_attrs||{});
#
#      my $obj;
#      if (ref $_[0]) {
#        if (ref $_[0] eq 'HASH') {
#          $obj = $f_rel_rs->find_or_create($_[0]);
#        } else {
#          $obj = $_[0];
#        }
#      } else {
#        $obj = $f_rel_rs->find_or_create({@_});
#      }
#
#      my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {};
#      my $link = $self->search_related($rel)->new_result($link_vals);
#      $link->set_from_related($f_rel, $obj);
#      $link->insert();
#      return $obj;
#    };
#
#	my $set_meth_name = join '::', $class, $set_meth;
#    *$set_meth_name = subname $set_meth_name, sub {
#		my $self = shift;
#		@_ > 0 or $self->throw_exception(
#			"{$set_meth} needs a list of objects or hashrefs"
#		);
#		my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_);
#		# if there is a where clause in the attributes, ensure we only delete
#		# rows that are within the where restriction
#		if ($rel_attrs && $rel_attrs->{where}) {
#			$self->search_related( $rel, $rel_attrs->{where},{join => $f_rel})->delete;
#		} else {
#			$self->search_related( $rel, {} )->delete;
#		}
#		# add in the set rel objects
#		$self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set);
#	};
#}
## --

sub is_TableSpec_applied {
	my $self = shift;
	return (
		defined $self->TableSpec_cnf and
		defined $self->TableSpec_cnf->{apply_TableSpec_timestamp}
	);
}

sub apply_TableSpec {
	my $self = shift;
	my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref

	# ignore/return if apply_TableSpec has already been called:
	return if $self->is_TableSpec_applied;

	# make sure _virtual_columns and _virtual_columns_order get initialized
	$self->add_virtual_columns();


	$self->TableSpec_data_type_profiles(
		%{ $self->TableSpec_data_type_profiles || {} },
		%{ delete $opt{TableSpec_data_type_profiles} }
	) if ($opt{TableSpec_data_type_profiles});

	$self->TableSpec($self->create_result_TableSpec($self,%opt));

	$self->TableSpec_rel_columns({});
	$self->TableSpec_cnf({});
	$self->TableSpec_built_cnf(undef);

	$self->apply_row_methods();

	# Just doing this to ensure we're initialized:
	$self->TableSpec_set_conf( apply_TableSpec_timestamp => time );

	# --- Set some base defaults here:
	my $table = &_table_name_safe($self->table);
	my ($pri) = ($self->primary_columns,$self->columns); #<-- first primary col, or first col
	$self->TableSpec_set_conf(
		display_column => $pri,
		title => $table,

    # --
    # New: initialize the columns cnf key early. It doesn't even need all
    # the columns (just at least one -- we're just doing the base columns
    # and not bothering with relationships + virtual columns). This is
    # just about getting the Hash defined so that later calls will update
    # this hash rather than create a new one, which can get lost in certain
    # situations (such as a Result Class that loads the TableSpec component
    # in-line but does not apply any column configs).
    # This was needed added after the recent prelim TableSpec_cnf refactor (in v0.99030)
    # which is a temp/in-between change that consolidates storage of column
    # configs internally while still preserving the original API for now.
    # Yes, this is ugly/hackish but will go away as soon as the full-blown,
    # long-planned TableSpec refactor is undertaken...
    columns => { map { $_ => {} } $self->columns }
    # --
	);
	# ---

	return $self;
}

sub create_result_TableSpec {
	my $self = shift;
	my $ResultClass = shift;
	my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref

	my $table = &_table_name_safe($ResultClass->table);

	my $TableSpec = RapidApp::TableSpec->new(
		name => $table,
		%opt
	);

	my $data_types = $self->TableSpec_data_type_profiles;

	## WARNING! This logic overlaps with logic further down (in default_TableSpec_cnf_columns)
	foreach my $col ($ResultClass->columns) {
		my $info = $ResultClass->column_info($col);
		my @profiles = ();

		push @profiles, $info->{is_nullable} ? 'nullable' : 'notnull';
    push @profiles, 'autoinc' if ($info->{is_auto_increment});

		my $type_profile = $data_types->{$info->{data_type}} || ['text'];

    # -- PostgreSQL override until array columns are supported (Github Issue #55):
    $type_profile = ['unsearchable','virtual_source'] if (
      $info->{data_type} =~ /\[/ #<-- if the data_type contains a square backect, i.e. 'text[]'
    );
    # --

		$type_profile = [ $type_profile ] unless (ref $type_profile);
		push @profiles, @$type_profile;

		$TableSpec->add_columns( { name => $col, profiles => \@profiles } );
	}

	return $TableSpec;
}


sub get_built_Cnf {
	my $self = shift;

	$self->TableSpec_build_cnf unless ($self->TableSpec_built_cnf);
	return $self->TableSpec_built_cnf;
}

sub TableSpec_build_cnf {
	my $self = shift;
	my %set_cnf = %{ $self->TableSpec_cnf || {} };
	$self->TableSpec_built_cnf($self->default_TableSpec_cnf(\%set_cnf));
}

sub default_TableSpec_cnf  {
	my $self = shift;
	my $set = shift || {};

  my $data = $set;


	my $table = &_table_name_safe($self->table);

  my $is_virtual = $self->_is_virtual_source;
  my $defs_i = $is_virtual ? 'ra-icon-pg-red' : 'ra-icon-pg';
  my $defm_i = $is_virtual ? 'ra-icon-pg-multi-red' : 'ra-icon-pg-multi';

	# FIXME: These defaults cannot be seen via call from related tablespec, because of
	# a circular logic situation. For base-defaults, see apply_TableSpec above
	# This is one of the reasons the whole TableSpec design needs to be refactored
	my %defaults = ();
	$defaults{iconCls} = $data->{singleIconCls} if ($data->{singleIconCls} and ! $data->{iconCls});
	$defaults{iconCls} = $defaults{iconCls} || $data->{iconCls} || $defs_i;
	$defaults{multiIconCls} = $data->{multiIconCls} || $defm_i;
	$defaults{singleIconCls} = $data->{singleIconCls} || $defaults{iconCls};
	$defaults{title} = $data->{title} || $table;
	$defaults{title_multi} = $data->{title_multi} || $defaults{title};
	($defaults{display_column}) = $self->primary_columns;

	my @display_columns = $data->{display_column} ? ( $data->{display_column} ) : $self->primary_columns;

	# row_display coderef overrides display_column to provide finer grained display control
	my $orig_row_display = $data->{row_display} || sub {
		my $record = $_;
		my $title = join('/',map { $record->{$_} || '' } @display_columns);
		$title = sprintf('%.13s',$title) . '...' if (length $title > 13);
		return $title;
	};

	$defaults{row_display} = sub {
		my $display = $orig_row_display->(@_);
		return $display if (ref $display);
		return {
			title => $display,
			iconCls => $defaults{singleIconCls}
		};
	};

	my $rel_trans = {};

	$defaults{related_column_property_transforms} = $rel_trans;


  #my $defs = \%defaults;
  #my $col_cnf = $self->default_TableSpec_cnf_columns($set);
  #$defs = merge($defs,$col_cnf);
  #return merge($defs, $set);

  %defaults = ( %defaults, %$set );
  my $defs = \%defaults;
  my $col_cnf = $self->default_TableSpec_cnf_columns($defs);
  $defs->{columns} = $col_cnf->{columns};

  return $defs;
}

sub _is_virtual_source {
  my $self = shift;
  return (
    $self->result_source_instance->can('is_virtual') &&
    $self->result_source_instance->is_virtual
  );
}

sub default_TableSpec_cnf_columns {
	my $self = shift;
	my $set = shift || {};

  my $data = $set;

	my @col_order = $self->default_TableSpec_cnf_column_order($set);

	my $cols = { map { $_ => {} } @col_order };

  # lowest precidence:
  #$cols = merge($cols,$set->{column_properties_defaults} || {});
  %$cols = ( %$cols, %{ $set->{column_properties_defaults} || {}} );

  #$cols = merge($cols,$set->{column_properties_ordered} || {});
  %$cols = ( %$cols, %{ $set->{column_properties_ordered} || {}} );

	# higher precidence:
	#$cols = merge($cols,$set->{column_properties} || {});
  %$cols = ( %$cols, %{ $set->{column_properties} || {}} );

	my $data_types = $self->TableSpec_data_type_profiles;
	#scream(keys %$cols);

  my $is_virtual = $self->_is_virtual_source;

	foreach my $col (keys %$cols) {

		my $is_phy = $self->has_column($col) ? 1 : 0;
    $cols->{$col}{is_phy_colname} = $is_phy; #<-- track if this is also a physical column name

    my $is_local = $is_phy;

		# If this is both a local column and a relationship, allow the rel to take over
		# if 'priority_rel_columns' is true:
		$is_local = 0 if (
			$is_local and
			$self->has_relationship($col) and
			$set->{'priority_rel_columns'}
		);

		# -- If priority_rel_columns is on but we need to exclude a specific column:
		$is_local = 1 if (
			! $is_local and
			$set->{no_priority_rel_column} and
			$set->{no_priority_rel_column}->{$col} and
			$is_phy
		);
		# --

		# Never allow a rel col to take over a primary key:
		my %pri_cols = map {$_=>1} $self->primary_columns;
		$is_local = 1 if ($pri_cols{$col});

		unless ($is_local) {
			# is it a rel col ?
			if($self->has_relationship($col)) {
				my $info = $self->relationship_info($col);

				$cols->{$col}->{relationship_info} = $info;
				my $cond_data = $self->parse_relationship_cond($info->{cond});
				$cols->{$col}->{relationship_cond_data} = { %$cond_data, %$info };

				if ($info->{attrs}->{accessor} eq 'single' || $info->{attrs}->{accessor} eq 'filter') {

          # -- NEW: Virtual Single Relationship - will be read-only
          unless($cond_data->{foreign} && $cond_data->{self}) {
            $cols->{$col}{virtualized_single_rel} = 1;
            $cols->{$col}{allow_add} = 0;
            $cols->{$col}{allow_edit} = 0;
            next;
          }
          # --

          # New: pass the is_nullable flag in from the local FK column:
          if($self->has_column($cond_data->{self})) {
            $cols->{$col}{is_nullable} = $self->column_info($cond_data->{self})
              ->{is_nullable} ? 1 : 0;
          }

					# Use TableSpec_related_get_set_conf instead of TableSpec_related_get_conf
					# to prevent possible deep recursion:

					my $display_column = $self->TableSpec_related_get_set_conf($col,'display_column');
					my $display_columns = $self->TableSpec_related_get_set_conf($col,'display_columns');

					# -- auto_editor_params/auto_editor_type can be defined in either the local column
					# properties, or the remote TableSpec conf
					my $auto_editor_type = $self->TableSpec_related_get_set_conf($col,'auto_editor_type') || 'combo';
					my $auto_editor_params = $self->TableSpec_related_get_set_conf($col,'auto_editor_params') || {};
					my $auto_editor_win_params = $self->TableSpec_related_get_set_conf($col,'auto_editor_win_params') || {};
					$cols->{$col}->{auto_editor_type} = $cols->{$col}->{auto_editor_type} || $auto_editor_type;
					$cols->{$col}->{auto_editor_params} = $cols->{$col}->{auto_editor_params} || {};
					$cols->{$col}->{auto_editor_params} = {
						%$auto_editor_params,
						%{$cols->{$col}->{auto_editor_params}}
					};
					# --

					$display_column = $display_columns->[0] if (
						! defined $display_column and
						ref($display_columns) eq 'ARRAY' and
						@$display_columns > 0
					);

					## fall-back set the display_column to the first key
					($display_column) = $self->primary_columns unless ($display_column);

					$display_columns = [ $display_column ] if (
						! defined $display_columns and
						defined $display_column
					);

					die "$col doesn't have display_column or display_columns set!" unless ($display_column);

					$cols->{$col}->{displayField} = $display_column;
					$cols->{$col}->{display_columns} = $display_columns; #<-- in progress - used for grid instead of combo

					#TODO: needs to be more generalized/abstracted
					#open_url, if defined, will add an autoLoad link to the renderer to
					#open/navigate to the related item
					$cols->{$col}->{open_url} = $self->TableSpec_related_get_set_conf($col,'open_url');

					$cols->{$col}->{valueField} = $cond_data->{foreign}
						or die "couldn't get foreign col condition data for $col relationship!";

					$cols->{$col}->{keyField} = $cond_data->{self}
						or die "couldn't get self col condition data for $col relationship!";

					next;
				}
				elsif($info->{attrs}->{accessor} eq 'multi') {
					$cols->{$col}->{title_multi} = $self->TableSpec_related_get_set_conf($col,'title_multi');
					$cols->{$col}->{multiIconCls} = $self->TableSpec_related_get_set_conf($col,'multiIconCls');
					$cols->{$col}->{open_url_multi} = $self->TableSpec_related_get_set_conf($col,'open_url_multi');

					$cols->{$col}->{open_url_multi_rs_join_name} =
						$self->TableSpec_related_get_set_conf($col,'open_url_multi_rs_join_name') || 'me';
				}

        # New: add the 'relcol' profile to relationship columns:
        $cols->{$col}->{profiles} ||= [];
        push @{$cols->{$col}->{profiles}}, 'relcol';
        push @{$cols->{$col}->{profiles}}, 'virtual_source' if ($is_virtual);
        push @{$cols->{$col}->{profiles}}, 'multirel' if ($info->{attrs}->{accessor} eq 'multi');
			}
			next;
		}

		## WARNING! This logic overlaps with logic further up (in create_result_TableSpec) FIXME!
		my $info = $self->column_info($col);
		my @profiles = ();

		push @profiles, $info->{is_nullable} ? 'nullable' : 'notnull';
    push @profiles, 'autoinc' if ($info->{is_auto_increment});

		my $type_profile = $data_types->{$info->{data_type}} || ['text'];

    # -- PostgreSQL override until array columns are supported (Github Issue #55):
    $type_profile = ['unsearchable','virtual_source'] if (
      $info->{data_type} =~ /\[/ #<-- if the data_type contains a square backect, i.e. 'text[]'
    );
    # --

		$type_profile = [ $type_profile ] unless (ref $type_profile);
		push @profiles, @$type_profile;

		$cols->{$col}->{profiles} = [ $cols->{$col}->{profiles} ] if (
			defined $cols->{$col}->{profiles} and
			not ref $cols->{$col}->{profiles}
		);
		push @profiles, @{$cols->{$col}->{profiles}} if ($cols->{$col}->{profiles});

    push @profiles, 'virtual_source' if ($is_virtual);

		$cols->{$col}->{profiles} = \@profiles;

		## --
		my $editor = {};

		## Set the 'default' field value to match the default from the db (if exists) for this column:
		$editor->{value} = $info->{default_value} if (exists $info->{default_value});

    # -- NEW:
    # ScalarRef values mean literal SQL which should be evaluated at the time. New feature in
    # RapidApp::JSON::MixedEncoder supports CodeRef values, which call them at encode time. This
    # lets us set the default editor value to what it should be at the time the form is loaded.
    if((ref($info->{default_value})||'') eq 'SCALAR') {
      $editor->{value} = sub {
        my $value = $info->{default_value};
        try {
          # Actually ask the database via calling a select on the literal SQL. We're in a try
          # block so if any of this fails, we fall back to the original ScalarRef which will
          # probably end up being undef
          $value = RapidApp->active_request_context
            ->stash->{'RAPIDAPP_DISPATCH_MODULE'} # only way to get Module by the time we're called in the view
            ->ResultSource->schema->storage->dbh
            ->selectrow_arrayref( "SELECT $$value" )->[0];
        };
        return $value;
      } unless (
        # just because this one is so common, don't waste resources asking the database
        ${$info->{default_value}} eq 'null'
      );
    }
    # --


		## This sets additional properties of the editor for numeric type columns according
		## to the DBIC schema (max-length, signed/unsigned, float vs int). The API with "profiles"
		## didn't anticipate this fine-grained need, so 'extra_properties' was added specifically
		## to accomidate this (see special logic in TableSpec::Column):
		## note: these properties only apply if the editor xtype is 'numberfield' which we assume,
		## and is already set from the profiles of 'decimal', 'float', etc
		my $unsigned = ($info->{extra} && $info->{extra}->{unsigned}) ? 1 : 0;
		$editor->{allowNegative} = \0 if ($unsigned);

		if($info->{size}) {
			my $size = $info->{size};

			# Special case for 'float'/'decimal' with a specified precision (where 0 is the same as int):
			if(ref $size eq 'ARRAY' ) {
				my ($s,$p) = @$size;
				$size = $s;
				$editor->{maxValue} = ('9' x $s);
				$size += 1 unless ($unsigned); #<-- room for a '-'
				if ($p && $p > 0) {
					$editor->{maxValue} .= '.' . ('9' x $p);
					$size += $p + 1 ; #<-- precision plus a spot for '.' in the max field length
					$editor->{decimalPrecision} = $p;
				}
				else {
					$editor->{allowDecimals} = \0;
				}
			}
			$editor->{maxLength} = $size;
		}

		if(keys %$editor > 0) {
			$cols->{$col}->{extra_properties} = $cols->{$col}->{extra_properties} || {};
			$cols->{$col}->{extra_properties} = merge($cols->{$col}->{extra_properties},{
				editor => $editor
			});
		}
		## --

    # --vv-- NEW: handling for 'enum' columns (Github Issue #30):
    if($info->{data_type} eq 'enum' && $info->{extra} && $info->{extra}{list}) {
      my $list = $info->{extra}{list};

      my $selections = [];
      # Null choice:
      push @$selections, {
        # #A9A9A9 = light grey
        text => '<span style="color:#A9A9A9;">(None)</span>', value => undef
      } if ($info->{is_nullable});

      push @$selections, map {
        { text => $_, value => $_ }
      } @$list;

      $cols->{$col}{menu_select_editor} = {
        #mode: 'combo', 'menu' or 'cycle':
        mode        => 'menu',
        selections  => $selections
      };

      # New: also save the list of possible values in a hashref...
      #      This is being done so that they can be pre-validated in
      #      quick search, needed for Postfix (Github Issue #56)
      #      TODO: not happy about having to do this - revisit later
      $cols->{$col}{enum_value_hash} = { map {$_=>1} @$list }
    }
    # --^^--

  }

  return { columns => $cols };
}

sub TableSpec_valid_db_columns {
  my $self = shift;

  my @single_rels = ();
  my @multi_rels = ();
  my @virtual_single_rels = ();

  my %fk_cols = ();
  my %pri_cols = map {$_=>1} $self->primary_columns;

  foreach my $rel ($self->relationships) {
    my $info = $self->relationship_info($rel);

    my $accessor = $info->{attrs}->{accessor};

    # 'filter' means single, but the name is also a local column
    $accessor = 'single' if (
      $accessor eq 'filter' and
      $self->TableSpec_cnf->{'priority_rel_columns'} and
      !(
        $self->TableSpec_cnf->{'no_priority_rel_column'} and
        $self->TableSpec_cnf->{'no_priority_rel_column'}->{$rel}
      ) and
      ! $pri_cols{$rel} #<-- exclude primary column names. TODO: this check is performed later, fix
    );

    if($accessor eq 'single') {
      my $cond_info = $self->parse_relationship_cond($info->{cond});
      if($cond_info->{self} && $cond_info->{foreign}) {
        push @single_rels, $rel;
        my ($fk) = keys %{$info->{attrs}->{fk_columns}};
        $fk_cols{$fk} = $rel if($fk);
      }
      else {
        # (Github Issue #40)
        # New: "virtual" single rels are relationships for which we
        # cannot introspect in both directions (i.e. not physical
        # foreign keys). These are still "single" in that they map to
        # one related row, but will not be editable and not have a
        # open link (yet)
        push @virtual_single_rels, $rel;
      }
    }
    elsif($accessor eq 'multi') {
      push @multi_rels, $rel;
    }
  }

  $self->TableSpec_set_conf('relationship_column_names',\@single_rels);
  $self->TableSpec_set_conf('multi_relationship_column_names',\@multi_rels);
  $self->TableSpec_set_conf('relationship_column_fks_map',\%fk_cols);

  # New: move single rels up to immediately follow their FK column:
  my @cols = map { $_, ( $fk_cols{$_} ? $fk_cols{$_} : () ) } $self->columns;

  return uniq(@cols,@single_rels,@multi_rels,@virtual_single_rels);
}

# There is no longer extra logic at this stage because we're
# backing off of the entire original "ordering" design:
sub default_TableSpec_cnf_column_order { (shift)->TableSpec_valid_db_columns }

# Tmp code: these are all key names that may be used to set column
# properties (column TableSpecs). We are keeping track of them to
# use to for remapping while the TableSpec_cnf refactor/consolidation
# is underway...
my @col_prop_names = qw(
columns
column_properties
column_properties_ordered
column_properties_defaults
);
my %col_prop_names = map {$_=>1} @col_prop_names;

# The TableSpec_set_conf method is overly complex to allow
# flexible arguments as either hash or hashref, and because of
# the special case of setting the nested 'column_properties'
# param, if specified as the first argument, and then be able to
# accept its sub params as either a hash or a hashref. In hindsight,
# allowing this was probably not worth the extra maintenace/code and
# was too fancy for its own good (since this case may or may not
# shift the key/value positions in the arg list) but it is a part
# of the API for now...
sub TableSpec_set_conf {
  my $self = shift;
  die "TableSpec_set_conf(): bad arguments" unless (scalar(@_) > 0);

  # First arg can be a hashref - deref and call again:
  if(ref($_[0])) {
    die "TableSpec_set_conf(): bad arguments" unless (
      ref($_[0]) eq 'HASH' and
      scalar(@_) == 1
    );
    return $self->TableSpec_set_conf(%{$_[0]})
  }

  $self->TableSpec_built_cnf(undef); #<-- FIXME!!

  # Special handling for setting 'column_properties':
  if ($col_prop_names{$_[0]}) {
    shift @_; #<-- pull out the 'column_properties' first arg
    return $self->_TableSpec_set_column_properties(@_);
  };

  # Enforce even number of args for good measure:
  die join(' ',
    'TableSpec_set_conf( %cnf ):',
    "odd number of args in key/value list:", Dumper(\@_)
  ) if (scalar(@_) & 1);

  my %cnf = @_;

  for my $param (keys %cnf) {
    # Also make sure all the keys (even positions) are simple scalars:
    die join(' ',
      'TableSpec_set_conf( %cnf ):',
      'found ref in key position:', Dumper($_)
    ) if (ref($param));

    if($col_prop_names{$param}) {
      # Also handle column_properties specified with other params:
      die join(' ',
        'TableSpec_set_conf( %cnf ): Expected',
        "HashRef value for config key '$param':", Dumper($cnf{$param})
      ) unless (ref($cnf{$param}) eq 'HASH');
      $self->_TableSpec_set_column_properties($cnf{$param});
    }
    else {
      $self->TableSpec_cnf->{$param} = $cnf{$param}
    }
  }
}

# Special new internal method for setting column properties and
# properly handle backward compatability. Simultaneously sets/updates
# the cnf key names for all the 'column_properties' names that are
# currently supported by the API (as references pointing to the same
# single config HashRef). This is only temporary and is a throwback
# caused by the older/original API design for the TableSpec_cnf and
# will be removed later on once the other config names can be depricated
# along with other planned refactored. This is just a stop-gap to
# allow this refactor to be done in stages...
sub _TableSpec_set_column_properties {
  my $self = shift;
  die "TableSpec_set_conf( column_properties => %cnf ): bad args"
    unless (scalar(@_) > 0);

  # First arg can be a hashref - deref and call again:
  if(ref($_[0])) {
    die "TableSpec_set_conf( column_properties => %cnf ): bad args"  unless (
      ref($_[0]) eq 'HASH' and
      scalar(@_) == 1
    );
    return $self->_TableSpec_set_column_properties(%{$_[0]})
  }

  # Enforce even number of args for good measure:
  die join(' ',
    'TableSpec_set_conf( column_properties => %cnf ):',
    "odd number of args in key/value list:", Dumper(\@_)
  ) if (scalar(@_) & 1);

  my %cnf = @_;

  # Also make sure all the keys (even positions) are simple scalars:
  ref($_) and die join(' ',
    'TableSpec_set_conf( column_properties => %cnf ):',
    'found ref in key position:', Dumper($_)
  ) for (keys %cnf);

  my %valid_colnames = map {$_=>1} ($self->TableSpec_valid_db_columns);

  my $col_props;
  $col_props ||= $self->TableSpec_cnf->{$_} for (@col_prop_names);
  $col_props ||= {};

  for my $col (keys %cnf) {
    warn join(' ',
      "Ignoring config for unknown column name '$col'",
      "in $self TableSpec config\n"
    ) and next unless ($valid_colnames{$col});
    $col_props->{$col} = $cnf{$col};
  }

  $self->TableSpec_cnf->{$_} = $col_props for (@col_prop_names);
}


# New function for updating/merging in column configs. This allows
# setting certain column configs without overwriting existing config
# keys that are not being specified:
sub TableSpec_merge_columns_conf {
  my $self = shift;
  my $conf = shift;

  die "TableSpec_merge_columns_conf( \%columns ): bad args"
    unless (ref($conf) eq 'HASH');

  my $existing = $self->TableSpec_get_conf('columns') || {};

  my @cols = uniq( keys %$conf, keys %$existing );

  my %new = ( map {
    $_ => {
      %{ $existing->{$_} || {} },
      %{ $conf->{$_} || {} },
    }
  } @cols );

  return $self->TableSpec_set_conf( columns => \%new );
}



sub TableSpec_get_conf {
  my $self = shift;
  my $param = shift || return undef;
  my $storage = shift || $self->get_built_Cnf;

  # Special: map all column prop names into 'column_properties'
  $param = 'column_properties' if ($col_prop_names{$param});

  my $value = $storage->{$param};

  # --- FIXME FIXME FIXME
  # In the original design of the TableSpec_cnf internals, which
  # was too fancy for its own good, meta/type information was
  # transparently stored to be able to do things like remember
  # the order of keys in hashes, auto dereference, etc. This has
  # been unfactored and converted to simple key/values since, however,
  # places that might still call TableSpec_get_conf still expect
  # to get back lists instead of ArrayRefs/HashRefs in certain
  # places. These places should be very limited (part of the reason
  # it was decided this whole thing wasn't worth it, because it just
  # wasn't used enough), but for now, to honor the original API (mostly)
  # we're dereferencing according to wantarray, since all the places
  # that expect to get lists back obviously call TableSpec_get_conf
  # in LIST context. This should not be kept this way for too long,
  # however! It is just temporary until those outside places
  # can be confirmed and eliminated, or a proper deprecation plan
  # can be made, should that even be needed...

  if(wantarray && ref($value)) {
    cluck join("\n",'',
      "  WARNING: calling TableSpec_get_conf() in LIST context",
      "  is deprecated, please update your code.",
      "   --> Auto-dereferencing param '$param' $value",'',
    '') if (ref($value) eq 'ARRAY' || ref($value) eq 'HASH');
    return @$value if (ref($value) eq 'ARRAY');
    return %$value if (ref($value) eq 'HASH');
  }

  # When trying to get a param that does not exist, return an
  # empty list if called in LIST context, otherwise undef
  return wantarray ? () : undef unless (exists $storage->{$param});
  # ---

  return $value;
}


sub TableSpec_has_conf {
	my $self = shift;
	my $param = shift;
	my $storage = shift || $self->get_built_Cnf;
	return 1 if (exists $storage->{$param});
	return 0;
}


sub TableSpec_related_class {
	my $self = shift;
	my $rel = shift || return undef;
	my $info = $self->relationship_info($rel) || return undef;
	my $relclass = $info->{class};

	eval "require $relclass;";

	#my $relclass = $self->related_class($rel) || return undef;
	$relclass->can('TableSpec_get_conf') || return undef;
	return $relclass;
}

# Gets a TableSpec conf param, if exists, from a related Result Class
sub TableSpec_related_get_conf {
	my $self = shift;
	my $rel = shift || return undef;
	my $param = shift || return undef;

	my $relclass = $self->TableSpec_related_class($rel) || return undef;

	return $relclass->TableSpec_get_conf($param);
}

# Gets a TableSpec conf param, if exists, from a related Result Class,
# but uses the already 'set' params in TableSpec_cnf as storage, so that
# get_built_cnf doesn't get called.
sub TableSpec_related_get_set_conf {
	my $self = shift;
	my $rel = shift || return undef;
	my $param = shift || return undef;

	my $relclass = $self->TableSpec_related_class($rel) || return undef;

	#return $relclass->TableSpec_get_conf($param,$relclass->TableSpec_cnf);
	return $relclass->TableSpec_get_set_conf($param);
}

# The "set conf" is different from the "built conf" in that it is passive, and only
# returns the values which have been expressly "set" on the Result class with a
# "TableSpec_set_conf" call. The built conf reaches out to code to build a configuration,
# which causes recursive limitations in that code that reaches out to other TableSpec
# classes.
sub TableSpec_get_set_conf {
	my $self = shift;
	my $param = shift || return undef;
	return $self->TableSpec_get_conf($param,$self->TableSpec_cnf);
}


# TODO: Find a better way to handle this. Is there a real API
# in DBIC to find this information?
sub get_foreign_column_from_cond {
	my $self = shift;
	my $cond = shift;

	die "currently only single-key hashref conditions are supported" unless (
		ref($cond) eq 'HASH' and
		scalar keys %$cond == 1
	);

	foreach my $i (%$cond) {
		my ($side,$col) = split(/\./,$i);
		return $col if (defined $col and $side eq 'foreign');
	}

	die "Failed to find forein column from condition: " . Dumper($cond);
}

# This function parses 'foreign' and 'self' column names from the
# 'cond' of a defined in a DBIC relationship into a hashref. It is
# only able to do this for simple, single-key foreign key rels
# of the form:    { "foreign.id_col" => "self.fk_col" }
# All other forms, such as multi-keys and CodeRefs, will return
# and empty HashRef. The only reason we really need this information
# outside of DBIC is for editable single rels (FKs) to be able
# to present selection dialogs (i.e. dropdowns) and currently
# the "open" magnify links, but the open links are planned to be
# changed to reference URLs based on the relationship name, which
# will remove this dependency and allow open links for any relationship
# column, including even those with CodeRef conditions...
sub parse_relationship_cond {
  my ($self,$cond,$info) = @_;

  return {} unless (
    ref($cond) eq 'HASH' and
    scalar keys %$cond == 1
  );

  my $data = {};
  foreach my $i (%$cond) {
    my ($side,$col) = split(/\./,$i);
    $data->{$side} = $col;
  }
  return $data;
}

# Works like an around method modifier, but $self is expected as first arg and
# $orig (method) is expected as second arg (reversed from a normal around modifier).
# Calls the supplied method and returns what changed in the record from before to
# after the call. e.g.:
#
# my ($changes) = $self->proxy_method_get_changed('update',{ foo => 'sdfds'});
#
# This is typically used for update, but could be any other method, too.
#
# Detects/propogates wantarray context. Call like this to chain from another modifier:
#my ($changes,@ret) = wantarray ?
# $self->proxy_method_get_changed($orig,@_) :
#  @{$self->proxy_method_get_changed($orig,@_)};
#
sub proxy_method_get_changed {
	my $self = shift;
	my $method = shift;

  no warnings 'uninitialized'; # because we might compare undef values

	my $origRow = $self;
	my %old = ();
	if($self->in_storage) {
		$origRow = $self->get_from_storage || $self;
		%old = $origRow->get_columns;
	}

	my @ret = ();
	wantarray ?
		@ret = $self->$method(@_) :
			$ret[0] = $self->$method(@_);

	my %new = ();
	if($self->in_storage) {
		%new = $self->get_columns;
	}

	# This logic is duplicated in DbicLink2. Not sure how to avoid it, though,
	# and keep a clean API
	my @changed = ();
	foreach my $col (uniq(keys %new,keys %old)) {
		next if (! defined $new{$col} and ! defined $old{$col});
		next if ($new{$col} eq $old{$col});
		push @changed, $col;
	}

	my @new_changed = ();
	my $fk_map = $self->TableSpec_get_conf('relationship_column_fks_map');
	foreach my $col (@changed) {
		unless($fk_map->{$col}) {
			push @new_changed, $col;
			next;
		}

		my $rel = $fk_map->{$col};
		my $display_col = $self->TableSpec_related_get_set_conf($rel,'display_column');

		my $relOld = $origRow->$rel;
		my $relNew = $self->$rel;

		unless($display_col and ($relOld or $relNew)) {
			push @new_changed, $col;
			next;
		}

		push @new_changed, $rel;

		$old{$rel} = $relOld->get_column($display_col) if (exists $old{$col} and $relOld);
		$new{$rel} = $relNew->get_column($display_col) if (exists $new{$col} and $relNew);
	}

	@changed = @new_changed;

	my $col_props = $self->TableSpec_get_conf('columns');

	my %diff = map {
		$_ => {
			old => $old{$_},
			new => $new{$_},
			header => ($col_props->{$_} && $col_props->{$_}->{header}) ?
				$col_props->{$_}->{header} : $_
		}
	} @changed;

	return wantarray ? (\%diff,@ret) : [\%diff,@ret];
}


sub getOpenUrl {
	my $self = shift;
	return $self->TableSpec_get_conf('open_url');
}

sub getRestKey {
	my $self = shift;
	my $rest_key_col = $self->TableSpec_get_conf('rest_key_column');
	return $rest_key_col if ($rest_key_col && $rest_key_col ne '');
	my @pri = $self->primary_columns;
	return $pri[0] if ($pri[0] && scalar @pri == 1);
	return undef;
}

### Util functions: to be called in Row-object context
sub apply_row_methods {
	my $class = shift;

	my %RowMethods = (

		getOpenUrl => sub { $class->TableSpec_get_conf('open_url') },

		getRecordPkValue => sub {
			my $self = shift;
			my @pk_vals = map { $self->get_column($_) } $self->primary_columns;
			return join('~$~',@pk_vals);
		},

		getRestKeyVal => sub {
			my $self = shift;
			my $col = $class->getRestKey or return $self->getRecordPkValue;
			return try{$self->get_column($col)};
		},

		getRestPath => sub {
			my $self = shift;
			my $url = $class->getOpenUrl or return undef;
			my $val = $self->getRestKeyVal or return undef;
			return "$url/$val";
		},

		getDisplayValue => sub {
			my $self = shift;
			my $display_column = $class->TableSpec_get_conf('display_column');
			return $self->get_column($display_column) if ($self->has_column($display_column));
			return $self->getRecordPkValue;
		},

		inlineNavLink => sub {
			my $self = shift;
			my $text = shift || '<span>open</span>';
			my %attrs = ( class => "ra-nav-link ra-icon-magnify-tiny", @_ );

			my $title = $self->getDisplayValue or return undef;
			my $url = $self->getRestPath or return undef;

			%attrs = (
				href => '#!' . $url,
				title => $title,
				%attrs
			);

			my $attr_str = join(' ',map { $_ . '="' . $attrs{$_} . '"' } keys %attrs);
			return '<a ' . $attr_str . '>' . $text . '</a>';
		},

		displayWithLink => sub {
			my $self = shift;
			return $self->getDisplayValue . ' ' . $self->inlineNavLink;
		}
	);

	# --- Actualize/load methods into the Row object namespace:
	foreach my $meth (keys %RowMethods) {
		no strict 'refs';
    my $meth_name = join '::', $class, $meth;
		*$meth_name = subname $meth_name => $RowMethods{$meth};
	}
	# ---
}


sub _table_name_safe {
  my $arg = shift;

  my $table = !(ref $arg) && $arg->can('table') ? $arg->table : $arg; # class method or straight function

  $table = $$table if ((ref($table)||'') eq 'SCALAR'); # Handle ScalarRef values
  $table = (reverse split(/\./,$table))[0]; # Handle 'db.table' and 'schema.db.table' formats

  $table =~ s/[\'\"]//g; # Strip quotes
  $table =~ s/\W/_/g;    # Convert any non-word characters to underscore

  $table
}



### -- old, pre-rest inlineNavLink:
## This function creates links just like the JavaScript function Ext.ux.RapidApp.inlineLink
#use URI::Escape;
#sub inlineNavLink {
#	my $self = shift;
#	my $text = shift || '<span>open</span>';
#	my %attrs = ( class => "magnify-link-tiny", @_ );
#	my $loadCfg = delete $attrs{loadCfg} || {};
#
#	my $title = $self->getDisplayValue || return undef;
#	my $url = $self->getOpenUrl || return undef;
#	my $pk_val = $self->getRecordPkValue || return undef;
#
#	$loadCfg = merge({
#		title => $title,
#		autoLoad => {
#			url => $url,
#			params => { '___record_pk' => $pk_val }
#		}
#	},$loadCfg);
#
#	my $href = '#loadcfg:data=' . uri_escape(encode_json($loadCfg));
#	my $onclick = 'return Ext.ux.RapidApp.InlineLinkHandler.apply(this,arguments);';
#
#	%attrs = (
#		href => $href,
#		onclick => $onclick,
#		ondblclick => $onclick,
#		title => $title,
#		%attrs
#	);
#
#	my $attr_str = join(' ',map { $_ . '="' . $attrs{$_} . '"' } keys %attrs);
#
#	return '<a ' . $attr_str . '>' . $text . '</a>';
#
#}
#


1;