more error handling and testing

diff --git a/lib/DBIx/Class/ParameterizedJoinHack.pm b/lib/DBIx/Class/ParameterizedJoinHack.pm
index cfd5960..b332c89 100644 (file)
--- a/lib/DBIx/Class/ParameterizedJoinHack.pm
+++ b/lib/DBIx/Class/ParameterizedJoinHack.pm
@@ -13,16 +13,39 @@ __PACKAGE__->mk_group_accessors(inherited => $STORE);
 
 sub parameterized_has_many {
   my ($class, $rel, $f_source, $cond, $attrs) = @_;
+
+  die "Missing relation name for parameterized_has_many"
+    unless defined $rel;
+  die "Missing foreign source"
+    unless defined $f_source;
+
   {
     my $cond_ref = ref($cond);
-    die "Condition needs to be [ \\\@args, \$code ], not ${cond_ref}"
+    $cond_ref = 'non-reference value'
+      unless $cond_ref;
+    die "Condition needs to be [ \\\@args, \&code ], not ${cond_ref}"
       unless $cond_ref eq 'ARRAY';
   }
   my ($args, $code) = @$cond;
+
+  {
+    my $arg_ref = ref($cond->[0]);
+    $arg_ref = 'non-reference value'
+      unless $arg_ref;
+    die "Arguments must be declared as array ref of names, not ${arg_ref}"
+      unless $arg_ref eq 'ARRAY';
+    my $code_ref = ref($cond->[1]);
+    $code_ref = 'non-reference value'
+      unless $code_ref;
+    die "Condition builder must be declared as code ref, not ${code_ref}"
+      unless $code_ref eq 'CODE';
+  }
+
   my $store = $class->$STORE({
     %{$class->$STORE||{}},
     $rel => { params => {}, args => $args },
   })->{$rel};
+
   my $wrapped_code = sub {
     my $params = $store->{params};
     my @missing = grep !exists $params->{$_}, @$args;
@@ -31,6 +54,7 @@ sub parameterized_has_many {
     local *_ = $params;
     &$code;
   };
+
   $class->has_many($rel, $f_source, $wrapped_code, $attrs);
   return; # no, you are not going to accidentally rely on a return value
 }

diff --git a/lib/DBIx/Class/ResultSet/ParameterizedJoinHack.pm b/lib/DBIx/Class/ResultSet/ParameterizedJoinHack.pm
index 75db8b7..25c7483 100644 (file)
--- a/lib/DBIx/Class/ResultSet/ParameterizedJoinHack.pm
+++ b/lib/DBIx/Class/ResultSet/ParameterizedJoinHack.pm
@@ -14,6 +14,7 @@ sub with_parameterized_join {
   my ($self, $rel, $params) = @_;
   die "Missing relation name in with_parameterized_join"
     unless defined $rel;
+
   {
     my $params_ref = ref($params);
     $params_ref = 'non-reference-value'
@@ -21,6 +22,7 @@ sub with_parameterized_join {
     die "Parameters value must be a hash ref, not ${params_ref}"
       unless $params_ref eq 'HASH';
   }
+
   $self->search_rs(
     {},
     { join => $rel,

diff --git a/t/00basic.t b/t/00basic.t
index 5da8cfe..348353e 100644 (file)
--- a/t/00basic.t
+++ b/t/00basic.t
@@ -125,6 +125,27 @@ subtest 'has_many' => sub {
             $people->with_parameterized_join(foo => 23);
         }, qr{parameters.+hash.+not.+non-reference}i, 'non ref parameters';
     };
+
+    subtest 'declaration errors' => sub {
+        my $errors = \%My::Schema::Result::Person::ERROR;
+        like delete $errors->{no_args}, qr{Missing.+relation.+name}i,
+            'no arguments';
+        like delete $errors->{no_source}, qr{Missing.+foreign.+source}i,
+            'no foreign source';
+        like delete $errors->{no_cond}, qr{Condition.+non-ref.+value}i,
+            'no condition';
+        like delete $errors->{invalid_cond}, qr{Condition.+SCALAR}i,
+            'invalid condition';
+        like delete $errors->{undef_args}, qr{Arguments.+array.+non-ref}i,
+            'undef args';
+        like delete $errors->{invalid_args}, qr{Arguments.+array.+SCALAR}i,
+            'invalid args';
+        like delete $errors->{undef_builder}, qr{builder.+code.+non-ref}i,
+            'undef builder';
+        like delete $errors->{invalid_builder}, qr{builder.+code.+ARRAY}i,
+            'invalid builder';
+        is_deeply $errors, {}, 'no more errors';
+    };
 };
 
 done_testing;

diff --git a/t/lib/My/Schema/Result/Person.pm b/t/lib/My/Schema/Result/Person.pm
index e89b3a6..88c11ca 100644 (file)
--- a/t/lib/My/Schema/Result/Person.pm
+++ b/t/lib/My/Schema/Result/Person.pm
@@ -50,4 +50,40 @@ __PACKAGE__->parameterized_has_many(
   ]
 );
 
+our %ERROR;
+my $_catch_fail = sub {
+  my $key = shift;
+  die "Error key redefinition"
+    if exists $ERROR{ $key };
+  local $@;
+  eval {
+    __PACKAGE__->parameterized_has_many(@_);
+  };
+  $ERROR{ $key } = $@;
+};
+
+$_catch_fail->('no_args');
+$_catch_fail->('no_source', 'fail_1');
+$_catch_fail->('no_cond', fail_2 => 'My::Schema::Result::Task');
+$_catch_fail->('invalid_cond',
+  fail_3 => 'My::Schema::Result::Task',
+  \"foo",
+);
+$_catch_fail->('undef_args',
+  fail_4 => 'My::Schema::Result::Task',
+  [undef, sub {}],
+);
+$_catch_fail->('invalid_args',
+  fail_5 => 'My::Schema::Result::Task',
+  [\"foo", sub {}],
+);
+$_catch_fail->('undef_builder',
+  fail_6 => 'My::Schema::Result::Task',
+  [[qw( foo )], undef],
+);
+$_catch_fail->('invalid_builder',
+  fail_7 => 'My::Schema::Result::Task',
+  [[qw( foo )], []],
+);
+
 1;