Commit | Line | Data |
a9c8094b |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
03dc7a51 |
4 | use Test::More; |
5 | |
09d46657 |
6 | BEGIN { |
40f05175 |
7 | eval "use DBIx::Class::CDBICompat;"; |
8 | plan skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@" |
9 | if $@; |
03dc7a51 |
10 | |
40f05175 |
11 | plan skip_all => "Time::Piece required for this test" |
12 | unless eval { require Time::Piece }; |
13 | |
14 | plan tests => 12; |
09d46657 |
15 | } |
16 | |
a9c8094b |
17 | use Test::Warn; |
18 | |
19 | package Temp::DBI; |
20 | use base qw(DBIx::Class::CDBICompat); |
21 | Temp::DBI->columns(All => qw(id date)); |
1097f5e4 |
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 | ); |
a9c8094b |
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' ); |
a9c8094b |
67 | |
1097f5e4 |
68 | is_deeply $owners->args, { |
69 | foreign_key => 'pet', |
70 | mapping => [], |
71 | }; |
a9c8094b |
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'; |
1097f5e4 |
79 | is $date->args->{inflate}, $strptime_inflate; |
a9c8094b |
80 | } |