1
0
Fork 0
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:
Kenichi Ishigaki 2009-04-15 20:31:17 +00:00
parent bc89563e52
commit b04ff786fc
2 changed files with 24 additions and 3 deletions

View file

@ -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?

View file

@ -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;
}