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