Commit | Line | Data |
a9c8094b |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
4 | use Test::More tests => 12; |
5 | use Test::Warn; |
6 | |
7 | package Temp::DBI; |
8 | use base qw(DBIx::Class::CDBICompat); |
9 | Temp::DBI->columns(All => qw(id date)); |
10 | Temp::DBI->has_a( date => 'Time::Piece', inflate => sub { |
11 | Time::Piece->strptime(shift, "%Y-%m-%d") |
12 | }); |
13 | |
14 | |
15 | package Temp::Person; |
16 | use base 'Temp::DBI'; |
17 | Temp::Person->table('people'); |
18 | Temp::Person->columns(Info => qw(name pet)); |
19 | Temp::Person->has_a( pet => 'Temp::Pet' ); |
20 | |
21 | package Temp::Pet; |
22 | use base 'Temp::DBI'; |
23 | Temp::Pet->table('pets'); |
24 | Temp::Pet->columns(Info => qw(name)); |
25 | Temp::Pet->has_many(owners => 'Temp::Person'); |
26 | |
27 | package main; |
28 | |
29 | { |
30 | my $pn_meta = Temp::Person->meta_info('has_a'); |
31 | is_deeply [sort keys %$pn_meta], [qw/date pet/], "Person has Date and Pet"; |
32 | } |
33 | |
34 | { |
35 | my $pt_meta = Temp::Pet->meta_info; |
36 | is_deeply [keys %{$pt_meta->{has_a}}], [qw/date/], "Pet has Date"; |
37 | is_deeply [keys %{$pt_meta->{has_many}}], [qw/owners/], "And owners"; |
38 | } |
39 | |
40 | { |
41 | my $pet = Temp::Person->meta_info( has_a => 'pet' ); |
42 | is $pet->class, 'Temp::Person'; |
43 | is $pet->foreign_class, 'Temp::Pet'; |
44 | is $pet->accessor, 'pet'; |
45 | is $pet->name, 'has_a'; |
46 | } |
47 | |
48 | { |
49 | my $owners = Temp::Pet->meta_info( has_many => 'owners' ); |
50 | warning_like { |
51 | local $TODO = 'args is unlikely to ever work'; |
52 | |
53 | is_deeply $owners->args, { |
54 | foreign_key => 'pet', |
55 | mapping => [], |
56 | order_by => undef |
57 | }; |
58 | } qr/^\Qargs() is unlikely to ever work/; |
59 | } |
60 | |
61 | { |
62 | my $date = Temp::Pet->meta_info( has_a => 'date' ); |
63 | is $date->class, 'Temp::DBI'; |
64 | is $date->foreign_class, 'Time::Piece'; |
65 | is $date->accessor, 'date'; |
66 | } |