From: Matt S Trout Date: Mon, 25 Jul 2005 05:09:07 +0000 (+0000) Subject: Added tests for the core APIs, refactored some X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=604d9f388716261ca478b574f891928e8e0852ef;p=dbsrgits%2FDBIx-Class-Historic.git Added tests for the core APIs, refactored some --- diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm index bfaef4d..35fcec9 100644 --- a/lib/DBIx/Class/AccessorGroup.pm +++ b/lib/DBIx/Class/AccessorGroup.pm @@ -4,6 +4,7 @@ use strict; use warnings; use base qw/Class::Data::Inheritable/; +use NEXT; __PACKAGE__->mk_classdata('_accessor_group_deleted' => { }); diff --git a/lib/DBIx/Class/CDBICompat/Convenience.pm b/lib/DBIx/Class/CDBICompat/Convenience.pm index b82e4a0..23ff2ed 100644 --- a/lib/DBIx/Class/CDBICompat/Convenience.pm +++ b/lib/DBIx/Class/CDBICompat/Convenience.pm @@ -10,23 +10,6 @@ sub find_or_create { 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' ); diff --git a/lib/DBIx/Class/CDBICompat/HasMany.pm b/lib/DBIx/Class/CDBICompat/HasMany.pm index 7c5349c..f96cf9c 100644 --- a/lib/DBIx/Class/CDBICompat/HasMany.pm +++ b/lib/DBIx/Class/CDBICompat/HasMany.pm @@ -11,10 +11,10 @@ sub has_many { 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 =~ /([^\:]+)$/; diff --git a/lib/DBIx/Class/CDBICompat/LazyLoading.pm b/lib/DBIx/Class/CDBICompat/LazyLoading.pm index d15345a..21bcdcd 100644 --- a/lib/DBIx/Class/CDBICompat/LazyLoading.pm +++ b/lib/DBIx/Class/CDBICompat/LazyLoading.pm @@ -28,6 +28,7 @@ sub _flesh { $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; } diff --git a/lib/DBIx/Class/DB.pm b/lib/DBIx/Class/DB.pm index 0ef24b4..1df8835 100644 --- a/lib/DBIx/Class/DB.pm +++ b/lib/DBIx/Class/DB.pm @@ -1,6 +1,7 @@ package DBIx::Class::DB; use base qw/Class::Data::Inheritable/; +use DBI; __PACKAGE__->mk_classdata('_dbi_connect_info'); __PACKAGE__->mk_classdata('_dbi_connect_package'); @@ -24,7 +25,7 @@ sub _populate_dbh { sub _dbi_connect { my ($class, @info) = @_; - return DBI->connect(@info); + return DBI->connect_cached(@info); } sub connection { diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm index d1dc87c..edb7277 100644 --- a/lib/DBIx/Class/PK.pm +++ b/lib/DBIx/Class/PK.pm @@ -52,4 +52,11 @@ sub discard_changes { $_[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; diff --git a/lib/DBIx/Class/SQL.pm b/lib/DBIx/Class/SQL.pm index a06062e..6bba4d9 100644 --- a/lib/DBIx/Class/SQL.pm +++ b/lib/DBIx/Class/SQL.pm @@ -32,7 +32,7 @@ sub _get_sql { sub _sql_to_sth { my ($class, $sql) = @_; - return $class->_get_dbh->prepare($sql); + return $class->_get_dbh->prepare_cached($sql); } sub _get_sth { diff --git a/lib/DBIx/Class/SQL/Abstract.pm b/lib/DBIx/Class/SQL/Abstract.pm index 2286931..93a477c 100644 --- a/lib/DBIx/Class/SQL/Abstract.pm +++ b/lib/DBIx/Class/SQL/Abstract.pm @@ -124,7 +124,7 @@ sub _cond_resolve { } # assemble and return sql - my $wsql = @sqlf ? '( ' . join(" $join ", @sqlf) . ' )' : ''; + my $wsql = @sqlf ? '( ' . join(" $join ", @sqlf) . ' )' : '1 = 1'; return wantarray ? ($wsql, @{$attrs->{bind} || []}) : $wsql; } diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm index 56eea71..51d7ceb 100644 --- a/lib/DBIx/Class/Table.pm +++ b/lib/DBIx/Class/Table.pm @@ -30,11 +30,16 @@ sub insert { 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'; @@ -50,6 +55,7 @@ sub update { $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) { @@ -62,6 +68,7 @@ sub update { 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); @@ -125,7 +132,8 @@ sub add_columns { 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); @@ -142,6 +150,7 @@ sub sth_to_objects { $new->{_in_database} = 1; push(@found, $new); } + $sth->finish; return @found; } @@ -178,6 +187,7 @@ sub copy { sub _cond_resolve { my ($self, $query, $attrs) = @_; + return '1 = 1' unless keys %$query; my $op = $attrs->{'cmp'} || '='; my $cond = join(' AND ', map { (defined $query->{$_} diff --git a/t/01core.t b/t/01core.t new file mode 100644 index 0000000..692c6cb --- /dev/null +++ b/t/01core.t @@ -0,0 +1,75 @@ +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');