use warnings;
use base qw/Class::Data::Inheritable/;
+use NEXT;
__PACKAGE__->mk_classdata('_accessor_group_deleted' => { });
return defined($exists) ? $exists : $class->create($hash);
}
-sub id {
- my ($self) = @_;
- die "Can't call id() as a class method" unless ref $self;
- my @pk = $self->_ident_values;
- return (wantarray ? @pk : $pk[0]);
-}
-
-#sub insert {
-# my $self = shift;
-# $self->NEXT::insert(@_);
-# my @pk = keys %{ $self->_primaries };
-# if ((@pk == 1) && (!$self->{_column_data}{$pk[0]})) {
-# $self->{_column_data}{$pk[0]} = $self->_get_dbh->last_insert_id;
-# }
-# return $self;
-#}
-
sub retrieve_all {
my ($class) = @_;
return $class->retrieve_from_sql( '1' );
die "has_many only works with a single primary key; ${class} has more"
if $too_many;
if (ref $f_key eq 'HASH') { $args = $f_key; undef $f_key; };
- unless ($f_key) {
- ($f_key) = grep { $_->{class} && $_->{class} eq $class }
- $f_class->_relationships;
- }
+ #unless ($f_key) { Not selective enough. Removed pending fix.
+ # ($f_rel) = grep { $_->{class} && $_->{class} eq $class }
+ # $f_class->_relationships;
+ #}
unless ($f_key) {
#warn join(', ', %{ $f_class->_columns });
$class =~ /([^\:]+)$/;
$self->_ident_cond);
$sth->execute($self->_ident_values);
my @val = $sth->fetchrow_array;
+ $sth->finish;
foreach my $w (@want) {
$self->{'_column_data'}{$w} = shift @val;
}
package DBIx::Class::DB;
use base qw/Class::Data::Inheritable/;
+use DBI;
__PACKAGE__->mk_classdata('_dbi_connect_info');
__PACKAGE__->mk_classdata('_dbi_connect_package');
sub _dbi_connect {
my ($class, @info) = @_;
- return DBI->connect(@info);
+ return DBI->connect_cached(@info);
}
sub connection {
$_[0] = $self->retrieve($self->id);
}
+sub id {
+ my ($self) = @_;
+ die "Can't call id() as a class method" unless ref $self;
+ my @pk = $self->_ident_values;
+ return (wantarray ? @pk : $pk[0]);
+}
+
1;
sub _sql_to_sth {
my ($class, $sql) = @_;
- return $class->_get_dbh->prepare($sql);
+ return $class->_get_dbh->prepare_cached($sql);
}
sub _get_sth {
}
# assemble and return sql
- my $wsql = @sqlf ? '( ' . join(" $join ", @sqlf) . ' )' : '';
+ my $wsql = @sqlf ? '( ' . join(" $join ", @sqlf) . ' )' : '1 = 1';
return wantarray ? ($wsql, @{$attrs->{bind} || []}) : $wsql;
}
my $sth = $self->_get_sth('insert', [ keys %{$self->{_column_data}} ],
$self->_table_name, undef);
$sth->execute(values %{$self->{_column_data}});
+ $sth->finish;
$self->{_in_database} = 1;
$self->{_dirty_columns} = {};
return $self;
}
+sub in_database {
+ return $_[0]->{_in_database};
+}
+
sub create {
my ($class, $attrs) = @_;
die "create needs a hashref" unless ref $attrs eq 'HASH';
$self->_table_name, $self->_ident_cond);
my $rows = $sth->execute( (map { $self->{_column_data}{$_} } @to_update),
$self->_ident_values );
+ $sth->finish;
if ($rows == 0) {
die "Can't update $self: row not found";
} elsif ($rows > 1) {
sub delete {
my $self = shift;
if (ref $self) {
+ die "Not in database" unless $self->{_in_database};
#warn $self->_ident_cond.' '.join(', ', $self->_ident_values);
my $sth = $self->_get_sth('delete', undef,
$self->_table_name, $self->_ident_cond);
sub retrieve_from_sql {
my ($class, $cond, @vals) = @_;
$cond =~ s/^\s*WHERE//i;
- my @cols = $class->_select_columns;
+ my $attrs = (ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
+ my @cols = $class->_select_columns($attrs);
my $sth = $class->_get_sth( 'select', \@cols, $class->_table_name, $cond);
#warn "$cond @vals";
return $class->sth_to_objects($sth, \@vals, \@cols);
$new->{_in_database} = 1;
push(@found, $new);
}
+ $sth->finish;
return @found;
}
sub _cond_resolve {
my ($self, $query, $attrs) = @_;
+ return '1 = 1' unless keys %$query;
my $op = $attrs->{'cmp'} || '=';
my $cond = join(' AND ',
map { (defined $query->{$_}
--- /dev/null
+use Test::More;
+
+plan tests => 19;
+
+use lib qw(t/lib);
+
+use_ok('DBICTest');
+
+my @art = DBICTest::Artist->search({ }, { order_by => 'name DESC'});
+
+cmp_ok(@art, '==', 3, "Three artists returned");
+
+my $art = $art[0];
+
+is($art->name, 'We Are Goth', "Correct order too");
+
+$art->name('We Are In Rehab');
+
+is($art->name, 'We Are In Rehab', "Accessor update ok");
+
+is($art->get_column("name"), 'We Are In Rehab', 'And via get_column');
+
+ok($art->update, 'Update run');
+
+@art = DBICTest::Artist->search({ name => 'We Are In Rehab' });
+
+cmp_ok(@art, '==', 1, "Changed artist returned by search");
+
+cmp_ok($art[0]->artistid, '==', 3,'Correct artist too');
+
+$art->delete;
+
+@art = DBICTest::Artist->search({ });
+
+cmp_ok(@art, '==', 2, 'And then there were two');
+
+ok(!$art->in_database, "It knows it's dead");
+
+eval { $art->delete; };
+
+ok($@, "Can't delete twice: $@");
+
+is($art->name, 'We Are In Rehab', 'But the object is still live');
+
+$art->insert;
+
+ok($art->in_database, "Re-created");
+
+@art = DBICTest::Artist->search({ });
+
+cmp_ok(@art, '==', 3, 'And now there are three again');
+
+my $new = DBICTest::Artist->create({ artistid => 4 });
+
+cmp_ok($new->artistid, '==', 4, 'Create produced record ok');
+
+@art = DBICTest::Artist->search({ });
+
+cmp_ok(@art, '==', 4, "Oh my god! There's four of them!");
+
+$new->set_column('name' => 'Man With A Fork');
+
+is($new->name, 'Man With A Fork', 'set_column ok');
+
+$new->discard_changes;
+
+ok(!defined $new->name, 'Discard ok');
+
+$new->name('Man With A Spoon');
+
+$new->update;
+
+$new_again = DBICTest::Artist->retrieve(4);
+
+is($new_again->name, 'Man With A Spoon', 'Retrieved correctly');
projects / dbsrgits/DBIx-Class-Historic.git / commitdiff