1use strict; 2use Test::More; 3 4BEGIN { 5 eval "use DBIx::Class::CDBICompat;"; 6 if ($@) { 7 plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required'); 8 next; 9 } 10 eval "use DBD::SQLite"; 11 plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 23); 12} 13 14use lib 't/cdbi/testlib'; 15use Film; 16 17sub valid_rating { 18 my $value = shift; 19 my $ok = grep $value eq $_, qw/U Uc PG 12 15 18/; 20 return $ok; 21} 22 23Film->add_constraint('valid rating', Rating => \&valid_rating); 24 25my %info = ( 26 Title => 'La Double Vie De Veronique', 27 Director => 'Kryzstof Kieslowski', 28 Rating => '18', 29); 30 31{ 32 local $info{Title} = "nonsense"; 33 local $info{Rating} = 19; 34 eval { Film->create({%info}) }; 35 ok $@, $@; 36 ok !Film->retrieve($info{Title}), "No film created"; 37 is(Film->retrieve_all, 0, "So no films"); 38} 39 40ok(my $ver = Film->create({%info}), "Can create with valid rating"); 41is $ver->Rating, 18, "Rating 18"; 42 43ok $ver->Rating(12), "Change to 12"; 44ok $ver->update, "And update"; 45is $ver->Rating, 12, "Rating now 12"; 46 47eval { 48 $ver->Rating(13); 49 $ver->update; 50}; 51ok $@, $@; 52is $ver->Rating, 12, "Rating still 12"; 53ok $ver->delete, "Delete"; 54 55# this threw an infinite loop in old versions 56Film->add_constraint('valid director', Director => sub { 1 }); 57my $fred = Film->create({ Rating => '12' }); 58 59# this test is a bit problematical because we don't supply a primary key 60# to the create() and the table doesn't use auto_increment or a sequence. 61ok $fred, "Got fred"; 62 63{ 64 ok +Film->constrain_column(rating => [qw/U PG 12 15 19/]), 65 "constraint_column"; 66 my $narrower = eval { Film->create({ Rating => 'Uc' }) }; 67 like $@, qr/fails.*constraint/, "Fails listref constraint"; 68 my $ok = eval { Film->create({ Rating => 'U' }) }; 69 is $@, '', "Can create with rating U"; 70 SKIP: { 71 skip "No column objects", 2; 72 ok +Film->find_column('rating')->is_constrained, "Rating is constrained"; 73 ok +Film->find_column('director')->is_constrained, "Director is not"; 74 } 75} 76 77{ 78 ok +Film->constrain_column(title => qr/The/), "constraint_column"; 79 my $inferno = eval { Film->create({ Title => 'Towering Infero' }) }; 80 like $@, qr/fails.*constraint/, "Can't create towering inferno"; 81 my $the_inferno = eval { Film->create({ Title => 'The Towering Infero' }) }; 82 is $@, '', "But can create THE towering inferno"; 83} 84 85{ 86 87 sub Film::_constrain_by_untaint { 88 my ($class, $col, $string, $type) = @_; 89 $class->add_constraint( 90 untaint => $col => sub { 91 my ($value, $self, $column_name, $changing) = @_; 92 $value eq "today" ? $changing->{$column_name} = "2001-03-03" : 0; 93 } 94 ); 95 } 96 eval { Film->constrain_column(codirector => Untaint => 'date') }; 97 is $@, '', 'Can constrain with untaint'; 98 99 my $freeaa = 100 eval { Film->create({ title => "The Freaa", codirector => 'today' }) }; 101 is $@, '', "Can create codirector"; 102 is $freeaa && $freeaa->codirector, '2001-03-03', "Set the codirector"; 103} 104 105__DATA__ 106 107use CGI::Untaint; 108 109sub _constrain_by_untaint { 110 my ($class, $col, $string, $type) = @_; 111 $class->add_constraint(untaint => $col => sub { 112 my ($value, $self, $column_name, $changing) = @_; 113 my $h = CGI::Untaint->new({ %$changing }); 114 return unless my $val = $h->extract("-as_$type" => $column_name); 115 $changing->{$column_name} = $val; 116 return 1; 117 }); 118} 119 120