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