#!/usr/bin/perl -w use strict; use warnings; use Encode; use utf8; use BerkeleyDB; use Encode; use Data::Dumper; use Devel::Peek; # Encode::_utf8_off($string); unlink "xx.db"; tie my %h, "BerkeleyDB::Btree", -Filename=>"xx.db", -Flags=>DB_CREATE; my $db=tied %h; $Data::Dumper::Useqq=1; $db->filter_fetch_key( sub { warn ">>fetch: ".Dumper($_); Dump($_); $_=decode("utf8", $_); warn "<filter_store_key( sub { warn ">>store: ".Dumper($_); Dump($_); $_=encode("utf8", $_); warn "<db_cursor(); my $value; $key = "لل"; print "key before c_get call\n"; Dump($key); print "calling c_get\n"; my $status = $cursor->c_get($key, $value, DB_SET_RANGE); print "\n\ntry again, turning UTF8 flag off key\n"; $key = "لل"; Encode::_utf8_off($key); print "key before c_get call\n"; Dump($key); print "calling c_get\n"; $status = $cursor->c_get($key, $value, DB_SET_RANGE); #### setting $h{$key} SV = PV(0x9b08c74) at 0x9d35d48 REFCNT = 1 FLAGS = (PADBUSY,PADMY,POK,pPOK,UTF8) PV = 0x9d337a8 "\303\244\303\244"\0 [UTF8 "\x{e4}\x{e4}"] CUR = 4 LEN = 8 >>store: $VAR1 = "\x{e4}\x{e4}"; SV = PVMG(0x9b823a0) at 0x9d35f28 REFCNT = 1 FLAGS = (SMG,POK,pPOK,UTF8) IV = 0 NV = 0 PV = 0x9b58b38 "\303\244\303\244"\0 [UTF8 "\x{e4}\x{e4}"] CUR = 4 LEN = 8 MAGIC = 0x9d41510 MG_VIRTUAL = &PL_vtbl_mglob MG_TYPE = PERL_MAGIC_regex_global(g) MG_LEN = -1 MAGIC = 0x9d95400 MG_VIRTUAL = &PL_vtbl_utf8 MG_TYPE = PERL_MAGIC_utf8(w) MG_LEN = 2 <>fetch: $VAR1 = "\303\244\303\244"; SV = PVMG(0x9b823a0) at 0x9b25d40 REFCNT = 1 FLAGS = (SMG,POK,pPOK) IV = 0 NV = 0 PV = 0x9d48548 "\303\244\303\244"\0 CUR = 4 LEN = 8 MAGIC = 0x9d907c0 MG_VIRTUAL = &PL_vtbl_mglob MG_TYPE = PERL_MAGIC_regex_global(g) MG_LEN = -1 <>store: $VAR1 = "\x{e4}\x{e4}"; SV = PVMG(0x9d69908) at 0x9b25944 REFCNT = 1 FLAGS = (SMG,POK,pPOK,UTF8) IV = 0 NV = 0 PV = 0x9d48890 "\303\244\303\244"\0 [UTF8 "\x{e4}\x{e4}"] CUR = 4 LEN = 8 MAGIC = 0x9d69748 MG_VIRTUAL = &PL_vtbl_mglob MG_TYPE = PERL_MAGIC_regex_global(g) MG_LEN = -1 MAGIC = 0x9d69708 MG_VIRTUAL = &PL_vtbl_utf8 MG_TYPE = PERL_MAGIC_utf8(w) MG_LEN = 2 <>fetch: $VAR1 = "\x{e4}\x{e4}"; SV = PVMG(0x9b82340) at 0x9d35d48 REFCNT = 1 FLAGS = (PADBUSY,PADMY,SMG,POK,pPOK,UTF8) IV = 0 NV = 0 PV = 0x9d337a8 "\303\244\303\244"\0 [UTF8 "\x{e4}\x{e4}"] CUR = 4 LEN = 8 MAGIC = 0x9d67040 MG_VIRTUAL = &PL_vtbl_mglob MG_TYPE = PERL_MAGIC_regex_global(g) MG_LEN = -1 MAGIC = 0x9d24fd0 MG_VIRTUAL = &PL_vtbl_utf8 MG_TYPE = PERL_MAGIC_utf8(w) MG_LEN = 2 <>store: $VAR1 = "\303\244\303\244"; SV = PVMG(0x9d69908) at 0x9b25944 REFCNT = 1 FLAGS = (SMG,POK,pPOK) IV = 0 NV = 0 PV = 0x9d4b610 "\303\244\303\244"\0 CUR = 4 LEN = 8 MAGIC = 0x9d69708 MG_VIRTUAL = &PL_vtbl_mglob MG_TYPE = PERL_MAGIC_regex_global(g) MG_LEN = -1 <>fetch: $VAR1 = "\303\244\303\244"; SV = PVMG(0x9b82340) at 0x9d35d48 REFCNT = 1 FLAGS = (PADBUSY,PADMY,SMG,POK,pPOK) IV = 0 NV = 0 PV = 0x9d95ce8 "\303\244\303\244"\0 CUR = 4 LEN = 8 MAGIC = 0x9d67040 MG_VIRTUAL = &PL_vtbl_mglob MG_TYPE = PERL_MAGIC_regex_global(g) MG_LEN = -1 MAGIC = 0x9d24fd0 MG_VIRTUAL = &PL_vtbl_utf8 MG_TYPE = PERL_MAGIC_utf8(w) MG_LEN = -1 <