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