queue.t

介绍：MySQL是比较出名的数据库软件

    ok 96, $cursor->c_get($k, $v, DB_FIRST) == DB_NOTFOUND ;

    undef $cursor ;
    undef $db ;
    untie @array ;
}

{
    # in-memory file

    my @array ;
    my $fd ;
    my $value ;
    my $rec_len = 15 ;
    ok 97, my $db = tie @array, 'BerkeleyDB::Queue',
				    	    -Len       => $rec_len;

    ok 98, $db->db_put(1, "some value") == 0  ;
    ok 99, $db->db_get(1, $value) == 0 ;
    ok 100, $value eq fillout("some value", $rec_len) ;

}
 
{
    # partial
    # check works via API

    my $lex = new LexFile $Dfile ;
    my $value ;
    my $rec_len = 8 ;
    ok 101, my $db = new BerkeleyDB::Queue  -Filename => $Dfile,
                                      	    -Flags    => DB_CREATE ,
				    	    -Len      => $rec_len,
				    	    -Pad      => " " ;

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

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

    # do a partial get
    my ($pon, $off, $len) = $db->partial_set(0,2) ;
    ok 103, ! $pon && $off == 0 && $len == 0 ;
    ok 104, $db->db_get(1, $value) == 0 && $value eq "bo" ;
    ok 105, $db->db_get(2, $value) == 0 && $value eq "ho" ;
    ok 106, $db->db_get(3, $value) == 0 && $value eq "se" ;

    # do a partial get, off end of data
    ($pon, $off, $len) = $db->partial_set(3,2) ;
    ok 107, $pon ;
    ok 108, $off == 0 ;
    ok 109, $len == 2 ;
    ok 110, $db->db_get(1, $value) == 0 && $value eq fillout("t", 2) ;
    ok 111, $db->db_get(2, $value) == 0 && $value eq "se" ;
    ok 112, $db->db_get(3, $value) == 0 && $value eq "  " ;

    # switch of partial mode
    ($pon, $off, $len) = $db->partial_clear() ;
    ok 113, $pon ;
    ok 114, $off == 3 ;
    ok 115, $len == 2 ;
    ok 116, $db->db_get(1, $value) == 0 && $value eq fillout("boat", $rec_len) ;
    ok 117, $db->db_get(2, $value) == 0 && $value eq fillout("house", $rec_len) ;
    ok 118, $db->db_get(3, $value) == 0 && $value eq fillout("sea", $rec_len) ;

    # now partial put
    $db->partial_set(0,2) ;
    ok 119, $db->db_put(1, "") != 0 ;
    ok 120, $db->db_put(2, "AB") == 0 ;
    ok 121, $db->db_put(3, "XY") == 0 ;
    ok 122, $db->db_put(4, "KLM") != 0 ;
    ok 123, $db->db_put(4, "KL") == 0 ;

    ($pon, $off, $len) = $db->partial_clear() ;
    ok 124, $pon ;
    ok 125, $off == 0 ;
    ok 126, $len == 2 ;
    ok 127, $db->db_get(1, $value) == 0 && $value eq fillout("boat", $rec_len) ;
    ok 128, $db->db_get(2, $value) == 0 && $value eq fillout("ABuse", $rec_len) ;
    ok 129, $db->db_get(3, $value) == 0 && $value eq fillout("XYa", $rec_len) ;
    ok 130, $db->db_get(4, $value) == 0 && $value eq fillout("KL", $rec_len) ;

    # now partial put
    ($pon, $off, $len) = $db->partial_set(3,2) ;
    ok 131, ! $pon ;
    ok 132, $off == 0 ;
    ok 133, $len == 0 ;
    ok 134, $db->db_put(1, "PP") == 0 ;
    ok 135, $db->db_put(2, "Q") != 0 ;
    ok 136, $db->db_put(3, "XY") == 0 ;
    ok 137, $db->db_put(4, "TU") == 0 ;

    $db->partial_clear() ;
    ok 138, $db->db_get(1, $value) == 0 && $value eq fillout("boaPP", $rec_len) ;
    ok 139, $db->db_get(2, $value) == 0 && $value eq fillout("ABuse",$rec_len) ;
    ok 140, $db->db_get(3, $value) == 0 && $value eq fillout("XYaXY", $rec_len) ;
    ok 141, $db->db_get(4, $value) == 0 && $value eq fillout("KL TU", $rec_len) ;
}

{
    # partial
    # check works via tied array 

    my $lex = new LexFile $Dfile ;
    my @array ;
    my $value ;
    my $rec_len = 8 ;
    ok 142, my $db = tie @array, 'BerkeleyDB::Queue', -Filename => $Dfile,
                                      	        -Flags    => DB_CREATE ,
				    	        -Len       => $rec_len,
				    	        -Pad       => " " ;

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

    my $i ;
    my $status = 0 ;
    for ($i = 1 ; $i < @data ; ++$i) {
	$array[$i] = $data[$i] ;
	$status += $db->status() ;
    }

    ok 143, $status == 0 ;

    # do a partial get
    $db->partial_set(0,2) ;
    ok 144, $array[1] eq fillout("bo", 2) ;
    ok 145, $array[2] eq fillout("ho", 2) ;
    ok 146, $array[3]  eq fillout("se", 2) ;

    # do a partial get, off end of data
    $db->partial_set(3,2) ;
    ok 147, $array[1] eq fillout("t", 2) ;
    ok 148, $array[2] eq fillout("se", 2) ;
    ok 149, $array[3] eq fillout("", 2) ;

    # switch of partial mode
    $db->partial_clear() ;
    ok 150, $array[1] eq fillout("boat", $rec_len) ;
    ok 151, $array[2] eq fillout("house", $rec_len) ;
    ok 152, $array[3] eq fillout("sea", $rec_len) ;

    # now partial put
    $db->partial_set(0,2) ;
    $array[1] = "" ;
    ok 153, $db->status() != 0 ;
    $array[2] = "AB" ;
    ok 154, $db->status() == 0 ;
    $array[3] = "XY" ;
    ok 155, $db->status() == 0 ;
    $array[4] = "KL" ;
    ok 156, $db->status() == 0 ;

    $db->partial_clear() ;
    ok 157, $array[1] eq fillout("boat", $rec_len) ;
    ok 158, $array[2] eq fillout("ABuse", $rec_len) ;
    ok 159, $array[3] eq fillout("XYa", $rec_len) ;
    ok 160, $array[4] eq fillout("KL", $rec_len) ;

    # now partial put
    $db->partial_set(3,2) ;
    $array[1] = "PP" ;
    ok 161, $db->status() == 0 ;
    $array[2] = "Q" ;
    ok 162, $db->status() != 0 ;
    $array[3] = "XY" ;
    ok 163, $db->status() == 0 ;
    $array[4] = "TU" ;
    ok 164, $db->status() == 0 ;

    $db->partial_clear() ;
    ok 165, $array[1] eq fillout("boaPP", $rec_len) ;
    ok 166, $array[2] eq fillout("ABuse", $rec_len) ;
    ok 167, $array[3] eq fillout("XYaXY", $rec_len) ;
    ok 168, $array[4] eq fillout("KL TU", $rec_len) ;
}

{
    # transaction

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

    my $home = "./fred" ;
    rmtree $home if -e $home ;
    ok 169, mkdir($home, 0777) ;
    my $rec_len = 9 ;
    ok 170, my $env = new BerkeleyDB::Env -Home => $home,
				     -Flags => DB_CREATE|DB_INIT_TXN|
					  	DB_INIT_MPOOL|DB_INIT_LOCK ;
    ok 171, my $txn = $env->txn_begin() ;
    ok 172, my $db1 = tie @array, 'BerkeleyDB::Queue', 
				-Filename => $Dfile,
				-ArrayBase => 0,
                      		-Flags    =>  DB_CREATE ,
		        	-Env 	  => $env,
		        	-Txn	  => $txn ,
				-Len      => $rec_len,
				-Pad      => " " ;

    
    # 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 ;
    rmtree $home ;
}


{
    # db_stat

    my $lex = new LexFile $Dfile ;
    my $recs = ($BerkeleyDB::db_version >= 3.1 ? "qs_ndata" : "qs_nrecs") ;
    my @array ;
    my ($k, $v) ;
    my $rec_len = 7 ;
    ok 179, my $db = new BerkeleyDB::Queue -Filename 	=> $Dfile, 
				     	   -Flags    	=> DB_CREATE,
					   -Pagesize	=> 4 * 1024,
				           -Len       => $rec_len,
				           -Pad       => " " 
					;

    my $ref = $db->db_stat() ; 
    ok 180, $ref->{$recs} == 0;
    ok 181, $ref->{'qs_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::Queue);
   @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 ;
    my $rec_len = 34 ;
    eval '
	$X = tie(@h, "SubDB", -Filename => "dbbtree.tmp", 
			-Flags => DB_CREATE,
			-Mode => 0640 ,
	                -Len       => $rec_len,
	                -Pad       => " " 
			);		   
	' ;

    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]]" ;

    unlink "SubDB.pm", "dbbtree.tmp" ;

}

{
    # DB_APPEND

    my $lex = new LexFile $Dfile;
    my @array ;
    my $value ;
    my $rec_len = 21 ;
    ok 194, my $db = tie @array, 'BerkeleyDB::Queue', 
					-Filename  => $Dfile,
                                       	-Flags     => DB_CREATE ,
	                		-Len       => $rec_len,
	                		-Pad       => " " ;

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

    my $k = 0 ;
    ok 195, $db->db_put($k, "fred", DB_APPEND) == 0 ;
    ok 196, $k == 4 ;
    ok 197, $array[4] eq fillout("fred", $rec_len) ;

    undef $db ;
    untie @array ;
}

__END__


# TODO
#
# DB_DELIMETER DB_FIXEDLEN DB_PAD DB_SNAPSHOT with partial records