script/t/db-fs-lp.t

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

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

sub filename ($;$) {
  my ($key, $suffix) = (shift, shift || '.txt');
  $dir.'/'.join ('.ns/', map {s/(.)/sprintf '%02X', ord $1/ges;$_} @$key).$suffix;
}

my $db = new SuikaWiki::DB::FileSystem::LeafProp
           base_directory => $dir,
           directory_suffix => '.ns',
           file_suffix => '.txt';

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;

my $v = $db->get (test => ['Key']);
ok $v->get_attribute_value ('V1'), undef;

$v->set_attribute (V1 => 'value1');
$db->set (test => ['Key'] => $v);
ok $db->get (test => ['Key'])->get_attribute_value ('V1'), 'value1';

$db->close;

undef $db;

my $file = filename (['Key']);
ok -e $file, 1, 'Value is written on disk';
unlink $file or warn "$0: $file: $!";

1	#!/usr/bin/perl
2	use strict;
3	use warnings;
4	use Test;
5	use FindBin q($Bin);
6	BEGIN {plan tests => 6}
7	use SuikaWiki::DB::FileSystem::LeafProp;
8
9	my $dir = $Bin.'/db.tmp';
10	#mkdir $dir or die "$0: $dir: $!" unless -d $dir;
11
12	sub filename ($;$) {
13	my ($key, $suffix) = (shift, shift \|\| '.txt');
14	$dir.'/'.join ('.ns/', map {s/(.)/sprintf '%02X', ord $1/ges;$_} @$key).$suffix;
15	}
16
17	my $db = new SuikaWiki::DB::FileSystem::LeafProp
18	base_directory => $dir,
19	directory_suffix => '.ns',
20	file_suffix => '.txt';
21
22	unshift @{$db->{event}->{error}}, sub {
23	my ($self, $event) = @_;
24	unless ({qw/fatal 1 stop 1 warn 1/}->{$event->{error}->{-def}->{level}}) {
25	warn "DEBUG: ". $event->{error}->stringify;
26	}
27	} if $^W;
28
29	my $v = $db->get (test => ['Key']);
30	ok $v->get_attribute_value ('V1'), undef;
31
32	$v->set_attribute (V1 => 'value1');
33	$db->set (test => ['Key'] => $v);
34	ok $db->get (test => ['Key'])->get_attribute_value ('V1'), 'value1';
35
36	$db->close;
37
38	undef $db;
39
40	my $file = filename (['Key']);
41	ok -e $file, 1, 'Value is written on disk';
42	unlink $file or warn "$0: $file: $!";
43