t/cdbi/24-meta_info.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 use Test::Warn;
   5
   6 use lib 't/cdbi/testlib';
   7 use DBIC::Test::SQLite (); # this will issue the necessary SKIPs on missing reqs
   8
   9 eval { require Time::Piece }
  10   or plan skip_all => 'Time::Piece required for this test';
  11
  12 package Temp::DBI;
  13 use base qw(DBIx::Class::CDBICompat);
  14 Temp::DBI->columns(All => qw(id date));
  15
  16 my $strptime_inflate = sub {
  17     Time::Piece->strptime(shift, "%Y-%m-%d")
  18 };
  19 Temp::DBI->has_a(
  20     date => 'Time::Piece',
  21     inflate => $strptime_inflate
  22 );
  23
  24
  25 package Temp::Person;
  26 use base 'Temp::DBI';
  27 Temp::Person->table('people');
  28 Temp::Person->columns(Info => qw(name pet));
  29 Temp::Person->has_a( pet => 'Temp::Pet' );
  30
  31 package Temp::Pet;
  32 use base 'Temp::DBI';
  33 Temp::Pet->table('pets');
  34 Temp::Pet->columns(Info => qw(name));
  35 Temp::Pet->has_many(owners => 'Temp::Person');
  36
  37 package main;
  38
  39 {
  40     my $pn_meta = Temp::Person->meta_info('has_a');
  41     is_deeply [sort keys %$pn_meta], [qw/date pet/], "Person has Date and Pet";
  42 }
  43
  44 {
  45     my $pt_meta = Temp::Pet->meta_info;
  46     is_deeply [keys %{$pt_meta->{has_a}}], [qw/date/], "Pet has Date";
  47     is_deeply [keys %{$pt_meta->{has_many}}], [qw/owners/], "And owners";
  48 }
  49
  50 {
  51     my $pet = Temp::Person->meta_info( has_a => 'pet' );
  52     is $pet->class,         'Temp::Person';
  53     is $pet->foreign_class, 'Temp::Pet';
  54     is $pet->accessor,      'pet';
  55     is $pet->name,          'has_a';
  56 }
  57
  58 {
  59     my $owners = Temp::Pet->meta_info( has_many => 'owners' );
  60
  61     is_deeply $owners->args, {
  62         foreign_key     => 'pet',
  63         mapping         => [],
  64     };
  65 }
  66
  67 {
  68     my $date = Temp::Pet->meta_info( has_a => 'date' );
  69     is $date->class,            'Temp::DBI';
  70     is $date->foreign_class,    'Time::Piece';
  71     is $date->accessor,         'date';
  72     is $date->args->{inflate},  $strptime_inflate;
  73 }
  74
  75 done_testing;