view release on metacpan or  search on metacpan

lib/Basset/DB/Table.pm  view on Meta::CPAN

		my $vals = $self->$prop() || [];
	
		my @vals = @$vals ? @$vals : $self->cols;
	
		#weed out our non-columns, if they were provided.
		if ($propname !~ /non/) {
			my $nonprop = $prefix . 'non' . $propname;
			my $nonvals = {map {$_, 1} @{$self->$nonprop() || []}};
	
			@vals = grep {! $nonvals->{$_}} @vals;
		}
	
		return @vals;
	}
}

sub _isa_translation_accessor {
	my $pkg = shift;
	my $attr = shift;
	my $prop = shift;

	return sub {
		my $self = shift;
		$self->_cached_queries({}) if @_;
		$self->_cached_bindables({}) if @_;
		return $self->$prop(@_);
	};
}


=pod

=begin btest init

my $o = __PACKAGE__->new();
$test->ok($o, "got object");
$test->is(ref $o->definition, 'HASH', 'definition initialized to hash');
$test->is(ref $o->extra_select, 'HASH', 'extra_select initialized to hash');
$test->is(ref $o->db_write_translation, 'HASH', 'db_write_translation initialized to hash');
$test->is(ref $o->db_read_translation, 'HASH', 'db_read_translation initialized to hash');
$test->is(ref $o->column_aliases, 'HASH', 'column_aliases initialized to hash');
$test->is(ref $o->references, 'HASH', 'references initialized to hash');

=end btest

=cut

#just a bubble-up initializer. Initializes some values and passes them through.
sub init {
	my $self = shift;

	my %init = (
		'definition'				=> {},
		'extra_select'				=> {},
		'db_write_translation'		=> {},
		'db_read_translation'		=> {},
		'column_aliases'			=> {},
		'references'				=> {},
		'_cached_queries'			=> {},
		'_cached_bindables'			=> {},
		'attributes_not_to_create'	=> [],
		'create_attributes'			=> 0,
		'last_insert_query'			=> 'SELECT LAST_INSERT_ID()',
		@_
	);

	if ($init{'discover'}) {
		$init{'definition'} = $self->discover_columns($init{'name'}) or return;
	} elsif ($init{'non_primary_columns'}) {
		my @primary = ref $init{'primary_column'} ? @{$init{'primary_column'}} : ($init{'primary_column'});
		$init{'definition'} = $self->discover_columns($init{'name'}, (@primary, @{$init{'non_primary_columns'}})) or return;
	}

	#$self->definition($init{'definition'});

	return $self->SUPER::init(
		'definition' => $init{'definition'},
		%init
	);
};

__PACKAGE__->add_attr('_attributes_to_create');
__PACKAGE__->add_attr('attributes_not_to_create');

__PACKAGE__->add_attr('create_attributes');

sub attributes_to_create {
	my $self = shift;
	if (@_) {
		$self->_attributes_to_create($_[0]);
	};
	
	my %not = map {$_, 1} @{$self->attributes_not_to_create};
	
	return grep {! $not{$_} } $self->alias_column($self->_attributes_to_create ? @{$self->_attributes_to_create} : $self->cols);
}

=pod

=back

=head1 METHODS

=over

=pod

=item cols

Returns the columns defined for this table, in an unspecified order

 my @cols = $table->cols();

=cut

=pod

=begin btest cols

my $o = __PACKAGE__->new();
$test->ok($o, "Created object");
my $def = {
	'able' => 'SQL_INTEGER',
	'baker' => 'SQL_VARCHAR',
	'charlie' => 'SQL_DATE',
	'delta' => 'SQL_UNKNOWN_TYPE'
};

$test->is($o->definition($def), $def, "Set definition");
$test->is($o->definition, $def, "Got definition");

my %cols = map {$_, 1} $o->cols();

$test->is(scalar(keys %cols), scalar(keys %$def), "proper number of columns");
$test->is($cols{'able'}, 1, 'able is column');
$test->is($cols{'baker'}, 1, 'baker is column');
$test->is($cols{'charlie'}, 1, 'charlie is column');
$test->is($cols{'delta'}, 1, 'delta is column');
$test->is($cols{'edgar'}, undef, 'edgar is not column');
$test->is($cols{'foxtrot'}, undef, 'foxtrot is not column');
$test->is($cols{'goat'}, undef, 'goat is not column');

=end btest

=cut

sub cols {
	my $self = shift;
	return keys %{$self->definition};
};

=item defs