1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
#!./perl -w
use strict ;
use lib 't' ;
use BerkeleyDB;
use Test::More ;
use util ;
plan(skip_all => "this needs Berkeley DB 4.4.x or better\n" )
if $BerkeleyDB::db_version < 4.4;
plan tests => 12;
{
title "Testing compact";
# db->db_compact
my $Dfile;
my $lex = new LexFile $Dfile ;
my ($k, $v) ;
ok my $db = new BerkeleyDB::Btree -Filename => $Dfile,
-Flags => DB_CREATE ;
# create some data
my %data = (
"red" => 2,
"green" => "house",
"blue" => "sea",
) ;
my $ret = 0 ;
while (($k, $v) = each %data) {
$ret += $db->db_put($k, $v) ;
}
ok $ret == 0, " Created some data" ;
my $key;
my $end;
my %hash;
$hash{compact_filepercent} = 20;
ok $db->compact("red", "green", \%hash, 0, $end) == 0, " Compacted ok";
if (0)
{
diag "end at $end";
for my $key (sort keys %hash)
{
diag "[$key][$hash{$key}]\n";
}
}
ok $db->compact() == 0, " Compacted ok";
}
{
title "Testing lg_filemode";
# switch umask
my $omask = umask 077;
use Cwd ;
my $cwd = cwd() ;
my $home = "$cwd/test-log-perms" ;
my $data_file = "data.db" ;
ok my $lexD = new LexDir($home) ;
my $env = new BerkeleyDB::Env
-Home => $home,
-LogFileMode => 0641, # something weird
-Flags => DB_CREATE|DB_INIT_TXN|DB_INIT_LOG|
DB_INIT_MPOOL|DB_INIT_LOCK ;
ok $env ;
# something crazy small
#is($env->set_lg_max(1024), 0);
ok my $txn = $env->txn_begin() ;
my %hash ;
ok tie %hash, 'BerkeleyDB::Hash', -Filename => $data_file,
-Flags => DB_CREATE ,
-Env => $env,
-Txn => $txn ;
$hash{"abc"} = 123 ;
$hash{"def"} = 456 ;
$txn->txn_commit() ;
ok(my ($log) = glob("$home/log.*"), "log.* file is present");
SKIP: {
skip "POSIX only", 1 if $^O eq 'MSWin32';
my (undef, undef, $perms) = stat $log;
is($perms, 0100641, "log perms match");
};
# meh this one is gonna be harder to test because it would entail
# spurring the database into generating a second log file
# $env->set_lg_filemode(0777);
# $env->txn_checkpoint(0, 0);
# $txn = $env->txn_begin;
# $txn->Txn(tied %hash);
# for my $i (0..10_000) {
# $hash{$i} = $i x 10;
# }
# $txn->txn_commit;
# $env->txn_checkpoint(0, 0);
#diag(`ls -l $home`);
untie %hash ;
undef $txn ;
undef $env ;
umask $omask;
}
|
