script/t/db-logical.t

#!/usr/bin/perl
use strict;
use warnings;
use Test;
use FindBin q($Bin);
BEGIN {plan tests => 5}
use SuikaWiki::DB::Logical;
use SuikaWiki::DB::FileSystem::SuikaWikiMetaInfo09;
use SuikaWiki::DB::Util::Error;

my $dir = $Bin.'/db.tmp';
mkdir $dir or die "$0: $dir: $!" unless -d $dir;

my $db = new SuikaWiki::DB::Logical;
my $subdb = new SuikaWiki::DB::FileSystem::SuikaWikiMetaInfo09
              directory => $dir;
_set_prop_db $db
  'test' => {-db => $subdb, -db_close => sub {
               my %opt = @_;
               local $Error::Depth = $Error::Depth + 1;
               $opt{prop_info}->{-db}->close;
               delete $opt{prop_info}->{-db};
             }};

unshift @{$db->{event}->{error}}, sub {
  my ($self, $event) = @_;
  unless ({qw/fatal 1 stop 1 warn 1/}->{$event->{error}->{-def}->{level}}) {
    warn "DEBUG: ". $event->{error}->stringify;
  }
} if $^W;
unshift @{$subdb->{event}->{error}}, sub {
  my ($self, $event) = @_;
  unless ({qw/fatal 1 stop 1 warn 1/}->{$event->{error}->{-def}->{level}}) {
    warn "DEBUG: test: ". $event->{error}->stringify;
  }
} if $^W;

$db->set (test => ['Key'] => 'Value');
ok $db->get (test => ['Key']), 'Value';

ok $db->get (other => ['Key']), undef;
ok $db->get (test => ['other']), undef;

$db->set (test => ['Key', 'Subkey'] => 'SubValue');
ok $db->get (test => ['Key', 'Subkey']), 'SubValue';

$db->close;

my $file = $subdb->{directory}.$subdb->{prefix}.$subdb->__encode_base16 ('test')
          .$subdb->{suffix};
undef $subdb;
undef $db;

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