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
|
# Tests path containing non-latine-1 characters
# currently fails on Windows
use strict;
use warnings;
use lib "t/lib";
use SQLiteTest;
use Test::More;
use if -d ".git", "Test::FailWarnings";
use File::Temp ();
use File::Spec::Functions ':ALL';
use DBD::SQLite::Constants ':dbd_sqlite_string_mode';
my $unicode_opt = DBD_SQLITE_STRING_MODE_UNICODE_STRICT;
BEGIN { requires_unicode_support() }
my $dir = File::Temp::tempdir( CLEANUP => 1 );
foreach my $subdir ( 'longascii', 'adatbzis', 'name with spaces', ' ') {
if ($^O eq 'cygwin') {
next if (($subdir eq 'adatbzis') || ($subdir eq ' '));
}
# rt48048: don't need to "use utf8" nor "require utf8"
utf8::upgrade($subdir);
ok(
mkdir(catdir($dir, $subdir)),
"$subdir created",
);
# Open the database
my $dbfile = catfile($dir, $subdir, 'db.db');
eval {
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", undef, undef, {
RaiseError => 1,
PrintError => 0,
} );
isa_ok( $dbh, 'DBI::db' );
};
is( $@, '', "Could connect to database in $subdir" );
diag( $@ ) if $@;
# Reopen the database
eval {
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", undef, undef, {
RaiseError => 1,
PrintError => 0,
} );
isa_ok( $dbh, 'DBI::db' );
};
is( $@, '', "Could connect to database in $subdir" );
diag( $@ ) if $@;
unlink(_path($dbfile)) if -e _path($dbfile);
# Repeat with the unicode flag on
my $ufile = $dbfile;
eval {
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", undef, undef, {
RaiseError => 1,
PrintError => 0,
sqlite_string_mode => $unicode_opt,
} );
isa_ok( $dbh, 'DBI::db' );
};
is( $@, '', "Could connect to database in $subdir" );
diag( $@ ) if $@;
# Reopen the database
eval {
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", undef, undef, {
RaiseError => 1,
PrintError => 0,
sqlite_string_mode => $unicode_opt,
} );
isa_ok( $dbh, 'DBI::db' );
};
is( $@, '', "Could connect to database in $subdir" );
diag( $@ ) if $@;
unlink(_path($ufile)) if -e _path($ufile);
# when the name of the database file has non-latin characters
my $dbfilex = catfile($dir, "$subdir.db");
eval {
DBI->connect("dbi:SQLite:dbname=$dbfilex", "", "", {RaiseError => 1, PrintError => 0});
};
ok(!$@, "Could connect to database in $dbfilex") or diag $@;
ok -f _path($dbfilex), "file exists: "._path($dbfilex)." ($dbfilex)";
# Reopen the database
eval {
DBI->connect("dbi:SQLite:dbname=$dbfilex", "", "", {RaiseError => 1, PrintError => 0});
};
ok(!$@, "Could connect to database in $dbfilex") or diag $@;
unlink(_path($dbfilex)) if -e _path($dbfilex);
}
# connect to an empty filename - sqlite will create a tempfile
eval {
my $dbh = DBI->connect("dbi:SQLite:dbname=", undef, undef, {
RaiseError => 1,
PrintError => 0,
} );
isa_ok( $dbh, 'DBI::db' );
};
is( $@, '', "Could connect to temp database (empty filename)" );
diag( $@ ) if $@;
sub _path { # copied from DBD::SQLite::connect
my $path = shift;
if ($^O =~ /MSWin32/) {
require Win32;
require File::Basename;
my ($file, $dir, $suffix) = File::Basename::fileparse($path);
my $short = Win32::GetShortPathName($path);
if ( $short && -f $short ) {
# Existing files will work directly.
$path = $short;
} elsif ( -d $dir ) {
$path = join '', grep { defined } Win32::GetShortPathName($dir), $file, $suffix;
}
}
return $path;
}
done_testing;
|
