File: 01-columns.t

package info (click to toggle)
libclass-dbi-perl 0.96-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 388 kB
  • ctags: 229
  • sloc: perl: 1,933; makefile: 43
file content (130 lines) | stat: -rw-r--r-- 4,270 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
use strict;
use Test::More tests => 35;

#-----------------------------------------------------------------------
# Make sure that we can set up columns properly
#-----------------------------------------------------------------------
package State;

use base 'Class::DBI';

State->table('State');
State->columns('Primary',   'Name');
State->columns('Essential', qw/Abbreviation/);
State->columns('Weather',   qw/Rain Snowfall/);
State->columns('Other',     qw/Capital Population/);
State->has_many(cities => "City");

sub accessor_name {
	my ($class, $column) = @_;
	my $return = $column eq "Rain" ? "Rainfall" : $column;
	return $return;
}

sub mutator_name {
	my ($class, $column) = @_;
	my $return = $column eq "Rain" ? "set_Rainfall" : "set_$column";
	return "set_$column";
}

sub Snowfall { 1 }


package City;

use base 'Class::DBI';

City->table('City');
City->columns(All => qw/Name State Population/);
City->has_a(State => 'State');


#-------------------------------------------------------------------------
package CD;
use base 'Class::DBI';

CD->table('CD');
CD->columns('All' => qw/artist title length/);

#-------------------------------------------------------------------------

package main;

is(State->table,          'State', 'State table()');
is(State->primary_column, 'name',  'State primary()');
is_deeply [ State->columns('Primary') ] => [qw/name/],
	'State Primary:' . join ", ", State->columns('Primary');
is_deeply [ sort State->columns('Essential') ] => [qw/abbreviation name/],
	'State Essential:' . join ", ", State->columns('Essential');
is_deeply [ sort State->columns('All') ] =>
	[ sort qw/name abbreviation rain snowfall capital population/ ],
	'State All:' . join ", ", State->columns('All');

is(CD->primary_column, 'artist', 'CD primary()');
is_deeply [ CD->columns('Primary') ] => [qw/artist/],
	'CD primary:' . join ", ", CD->columns('Primary');
is_deeply [ sort CD->columns('All') ] => [qw/artist length title/],
	'CD all:' . join ", ", CD->columns('All');
is_deeply [ sort CD->columns('Essential') ] => [qw/artist/],
	'CD essential:' . join ", ", CD->columns('Essential');

{
	local $SIG{__WARN__} = sub { ok 1, "Error thrown" };
	ok(!State->columns('Nonsense'), "No Nonsense group");
	ok(State->is_column('capital'), 'is_column deprecated');
}
ok(State->find_column('Rain'), 'find_column Rain');
ok(State->find_column('rain'), 'find_column rain');
ok(!State->find_column('HGLAGAGlAG'), '!find_column HGLAGAGlAG');

ok(!State->can('Rain'), 'No Rain accessor set up');
ok(State->can('Rainfall'),           'Rainfall accessor set up');
ok(State->can('_Rainfall_accessor'), ' with correct alias');
ok(!State->can('_Rain_accessor'), ' (not by colname)');
ok(!State->can('rain'),           ' (not normalized)');
ok(State->can('set_Rain'),           'overriden mutator');
ok(State->can('_set_Rain_accessor'), ' with alias');

ok(State->can('Snowfall'),           'overridden accessor set up');
ok(State->can('_Snowfall_accessor'), ' with alias');
ok(!State->can('snowfall'), ' (not normalized)');
ok(State->can('set_Snowfall'),           'overriden mutator');
ok(State->can('_set_Snowfall_accessor'), ' with alias');

{
	eval { my @grps = State->__grouper->groups_for("Huh"); };
	ok $@, "Huh not in groups";

	my @grps = sort State->__grouper->groups_for(State->_find_columns(qw/rain capital/));
	is @grps, 2, "Rain and Capital = 2 groups";
	is $grps[0], 'Other',   " - Other";
	is $grps[1], 'Weather', " - Weather";
}

{
	local $SIG{__WARN__} = sub { };
	eval { Class::DBI->retrieve(1) };
	like $@, qr/Can't retrieve unless primary columns are defined/, "Need primary key for retrieve";
}

#-----------------------------------------------------------------------
# Make sure that columns inherit properly
#-----------------------------------------------------------------------
package State;

package A;
@A::ISA = qw(Class::DBI);
__PACKAGE__->columns(Primary => 'id');

package A::B;
@A::B::ISA = 'A';
__PACKAGE__->columns(All => qw(id b1));

package A::C;
@A::C::ISA = 'A';
__PACKAGE__->columns(All => qw(id c1 c2 c3));

package main;
is join (' ', sort A->columns),    'id',          "A columns";
is join (' ', sort A::B->columns), 'b1 id',       "A::B columns";
is join (' ', sort A::C->columns), 'c1 c2 c3 id', "A::C columns";