1use strict; 2use Test::More; 3use File::Temp qw/tempdir/; 4 5#---------------------------------------------------------------------- 6# Test various errors / warnings / deprecations etc 7#---------------------------------------------------------------------- 8 9BEGIN { 10 eval "use DBD::SQLite"; 11 plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 22); 12} 13 14use File::Temp qw/tempfile/; 15my (undef, $DB) = tempfile(); 16my @DSN = ("dbi:SQLite:dbname=$DB", '', '', { AutoCommit => 1 }); 17 18END { unlink $DB if -e $DB } 19 20package Holiday; 21 22use base 'Class::DBI'; 23 24{ 25 my $warning; 26 local $SIG{__WARN__} = sub { 27 $warning = $_[0]; 28 }; 29 no warnings 'once'; 30 local *UNIVERSAL::wonka = sub { }; 31 Holiday->columns(TEMP => 'wonka'); 32 ::like $warning, qr/wonka.*clashes/, "Column clash warning for inherited"; 33 undef $warning; 34 35 Holiday->columns(Primary => 'new'); 36 ::like $warning, qr/new.*clashes/, "Column clash warning with CDBI"; 37 undef $warning; 38 39 Holiday->add_constructor('by_train'); 40 Holiday::Camp->add_constructor('by_train'); 41 ::is $warning, undef, "subclassed constructor"; 42} 43 44{ 45 local $SIG{__WARN__} = sub { 46 ::like $_[0], qr/deprecated/, "create trigger deprecated"; 47 }; 48 Holiday->add_trigger('create' => sub { 1 }); 49 Holiday->add_trigger('delete' => sub { 1 }); 50} 51 52{ 53 eval { Holiday->add_constraint }; 54 ::like $@, qr/needs a name/, "Constraint with no name"; 55 eval { Holiday->add_constraint('check_mate') }; 56 ::like $@, qr/needs a valid column/, "Constraint needs a column"; 57 eval { Holiday->add_constraint('check_mate', 'jamtart') }; 58 ::like $@, qr/needs a valid column/, "No such column"; 59 eval { Holiday->add_constraint('check_mate', 'new') }; 60 ::like $@, qr/needs a code ref/, "Need a coderef"; 61 eval { Holiday->add_constraint('check_mate', 'new', {}) }; 62 ::like $@, qr/not a code ref/, "Not a coderef"; 63 64 eval { Holiday->has_a('new') }; 65 ::like $@, qr/associated class/, "has_a needs a class"; 66 67 eval { Holiday->add_constructor() }; 68 ::like $@, qr/name/, "add_constructor needs a method name"; 69 70 eval { 71 Holiday->add_trigger(on_setting => sub { 1 }); 72 }; 73 ::like $@, qr/no longer exists/, "No on_setting trigger"; 74 75 { 76 local $SIG{__WARN__} = sub { 77 ::like $_[0], qr/new.*clashes/, "Column clash warning"; 78 }; 79 } 80} 81 82package main; 83 84{ 85 package Holiday::Camp; 86 use base 'Holiday'; 87 88 __PACKAGE__->table("holiday"); 89 __PACKAGE__->add_trigger(before_create => sub { 90 my $self = shift; 91 $self->_croak("Problem with $self\n"); 92 }); 93 94 package main; 95 eval { Holiday::Camp->insert({}) }; 96 like $@, qr/Problem with Holiday/, '$self stringifies with no PK values'; 97} 98 99eval { my $foo = Holiday->retrieve({ id => 1 }) }; 100like $@, qr/retrieve a reference/, "Can't retrieve a reference"; 101 102eval { my $foo = Holiday->insert(id => 10) }; 103like $@, qr/a hashref/, "Can't create without hashref"; 104 105{ 106 my $foo = bless {}, 'Holiday'; 107 local $SIG{__WARN__} = sub { die $_[0] }; 108 eval { $foo->has_a(date => 'Date::Simple') }; 109 like $@, qr/object method/, "has_a is class-level: $@"; 110} 111 112eval { Holiday->update; }; 113like $@, qr/class method/, "Can't call update as class method"; 114 115is(Holiday->table, 'holiday', "Default table name"); 116 117Holiday->_flesh('Blanket'); 118 119eval { Holiday->insert({ yonkey => 84 }) }; 120like $@, qr/not a column/, "Can't create with nonsense column"; 121 122eval { Film->_require_class('Class::DBI::__::Nonsense') }; 123like $@, qr/Can't locate/, "Can't require nonsense class"; 124 125eval { Holiday->search_DeleteMe }; 126like $@, qr/locate.*DeleteMe/, $@; 127 128