Multiple cdbi-compat test cleanups

Clarify search_like deprecation

diff --git a/lib/DBIx/Class/DB.pm b/lib/DBIx/Class/DB.pm
index 1f1ffd8..57381d0 100644 (file)
--- a/lib/DBIx/Class/DB.pm
+++ b/lib/DBIx/Class/DB.pm
@@ -162,11 +162,12 @@ __PACKAGE__->mk_classdata('_result_source_instance' => []);
 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;
+    }
   }
 }
 

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 38f4169..964d44a 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -873,7 +873,11 @@ instead. An example conversion is:
 
 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;

diff --git a/t/cdbi/02-Film.t b/t/cdbi/02-Film.t
index 988951d..0e1b22e 100644 (file)
--- a/t/cdbi/02-Film.t
+++ b/t/cdbi/02-Film.t
@@ -151,7 +151,7 @@ is($blrunner_dc->NumExplodingSheep, undef, 'Sheep correct');
 
 # 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(scalar @films, 1, ' search returns one film');
 is($films[0]->id, $gone->id, ' ... the correct one');
 
 # Find all films which were directed by Bob
-@films = Film->search_like('Director', 'Bob %');
+@films = Film->search ( { 'Director' => { -like => 'Bob %' } });
 is(scalar @films, 3, ' search_like returns 3 films');
 ok(
        eq_array(

diff --git a/t/cdbi/15-accessor.t b/t/cdbi/15-accessor.t
index 72f2c54..3419cf0 100644 (file)
--- a/t/cdbi/15-accessor.t
+++ b/t/cdbi/15-accessor.t
@@ -25,6 +25,11 @@ INIT {
     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 @@ is $@, '', "No errors";
     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 @@ is $@, '', "No errors";
     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);
 }

diff --git a/t/cdbi/22-deflate_order.t b/t/cdbi/22-deflate_order.t
index 9d943e5..5267ae0 100644 (file)
--- a/t/cdbi/22-deflate_order.t
+++ b/t/cdbi/22-deflate_order.t
@@ -12,6 +12,7 @@ if ($@) {
 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 $@;
 

diff --git a/t/cdbi/testlib/MyBase.pm b/t/cdbi/testlib/MyBase.pm
index eeb7cf0..5dfbfed 100644 (file)
--- a/t/cdbi/testlib/MyBase.pm
+++ b/t/cdbi/testlib/MyBase.pm
@@ -8,9 +8,7 @@ use DBI;
 
 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;