t/cdbi-t/mk_group_accessors.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More;
   5
   6 BEGIN {
   7     eval "use DBIx::Class::CDBICompat;";
   8     plan skip_all => 'Class::Trigger and DBIx::ContextualFetch required' if $@;
   9
  10     eval "use DBD::SQLite";
  11     plan skip_all => 'needs DBD::SQLite for testing' if $@;
  12
  13     plan 'no_plan';
  14 }
  15
  16 INIT {
  17     use lib 't/testlib';
  18     require Film;
  19 }
  20
  21 sub Film::get_test {
  22     my $self = shift;
  23     my $key = shift;
  24     $self->{get_test}++;
  25     return $self->{$key};
  26 }
  27
  28 sub Film::set_test {
  29     my($self, $key, $val) = @_;
  30     $self->{set_test}++;
  31     return $self->{$key} = $val;
  32 }
  33
  34
  35 my $film = Film->create({ Title => "No Wolf McQuade" });
  36
  37 # Test mk_group_accessors() with a list of fields.
  38 {
  39     Film->mk_group_accessors(test => qw(foo bar));
  40     $film->foo(42);
  41     is $film->foo, 42;
  42
  43     $film->bar(23);
  44     is $film->bar, 23;
  45 }
  46
  47
  48 # An explicit accessor passed to mk_group_accessors should
  49 # ignore accessor/mutator_name_for.
  50 sub Film::accessor_name_for {
  51     my($class, $col) = @_;
  52     return "hlaglagh" if $col eq "wibble";
  53     return $col;
  54 }
  55
  56 sub Film::mutator_name_for {
  57     my($class, $col) = @_;
  58     return "hlaglagh" if $col eq "wibble";
  59     return $col;
  60 }
  61
  62
  63 # Test with a mix of fields and field specs
  64 {
  65     Film->mk_group_accessors(test => ("baz", [wibble_thing => "wibble"]));
  66     $film->baz(42);
  67     is $film->baz, 42;
  68
  69     $film->wibble_thing(23);
  70     is $film->wibble_thing, 23;
  71 }