File: 01-columns.t

package info (click to toggle)
libdbix-class-perl 0.082841-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster
  • size: 5,236 kB
  • sloc: perl: 26,763; sql: 322; makefile: 10
file content (151 lines) | stat: -rw-r--r-- 4,388 bytes parent folder | download | duplicates (5)
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
use strict;
use warnings;

use Test::More;
use lib 't/cdbi/testlib';


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

use base 'DBIC::Test::SQLite';

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

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

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

sub Snowfall { 1 }


package City;

use base 'DBIC::Test::SQLite';

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

{
  # Disable the `no such table' warning
  local $SIG{__WARN__} = sub {
    my $warning = shift;
    warn $warning unless ($warning =~ /\Qno such table: City(1)\E/);
  };

  City->has_a(State => 'State');
}

#-------------------------------------------------------------------------
package CD;
use base 'DBIC::Test::SQLite';

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');

ok(State->find_column('Rain'), 'find_column Rain');
ok(State->find_column('rain'), 'find_column rain');
ok(!State->find_column('HGLAGAGlAG'), '!find_column HGLAGAGlAG');

{

    can_ok +State => qw/Rainfall _Rainfall_accessor set_Rainfall
      _set_Rainfall_accessor Snowfall _Snowfall_accessor set_Snowfall
      _set_Snowfall_accessor/;

    foreach my $method (qw/Rain _Rain_accessor rain snowfall/) {
      ok !State->can($method), "State can't $method";
    }

}

{
  SKIP: {
    skip "No column objects", 1;

    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";
        @grps = sort @grps; # Because the underlying API is hash-based
  is $grps[0], 'Other',   " - Other";
  is $grps[1], 'Weather', " - Weather";
}

#{
#
#        package DieTest;
#        @DieTest::ISA = qw(DBIx::Class);
#        DieTest->load_components(qw/CDBICompat::Retrieve Core/);
#        package main;
#  local $SIG{__WARN__} = sub { };
#  eval { DieTest->retrieve(1) };
#  like $@, qr/unless primary columns are defined/, "Need primary key for retrieve";
#}

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

package A;
@A::ISA = qw(DBIx::Class);
__PACKAGE__->load_components(qw/CDBICompat Core/);
__PACKAGE__->table('dummy');
__PACKAGE__->columns(Primary => 'id');

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

package A::C;
@A::C::ISA = 'A';
__PACKAGE__->table('dummy3');
__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";

done_testing;