# -*- coding: utf-8; mode: cperl -*- use strict; # Adjust the number here! use Test::More tests => 41; use File::Basename; use_ok('Tie::MAB2::Dualdb'); use_ok('Tie::MAB2::Dualdb::Recno'); use_ok('Tie::MAB2::Dualdb::Id'); # Add more test here! use BerkeleyDB qw( DB_CREATE DB_INIT_MPOOL DB_INIT_CDB DB_NEXT DB_RDONLY ); my $dualdb = "t/kafka.dualdb"; { # Create the database with one record my @tie; my $flags = DB_CREATE|DB_INIT_MPOOL; # |DB_INIT_CDB ; tie(@tie, "Tie::MAB2::Dualdb", filename => $dualdb, flags => $flags, ) or die; open my $fh, "t/kafka.mab" or die; local $/ = "\n"; my $rec = <$fh>; close $fh; $tie[0] = $rec; eval { $tie[1] = $rec; }; # must fail ok($@, "no duplicates"); untie @tie; } { # verify that the two tables exist my $e = BerkeleyDB::Unknown->new( Filename => $dualdb, Flags => DB_RDONLY ) or die $BerkeleyDB::Error; my $c = $e->db_cursor; my ($k, $v) = ("", "") ; my %found; while ($c->c_get($k, $v, DB_NEXT) == 0) { $found{$k}++; } ok(keys %found == 2, "two tables in database"); ok($found{id}, "table 'id'"); ok($found{recno}, "table 'recno'"); } { # verify that there is one record in the array and that it is blessed my @tie; tie(@tie, "Tie::MAB2::Dualdb::Recno", filename => $dualdb, flags => DB_RDONLY, ) or die; ok(@tie==1, "one record"); my $rec = $tie[0]; ok($rec->isa("MAB2::Record::titel"), "record blessed"); } { # verify that there is one record in the hash and that the value is 0 my %tie; tie(%tie, "Tie::MAB2::Dualdb::Id", filename => $dualdb, flags => DB_RDONLY, ) or die; ok(keys %tie==1, "exactly one record in hash"); my($key,$val) = each %tie; ok($val == 0, "points to record no 0"); } { # delete that one record my @tie; my $flags = DB_CREATE|DB_INIT_MPOOL; # |DB_INIT_CDB ; tie(@tie, "Tie::MAB2::Dualdb", filename => $dualdb, flags => $flags, ) or die; eval {@tie = ();}; # impossible ok($@, "clear not allowed"); untie @tie; } unlink $dualdb; { # Create the database with 26 records # Als das funktionierte, rief einer laut: geil! my(@tie,%tie); my $flags = DB_CREATE|DB_INIT_MPOOL; # |DB_INIT_CDB ; my $tied_array = tie(@tie, "Tie::MAB2::Dualdb", filename => $dualdb, flags => $flags, ) or die; my $env = $tied_array->env; tie(%tie, "Tie::MAB2::Dualdb::Id", filename => File::Basename::basename($dualdb), flags => $flags, env => $env, ) or die; open my $fh, "t/kafka.mab" or die; local $/ = "\n"; while (my $rec = <$fh>) { chomp $rec; push @tie, $rec; ok($. == scalar keys %tie, "correct keys in hash at record $."); } close $fh; my $tie = @tie; ok($tie == 26, "exactly $tie==26 records"); $tie[12] = ""; ok(scalar keys %tie == 25, "25 keys in hash after one delete"); my $rec = $tie[6]->as_string; $tie[6] = ""; $tie[12] = $rec; ok(scalar keys %tie == 25, "still 25 keys in hash after a small shuffle"); undef $tied_array; untie @tie; untie %tie; } unlink $dualdb;