1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
#!./perl -w
use strict ;
use lib 't' ;
use BerkeleyDB;
use util ;
use Test::More ;
BEGIN
{
eval { require Encode; };
plan skip_all => "Encode is not available"
if $@;
plan tests => 8;
use_ok('charnames', qw{greek});
}
use charnames qw{greek};
my $Dfile = "dbhash.tmp";
unlink $Dfile;
umask(0) ;
{
# UTF8
#
#use warnings ;
use strict ;
my (%h, $db) ;
unlink $Dfile;
ok $db = tie %h, 'BerkeleyDB::Hash',
-Filename => $Dfile,
-Flags => DB_CREATE;
$db->filter_fetch_key (sub { $_ = Encode::decode_utf8($_) if defined $_ });
$db->filter_store_key (sub { $_ = Encode::encode_utf8($_) if defined $_ });
$db->filter_fetch_value (sub { $_ = Encode::decode_utf8($_) if defined $_ });
$db->filter_store_value (sub { $_ = Encode::encode_utf8($_) if defined $_ });
$h{"\N{alpha}"} = "alpha";
$h{"gamma"} = "\N{gamma}";
is $h{"\N{alpha}"}, "alpha";
is $h{"gamma"}, "\N{gamma}";
undef $db ;
untie %h;
my %newH;
ok $db = tie %newH, 'BerkeleyDB::Hash',
-Filename => $Dfile,
-Flags => DB_CREATE;
$newH{"fred"} = "joe" ;
is $newH{"fred"}, "joe";
is $newH{"gamma"}, "\xCE\xB3";
is $newH{"\xCE\xB1"}, "alpha";
undef $db ;
untie %newH;
unlink $Dfile;
}
|
