mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -04:00
DBD-SQLite: unicode dirs/files may not be removed by CLEANUP of File::Temp (as they may requrie special treatment on Win32)
This commit is contained in:
parent
bc89563e52
commit
b04ff786fc
2 changed files with 24 additions and 3 deletions
|
@ -69,9 +69,10 @@ sub connect {
|
|||
require Win32;
|
||||
require File::Basename;
|
||||
my ($file, $dir, $suffix) = File::Basename::fileparse($real);
|
||||
if ( -f $real ) {
|
||||
my $short = Win32::GetShortPathName($real);
|
||||
if ( $short && -f $short ) {
|
||||
# Existing files will work directly.
|
||||
$real = Win32::GetShortPathName($real);
|
||||
$real = short;
|
||||
} elsif ( -d $dir ) {
|
||||
# We are creating a new file.
|
||||
# Does the directory it's in at least exist?
|
||||
|
|
|
@ -47,7 +47,7 @@ foreach my $subdir ( 'longascii', 'adatb
|
|||
};
|
||||
is( $@, '', "Could connect to database in $subdir" );
|
||||
diag( $@ ) if $@;
|
||||
unlink($dbfile) if -e $dbfile;
|
||||
unlink(_path($dbfile)) if -e _path($dbfile);
|
||||
|
||||
# Repeat with the unicode flag on
|
||||
my $ufile = $dbfile;
|
||||
|
@ -61,6 +61,7 @@ foreach my $subdir ( 'longascii', 'adatb
|
|||
};
|
||||
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");
|
||||
|
@ -68,4 +69,23 @@ foreach my $subdir ( 'longascii', 'adatb
|
|||
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);
|
||||
}
|
||||
|
||||
sub _path { # copied from DBD::SQLite::connect
|
||||
my $path = shift;
|
||||
return $path unless $^O eq '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.
|
||||
return $short;
|
||||
} elsif ( -d $dir ) {
|
||||
return join '', grep { defined } Win32::GetShortPathName($dir), $file, $suffix;
|
||||
}
|
||||
return $path;
|
||||
}
|
Loading…
Add table
Reference in a new issue