+
+
+
+
+=head2 _isa_class
+
+Private method to return the class a column
+belongs to that was inherited by an is_a relationship.
+This should probably be public but need to think of API
+
+=cut
+
+sub _isa_class {
+ my ($class, $col) = @_;
+ $class->_croak( "Need a column for _isa_class." ) unless $col;
+ my $isaclass;
+ my $isa = $class->meta_info("is_a") || {};
+ foreach ( keys %$isa ) {
+ $isaclass = $isa->{$_}->foreign_class;
+ return $isaclass if ($isaclass->find_column($col));
+ }
+ return; # col not in a is_a class
+}
+
+
+
+# Thanks to dave baird -- form builder for these private functions
+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;
+}
+
+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;
+ }
+ 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;
+ }
+ return $meta;
+}
+
+
+
+=head2 column_type
+
+ my $type = $class->column_type('column_name');
+
+This returns the 'type' of this column (VARCHAR(20), BIGINT, etc.)
+For now, it returns "BOOL" for tinyints.
+
+TODO :: TEST with enums and postgres
+
+=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})"; }
+ }
+ # Bool if tinyint
+ if ($type and $type =~ /^tinyint/i and $info->{COLUMN_SIZE} == 1) {
+ $type = 'BOOL';
+ }
+ return $type;
+}
+
+=head2 column_nullable
+
+Returns true if a column can be NULL and false if not.
+
+=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};
+}
+
+=head2 column_default
+
+Returns default value for column or the empyty 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;
+}
+
+
+
+
+
+=head2 get_classmetadata
+
+Gets class meta data *excluding cgi input* for the passed in class or the
+calling class. *NOTE* excludes cgi inputs. This method is handy to call from
+templates when you need some metadata for a related class.
+
+=cut
+
+sub get_classmetadata {
+ my ($self, $class) = @_; # class is class we want data for
+ $class ||= $self;
+ $class = ref $class || $class;
+
+ my %res;
+ $res{name} = $class;
+ $res{colnames} = {$class->column_names};
+ $res{columns} = [$class->display_columns];
+ $res{list_columns} = [$class->list_columns];
+ $res{moniker} = $class->moniker;
+ $res{plural} = $class->plural_moniker;
+ $res{table} = $class->table;
+ \%res;
+}
+
+