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
|
package CGI::Uploader::Test;
use Test::More;
use Carp;
use base 'Exporter';
use strict;
# These vars are package-scope so we can call them in the END block.
use vars (qw/@EXPORT
$DBH $drv $created_up_table $created_test_table
/);
@EXPORT = (qw/
&setup
&read_file
&test_gen_transform
/);
=head2 setup
my ($DBH,$drv) = setup();
Set up empty database tables for testing and return a database handle.
Runs some Test::More Tests.
Dies if there is a problem.
=cut
sub setup {
my %p = @_;
use vars qw($dsn $user $password);
my $file ='t/cgi-uploader.config';
my $return;
unless ($return = do $file) {
warn "couldn't parse $file: $@" if $@;
warn "couldn't do $file: $!" unless defined $return;
warn "couldn't run $file" unless $return;
}
# For SQLite
unlink <t/test.db>;
ok($return, 'loading configuration');
$DBH = DBI->connect($dsn,$user,$password);
ok($DBH,'connecting to database'),
# create uploads table
$drv = $DBH->{Driver}->{Name};
if ($drv eq 'SQLite') {
# diag "testing with SQLite version: " .$DBH->selectrow_array("SELECT sqlite_version()");
}
if (not $p{skip_create_uploader_table}) {
ok(open(IN, "<create_uploader_table.".$drv.".sql"), 'opening SQL create file');
my $sql = join "\n", (<IN>);
$created_up_table = $DBH->do($sql);
ok($created_up_table, 'creating uploads table');
}
ok(open(IN, "<t/create_test_table.sql"), 'opening SQL create test table file');
my $item_tbl_sql = join "\n", (<IN>);
# Fix mysql non-standard quoting
$item_tbl_sql =~ s/"/`/gs if ($drv eq 'mysql');
$created_test_table = $DBH->do($item_tbl_sql);
ok($created_test_table, 'creating test table') || croak;
return ($DBH,$drv);
}
=head2 read_file
my $file_contents_as_one_line = read_file('file.txt');
Slurp a file, like File::Slurp;
=cut
sub read_file {
my $file = shift;
local( $/, *FH );
open( FH, $file ) or croak "failed to open file: $file: $!\n";
my $text = <FH>;
return $text;
}
# A trivial transform method for testing
sub test_gen_transform {
my $self = shift;
my $path = shift;
my $file_contents = read_file($path);
$file_contents =~ s/test/generated/;
# remove possible leading "t/"
$path =~ s?^t/??;
my $new_path = "t/$path".'.gen';
open(OUT, ">$new_path") || croak "can't open $new_path";
print OUT $file_contents;
close(OUT);
return $new_path;
}
# We use an end block to clean up even if the script dies.
END {
unlink <t/uploads/*>;
if ($DBH) {
# For SQLite, just delete the whole database file. :)
if ($drv eq 'SQLite') {
$DBH->disconnect;
unlink <t/test.db>;
}
else {
if ($created_up_table) {
$DBH->do("DROP SEQUENCE upload_id_seq") if ($drv eq 'Pg');
$DBH->do("DROP TABLE uploads");
}
if ($created_test_table) {
$DBH->do('DROP TABLE cgi_uploader_test');
}
}
$DBH->disconnect;
}
};
1;
|
