Imported from /home/lorry/working-area/delta_berkeleydb/db-6.1.23.tar.gz.HEADdb-6.1.23master

1 files changed, 166 insertions, 0 deletions

diff --git a/lang/perl/BerkeleyDB/t/blob.t b/lang/perl/BerkeleyDB/t/blob.t
new file mode 100644
index 00000000..6931418a
--- /dev/null
+++ b/lang/perl/BerkeleyDB/t/blob.t
@@ -0,0 +1,166 @@
+#!./perl -w
+
+use strict ;
+
+use lib 't';
+use BerkeleyDB; 
+use util ;
+use Test::More;
+
+plan(skip_all => "this needs Berkeley DB 6.x.x or better\n" )
+    if $BerkeleyDB::db_version < 6;
+
+plan tests => 84;
+
+my $Dfile = "dbhash.tmp";
+my $Dfile2 = "dbhash2.tmp";
+my $Dfile3 = "dbhash3.tmp";
+unlink $Dfile;
+
+umask(0) ;
+
+sub isBlob
+{
+    my $cursor = shift ;
+    my $key = shift;
+
+    my $v = '';
+    $cursor->partial_set(0,0) ;
+    $cursor->c_get($key, $v, DB_SET) ;
+    $cursor->partial_clear() ;
+    return defined $cursor->db_stream(DB_STREAM_WRITE);
+}
+
+for my $TYPE ( qw(BerkeleyDB::Hash BerkeleyDB::Btree ))
+{
+    #diag "Test $TYPE";
+    my $lex = new LexFile $Dfile ;
+    my $home = "./fred" ;
+    my $lexd = new LexDir $home ;
+    my $threshold = 1234 ;
+
+    ok my $env = new BerkeleyDB::Env 
+                        Flags => DB_CREATE|DB_INIT_MPOOL,
+                        #@StdErrFile, 
+                        BlobDir => $home,
+                        Home => $home ;
+
+    ok my $db = new $TYPE Filename => $Dfile, 
+				    Env      => $env,
+                    BlobThreshold => $threshold,
+				    Flags    => DB_CREATE ;
+
+    isa_ok $db, $TYPE ;
+
+    ok $env->get_blob_threshold(my $t1) == 0 ;
+    is $t1, 0," env threshold is 0" ;
+
+    ok $env->get_blob_dir(my $dir1) == 0 ;
+    is $dir1, $home," env threshold is 0" ;
+
+    ok $db->get_blob_threshold(my $t2) == 0 ;
+    is $t2, $threshold," db threshold is $threshold" ;
+
+    ok $db->get_blob_dir(my $dir2) == 0 ;
+    is $dir2, $home, " env threshold is 0" ;
+
+    my $smallData = "a234";
+    my $bigData = "x" x ($threshold+1) ;
+    ok $db->db_put("1", $bigData) == 0  ;
+    ok $db->db_put("2", $smallData) == 0  ;
+
+    my $v2 ;
+    ok $db->db_get("1", $v2) == 0 ;
+    is $v2, $bigData;
+
+    my $v1 ;
+    ok $db->db_get("2", $v1) == 0 ;
+    is $v1, $smallData;
+
+    ok my $cursor = $db->db_cursor() ;
+
+    ok isBlob($cursor, "1");
+    ok !isBlob($cursor, "2");
+
+    my $k = "1";
+    my $v = '';
+    $cursor->partial_set(0,0) ;
+    ok $cursor->c_get($k, $v, DB_SET) == 0, "set cursor"
+        or diag "Status is [" . $cursor->status() . "]";
+    $cursor->partial_clear() ;
+    is $k, "1";
+    ok my $dbstream = $cursor->db_stream(DB_STREAM_WRITE)
+        or diag "Status is [" . $cursor->status() . "]";
+    isa_ok $dbstream, 'BerkeleyDB::DbStream';
+    ok $dbstream->size(my $s) == 0 , "size";
+    is $s, length $bigData, "length ok";
+    my $new ;
+    ok $dbstream->read($new, 0, length $bigData) == 0 , "read"
+        or diag "Status is [" . $cursor->status() . "]";
+    is $new, $bigData;
+    my $newData = "hello world" ;
+    ok $dbstream->write($newData) == 0 , "write";
+
+    substr($bigData, 0, length($newData)) = $newData;
+    
+    my $new1;
+    ok $dbstream->read($new, 0, 5) == 0 , "read";
+    is $new, "hello";
+
+    ok $dbstream->close() == 0 , "close";
+
+    $k = "1";
+    my $stream = $cursor->c_get_db_stream($k, DB_SET, DB_STREAM_WRITE) ;
+    isa_ok $stream, 'BerkeleyDB::DbStream';
+    is $k, "1";
+    ok $stream->size($s) == 0 , "size";
+    is $s, length $bigData, "length ok";
+    $new = 'abc';
+    ok $stream->read($new, 0, 5) == 0 , "read";
+    is $new, "hello";
+    ok $stream->close() == 0 , "close";
+
+
+    ok my $cursor1 = $db->db_cursor() ;
+    my $d1 ;
+    my $d2 ;
+    while (1)
+    {
+        my $k = '';
+        my $v = '';
+        $cursor->partial_set(0,0) ;
+        my $status = $cursor1->c_get($k, $v, DB_NEXT) ;
+        $cursor->partial_clear();
+
+        last if $status != 0 ;
+
+        my $stream = $cursor1->db_stream(DB_STREAM_WRITE);
+
+        if (defined $stream)
+        {
+            $stream->size(my $s) ;
+            my $d = '';
+            my $delta = 1024;
+            my $off = 0;
+            while ($s)
+            {
+                $delta = $s if $s - $delta < 0 ;
+
+                $stream->read($d, $off, $delta);
+                $off += $delta ;
+                $s -= $delta ;
+                $d1 .= $d ;
+            }
+
+        }
+        else
+        {
+            $cursor1->c_get($k, $d2, DB_CURRENT) ;
+        }
+    }
+
+    is $d1, $bigData;
+    is $d2, $smallData;
+
+}
+