The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- 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;