1 |
wakaba |
1.1 |
#!/usr/bin/perl |
2 |
|
|
use strict; |
3 |
|
|
use warnings; |
4 |
|
|
use Test; |
5 |
|
|
use FindBin q($Bin); |
6 |
wakaba |
1.2 |
BEGIN {plan tests => 5} |
7 |
wakaba |
1.1 |
use SuikaWiki::DB::FileSystem::SuikaWikiMetaInfo09; |
8 |
|
|
use SuikaWiki::DB::Util::Error; |
9 |
|
|
|
10 |
|
|
my $dir = $Bin.'/db.tmp'; |
11 |
|
|
mkdir $dir or die "$0: $dir: $!" unless -d $dir; |
12 |
|
|
|
13 |
|
|
my $db = new SuikaWiki::DB::FileSystem::SuikaWikiMetaInfo09 |
14 |
|
|
directory => $dir; |
15 |
|
|
|
16 |
wakaba |
1.2 |
unshift @{$db->{event}->{error}}, sub { |
17 |
|
|
my ($self, $event) = @_; |
18 |
|
|
unless ({qw/fatal 1 stop 1 warn 1/}->{$event->{error}->{-def}->{level}}) { |
19 |
|
|
warn "DEBUG: ". $event->{error}->stringify; |
20 |
|
|
} |
21 |
|
|
} if $^W; |
22 |
|
|
|
23 |
wakaba |
1.1 |
$db->set (test => ['Key'] => 'Value'); |
24 |
wakaba |
1.2 |
ok $db->get (test => ['Key']), 'Value'; |
25 |
wakaba |
1.1 |
|
26 |
|
|
ok $db->get (other => ['Key']), undef; |
27 |
|
|
ok $db->get (test => ['other']), undef; |
28 |
|
|
|
29 |
wakaba |
1.2 |
$db->set (test => ['Key', 'Subkey'] => 'SubValue'); |
30 |
|
|
ok $db->get (test => ['Key', 'Subkey']), 'SubValue'; |
31 |
|
|
|
32 |
wakaba |
1.1 |
$db->close; |
33 |
|
|
|
34 |
|
|
my $file = $db->{directory}.$db->{prefix}.$db->__encode_base16 ('test') |
35 |
|
|
.$db->{suffix}; |
36 |
|
|
undef $db; |
37 |
|
|
|
38 |
|
|
ok -e $file, 1, 'Database is written on disk'; |
39 |
|
|
unlink $file or warn "$0: $file: $!"; |