File: 01.t

package info (click to toggle)
libclass-dbi-fromcgi-perl 1.00-5
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 100 kB
  • sloc: perl: 279; makefile: 2
file content (189 lines) | stat: -rw-r--r-- 5,794 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
#!/usr/bin/perl -w

use strict;

use CGI::Untaint;
use Test::More;

BEGIN {
  eval "use DBD::SQLite";
  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 78);
}

#-------------------------------------------------------------------------

package Water;

use base 'Class::DBI';
use Class::DBI::FromCGI;

use File::Temp qw/tempfile/;
my (undef, $DB) = tempfile();
my @DSN = ("dbi:SQLite:dbname=$DB", '', '', { AutoCommit => 1 });
END { unlink $DB if -e $DB }

__PACKAGE__->set_db(Main => @DSN);
__PACKAGE__->table('Water');
__PACKAGE__->columns(Primary => 'id');
__PACKAGE__->columns(Other   => qw/title count wibble/);
__PACKAGE__->untaint_columns(
    printable => [qw/title/],
    integer   => [qw/id count wibble/],
);

__PACKAGE__->db_Main->do(qq{
     CREATE TABLE Water (
        id     INTEGER,
        title  VARCHAR(80),
        count  INTEGER,
        wibble INTEGER
    )
});

#-------------------------------------------------------------------------


package main;
my %orig = (
  id     => 1,
  title  => 'Bout Ye',
  count  => 2,
  wibble => 10,
);
my $hoker = Water->create(\%orig);
isa_ok $hoker => 'Water';

my %args = (
  title  => 'Quare Geg',
  count  => 10,
  wibble => 8,
);

{ # Test an invalid count
  local $args{count} = "Foo";
  my $h = CGI::Untaint->new(%args);
  isa_ok $h => 'CGI::Untaint', "(Invalid count)";
  ok !$hoker->update_from_cgi($h), "Update fails";
  ok my %error = $hoker->cgi_update_errors, "We have errors";
  ok $error{$_}, "Error with $_" foreach qw/count/;
  ok !$error{$_}, "No error with $_" foreach qw/title wibble/;
  is $hoker->$_(), $orig{$_}, "$_ unchanged" foreach qw/title count wibble/;
}

{ # Test multiple errors
  local $args{count} = "Foo";
  local $args{wibble} = "Bar";
  my $h = CGI::Untaint->new(%args);
  isa_ok $h => 'CGI::Untaint', "(Multiple errors)";
  ok !$hoker->update_from_cgi($h), "Update fails";
  ok my %error = $hoker->cgi_update_errors, "We have errors";
  ok $error{$_}, "Error with $_" foreach qw/count wibble/;
  ok !$error{$_}, "No error with $_" foreach qw/title/;
  is $hoker->$_(), $orig{$_}, "$_ unchanged" foreach qw/title count wibble/;
}

{ # Fail update with 'forced' column
  local $args{title} = undef;
  my $h = CGI::Untaint->new(%args);
  isa_ok $h => 'CGI::Untaint', "(Fail forced)";
  ok !$hoker->update_from_cgi($h => {required => [qw/title/]}), "Update fails";
  ok my %error = $hoker->cgi_update_errors, "We have errors";
  ok $error{$_}, "Error with $_" foreach qw/title/;
  ok !$error{$_}, "No error with $_" foreach qw/wibble count/;
  is $hoker->$_(), $orig{$_}, "$_ unchanged" foreach qw/title count wibble/;
}

{ # Fail update with 'forced' columns
  local $args{title} = undef;
  local $args{wibble} = undef;
  my $h = CGI::Untaint->new(%args);
  isa_ok $h => 'CGI::Untaint', "(Fail multi-forced)";
  ok !$hoker->update_from_cgi($h => {required => [qw/title wibble/]}), 
     "Update fails";
  ok my %error = $hoker->cgi_update_errors, "We have errors";
  ok $error{$_}, "Error with $_" foreach qw/title wibble/;
  ok !$error{$_}, "No error with $_" foreach qw/count/;
  is $hoker->$_(), $orig{$_}, "$_ unchanged" foreach qw/title count wibble/;
}

{ # Only update some columns
  my $h = CGI::Untaint->new(%args);
  isa_ok $h => 'CGI::Untaint', "(Partial update)";
  ok $hoker->update_from_cgi($h => 'title'), "Can update";
  ok !$hoker->cgi_update_errors, "No error";
  is $hoker->$_(), $args{$_}, "$_ changed" foreach qw/title/;
  isnt $hoker->$_(), $args{$_}, "$_ not changed" foreach qw/count wibble/;
  $hoker->update;
}

{ # Ignore some
  local $args{title} = "Ignored?";
  my $h = CGI::Untaint->new(%args);
  isa_ok $h => 'CGI::Untaint', "(Partial update)";
  ok $hoker->update_from_cgi($h => {ignore => [qw/title/]}), "Can update";
  ok !$hoker->cgi_update_errors, "No error";
  is $hoker->$_(), $args{$_}, "$_ changed" foreach qw/count wibble/;
  isnt $hoker->$_(), $args{$_}, "$_ not changed" foreach qw/title/;
  $hoker->update;
}

{ # Update all
  local $args{title} = "Hoke it out";
  my $h = CGI::Untaint->new(%args);
  isa_ok $h => 'CGI::Untaint', "(Full update)";
  ok $hoker->update_from_cgi($h), "Can update";
  ok !$hoker->cgi_update_errors, "No error";
  is $hoker->$_(), $args{$_}, "$_ changed" foreach qw/title count wibble/;
  $hoker->update;
}

{ # Create
  local $args{id} = 438;
  my $h = CGI::Untaint->new(%args);
  isa_ok $h => 'CGI::Untaint', "(Creation)";
  my $new = Water->create_from_cgi($h);
  isa_ok $new, 'Water';
  ok !$new->cgi_update_errors, "No error";
  is $new->$_(), $args{$_}, "$_ changed" foreach qw/title count wibble/;

  my $id = $new->id;
  my $fetch = Water->retrieve($id);
  isa_ok $new, 'Water', "It was stored";
}

{ # OK Create - missing args
  my %args = %args;
  $args{id} = 404;
  delete $args{title};
  my $h = CGI::Untaint->new(%args);
  isa_ok $h => 'CGI::Untaint', "(Missing args create)";
  my $new = Water->create_from_cgi($h);
  isa_ok $new, 'Water';
  ok !$new->cgi_update_errors, "No errors";
  is $new->$_(), $args{$_}, "$_ changed" foreach qw/count wibble/;
}

{ # Failed Create
  local $args{id} = 432;
  my $h = CGI::Untaint->new(%args);
  isa_ok $h => 'CGI::Untaint', "(Failed Creation)";
  my $new = Water->create_from_cgi($h);
  isa_ok $new, 'Water';
  ok !$new->cgi_update_errors, "No error";
  is $new->$_(), $args{$_}, "$_ changed" foreach qw/title count wibble/;
}

is (Water->untaint_type('title'), 'printable', "title is printable");
is (Water->untaint_type('count'), 'integer', "count is integer");
is (Water->untaint_type('wibble'), 'integer', "count is integer");
is (Water->untaint_type('foo'), undef, "no type for id");

eval { 
	Water->untaint_columns({
    printable => [qw/title/],
    integer   => [qw/id count wibble/],
	});
};
ok $@, "Can't set up untaints with hashref: $@";