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