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
|
#!/usr/bin/perl
########################################################################
# this tesst checks that store_XXX in Test::DatabaseRow's row_ok
# functions works
########################################################################
use strict;
use warnings;
use Test::More tests => 10;
use Test::DatabaseRow;
use Test::Builder::Tester;
use Data::Dumper;
$Test::DatabaseRow::dbh = FakeDBI->new(results => 2);
########################################################################
my @rows;
test_out("ok 1 - matches");
row_ok(table => "dummy",
where => [ dummy => "dummy" ],
results => 2,
label => "matches",
store_rows => \@rows);
test_test("array");
is_deeply(\@rows, [
{ fooid => 123, name => "fred" },
{ fooid => 124, name => "bert" },
]);
########################################################################
my $row;
test_out("ok 1 - matches");
row_ok(table => "dummy",
where => [ dummy => "dummy" ],
results => 2,
label => "matches",
store_row => \$row);
test_test("scalar");
is_deeply($row, { fooid => 123, name => "fred" });
test_out("ok 1 - matches");
row_ok(table => "dummy",
where => [ dummy => "dummy" ],
results => 2,
label => "matches",
store_row => \$row);
test_test("scalar");
is_deeply($row, { fooid => 123, name => "fred" });
my %row;
test_out("ok 1 - matches");
row_ok(table => "dummy",
where => [ dummy => "dummy" ],
results => 2,
label => "matches",
store_row => \%row);
test_test("hash");
is_deeply(\%row, { fooid => 123, name => "fred" });
$row = {};
test_out("ok 1 - matches");
row_ok(table => "dummy",
where => [ dummy => "dummy" ],
results => 2,
label => "matches",
store_row => \$row);
test_test("ref");
is_deeply($row, { fooid => 123, name => "fred" });
########################################################################
# fake database package
package FakeDBI;
sub new { my $class = shift; return bless { @_ }, $class };
sub quote { return "qtd<$_[1]>" };
sub prepare
{
my $this = shift;
# die if we need to
if ($this->fallover)
{ die "Khaaaaaaaaaaaaan!" }
return FakeSTH->new($this);
}
sub results { return $_[0]->{results} }
sub nomatch { return $_[0]->{nomatch} }
sub fallover { return $_[0]->{fallover} }
package FakeSTH;
sub new { return bless { parent => $_[1] }, $_[0] };
sub execute { return 1 };
sub fetchrow_hashref
{
my $this = shift;
my $parent = $this->{parent};
$this->{returned}++;
return if $parent->nomatch;
return if $this->{returned} > $parent->results;
if ($this->{returned} == 1)
{ return { fooid => 123, name => "fred" } }
if ($this->{returned} == 2)
{ return { fooid => 124, name => "bert" } }
if ($this->{returned} == 3)
{ return { fooid => 125, name => "ernie" } }
# oops, someone wanted more results than we prepared
return;
}
|
