Removed PRIVATE METHODS pod section from Ordered.
[dbsrgits/DBIx-Class-Historic.git] / t / cdbi / 24-meta_info.t
CommitLineData
a9c8094b 1use strict;
03dc7a51 2use Test::More;
a9c8094b 3use Test::Warn;
4
d9bd5195 5use lib 't/cdbi/testlib';
6use DBIC::Test::SQLite (); # this will issue the necessary SKIPs on missing reqs
7
a9c8094b 8package Temp::DBI;
9use base qw(DBIx::Class::CDBICompat);
10Temp::DBI->columns(All => qw(id date));
1097f5e4 11
8273e845 12my $strptime_inflate = sub {
13 Time::Piece->strptime(shift, "%Y-%m-%d")
1097f5e4 14};
15Temp::DBI->has_a(
16 date => 'Time::Piece',
17 inflate => $strptime_inflate
18);
a9c8094b 19
20
21package Temp::Person;
22use base 'Temp::DBI';
23Temp::Person->table('people');
24Temp::Person->columns(Info => qw(name pet));
25Temp::Person->has_a( pet => 'Temp::Pet' );
26
27package Temp::Pet;
28use base 'Temp::DBI';
29Temp::Pet->table('pets');
30Temp::Pet->columns(Info => qw(name));
31Temp::Pet->has_many(owners => 'Temp::Person');
32
33package main;
34
35{
36 my $pn_meta = Temp::Person->meta_info('has_a');
37 is_deeply [sort keys %$pn_meta], [qw/date pet/], "Person has Date and Pet";
38}
39
40{
41 my $pt_meta = Temp::Pet->meta_info;
42 is_deeply [keys %{$pt_meta->{has_a}}], [qw/date/], "Pet has Date";
43 is_deeply [keys %{$pt_meta->{has_many}}], [qw/owners/], "And owners";
44}
45
46{
47 my $pet = Temp::Person->meta_info( has_a => 'pet' );
48 is $pet->class, 'Temp::Person';
49 is $pet->foreign_class, 'Temp::Pet';
50 is $pet->accessor, 'pet';
51 is $pet->name, 'has_a';
52}
53
54{
55 my $owners = Temp::Pet->meta_info( has_many => 'owners' );
a9c8094b 56
1097f5e4 57 is_deeply $owners->args, {
58 foreign_key => 'pet',
59 mapping => [],
60 };
a9c8094b 61}
62
63{
64 my $date = Temp::Pet->meta_info( has_a => 'date' );
65 is $date->class, 'Temp::DBI';
66 is $date->foreign_class, 'Time::Piece';
67 is $date->accessor, 'date';
1097f5e4 68 is $date->args->{inflate}, $strptime_inflate;
a9c8094b 69}
d9bd5195 70
71done_testing;