recno.t

关于Berkelay数据库的共享源码

    my $lex = new LexFile $Dfile ;
    my @array ;
    my $value ;

    my $home = "./fred" ;
    ok 167, my $lexD = new LexDir($home);
    ok 168, my $env = new BerkeleyDB::Env -Home => $home,@StdErrFile,
				     -Flags => DB_CREATE|DB_INIT_TXN|
					  	DB_INIT_MPOOL|DB_INIT_LOCK ;
    ok 169, my $txn = $env->txn_begin() ;
    ok 170, my $db1 = tie @array, 'BerkeleyDB::Recno', 
				-Filename => $Dfile,
				-ArrayBase => 0,
                      		-Flags    =>  DB_CREATE ,
		        	-Env 	  => $env,
		        	-Txn	  => $txn ;

    
    ok 171, $txn->txn_commit() == 0 ;
    ok 172, $txn = $env->txn_begin() ;
    $db1->Txn($txn);

    # create some data
    my @data =  (
		"boat",
		"house",
		"sea",
		) ;

    my $ret = 0 ;
    my $i ;
    for ($i = 0 ; $i < @data ; ++$i) {
        $ret += $db1->db_put($i, $data[$i]) ;
    }
    ok 173, $ret == 0 ;

    # should be able to see all the records

    ok 174, my $cursor = $db1->db_cursor() ;
    my ($k, $v) = (0, "") ;
    my $count = 0 ;
    # sequence forwards
    while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
        ++ $count ;
    }
    ok 175, $count == 3 ;
    undef $cursor ;

    # now abort the transaction
    ok 176, $txn->txn_abort() == 0 ;

    # there shouldn't be any records in the database
    $count = 0 ;
    # sequence forwards
    ok 177, $cursor = $db1->db_cursor() ;
    while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
        ++ $count ;
    }
    ok 178, $count == 0 ;

    undef $txn ;
    undef $cursor ;
    undef $db1 ;
    undef $env ;
    untie @array ;
}


{
    # db_stat

    my $lex = new LexFile $Dfile ;
    my $recs = ($BerkeleyDB::db_version >= 3.1 ? "bt_ndata" : "bt_nrecs") ;
    my @array ;
    my ($k, $v) ;
    ok 179, my $db = new BerkeleyDB::Recno -Filename 	=> $Dfile, 
				     	   -Flags    	=> DB_CREATE,
					   -Pagesize	=> 4 * 1024,
					;

    my $ref = $db->db_stat() ; 
    ok 180, $ref->{$recs} == 0;
    ok 181, $ref->{'bt_pagesize'} == 4 * 1024;

    # create some data
    my @data =  (
		2,
		"house",
		"sea",
		) ;

    my $ret = 0 ;
    my $i ;
    for ($i = $db->ArrayOffset ; @data ; ++$i) {
        $ret += $db->db_put($i, shift @data) ;
    }
    ok 182, $ret == 0 ;

    $ref = $db->db_stat() ; 
    ok 183, $ref->{$recs} == 3;
}

{
   # sub-class test

   package Another ;

   use strict ;

   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
   print FILE <<'EOM' ;

   package SubDB ;

   use strict ;
   use vars qw( @ISA @EXPORT) ;

   require Exporter ;
   use BerkeleyDB;
   @ISA=qw(BerkeleyDB BerkeleyDB::Recno);
   @EXPORT = @BerkeleyDB::EXPORT ;

   sub db_put { 
	my $self = shift ;
        my $key = shift ;
        my $value = shift ;
        $self->SUPER::db_put($key, $value * 3) ;
   }

   sub db_get { 
	my $self = shift ;
        $self->SUPER::db_get($_[0], $_[1]) ;
	$_[1] -= 2 ;
   }

   sub A_new_method
   {
	my $self = shift ;
        my $key = shift ;
        my $value = $self->FETCH($key) ;
	return "[[$value]]" ;
   }

   1 ;
EOM

    close FILE ;

    BEGIN { push @INC, '.'; }    
    eval 'use SubDB ; ';
    main::ok 184, $@ eq "" ;
    my @h ;
    my $X ;
    eval '
	$X = tie(@h, "SubDB", -Filename => "dbrecno.tmp", 
			-Flags => DB_CREATE,
			-Mode => 0640 );
	' ;

    main::ok 185, $@ eq "" ;

    my $ret = eval '$h[1] = 3 ; return $h[1] ' ;
    main::ok 186, $@ eq "" ;
    main::ok 187, $ret == 7 ;

    my $value = 0;
    $ret = eval '$X->db_put(1, 4) ; $X->db_get(1, $value) ; return $value' ;
    main::ok 188, $@ eq "" ;
    main::ok 189, $ret == 10 ;

    $ret = eval ' DB_NEXT eq main::DB_NEXT ' ;
    main::ok 190, $@ eq ""  ;
    main::ok 191, $ret == 1 ;

    $ret = eval '$X->A_new_method(1) ' ;
    main::ok 192, $@ eq "" ;
    main::ok 193, $ret eq "[[10]]" ;

    undef $X;
    untie @h;
    unlink "SubDB.pm", "dbrecno.tmp" ;

}

{
    # variable length records, DB_DELIMETER -- defaults to \n

    my $lex = new LexFile $Dfile, $Dfile2 ;
    touch $Dfile2 ;
    my @array ;
    my $value ;
    ok 194, tie @array, 'BerkeleyDB::Recno', -Filename  => $Dfile,
						-ArrayBase => 0,
                                      	       	-Flags  => DB_CREATE ,
						-Source	=> $Dfile2 ;
    $array[0] = "abc" ;
    $array[1] = "def" ;
    $array[3] = "ghi" ;
    untie @array ;

    my $x = docat($Dfile2) ;
    ok 195, $x eq "abc\ndef\n\nghi\n" ;
}

{
    # variable length records, change DB_DELIMETER

    my $lex = new LexFile $Dfile, $Dfile2 ;
    touch $Dfile2 ;
    my @array ;
    my $value ;
    ok 196, tie @array, 'BerkeleyDB::Recno', -Filename  => $Dfile,
						-ArrayBase => 0,
                                      	       	-Flags  => DB_CREATE ,
						-Source	=> $Dfile2 ,
						-Delim	=> "-";
    $array[0] = "abc" ;
    $array[1] = "def" ;
    $array[3] = "ghi" ;
    untie @array ;

    my $x = docat($Dfile2) ;
    ok 197, $x eq "abc-def--ghi-";
}

{
    # fixed length records, default DB_PAD

    my $lex = new LexFile $Dfile, $Dfile2 ;
    touch $Dfile2 ;
    my @array ;
    my $value ;
    ok 198, tie @array, 'BerkeleyDB::Recno', -Filename  => $Dfile,
						-ArrayBase => 0,
                                      	       	-Flags  => DB_CREATE ,
						-Len 	=> 5,
						-Source	=> $Dfile2 ;
    $array[0] = "abc" ;
    $array[1] = "def" ;
    $array[3] = "ghi" ;
    untie @array ;

    my $x = docat($Dfile2) ;
    ok 199, $x eq "abc  def       ghi  " ;
}

{
    # fixed length records, change Pad

    my $lex = new LexFile $Dfile, $Dfile2 ;
    touch $Dfile2 ;
    my @array ;
    my $value ;
    ok 200, tie @array, 'BerkeleyDB::Recno', -Filename  => $Dfile,
						-ArrayBase => 0,
                                      	       	-Flags  => DB_CREATE ,
						-Len	=> 5,
						-Pad	=> "-",
						-Source	=> $Dfile2 ;
    $array[0] = "abc" ;
    $array[1] = "def" ;
    $array[3] = "ghi" ;
    untie @array ;

    my $x = docat($Dfile2) ;
    ok 201, $x eq "abc--def-------ghi--" ;
}

{
    # DB_RENUMBER

    my $lex = new LexFile $Dfile;
    my @array ;
    my $value ;
    ok 202, my $db = tie @array, 'BerkeleyDB::Recno', -Filename  => $Dfile,
				    	    	-Property => DB_RENUMBER,
						-ArrayBase => 0,
                                      	       	-Flags  => DB_CREATE ;
    # create a few records
    $array[0] = "abc" ;
    $array[1] = "def" ;
    $array[3] = "ghi" ;

    ok 203, my ($length, $joined) = joiner($db, "|") ;
    ok 204, $length == 3 ;
    ok 205, $joined eq "abc|def|ghi";

    ok 206, $db->db_del(1) == 0 ;
    ok 207, ($length, $joined) = joiner($db, "|") ;
    ok 208, $length == 2 ;
    ok 209, $joined eq "abc|ghi";

    undef $db ;
    untie @array ;

}

{
    # DB_APPEND

    my $lex = new LexFile $Dfile;
    my @array ;
    my $value ;
    ok 210, my $db = tie @array, 'BerkeleyDB::Recno', 
					-Filename  => $Dfile,
                                       	-Flags     => DB_CREATE ;

    # create a few records
    $array[1] = "def" ;
    $array[3] = "ghi" ;

    my $k = 0 ;
    ok 211, $db->db_put($k, "fred", DB_APPEND) == 0 ;
    ok 212, $k == 4 ;

    undef $db ;
    untie @array ;
}

{
    # in-memory Btree with an associated text file

    my $lex = new LexFile $Dfile2 ;
    touch $Dfile2 ;
    my @array ;
    my $value ;
    ok 213, tie @array, 'BerkeleyDB::Recno',    -Source => $Dfile2 ,
						-ArrayBase => 0,
				    	    	-Property => DB_RENUMBER,
                                      	       	-Flags  => DB_CREATE ;
    $array[0] = "abc" ;
    $array[1] = "def" ;
    $array[3] = "ghi" ;
    untie @array ;

    my $x = docat($Dfile2) ;
    ok 214, $x eq "abc\ndef\n\nghi\n" ;
}

{
    # in-memory, variable length records, change DB_DELIMETER

    my $lex = new LexFile $Dfile, $Dfile2 ;
    touch $Dfile2 ;
    my @array ;
    my $value ;
    ok 215, tie @array, 'BerkeleyDB::Recno', 
						-ArrayBase => 0,
                                      	       	-Flags  => DB_CREATE ,
						-Source	=> $Dfile2 ,
				    	    	-Property => DB_RENUMBER,
						-Delim	=> "-";
    $array[0] = "abc" ;
    $array[1] = "def" ;
    $array[3] = "ghi" ;
    untie @array ;

    my $x = docat($Dfile2) ;
    ok 216, $x eq "abc-def--ghi-";
}

{
    # in-memory, fixed length records, default DB_PAD

    my $lex = new LexFile $Dfile, $Dfile2 ;
    touch $Dfile2 ;
    my @array ;
    my $value ;
    ok 217, tie @array, 'BerkeleyDB::Recno', 	-ArrayBase => 0,
                                      	       	-Flags  => DB_CREATE ,
				    	    	-Property => DB_RENUMBER,
						-Len 	=> 5,
						-Source	=> $Dfile2 ;
    $array[0] = "abc" ;
    $array[1] = "def" ;
    $array[3] = "ghi" ;
    untie @array ;

    my $x = docat($Dfile2) ;
    ok 218, $x eq "abc  def       ghi  " ;
}

{
    # in-memory, fixed length records, change Pad

    my $lex = new LexFile $Dfile, $Dfile2 ;
    touch $Dfile2 ;
    my @array ;
    my $value ;
    ok 219, tie @array, 'BerkeleyDB::Recno', 
						-ArrayBase => 0,
                                      	       	-Flags  => DB_CREATE ,
				    	    	-Property => DB_RENUMBER,
						-Len	=> 5,
						-Pad	=> "-",
						-Source	=> $Dfile2 ;
    $array[0] = "abc" ;
    $array[1] = "def" ;
    $array[3] = "ghi" ;
    untie @array ;

    my $x = docat($Dfile2) ;
    ok 220, $x eq "abc--def-------ghi--" ;
}

{
    # 23 Sept 2001 -- push into an empty array
    my $lex = new LexFile $Dfile ;
    my @array ;
    my $db ;
    ok 221, $db = tie @array, 'BerkeleyDB::Recno', 
						-ArrayBase => 0,
                                      	       	-Flags  => DB_CREATE ,
				    	    	-Property => DB_RENUMBER,
						-Filename => $Dfile ;
    $FA ? push @array, "first"
        : $db->push("first") ;

    ok 222, $array[0] eq "first" ;
    ok 223, $FA ? pop @array : $db->pop() eq "first" ;

    undef $db;
    untie @array ;

}

{
    # 23 Sept 2001 -- unshift into an empty array
    my $lex = new LexFile $Dfile ;
    my @array ;
    my $db ;
    ok 224, $db = tie @array, 'BerkeleyDB::Recno', 
						-ArrayBase => 0,
                                      	       	-Flags  => DB_CREATE ,
				    	    	-Property => DB_RENUMBER,
						-Filename => $Dfile ;
    $FA ? unshift @array, "first"
        : $db->unshift("first") ;

    ok 225, $array[0] eq "first" ;
    ok 226, ($FA ? shift @array : $db->shift()) eq "first" ;

    undef $db;
    untie @array ;

}
__END__


# TODO
#
# DB_DELIMETER DB_FIXEDLEN DB_PAD DB_SNAPSHOT with partial records