The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Copyright (c) 2003, 2004 Jeffrey I Cohen.  All rights reserved.
#
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..57\n"; }
END {print "not ok 1\n" unless $loaded;}
use Genezzo::Block::Std;
use Genezzo::Block::RowDir;
use Genezzo::Block::RDBlock;
use Genezzo::Util;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
use strict;
use warnings;

my $TEST_COUNT;

$TEST_COUNT = 2;

{
    tt1(150);
#    tt1(200);
#    tt1(1000);

#    tt2(150);
#    tt2(200);
#    tt2(1000);
}

sub tt1 
{
    my $bsize = shift;

    local $Genezzo::Block::Std::DEFBLOCKSIZE = $bsize;
    my @buffarr;

    my $cnt = 50;
    
    my @hasharr;


    # build an array of hashes to tie, plus some byte buffers
    for my $i (1..$cnt)
    {
        push @hasharr, {};
        push @buffarr,  "\0" x (1+$bsize);

    }

    my @tiearr;

    # tie all the hashes
    for my $i (0..$cnt-1)
    {
        my $tie_thing = tie %{$hasharr[$i]}, 
        "Genezzo::Block::RDBlock", (refbufstr => \$buffarr[$i], 
                                 blocknum => $i)
            or
            not_ok( "Couldn't create new RDBlock" );
        ok();
        push @tiearr, $tie_thing;
    }

#    greet @tiearr;

    my $stat = $tiearr[0]->_update_meta_zero("alpha", "bravo")
        or
        not_ok( "Couldn't update metadata" );
    ok();

    $stat = $tiearr[0]->_update_meta_zero("charlie", "delta")
        or
        not_ok( "Couldn't update metadata" );
    ok();
    
    if ($tiearr[0]->_fetchmeta("alpha") =~  m/bravo/)
    {
        ok();
    }
    else
    {
        not_ok( "Couldn't find metadata" );
    }
    if ($tiearr[0]->_fetchmeta("charlie") =~  m/delta/)
    {
        ok();
    }
    else
    {
        not_ok( "Couldn't find metadata" );
    }

    my @plist = qw(romeo sierra tango);
    greet @plist;

    $stat = $tiearr[0]->_set_meta_row("I", \@plist)
        or
        not_ok( "Couldn't set metarow" );
    ok();

    greet $tiearr[0]->_fetchmeta("I");

    my $glist = $tiearr[0]->_get_meta_row("I");
    
    greet $glist;

    if (scalar(@{$glist}) != scalar(@plist))
    {
        not_ok("row size mismatch");
        not_ok("col mismatch");
    }
    else
    {
        for my $i (0..(scalar(@plist) - 1))
        {
            unless ($glist->[$i] eq $plist[$i])
            {
                not_ok("col mismatch");
            }
        }
        ok();
    }

#    for my $i (@tiearr)
#    {
#        greet $i->_fetchmeta('#');
#    }



} # end tt1

sub ok
{
    print "ok $TEST_COUNT\n";
    
    $TEST_COUNT++;
}


sub not_ok
{
    my ( $message ) = @_;
    
    print "not ok $TEST_COUNT #  $message\n";
        
        $TEST_COUNT++;
}


sub skip
{
    my ( $message ) = @_;
    
    print "ok $TEST_COUNT # skipped: $message\n";
        
        $TEST_COUNT++;
}