33_non_latin_path.t [plain text]
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use t::lib::Test;
use Test::More;
BEGIN {
if ( $] >= 5.008005 ) {
plan( tests => (($^O eq 'cygwin') ? 15 : 27) );
} else {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::NoWarnings;
use File::Temp ();
use File::Spec::Functions ':ALL';
eval "require utf8";
die $@ if $@;
my $dir = File::Temp::tempdir( CLEANUP => 1 );
foreach my $subdir ( 'longascii', 'adatbázis', 'name with spaces', '¿¿¿ ¿¿¿¿¿¿') {
if ($^O eq 'cygwin') {
next if (($subdir eq 'adatbázis') || ($subdir eq '¿¿¿ ¿¿¿¿¿¿'));
}
utf8::upgrade($subdir);
ok(
mkdir(catdir($dir, $subdir)),
"$subdir created",
);
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 $@;
unlink(_path($dbfile)) if -e _path($dbfile);
my $ufile = $dbfile;
eval {
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", undef, undef, {
RaiseError => 1,
PrintError => 0,
sqlite_unicode => 1,
} );
isa_ok( $dbh, 'DBI::db' );
};
is( $@, '', "Could connect to database in $subdir" );
diag( $@ ) if $@;
unlink(_path($ufile)) if -e _path($ufile);
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 $@;
unlink(_path($dbfilex)) if -e _path($dbfilex);
}
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 { 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 ) {
$path = $short;
} elsif ( -d $dir ) {
$path = join '', grep { defined } Win32::GetShortPathName($dir), $file, $suffix;
}
}
return $path;
}