t/cdbi-t/24-meta_info.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: $@"
   9     if $@;
  10
  11   plan skip_all => "Time::Piece required for this test"
  12     unless eval { require Time::Piece };
  13
  14   plan tests => 12;
  15 }
  16
  17 use Test::Warn;
  18
  19 package Temp::DBI;
  20 use base qw(DBIx::Class::CDBICompat);
  21 Temp::DBI->columns(All => qw(id date));
  22
  23 my $strptime_inflate = sub {
  24     Time::Piece->strptime(shift, "%Y-%m-%d")
  25 };
  26 Temp::DBI->has_a(
  27     date => 'Time::Piece',
  28     inflate => $strptime_inflate
  29 );
  30
  31
  32 package Temp::Person;
  33 use base 'Temp::DBI';
  34 Temp::Person->table('people');
  35 Temp::Person->columns(Info => qw(name pet));
  36 Temp::Person->has_a( pet => 'Temp::Pet' );
  37
  38 package Temp::Pet;
  39 use base 'Temp::DBI';
  40 Temp::Pet->table('pets');
  41 Temp::Pet->columns(Info => qw(name));
  42 Temp::Pet->has_many(owners => 'Temp::Person');
  43
  44 package main;
  45
  46 {
  47     my $pn_meta = Temp::Person->meta_info('has_a');
  48     is_deeply [sort keys %$pn_meta], [qw/date pet/], "Person has Date and Pet";
  49 }
  50
  51 {
  52     my $pt_meta = Temp::Pet->meta_info;
  53     is_deeply [keys %{$pt_meta->{has_a}}], [qw/date/], "Pet has Date";
  54     is_deeply [keys %{$pt_meta->{has_many}}], [qw/owners/], "And owners";
  55 }
  56
  57 {
  58     my $pet = Temp::Person->meta_info( has_a => 'pet' );
  59     is $pet->class,         'Temp::Person';
  60     is $pet->foreign_class, 'Temp::Pet';
  61     is $pet->accessor,      'pet';
  62     is $pet->name,          'has_a';
  63 }
  64
  65 {
  66     my $owners = Temp::Pet->meta_info( has_many => 'owners' );
  67
  68     is_deeply $owners->args, {
  69         foreign_key     => 'pet',
  70         mapping         => [],
  71     };
  72 }
  73
  74 {
  75     my $date = Temp::Pet->meta_info( has_a => 'date' );
  76     is $date->class,            'Temp::DBI';
  77     is $date->foreign_class,    'Time::Piece';
  78     is $date->accessor,         'date';
  79     is $date->args->{inflate},  $strptime_inflate;
  80 }