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