Centralize custom rel args check, be more thorough

diff --git a/t/lib/DBICTest/Schema/Artist.pm b/t/lib/DBICTest/Schema/Artist.pm
index 2bc7c4b..e060aff 100644 (file)
--- a/t/lib/DBICTest/Schema/Artist.pm
+++ b/t/lib/DBICTest/Schema/Artist.pm
@@ -4,8 +4,8 @@ package # hide from PAUSE
 use warnings;
 use strict;
 
-use base qw/DBICTest::BaseResult/;
-use Carp qw/confess/;
+use base 'DBICTest::BaseResult';
+use DBICTest::Util 'check_customcond_args';
 
 __PACKAGE__->table('artist');
 __PACKAGE__->source_info({
@@ -55,15 +55,10 @@ __PACKAGE__->has_many(
 __PACKAGE__->has_many(
   cds_80s => 'DBICTest::Schema::CD',
   sub {
-    my $args = shift;
-
     # This is for test purposes only. A regular user does not
     # need to sanity check the passed-in arguments, this is what
     # the tests are for :)
-    my @missing_args = grep { ! defined $args->{$_} }
-      qw/self_alias foreign_alias self_resultsource foreign_relname/;
-    confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
-      if @missing_args;
+    my $args = &check_customcond_args;
 
     return (
       { "$args->{foreign_alias}.artist" => { '=' => \ "$args->{self_alias}.artistid" },
@@ -81,15 +76,10 @@ __PACKAGE__->has_many(
 __PACKAGE__->has_many(
   cds_84 => 'DBICTest::Schema::CD',
   sub {
-    my $args = shift;
-
     # This is for test purposes only. A regular user does not
     # need to sanity check the passed-in arguments, this is what
     # the tests are for :)
-    my @missing_args = grep { ! defined $args->{$_} }
-      qw/self_alias foreign_alias self_resultsource foreign_relname/;
-    confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
-      if @missing_args;
+    my $args = &check_customcond_args;
 
     return (
       { "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
@@ -107,15 +97,10 @@ __PACKAGE__->has_many(
 __PACKAGE__->has_many(
   cds_90s => 'DBICTest::Schema::CD',
   sub {
-    my $args = shift;
-
     # This is for test purposes only. A regular user does not
     # need to sanity check the passed-in arguments, this is what
     # the tests are for :)
-    my @missing_args = grep { ! defined $args->{$_} }
-      qw/self_alias foreign_alias self_resultsource foreign_relname/;
-    confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
-      if @missing_args;
+    my $args = &check_customcond_args;
 
     return (
       { "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
@@ -150,7 +135,11 @@ __PACKAGE__->many_to_many('artworks', 'artwork_to_artist', 'artwork');
 __PACKAGE__->has_many(
     cds_without_genre => 'DBICTest::Schema::CD',
     sub {
-        my $args = shift;
+        # This is for test purposes only. A regular user does not
+        # need to sanity check the passed-in arguments, this is what
+        # the tests are for :)
+        my $args = &check_customcond_args;
+
         return (
           {
             "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },

diff --git a/t/lib/DBICTest/Schema/Artwork.pm b/t/lib/DBICTest/Schema/Artwork.pm
index 01ce450..6fc8bb6 100644 (file)
--- a/t/lib/DBICTest/Schema/Artwork.pm
+++ b/t/lib/DBICTest/Schema/Artwork.pm
@@ -4,8 +4,8 @@ package # hide from PAUSE
 use warnings;
 use strict;
 
-use base qw/DBICTest::BaseResult/;
-use Carp qw/confess/;
+use base 'DBICTest::BaseResult';
+use DBICTest::Util 'check_customcond_args';
 
 __PACKAGE__->table('cd_artwork');
 __PACKAGE__->add_columns(
@@ -28,15 +28,10 @@ __PACKAGE__->many_to_many('artists_test_m2m_noopt', 'artwork_to_artist', 'artist
 # other test to manytomany
 __PACKAGE__->has_many('artwork_to_artist_test_m2m', 'DBICTest::Schema::Artwork_to_Artist',
   sub {
-    my $args = shift;
-
     # This is for test purposes only. A regular user does not
     # need to sanity check the passed-in arguments, this is what
     # the tests are for :)
-    my @missing_args = grep { ! defined $args->{$_} }
-      qw/self_alias foreign_alias self_resultsource foreign_relname/;
-    confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
-      if @missing_args;
+    my $args = &check_customcond_args;
 
     return (
       { "$args->{foreign_alias}.artwork_cd_id" => { -ident => "$args->{self_alias}.cd_id" },

diff --git a/t/lib/DBICTest/Schema/Artwork_to_Artist.pm b/t/lib/DBICTest/Schema/Artwork_to_Artist.pm
index 57326e2..eb5b333 100644 (file)
--- a/t/lib/DBICTest/Schema/Artwork_to_Artist.pm
+++ b/t/lib/DBICTest/Schema/Artwork_to_Artist.pm
@@ -4,8 +4,8 @@ package # hide from PAUSE
 use warnings;
 use strict;
 
-use base qw/DBICTest::BaseResult/;
-use Carp qw/confess/;
+use base 'DBICTest::BaseResult';
+use DBICTest::Util 'check_customcond_args';
 
 __PACKAGE__->table('artwork_to_artist');
 __PACKAGE__->add_columns(
@@ -24,15 +24,10 @@ __PACKAGE__->belongs_to('artist', 'DBICTest::Schema::Artist', 'artist_id');
 
 __PACKAGE__->belongs_to('artist_test_m2m', 'DBICTest::Schema::Artist',
   sub {
-    my $args = shift;
-
     # This is for test purposes only. A regular user does not
     # need to sanity check the passed-in arguments, this is what
     # the tests are for :)
-    my @missing_args = grep { ! defined $args->{$_} }
-      qw/self_alias foreign_alias self_resultsource foreign_relname/;
-    confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
-      if @missing_args;
+    my $args = &check_customcond_args;
 
     return (
       { "$args->{foreign_alias}.artistid" => { -ident => "$args->{self_alias}.artist_id" },
@@ -48,15 +43,10 @@ __PACKAGE__->belongs_to('artist_test_m2m', 'DBICTest::Schema::Artist',
 
 __PACKAGE__->belongs_to('artist_test_m2m_noopt', 'DBICTest::Schema::Artist',
   sub {
-    my $args = shift;
-
     # This is for test purposes only. A regular user does not
     # need to sanity check the passed-in arguments, this is what
     # the tests are for :)
-    my @missing_args = grep { ! defined $args->{$_} }
-      qw/self_alias foreign_alias self_resultsource foreign_relname/;
-    confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
-      if @missing_args;
+    my $args = &check_customcond_args;
 
     return (
       { "$args->{foreign_alias}.artistid" => { -ident => "$args->{self_alias}.artist_id" },

diff --git a/t/lib/DBICTest/Schema/CD.pm b/t/lib/DBICTest/Schema/CD.pm
index 45fdf6f..e7cccca 100644 (file)
--- a/t/lib/DBICTest/Schema/CD.pm
+++ b/t/lib/DBICTest/Schema/CD.pm
@@ -4,7 +4,8 @@ package # hide from PAUSE
 use warnings;
 use strict;
 
-use base qw/DBICTest::BaseResult/;
+use base 'DBICTest::BaseResult';
+use DBICTest::Util 'check_customcond_args';
 
 # this tests table name as scalar ref
 # DO NOT REMOVE THE \
@@ -118,7 +119,11 @@ __PACKAGE__->might_have(
     'last_track',
     'DBICTest::Schema::Track',
     sub {
-        my $args = shift;
+        # This is for test purposes only. A regular user does not
+        # need to sanity check the passed-in arguments, this is what
+        # the tests are for :)
+        my $args = &check_customcond_args;
+
         return (
             {
                 "$args->{foreign_alias}.trackid" => { '=' =>

diff --git a/t/lib/DBICTest/Schema/Track.pm b/t/lib/DBICTest/Schema/Track.pm
index 5077bd0..60bad4e 100644 (file)
--- a/t/lib/DBICTest/Schema/Track.pm
+++ b/t/lib/DBICTest/Schema/Track.pm
@@ -4,8 +4,8 @@ package # hide from PAUSE
 use warnings;
 use strict;
 
-use base qw/DBICTest::BaseResult/;
-use Carp qw/confess/;
+use base 'DBICTest::BaseResult';
+use DBICTest::Util 'check_customcond_args';
 
 __PACKAGE__->load_components(qw{
     +DBICTest::DeployComponent
@@ -76,15 +76,10 @@ __PACKAGE__->belongs_to(
 __PACKAGE__->has_many (
   next_tracks => __PACKAGE__,
   sub {
-    my $args = shift;
-
     # This is for test purposes only. A regular user does not
     # need to sanity check the passed-in arguments, this is what
     # the tests are for :)
-    my @missing_args = grep { ! defined $args->{$_} }
-      qw/self_alias foreign_alias self_resultsource foreign_relname/;
-    confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
-      if @missing_args;
+    my $args = &check_customcond_args;
 
     return (
       { "$args->{foreign_alias}.cd"       => { -ident => "$args->{self_alias}.cd" },

diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm
index 0cd2b12..e7a0525 100644 (file)
--- a/t/lib/DBICTest/Util.pm
+++ b/t/lib/DBICTest/Util.pm
@@ -4,9 +4,11 @@ use warnings;
 use strict;
 
 use Config;
+use Carp 'confess';
+use Scalar::Util 'blessed';
 
 use base 'Exporter';
-our @EXPORT_OK = qw/local_umask stacktrace/;
+our @EXPORT_OK = qw(local_umask stacktrace check_customcond_args);
 
 sub local_umask {
   return unless defined $Config{d_umask};
@@ -44,4 +46,29 @@ sub stacktrace {
   return join "\tinvoked as ", map { sprintf ("%s at %s line %d\n", @$_ ) } @stack;
 }
 
+sub check_customcond_args ($) {
+  my $args = shift;
+
+  confess "Expecting a hashref"
+    unless ref $args eq 'HASH';
+
+  for (qw(foreign_relname self_alias foreign_alias)) {
+    confess "Custom condition argument '$_' must be a plain string"
+      if length ref $args->{$_} or ! length $args->{$_};
+  }
+
+  confess "Custom condition argument 'self_resultsource' must be a rsrc instance"
+    unless defined blessed $args->{self_resultsource} and $args->{self_resultsource}->isa('DBIx::Class::ResultSource');
+
+  confess "Passed resultsource has no record of the supplied rel_name - likely wrong \$rsrc"
+    unless ref $args->{self_resultsource}->relationship_info($args->{foreign_relname});
+
+  if (defined $args->{self_rowobj}) {
+    confess "Custom condition argument 'self_rowobj' must be a result instance"
+      unless defined blessed $args->{self_rowobj} and $args->{self_rowobj}->isa('DBIx::Class::Row');
+  }
+
+  $args;
+}
+
 1;