simcop2387/DBD-SQLite-SQLcipher
1
0
Fork 0
mirror of https://github.com/DBD-SQLite/DBD-SQLite synced 2025-06-07 22:28:47 -04:00
Code Issues Releases Wiki Activity

DBD-SQLite: unicode dirs/files may not be removed by CLEANUP of File::Temp (as they may requrie special treatment on Win32)

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lib/DBD/SQLite.pm
View file

@ -69,9 +69,10 @@ sub connect {
require Win32; require Win32;
require File::Basename; require File::Basename;
my ($file, $dir, $suffix) = File::Basename::fileparse($real); 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. # Existing files will work directly.
$real = Win32::GetShortPathName($real); $real = short;
} elsif ( -d $dir ) { } elsif ( -d $dir ) {
# We are creating a new file. # We are creating a new file.
# Does the directory it's in at least exist? # Does the directory it's in at least exist?

22
t/33_non_latin_path.t
View file

@ -47,7 +47,7 @@ foreach my $subdir ( 'longascii', 'adatb
}; };
is( $@, '', "Could connect to database in $subdir" ); is( $@, '', "Could connect to database in $subdir" );
diag( $@ ) if $@; diag( $@ ) if $@;
unlink($dbfile) if -e $dbfile; unlink(_path($dbfile)) if -e _path($dbfile);
# Repeat with the unicode flag on # Repeat with the unicode flag on
my $ufile = $dbfile; my $ufile = $dbfile;
@ -61,6 +61,7 @@ foreach my $subdir ( 'longascii', 'adatb
}; };
is( $@, '', "Could connect to database in $subdir" ); is( $@, '', "Could connect to database in $subdir" );
diag( $@ ) if $@; diag( $@ ) if $@;
unlink(_path($ufile)) if -e _path($ufile);
# when the name of the database file has non-latin characters # when the name of the database file has non-latin characters
my $dbfilex = catfile($dir, "$subdir.db"); 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}); DBI->connect("dbi:SQLite:dbname=$dbfilex", "", "", {RaiseError => 1, PrintError => 0});
}; };
ok(!$@, "Could connect to database in $dbfilex") or diag $@; 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;
} }