From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 25 Jul 2005 05:09:07 +0000 (+0000)
Subject: Added tests for the core APIs, refactored some
X-Git-Tag: v0.03001~129
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=604d9f388716261ca478b574f891928e8e0852ef;p=dbsrgits%2FDBIx-Class.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');