From 90b7b082066bee6303621aab49b166546445085c Mon Sep 17 00:00:00 2001 From: Aaron Trevena Date: Sun, 30 Jul 2006 16:19:02 +0000 Subject: [PATCH] changes to get/set default columns and column metadata git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@517 48953598-375a-da11-a14b-00016c27c3ee --- Changes | 5 + lib/Maypole.pm | 7 +- lib/Maypole/Model/CDBI.pm | 369 +++++++++++++++++------------- lib/Maypole/Model/CDBI/AsForm.pm | 210 +++++++++-------- lib/Maypole/Model/CDBI/FromCGI.pm | 9 +- t/db_colinfo.t | 12 +- 6 files changed, 335 insertions(+), 277 deletions(-) diff --git a/Changes b/Changes index 940512d..c7efd8a 100644 --- a/Changes +++ b/Changes @@ -12,6 +12,9 @@ Deprecated: Maypole no longer uses Class::DBI::AsForm, instead Maypole::Model::CDBI::AsForm has replaced it. + $config->{$table}{required_cols} is deprecated, please use $class->required_columns instead + + Incompatible API changes: Maypole - is_applicable() deprecated for is_model_applicable(). is_applicable is @@ -62,6 +65,8 @@ API additions and enhancements: - Changed factory edit/view to use object instead of objects Maypole::Model::CDBI - improved error messages in do_edit action + - new required_columns mutator method + - new column_required accessor method Bug fixes: Fix to cgi_maypole.t (bug 11346) diff --git a/lib/Maypole.pm b/lib/Maypole.pm index c3e3525..56c94e3 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -35,6 +35,9 @@ The canonical example used in the Maypole documentation is the beer database: # choose a frontend, initialise the config object, and load a plugin use Maypole::Application qw/Relationship/; + + # set everything up + __PACKAGE__->setup("dbi:SQLite:t/beerdb.db"); # get the empty config object created by Maypole::Application my $config = __PACKAGE__->config; @@ -62,8 +65,8 @@ The canonical example used in the Maypole documentation is the beer database: date => [ qw/date/], ); - # set everything up - __PACKAGE__->setup("dbi:SQLite:t/beerdb.db"); + # note : set up model before calling this method + BeerDB::Beer->required_columns([qw/name/]); 1; diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index bd9646f..5433beb 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -80,7 +80,7 @@ sub do_edit : Exported { return; } - my $required_cols = $config->{$table}{required_cols} || []; + my $required_cols = $config->{$table}{required_cols} || $self->required_columns; my $ignored_cols = $config->{$table}{ignore_cols} || []; ($obj, my $fatal, my $creating) = $self->_do_update_or_create($r, $obj, $required_cols, $ignored_cols); @@ -155,40 +155,6 @@ sub _do_update_or_create { return $obj, $fatal, $creating; } - -# split out from do_edit to be reported by Mp::P::Trace -#sub _do_update_or_create { -# my ($self, $r, $obj, $required_cols, $ignored_cols) = @_; -# -# my $fatal; -# my $creating = 0; -# -# my $h = $self->Untainter->new( %{$r->params} ); -# -# # update or create -# if ($obj) { -# # We have something to edit -# eval { $obj->update_from_cgi( $h => { -# required => $required_cols, -# ignore => $ignored_cols, -# } ); -# $obj->update(); # pos fix for bug 17132 'autoupdate required by do_edit' -# }; -# $fatal = $@; -# } else { -# eval { -# $obj = $self->create_from_cgi( $h => { -# required => $required_cols, -# ignore => $ignored_cols, -# } ); -# }; -# $fatal = $@; -# $creating++; -# } -# -# return $obj, $fatal, $creating; -#} - =head2 delete Deprecated method that calls do_delete or a given classes delete method, please @@ -533,100 +499,107 @@ sub _isa_class { } - # Thanks to dave baird -- form builder for these private functions +# sub _column_info { sub _column_info { - my $self = shift; - my $dbh = $self->db_Main; - return $self->COLUMN_INFO if ref $self->COLUMN_INFO; - - my $meta; # The info we are after - my ($catalog, $schema) = (undef, undef); - # Dave is suspicious this (above undefs) could - # break things if driver useses this info - - # '%' is a search pattern for columns - matches all columns - if ( my $sth = $dbh->column_info( $catalog, $schema, $self->table, '%' ) ) - { - $dbh->errstr && die "Error getting column info sth: " . $dbh->errstr; - $self->COLUMN_INFO( $self->_hash_type_meta( $sth ) ); -# use Data::Dumper; warn "col info for typed is " . Dumper($self->COLUMN_INFO); - } - else - { - $self->COLUMN_INFO( $self->_hash_typeless_meta( ) ); -# use Data::Dumper; warn "col info TYPELESS is " . Dumper($self->COLUMN_INFO); - } - return $self->COLUMN_INFO; + my $self = shift; + warn "__column_info called by ", join (', ', caller), "\n"; + my $dbh = $self->db_Main; + + my $meta; # The info we are after + my ($catalog, $schema) = (undef, undef); + # Dave is suspicious this (above undefs) could + # break things if driver useses this info + + my $original_metadata; + # '%' is a search pattern for columns - matches all columns + if ( my $sth = $dbh->column_info( $catalog, $schema, $self->table, '%' ) ) { + $dbh->errstr && die "Error getting column info sth: " . $dbh->errstr; + $self->COLUMN_INFO ($self->_hash_type_meta( $sth )); + } else { + $self->COLUMN_INFO ($self->_hash_typeless_meta( )); + } + + return $self->COLUMN_INFO; } -sub _hash_type_meta -{ - my ($self, $sth) = @_; - my $meta; - while ( my $row = $sth->fetchrow_hashref ) - - { - my ($col_meta, $col_name); - - foreach my $key ( keys %$row) - { - my $value = $row->{$key} || $row->{ uc $key }; - $col_meta->{$key} = $value; - $col_name = $row->{COLUMN_NAME} || $row->{column_name}; - } - - $meta->{$col_name} = $col_meta; +sub _hash_type_meta { + my ($self, $sth) = @_; + my $meta; + while ( my $row = $sth->fetchrow_hashref ) { + my $colname = $row->{COLUMN_NAME} || $row->{column_name}; + + # required / nullable + $meta->{$colname}{nullable} = $row->{NULLABLE}; + + $meta->{$colname}{required} = ($row->{NULLABLE} && $row->{NULLABLE} == 0) ? 1 : 0; + + # default + if (defined $row->{COLUMN_DEF}) { + my $default = $row->{COLUMN_DEF}; + $default =~ s/['"]?(.*?)['"]?::.*$/$1/; + $meta->{$colname}{default} = $default; + }else { + $meta->{$colname}{default} = ''; } - return $meta; -} -# typeless db e.g. sqlite -sub _hash_typeless_meta -{ - my ( $self ) = @_; - - $self->set_sql( fb_meta_dummy => 'SELECT * FROM __TABLE__ WHERE 1=0' ) - unless $self->can( 'sql_fb_meta_dummy' ); - - my $sth = $self->sql_fb_meta_dummy; - - $sth->execute or die "Error executing column info: " . $sth->errstr;; - - # see 'Statement Handle Attributes' in the DBI docs for a list of available attributes - my $cols = $sth->{NAME}; - my $types = $sth->{TYPE}; - # my $sizes = $sth->{PRECISION}; # empty - # my $nulls = $sth->{NULLABLE}; # empty - - # we haven't actually fetched anything from the sth, so need to tell DBI we're not going to - $sth->finish; - - my $order = 0; - my $meta; - foreach my $col ( @$cols ) - { - my $col_meta; - - $col_meta->{NULLABLE} = 1; - - # in my limited testing, the columns are returned in the same order as they were defined in the schema - $col_meta->{ORDINAL_POSITION} = $order++; - - # type_name is taken literally from the schema, but is not actually used by sqlite, - # so it can be anything, e.g. varchar or varchar(xxx) or VARCHAR etc. - my $type = shift( @$types ); - $type =~ /(\w+)\((\w+)\)/; - $col_meta->{type} = $type; - $col_meta->{TYPE_NAME} = $1; - my $size = $2; - $col_meta->{COLUMN_SIZE} = $size if $type =~ /(CHAR|INT)/i; - $meta->{$col} = $col_meta; + # type + my $type = $row->{mysql_type_name} || $row->{type}; + unless ($type) { + $type = $row->{TYPE_NAME}; + if ($row->{COLUMN_SIZE}) { + $type .= "($row->{COLUMN_SIZE})"; + } } - return $meta; -} + $type =~ s/['"]?(.*)['"]?::.*$/$1/; + # Bool if tinyint + if ($type and $type =~ /^tinyint/i and $row->{COLUMN_SIZE} == 1) { + $type = 'BOOL'; + } + $meta->{$colname}{type} = $type; + # order + $meta->{$colname}{position} = $row->{ORDINAL_POSITION} + } + return $meta; +} +# typeless db e.g. sqlite +sub _hash_typeless_meta { + my ( $self ) = @_; + + $self->set_sql( fb_meta_dummy => 'SELECT * FROM __TABLE__ WHERE 1=0' ) + unless $self->can( 'sql_fb_meta_dummy' ); + + my $sth = $self->sql_fb_meta_dummy; + + $sth->execute or die "Error executing column info: " . $sth->errstr;; + + # see 'Statement Handle Attributes' in the DBI docs for a list of available attributes + my $cols = $sth->{NAME}; + my $types = $sth->{TYPE}; + # my $sizes = $sth->{PRECISION}; # empty + # my $nulls = $sth->{NULLABLE}; # empty + + # we haven't actually fetched anything from the sth, so need to tell DBI we're not going to + $sth->finish; + + my $order = 0; + my $meta; + foreach my $col ( @$cols ) { + my $col_meta; + $col_meta->{nullable} = 1; + $col_meta->{required} = 0; + $col_meta->{default} = ''; + $col_meta->{position} = $order++; + # type_name is taken literally from the schema, but is not actually used by sqlite, + # so it can be anything, e.g. varchar or varchar(xxx) or VARCHAR etc. + my $type = shift( @$types ); + $col_meta->{type} = ($type =~ /(\w+)\((\w+)\)/) ? $1 :$type ; + $meta->{$col} = $col_meta; + } + return $meta; +} =head2 column_type @@ -635,68 +608,145 @@ sub _hash_typeless_meta This returns the 'type' of this column (VARCHAR(20), BIGINT, etc.) For now, it returns "BOOL" for tinyints. -TODO :: TEST with enums and postgres +TODO :: TEST with enums =cut + sub column_type { - my $class = shift; - my $col = shift or die "Need a column for column_type"; - my $info = $class->_column_info->{$col} || - eval { $class->_isa_class($col)->_column_info($col) } || - return ''; - - my $type = $info->{mysql_type_name} || $info->{type}; - unless ($type) { - $type = $info->{TYPE_NAME}; - if ($info->{COLUMN_SIZE}) { $type .= "($info->{COLUMN_SIZE})"; } + my $class = shift; + my $colname = shift or die "Need a column for column_type"; + $class->_column_info() unless (ref $class->COLUMN_INFO); + + if ($class->_isa_class($colname)) { + return $class->_isa_class($colname)->column_type($colname); + } + unless ( $class->find_column($colname) ) { + warn "$colname is not a recognised column in this class ", ref $class || $class, "\n"; + return undef; + } + return $class->COLUMN_INFO->{$colname}{type}; +} + +=head2 required_columns + + Accessor to get/set required columns for forms, validation, etc. + + Returns list of required columns. Accepts an array ref of column names. + + $class->required_columns([qw/foo bar baz/]); + + Allows you to specify the required columns for a class, over-riding any + assumptions and guesses made by Maypole. + + Use this instead of $config->{$table}{required_cols} + + Note : you need to setup the model class before calling this method. + +=cut + +sub required_columns { + my ($class, $columns) = @_; + $class->_column_info() unless ref $class->COLUMN_INFO; + my $column_info = $class->COLUMN_INFO; + if ($columns) { + foreach my $colname ( @$columns ) { + if ($class->_isa_class($colname)) { + $class->_isa_class($colname)->COLUMN_INFO->{$colname}{required} = 1 + unless ($class->_isa_class($colname)->column_required); + next; + } + unless ( $class->find_column($colname) ) { + warn "$colname is not a recognised column in this class ", ref $class || $class, "\n"; + next; + } + $column_info->{required} = 1; } - # Bool if tinyint - if ($type and $type =~ /^tinyint/i and $info->{COLUMN_SIZE} == 1) { - $type = 'BOOL'; - } - return $type; + $class->COLUMN_INFO($column_info); + } + + return [ grep ($column_info->{$_}{required}, keys %{$column_info}) ] ; +} + +=head2 column_required + + Returns true if a column is required + + my $required = $class->column_required($column_name); + + Columns can be required by the application but not the database, but not the other way around, + hence there is also a column_nullable method which will tell you if the column is nullable + within the database itself. + +=cut + +sub column_required { + my ($class, $colname) = @_; + $colname or $class->_croak( "Need a column for column_nullable" ); + $class->_column_info() unless ref $class->COLUMN_INFO; + if ($class->_isa_class($colname)) { + return $class->_isa_class($colname)->column_required($colname); + } + unless ( $class->find_column($colname) ) { + # handle non-existant columns + warn "$colname is not a recognised column in this class ", ref $class || $class, "\n"; + return undef; + } + return $class->COLUMN_INFO->{$colname}{required} || 0; } =head2 column_nullable -Returns true if a column can be NULL and false if not. + Returns true if a column can be NULL within the underlying database and false if not. + + my $nullable = $class->column_nullable($column_name); + + Any columns that are not nullable will automatically be specified as required, you can + also specify nullable columns as required within your application. + + It is recomended you use column_required rather than column_nullable within your + application, this method is more useful if extending the model or handling your own + validation. =cut sub column_nullable { my $class = shift; - my $col = shift or $class->_croak( "Need a column for column_nullable" ); - my $info = $class->_column_info->{$col} || - eval { $class->_isa_class($col)->_column_info($col) } || - return 1; - return $info->{NULLABLE}; + my $colname = shift or $class->_croak( "Need a column for column_nullable" ); + + $class->_column_info() unless ref $class->COLUMN_INFO; + if ($class->_isa_class($colname)) { + return $class->_isa_class($colname)->column_nullable($colname); + } + unless ( $class->find_column($colname) ) { + # handle non-existant columns + warn "$colname is not a recognised column in this class ", ref $class || $class, "\n"; + return undef; + } + return $class->COLUMN_INFO->{$colname}{nullable} || 0; } =head2 column_default -Returns default value for column or the empyty string. +Returns default value for column or the empty string. Columns with NULL, CURRENT_TIMESTAMP, or Zeros( 0000-00...) for dates and times have '' returned. =cut sub column_default { - my $class = shift; - my $col = shift or $class->_croak( "Need a column for column_default"); - #return unless $class->find_column($col); # not a real column - - my $info = $class->_column_info->{$col} || - eval { $class->_isa_class($col)->_column_info($col) } || - return ''; - - my $def = $info->{COLUMN_DEF}; - $def = '' unless defined $def; # is this good? - return $def; -} - - - + my $class = shift; + my $colname = shift or $class->_croak( "Need a column for column_default"); + $class->_column_info() unless (ref $class->COLUMN_INFO); + if ($class->_isa_class($colname)) { + return $class->_isa_class($colname)->column_default($colname); + } + unless ( $class->find_column($colname) ) { + warn "$colname is not a recognised column in this class ", ref $class || $class, "\n"; + return undef; + } + return $class->COLUMN_INFO->{$colname}{default}; +} =head2 get_classmetadata @@ -719,7 +769,8 @@ sub get_classmetadata { $res{moniker} = $class->moniker; $res{plural} = $class->plural_moniker; $res{table} = $class->table; - \%res; + $res{column_metadata} = (ref $class->COLUMN_INFO) ? $class->COLUMN_INFO : $class->_column_info() ; + return \%res; } diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm index cd295f3..1765482 100644 --- a/lib/Maypole/Model/CDBI/AsForm.pm +++ b/lib/Maypole/Model/CDBI/AsForm.pm @@ -326,26 +326,24 @@ See C. You can also pass this argument in $args->{how}. =cut sub to_field { - my ($self, $field, $how, $args) = @_; - if (ref $how) { $args = $how; $how = ''; } - unless ($how) { $how = $args->{how} || ''; } -#warn "In to_field field is $field how is $how. args ar e" . Dumper($args) . " \n"; - # Set sensible default value - if ($field and not defined $args->{default}) { - my $def = $self->column_default($field) ; - # exclude defaults we don't want actually put as value for input - if (defined $def) { - $def = $def =~ /(^0000-00-00.*$|^0[0]*$|^0\.00$|CURRENT_TIMESTAMP|NULL)/i ? '' : $def ; - $args->{default} = $def; - } - } - - + my ($self, $field, $how, $args) = @_; + if (ref $how) { $args = $how; $how = ''; } + unless ($how) { $how = $args->{how} || ''; } + #warn "In to_field field is $field how is $how. args ar e" . Dumper($args) . " \n"; + # Set sensible default value + if ($field and not defined $args->{default}) { + my $def = $self->column_default($field) ; + # exclude defaults we don't want actually put as value for input + if (defined $def) { + $def = $def =~ /(^0000-00-00.*$|^0[0]*$|^0\.00$|CURRENT_TIMESTAMP|NULL)/i ? '' : $def ; + $args->{default} = $def; + } + } - return $self->_field_from_how($field, $how, $args) || - $self->_field_from_relationship($field, $args) || - $self->_field_from_column($field, $args) || - $self->_to_textfield($field, $args); + return $self->_field_from_how($field, $how, $args) || + $self->_field_from_relationship($field, $args) || + $self->_field_from_column($field, $args) || + $self->_to_textfield($field, $args); } @@ -375,65 +373,64 @@ Example: sub search_inputs { - my ($class, $args) = @_; - $class = ref $class || $class; - #my $accssr_class = { $class->accessor_classes }; - my %cgi; - - $args->{columns} ||= $class->can('search_columns') ?[$class->search_columns] : [$class->display_columns]; - - foreach my $field ( @{ $args->{columns} } ) { - my $base_args = { - no_hidden_constraints => 1, - column_nullable => 1, # empty option on select boxes - value => '', - }; - if ( ref $field eq "HASH" ) { # foreign search fields - my ($accssr, $cols) = each %$field; - $base_args->{columns} = $cols; - unless ( @$cols ) { - # default to search fields for related - #$cols = $accssr_class->{$accssr}->search_columns; - die ("$class search_fields error: Must specify at least one column to search in the foreign object named '$accssr'"); - } - my $fcgi = $class->to_field($accssr, 'foreign_inputs', $base_args); - - # unset the default values for a select box - foreach (keys %$fcgi) { - my $el = $fcgi->{$_}; - if ($el->tag eq 'select') { - - $class->unselect_element($el); - my ($first, @content) = $el->content_list; - my @fc = $first->content_list; - my $val = $first ? $first->attr('value') : undef; - if ($first and (@fc > 0 or (defined $val and $val ne '')) ) { # something ( $first->attr('value') ne '' or - - #(defined $first->attr('value') or $first->attr('value') ne '')) - # push an empty option on stactk - $el->unshift_content(HTML::Element->new('option')); - } - } + my ($class, $args) = @_; + $class = ref $class || $class; + #my $accssr_class = { $class->accessor_classes }; + my %cgi; + + $args->{columns} ||= $class->can('search_columns') ?[$class->search_columns] : [$class->display_columns]; + + foreach my $field ( @{ $args->{columns} } ) { + my $base_args = { + no_hidden_constraints => 1, + column_nullable => 1, # empty option on select boxes + value => '', + }; + if ( ref $field eq "HASH" ) { # foreign search fields + my ($accssr, $cols) = each %$field; + $base_args->{columns} = $cols; + unless ( @$cols ) { + # default to search fields for related + #$cols = $accssr_class->{$accssr}->search_columns; + die ("$class search_fields error: Must specify at least one column to search in the foreign object named '$accssr'"); + } + my $fcgi = $class->to_field($accssr, 'foreign_inputs', $base_args); + + # unset the default values for a select box + foreach (keys %$fcgi) { + my $el = $fcgi->{$_}; + if ($el->tag eq 'select') { + + $class->unselect_element($el); + my ($first, @content) = $el->content_list; + my @fc = $first->content_list; + my $val = $first ? $first->attr('value') : undef; + if ($first and (@fc > 0 or (defined $val and $val ne '')) ) { # something ( $first->attr('value') ne '' or + + #(defined $first->attr('value') or $first->attr('value') ne '')) + # push an empty option on stactk + $el->unshift_content(HTML::Element->new('option')); + } + } - } - $cgi{$accssr} = $fcgi; - delete $base_args->{columns}; - } - else { - $cgi{$field} = $class->to_field($field, $base_args); #{no_select => $args->{no_select}{$field} }); - my $el = $cgi{$field}; - if ($el->tag eq 'select') { - $class->unselect_element($el); - my ($first, @content) = $el->content_list; - if ($first and $first->content_list) { # something - #(defined $first->attr('value') or $first->attr('value') ne '')) - # push an empty option on stactk - $el->unshift_content(HTML::Element->new('option')); - } - } - } - } - return \%cgi; + } + $cgi{$accssr} = $fcgi; + delete $base_args->{columns}; + } else { + $cgi{$field} = $class->to_field($field, $base_args); #{no_select => $args->{no_select}{$field} }); + my $el = $cgi{$field}; + if ($el->tag eq 'select') { + $class->unselect_element($el); + my ($first, @content) = $el->content_list; + if ($first and $first->content_list) { # something + #(defined $first->attr('value') or $first->attr('value') ne '')) + # push an empty option on stactk + $el->unshift_content(HTML::Element->new('option')); + } + } + } + } + return \%cgi; } @@ -536,36 +533,35 @@ Override at will. =cut sub _field_from_column { - my ($self, $field, $args) = @_; - # this class and pk are default class and field at this point - my $class = $args->{class} || $self; - $class = ref $class || $class; - $field ||= ($class->primary_columns)[0]; # TODO - - # Get column type - unless ($args->{column_type}) { - if ($class->can('column_type')) { - $args->{column_type} = $class->column_type($field); - } - else { - # Right, have some of this - eval "package $class; Class::DBI::Plugin::Type->import()"; - $args->{column_type} = $class->column_type($field); - } - } - my $type = $args->{column_type}; - - return $self->_to_textfield($field, $args) - if $type and $type =~ /^(VAR)?CHAR/i; #common type - return $self->_to_textarea($field, $args) - if $type and $type =~ /^(TEXT|BLOB)$/i; - return $self->_to_enum_select($field, $args) - if $type and $type =~ /^ENUM\((.*?)\)$/i; - return $self->_to_bool_select($field, $args) - if $type and $type =~ /^BOOL/i; - return $self->_to_readonly($field, $args) - if $type and $type =~ /^readonly$/i; - return; + my ($self, $field, $args) = @_; + # this class and pk are default class and field at this point + my $class = $args->{class} || $self; + $class = ref $class || $class; + $field ||= ($class->primary_columns)[0]; # TODO + + # Get column type + unless ($args->{column_type}) { + if ($class->can('column_type')) { + $args->{column_type} = $class->column_type($field); + } else { + # Right, have some of this + eval "package $class; Class::DBI::Plugin::Type->import()"; + $args->{column_type} = $class->column_type($field); + } + } + my $type = $args->{column_type}; + + return $self->_to_textfield($field, $args) + if $type and $type =~ /^(VAR)?CHAR/i; #common type + return $self->_to_textarea($field, $args) + if $type and $type =~ /^(TEXT|BLOB)$/i; + return $self->_to_enum_select($field, $args) + if $type and $type =~ /^ENUM\((.*?)\)$/i; + return $self->_to_bool_select($field, $args) + if $type and $type =~ /^BOOL/i; + return $self->_to_readonly($field, $args) + if $type and $type =~ /^readonly$/i; + return; } diff --git a/lib/Maypole/Model/CDBI/FromCGI.pm b/lib/Maypole/Model/CDBI/FromCGI.pm index cc27533..6cb95a0 100644 --- a/lib/Maypole/Model/CDBI/FromCGI.pm +++ b/lib/Maypole/Model/CDBI/FromCGI.pm @@ -279,12 +279,9 @@ sub validate_all { my $updating = $opts->{updating}; # Base case - validate this classes data - $opts->{all} ||= eval{ $r->config->{$self->table}{all_cols} } || - [$self->columns('All')]; - $opts->{required} ||= eval{ $r->config->{$self->table}{required_cols} } || - []; - my $ignore = $opts->{ignore} || eval{ $r->config->{$self->table}{ignore_cols} } - || []; + $opts->{all} ||= eval{ $r->config->{$self->table}{all_cols} } || [$self->columns('All')]; + $opts->{required} ||= eval { $r->config->{$self->table}{required_cols} || $self->required_columns } || []; + my $ignore = $opts->{ignore} || eval{ $r->config->{$self->table}{ignore_cols} } || []; push @$ignore, $self->primary_column->name if $updating; # Ignore hashes of foreign inputs. This takes care of required has_a's diff --git a/t/db_colinfo.t b/t/db_colinfo.t index c56fbf2..b387769 100755 --- a/t/db_colinfo.t +++ b/t/db_colinfo.t @@ -1,5 +1,6 @@ #!/usr/bin/perl -w use Test::More; +use Data::Dumper; use lib 'ex'; # Where BeerDB should live BEGIN { plan tests => 35; @@ -56,7 +57,7 @@ create table $table ( brewery => 1, modified => 1, style => 0, - name => 0, + name => 0, tasted => 0, ); @@ -76,6 +77,7 @@ sub run_method_tests { my $correct = $correct{$col}; like($val, qr/$correct/,"$method $col is $val"); } + } @@ -83,7 +85,7 @@ sub run_method_tests { # Make test class package BeerDB::BeerTestmysql; -use base Maypole::Model::CDBI; +use base qw(Maypole::Model::CDBI Class::DBI); package main; $DB_Class = 'BeerDB::BeerTestmysql'; @@ -117,6 +119,8 @@ SKIP: { $DB_Class->db_Main->do("drop table if exists $table;"); $DB_Class->db_Main->do($sql); $DB_Class->table($table); + $DB_Class->columns(All => keys %correct_types); + $DB_Class->columns(Primary => 'id'); run_method_tests($DB_Class,'column_type', %correct_types); run_method_tests($DB_Class,'column_default', %correct_defaults); run_method_tests($DB_Class,'column_nullable', %correct_nullables); @@ -125,7 +129,7 @@ SKIP: { # SQLite test package BeerDB::BeerTestsqlite; -use base Maypole::Model::CDBI; +use base qw(Maypole::Model::CDBI Class::DBI); package main; use Cwd; @@ -152,6 +156,8 @@ $skip_howmany = 13; SKIP: { skip $skip_msg, $skip_howmany if $err; $DB_Class->table($table); + $DB_Class->columns(All => keys %correct_types); + $DB_Class->columns(Primary => 'id'); #use Data::Dumper; run_method_tests($DB_Class,'column_type', %correct_types); # No support default -- 2.39.5