[Bast-commits] r5923 - in DBIx-Class/0.08/trunk: lib/DBIx/Class t/cdbi t/cdbi/testlib

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2009-04-21 09:51:03 +0100 (Tue, 21 Apr 2009)
New Revision: 5923

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/DB.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSet.pm
   DBIx-Class/0.08/trunk/t/cdbi/02-Film.t
   DBIx-Class/0.08/trunk/t/cdbi/15-accessor.t
   DBIx-Class/0.08/trunk/t/cdbi/22-deflate_order.t
   DBIx-Class/0.08/trunk/t/cdbi/testlib/MyBase.pm
Log:
Multiple cdbi-compat test cleanups
Clarify search_like deprecation

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/DB.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/DB.pm	2009-04-21 08:37:11 UTC (rev 5922)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/DB.pm	2009-04-21 08:51:03 UTC (rev 5923)
@@ -162,11 +162,12 @@
 sub _maybe_attach_source_to_schema {
   my ($class, $source) = @_;
   if (my $meth = $class->can('schema_instance')) {
-    my $schema = $class->$meth;
-    $schema->register_class($class, $class);
-    my $new_source = $schema->source($class);
-    %$source = %$new_source;
-    $schema->source_registrations->{$class} = $source;
+    if (my $schema = $class->$meth) {
+      $schema->register_class($class, $class);
+      my $new_source = $schema->source($class);
+      %$source = %$new_source;
+      $schema->source_registrations->{$class} = $source;
+    }
   }
 }
 

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSet.pm	2009-04-21 08:37:11 UTC (rev 5922)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSet.pm	2009-04-21 08:51:03 UTC (rev 5923)
@@ -873,7 +873,11 @@
 
 sub search_like {
   my $class = shift;
-  carp "search_like() is deprecated and will be removed in 0.09. Use search() instead.";
+  carp join ("\n",
+    'search_like() is deprecated and will be removed in 0.09.',
+    'Instead use ->search({ x => { -like => "y%" } })',
+    '(note the outer pair of {}s - they are important!)'
+  );
   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
   my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;

Modified: DBIx-Class/0.08/trunk/t/cdbi/02-Film.t
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/02-Film.t	2009-04-21 08:37:11 UTC (rev 5922)
+++ DBIx-Class/0.08/trunk/t/cdbi/02-Film.t	2009-04-21 08:51:03 UTC (rev 5923)
@@ -151,7 +151,7 @@
 
 # Multi-column search
 {
-	my @films = $blrunner->search_like(title => "Bladerunner%", rating => '15');
+	my @films = $blrunner->search (title => { -like => "Bladerunner%"}, rating => '15');
 	is @films, 1, "Only one Bladerunner is a 15";
 }
 
@@ -208,7 +208,7 @@
 is($films[0]->id, $gone->id, ' ... the correct one');
 
 # Find all films which were directed by Bob
- at films = Film->search_like('Director', 'Bob %');
+ at films = Film->search ( { 'Director' => { -like => 'Bob %' } });
 is(scalar @films, 3, ' search_like returns 3 films');
 ok(
 	eq_array(

Modified: DBIx-Class/0.08/trunk/t/cdbi/15-accessor.t
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/15-accessor.t	2009-04-21 08:37:11 UTC (rev 5922)
+++ DBIx-Class/0.08/trunk/t/cdbi/15-accessor.t	2009-04-21 08:51:03 UTC (rev 5923)
@@ -25,6 +25,11 @@
     sub Class::DBI::sheep { ok 0; }
 }
 
+# Install the deprecation warning intercept here for the rest of the 08 dev cycle
+local $SIG{__WARN__} = sub {
+  warn @_ unless (DBIx::Class->VERSION < 0.09 and $_[0] =~ /Query returned more than one row/);
+};
+
 sub Film::mutator_name {
     my ($class, $col) = @_;
     return "set_sheep" if lc $col eq "numexplodingsheep";
@@ -160,9 +165,6 @@
     like $@, qr/film/, "no hasa film";
 
     eval {
-        local $SIG{__WARN__} = sub {
-            warn @_ unless $_[0] =~ /Query returned more than one row/;
-        };
         ok my $f = $ac->movie, "hasa movie";
         isa_ok $f, "Film";
         is $f->id, $bt->id, " - Bad Taste";
@@ -264,5 +266,5 @@
     my $abigail = eval { Film->create({ title => "Abigail's Party" }) };
     like $@, qr/read only/, "Or create new films";
 
-    $sandl->discard_changes;
+    $_->discard_changes for ($naked, $sandl);
 }

Modified: DBIx-Class/0.08/trunk/t/cdbi/22-deflate_order.t
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/22-deflate_order.t	2009-04-21 08:37:11 UTC (rev 5922)
+++ DBIx-Class/0.08/trunk/t/cdbi/22-deflate_order.t	2009-04-21 08:51:03 UTC (rev 5923)
@@ -12,6 +12,7 @@
 eval { require Time::Piece::MySQL };
 plan skip_all => "Need Time::Piece::MySQL for this test" if $@;
 
+use lib 't/cdbi/testlib';
 eval { require 't/cdbi/testlib/Log.pm' };
 plan skip_all => "Need MySQL for this test" if $@;
 

Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/MyBase.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/testlib/MyBase.pm	2009-04-21 08:37:11 UTC (rev 5922)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/MyBase.pm	2009-04-21 08:51:03 UTC (rev 5923)
@@ -8,9 +8,7 @@
 
 use vars qw/$dbh/;
 
-# temporary, might get switched to the new test framework someday
-my @connect = ("dbi:mysql:test", "", "", { PrintError => 0});
-
+my @connect = (@ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/}, { PrintError => 0});
 $dbh = DBI->connect(@connect) or die DBI->errstr;
 my @table;