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