74 lines
2.3 KiB
Perl
74 lines
2.3 KiB
Perl
#-------------------------------------------------------------------
|
|
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
|
|
#-------------------------------------------------------------------
|
|
# Please read the legal notices (docs/legal.txt) and the license
|
|
# (docs/license.txt) that came with this distribution before using
|
|
# this software.
|
|
#-------------------------------------------------------------------
|
|
# http://www.plainblack.com info@plainblack.com
|
|
#-------------------------------------------------------------------
|
|
|
|
#The goal of this test is to checkout uft8 handling in filenames.
|
|
|
|
use utf8;
|
|
use FindBin;
|
|
use strict;
|
|
use lib "$FindBin::Bin/..//lib";
|
|
|
|
use WebGUI::Test;
|
|
use WebGUI::Session;
|
|
use WebGUI::Storage;
|
|
|
|
use Test::More;
|
|
use Test::Deep;
|
|
use Encode;
|
|
use Cwd ();
|
|
|
|
my $session = WebGUI::Test->session;
|
|
|
|
plan tests => 4;
|
|
|
|
my $storage = WebGUI::Storage->create($session);
|
|
WebGUI::Test->addToCleanup($storage);
|
|
|
|
my $filename = "Viel_Spa\x{00DF}.txt";
|
|
utf8::upgrade($filename);
|
|
$storage->addFileFromScalar($filename, 'some content');
|
|
ok -e $storage->getPath($filename), 'addFileFromScalar: wrote filename with UTF-8 name';
|
|
|
|
my $filesystem_storage = WebGUI::Storage->create($session);
|
|
WebGUI::Test->addToCleanup($filesystem_storage);
|
|
|
|
$filesystem_storage->addFileFromFilesystem($storage->getPath($filename));
|
|
ok -e $filesystem_storage->getPath($filename), 'addFileFromFilesystem: brought file over with UTF-8 name';
|
|
|
|
cmp_deeply(
|
|
$filesystem_storage->getFiles(),
|
|
[ $filename ],
|
|
'getFiles: returns names in UTF-8'
|
|
);
|
|
|
|
my $copy_name = "Ca\x{0303}on.txt";
|
|
utf8::upgrade($copy_name);
|
|
$filesystem_storage->copyFile($filename, $copy_name);
|
|
|
|
cmp_bag(
|
|
$filesystem_storage->getFiles(),
|
|
[ $filename, $copy_name ],
|
|
'copyFile: copies files handling UTF-8 correctly'
|
|
)
|
|
or diag(
|
|
"GOT: " . join( ', ', map { nice_string($_) } @{ $filesystem_storage->getFiles } )
|
|
. " EXPECT: " . join( ', ', map { nice_string($_) } ( $filename, $copy_name ) )
|
|
);
|
|
|
|
sub nice_string {
|
|
join("",
|
|
map { $_ > 255 ? # if wide character...
|
|
sprintf('\\x{%04X}', $_) : # \x{...}
|
|
chr($_) =~ /[[:cntrl:]]/ ? # else if control character ...
|
|
sprintf('\\x%02X', $_) : # \x..
|
|
quotemeta(chr($_)) # else quoted or as themselves
|
|
} unpack("W*", $_[0])); # unpack Unicode characters
|
|
}
|
|
|