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
|
use strict;
use Test::More;
use File::Temp qw/tempdir/;
#----------------------------------------------------------------------
# Test various errors / warnings / deprecations etc
#----------------------------------------------------------------------
BEGIN {
eval "use DBD::SQLite";
plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 27);
}
use File::Temp qw/tempfile/;
my (undef, $DB) = tempfile();
my @DSN = ("dbi:SQLite:dbname=$DB", '', '', { AutoCommit => 1 });
END { unlink $DB if -e $DB }
package Holiday;
use base 'Class::DBI';
sub wibble { shift->croak("Croak dies") }
{
my $warning;
local $SIG{__WARN__} = sub {
$warning = $_[0];
};
no warnings 'once';
local *UNIVERSAL::wonka = sub { };
Holiday->columns(TEMP => 'wonka');
::like $warning, qr/wonka.*clashes/, "Column clash warning for inherited";
undef $warning;
Holiday->columns(Primary => 'new');
::like $warning, qr/new.*clashes/, "Column clash warning with CDBI";
undef $warning;
Holiday->add_constructor('by_train');
Holiday::Camp->add_constructor('by_train');
::is $warning, undef, "subclassed constructor";
}
{
local $SIG{__WARN__} = sub {
::like $_[0], qr/deprecated/, "create trigger deprecated";
};
Holiday->add_trigger('create' => sub { 1 });
Holiday->add_trigger('delete' => sub { 1 });
}
{
local $SIG{__WARN__} = sub {
::like $_[0], qr/deprecated/, "croak() deprecated";
};
eval { Holiday->croak("Croak dies") };
::like $@, qr/Croak dies/, "Croak dies";
eval { Holiday->wibble };
::like $@, qr/Croak dies/, "Croak dies";
}
{
eval { Holiday->add_constraint };
::like $@, qr/needs a name/, "Constraint with no name";
eval { Holiday->add_constraint('check_mate') };
::like $@, qr/needs a valid column/, "Constraint needs a column";
eval { Holiday->add_constraint('check_mate', 'jamtart') };
::like $@, qr/needs a valid column/, "No such column";
eval { Holiday->add_constraint('check_mate', 'new') };
::like $@, qr/needs a code ref/, "Need a coderef";
eval { Holiday->add_constraint('check_mate', 'new', {}) };
::like $@, qr/not a code ref/, "Not a coderef";
eval { Holiday->has_a('new') };
::like $@, qr/associated class/, "has_a needs a class";
eval { Holiday->add_constructor() };
::like $@, qr/name/, "add_constructor needs a method name";
eval {
Holiday->add_trigger(on_setting => sub { 1 });
};
::like $@, qr/no longer exists/, "No on_setting trigger";
{
local $SIG{__WARN__} = sub {
::like $_[0], qr/new.*clashes/, "Column clash warning";
};
}
}
package main;
{
package Holiday::Camp;
use base 'Holiday';
__PACKAGE__->table("holiday");
__PACKAGE__->add_trigger(before_create => sub {
my $self = shift;
$self->_croak("Problem with $self\n");
});
package main;
eval { Holiday::Camp->create({}) };
like $@, qr/Problem with Holiday/, '$self stringifies with no PK values';
}
eval { my $foo = Holiday->retrieve({ id => 1 }) };
like $@, qr/retrieve a reference/, "Can't retrieve a reference";
eval { my $foo = Holiday->create(id => 10) };
like $@, qr/a hashref/, "Can't create without hashref";
{
my $foo = bless {}, 'Holiday';
local $SIG{__WARN__} = sub { die $_[0] };
eval { $foo->has_a(date => 'Date::Simple') };
like $@, qr/object method/, "has_a is class-level";
}
eval { Holiday->update; };
like $@, qr/class method/, "Can't call update as class method";
is(Holiday->table, 'holiday', "Default table name");
Holiday->_flesh('Blanket');
eval { Holiday->ordered_search() };
like $@, qr/order_by/, "ordered_search no longer works";
eval { Holiday->create({ yonkey => 84 }) };
like $@, qr/not a column/, "Can't create with nonsense column";
eval { Film->_require_class('Class::DBI::__::Nonsense') };
like $@, qr/Can't locate/, "Can't require nonsense class";
eval { Holiday->search_DeleteMe };
like $@, qr/locate.*DeleteMe/, $@;
|
