t/lib/My/Schema/Result/Person.pm

   1 package My::Schema::Result::Person;
   2
   3 use strict;
   4 use warnings;
   5 use base qw(DBIx::Class::Core);
   6
   7 __PACKAGE__->load_components(qw(ParameterizedJoinHack));
   8
   9 __PACKAGE__->table('people');
  10
  11 __PACKAGE__->add_columns(
  12   id => { data_type => 'integer', is_nullable => 0, is_auto_increment => 1 },
  13   name => { data_type => 'text', is_nullable => 0 }
  14 );
  15
  16 __PACKAGE__->set_primary_key('id');
  17
  18 __PACKAGE__->has_many(
  19   assigned_tasks => 'My::Schema::Result::Task',
  20   { 'foreign.assigned_to_id' => 'self.id' },
  21 );
  22
  23 __PACKAGE__->parameterized_has_many(
  24   urgent_assigned_tasks => 'My::Schema::Result::Task',
  25   [ [ qw(urgency_threshold) ], sub {
  26       my $args = shift;
  27       +{
  28         "$args->{foreign_alias}.assigned_to_id" =>
  29           { -ident => "$args->{self_alias}.id" },
  30         "$args->{foreign_alias}.urgency" =>
  31           { '>', $_{urgency_threshold} }
  32       }
  33     }
  34   ]
  35 );
  36
  37 __PACKAGE__->parameterized_has_many(
  38   tasks_in_urgency_range => 'My::Schema::Result::Task',
  39   [ [ qw( min max ) ], sub {
  40       my $args = shift;
  41       +{
  42         "$args->{foreign_alias}.assigned_to_id" =>
  43           { -ident => "$args->{self_alias}.id" },
  44         "$args->{foreign_alias}.urgency" =>
  45           { '>=', $_{min} },
  46         "$args->{foreign_alias}.urgency" =>
  47           { '<=', $_{max} },
  48       }
  49     }
  50   ]
  51 );
  52
  53 __PACKAGE__->parameterized_has_many(
  54   unconstrained_tasks => 'My::Schema::Result::Task',
  55   [ [], sub {
  56       my $args = shift;
  57       +{
  58         "$args->{foreign_alias}.assigned_to_id" =>
  59           { -ident => "$args->{self_alias}.id" },
  60       }
  61     }
  62   ]
  63 );
  64
  65 our %ERROR;
  66 my $_catch_fail = sub {
  67   my $key = shift;
  68   die "Error key redefinition"
  69     if exists $ERROR{ $key };
  70   local $@;
  71   eval {
  72     __PACKAGE__->parameterized_has_many(@_);
  73   };
  74   $ERROR{ $key } = $@;
  75 };
  76
  77 $_catch_fail->('no_args');
  78 $_catch_fail->('no_source', 'fail_1');
  79 $_catch_fail->('no_cond', fail_2 => 'My::Schema::Result::Task');
  80 $_catch_fail->('invalid_cond',
  81   fail_3 => 'My::Schema::Result::Task',
  82   \"foo",
  83 );
  84 $_catch_fail->('undef_args',
  85   fail_4 => 'My::Schema::Result::Task',
  86   [undef, sub {}],
  87 );
  88 $_catch_fail->('invalid_args',
  89   fail_5 => 'My::Schema::Result::Task',
  90   [\"foo", sub {}],
  91 );
  92 $_catch_fail->('undef_builder',
  93   fail_6 => 'My::Schema::Result::Task',
  94   [[qw( foo )], undef],
  95 );
  96 $_catch_fail->('invalid_builder',
  97   fail_7 => 'My::Schema::Result::Task',
  98   [[qw( foo )], []],
  99 );
 100
 101 1;