The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w 
#
# $Id: 01-basic.t,v 1.5 1999/08/03 10:47:31 andrew Exp $
#
# Basic file handling tests for Xbase module
# ==========================================
#
# Tests that a file can be created, basic information about the file can
# be retrieved and that the file can be closed (by destroying the file handle) 
# and then reopened.


use strict;
use vars qw($loaded $fh $table @temp $filename);

# Declare our test plan and try to ensure that the module to be tested
# will be found if we are not run from the test harness

BEGIN { 
    local($^W) = 0;
    use Test; plan tests => 9;
    eval "use blib" unless grep /blib/, @INC;
    eval { use lib qw(t); } if (defined -d 't');
}


# Test that the module loads OK

use CodeBase;
use CodeBaseTestsubs;

END { print "not ok 1\n" unless $loaded; }
$loaded = 1;
ok(1);

$table = 'test1';
$filename = table_filename($table);
my $f1val = 'abcdef';
my $f2val = 42;
my $f3val = 'A memo field';


# Test file creation

drop_table($table);
$fh = CodeBase::create($filename,
		       ("F1" => "C10",
			"F2" => "N10.2",
			"F3" => "M"));
ok ($fh and ref $fh eq 'CodeBase::FilePtr');

# Test basic operations

ok (    ($fh->alias eq $table)
    and (abspath($fh->filename) eq abspath("$filename.dbf"))
    and ($fh->fldcount == 3)
    and ($fh->reccount == 0)
    and ($fh->tagcount == 0)
    and ((@temp = $fh->names) == 3)
    and ((@temp = $fh->tags)  == 0));


# Try changing the alias

my $newalias = 'newalias';
ok (    ($fh->alias($newalias) eq $newalias)
    and ($fh->alias eq $newalias)
    and (abspath($fh->filename) eq abspath("$filename.dbf")));


# Add a record

ok ($fh->new_record($f1val, $f2val, $f3val)
    and $fh->flush
    and $fh->reccount == 1);


# Close file - handle is now invalid

undef($fh);


# Reopen file

$fh = CodeBase::open($filename);

ok ($fh 
    and ref $fh eq 'CodeBase::FilePtr'
    and ($fh->fldcount == 3)
    and ($fh->reccount == 1)
    and ($fh->tagcount == 0)
    and ((@temp = $fh->names) == 3)
    and ((@temp = $fh->tags)  == 0));

# Fetch the record

$fh->goto(1);
ok (    $fh->field('F1') eq $f1val . (' ' x 4)
    and $fh->field('F2') eq $f2val
    and $fh->field('F3') eq $f3val);

CodeBase::option('trim');
ok ($fh->field('F1') eq $f1val);

CodeBase::option('notrim');
ok ($fh->field('F1') eq $f1val . (' ' x 4));


exit(0);