diff options
Diffstat (limited to 't/lib/db-recno.t')
| -rwxr-xr-x | t/lib/db-recno.t | 188 |
1 files changed, 187 insertions, 1 deletions
diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t index d5afeb0e0d..cb223b1bc8 100755 --- a/t/lib/db-recno.t +++ b/t/lib/db-recno.t @@ -56,7 +56,7 @@ sub bad_one EOM } -print "1..78\n"; +print "1..124\n"; my $Dfile = "recno.tmp"; unlink $Dfile ; @@ -452,4 +452,190 @@ EOM } +{ + # DBM Filter tests + use strict ; + my (@h, $db) ; + my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + unlink $Dfile; + + sub checkOutput + { + my($fk, $sk, $fv, $sv) = @_ ; + return + $fetch_key eq $fk && $store_key eq $sk && + $fetch_value eq $fv && $store_value eq $sv && + $_ eq 'original' ; + } + + ok(79, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ); + + $db->filter_fetch_key (sub { $fetch_key = $_ }) ; + $db->filter_store_key (sub { $store_key = $_ }) ; + $db->filter_fetch_value (sub { $fetch_value = $_}) ; + $db->filter_store_value (sub { $store_value = $_ }) ; + + $_ = "original" ; + + $h[0] = "joe" ; + # fk sk fv sv + ok(80, checkOutput( "", 0, "", "joe")) ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok(81, $h[0] eq "joe"); + # fk sk fv sv + ok(82, checkOutput( "", 0, "joe", "")) ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok(83, $db->FIRSTKEY() == 0) ; + # fk sk fv sv + ok(84, checkOutput( 0, "", "", "")) ; + + # replace the filters, but remember the previous set + my ($old_fk) = $db->filter_fetch_key + (sub { ++ $_ ; $fetch_key = $_ }) ; + my ($old_sk) = $db->filter_store_key + (sub { $_ *= 2 ; $store_key = $_ }) ; + my ($old_fv) = $db->filter_fetch_value + (sub { $_ = "[$_]"; $fetch_value = $_ }) ; + my ($old_sv) = $db->filter_store_value + (sub { s/o/x/g; $store_value = $_ }) ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + $h[1] = "Joe" ; + # fk sk fv sv + ok(85, checkOutput( "", 2, "", "Jxe")) ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok(86, $h[1] eq "[Jxe]"); + # fk sk fv sv + ok(87, checkOutput( "", 2, "[Jxe]", "")) ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok(88, $db->FIRSTKEY() == 1) ; + # fk sk fv sv + ok(89, checkOutput( 1, "", "", "")) ; + + # put the original filters back + $db->filter_fetch_key ($old_fk); + $db->filter_store_key ($old_sk); + $db->filter_fetch_value ($old_fv); + $db->filter_store_value ($old_sv); + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + $h[0] = "joe" ; + ok(90, checkOutput( "", 0, "", "joe")) ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok(91, $h[0] eq "joe"); + ok(92, checkOutput( "", 0, "joe", "")) ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok(93, $db->FIRSTKEY() == 0) ; + ok(94, checkOutput( 0, "", "", "")) ; + + # delete the filters + $db->filter_fetch_key (undef); + $db->filter_store_key (undef); + $db->filter_fetch_value (undef); + $db->filter_store_value (undef); + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + $h[0] = "joe" ; + ok(95, checkOutput( "", "", "", "")) ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok(96, $h[0] eq "joe"); + ok(97, checkOutput( "", "", "", "")) ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok(98, $db->FIRSTKEY() == 0) ; + ok(99, checkOutput( "", "", "", "")) ; + + undef $db ; + untie @h; + unlink $Dfile; +} + +{ + # DBM Filter with a closure + + use strict ; + my (@h, $db) ; + + unlink $Dfile; + ok(100, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ); + + my %result = () ; + + sub Closure + { + my ($name) = @_ ; + my $count = 0 ; + my @kept = () ; + + return sub { ++$count ; + push @kept, $_ ; + $result{$name} = "$name - $count: [@kept]" ; + } + } + + $db->filter_store_key(Closure("store key")) ; + $db->filter_store_value(Closure("store value")) ; + $db->filter_fetch_key(Closure("fetch key")) ; + $db->filter_fetch_value(Closure("fetch value")) ; + + $_ = "original" ; + + $h[0] = "joe" ; + ok(101, $result{"store key"} eq "store key - 1: [0]"); + ok(102, $result{"store value"} eq "store value - 1: [joe]"); + ok(103, ! defined $result{"fetch key"} ); + ok(104, ! defined $result{"fetch value"} ); + ok(105, $_ eq "original") ; + + ok(106, $db->FIRSTKEY() == 0 ) ; + ok(107, $result{"store key"} eq "store key - 1: [0]"); + ok(108, $result{"store value"} eq "store value - 1: [joe]"); + ok(109, $result{"fetch key"} eq "fetch key - 1: [0]"); + ok(110, ! defined $result{"fetch value"} ); + ok(111, $_ eq "original") ; + + $h[7] = "john" ; + ok(112, $result{"store key"} eq "store key - 2: [0 7]"); + ok(113, $result{"store value"} eq "store value - 2: [joe john]"); + ok(114, $result{"fetch key"} eq "fetch key - 1: [0]"); + ok(115, ! defined $result{"fetch value"} ); + ok(116, $_ eq "original") ; + + ok(117, $h[0] eq "joe"); + ok(118, $result{"store key"} eq "store key - 3: [0 7 0]"); + ok(119, $result{"store value"} eq "store value - 2: [joe john]"); + ok(120, $result{"fetch key"} eq "fetch key - 1: [0]"); + ok(121, $result{"fetch value"} eq "fetch value - 1: [joe]"); + ok(122, $_ eq "original") ; + + undef $db ; + untie @h; + unlink $Dfile; +} + +{ + # DBM Filter recursion detection + use strict ; + my (@h, $db) ; + unlink $Dfile; + + ok(123, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ); + + $db->filter_store_key (sub { $_ = $h[0] }) ; + + eval '$h[1] = 1234' ; + ok(124, $@ =~ /^recursion detected in filter_store_key at/ ); + + undef $db ; + untie @h; + unlink $Dfile; +} + exit ; |