DB/FileSystem/YukiWikiDBNS.pm


=head1 NAME

SuikaWiki::DB::FileSystem::YukiWikiDBNS --- SuikaWiki WikiDatabase: WikiDatabase interface wrapper for Yuki::YukiWikiDBNS

=head1 DESCRIPTION

This module wrappes Yuki::YukiWikiDBNS (directory structuring extended
version of Yuki::YukiWikiDB2) for WikiDatabase common interface of
SuikaWiki.

This module is part of SuikaWiki.

=cut

package SuikaWiki::DB::FileSystem::YukiWikiDBNS;
use strict;
our $VERSION = do{my @r=(q$Revision: 1.8 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require SuikaWiki::DB::Util;
require Yuki::YukiWikiDBNS;
push our @ISA, 'SuikaWiki::DB::Util::template';
my $Self = '.';
my $Parent = '..';
my $Sep = '//';
my $DB_Module = q(Yuki::YukiWikiDBNS);

sub new ($%) {
  my $self = shift->SUPER::new (@_);
  $self->{option} = {@_};
  $self;
}

sub ___open_prop ($$) {
  my ($self, $opt) = @_;
  return "0 but true" if defined $self->{db_instance};
  local $Error::Depth = $Error::Depth + 1;
  my %db;
  $self->{db_instance} = tie (%db, $DB_Module => $self->{option}->{directory},
                              -lock => 0, ## Yuki::YukiWikiDBNS's lock is buggy
                              -backup => $self->{option}->{use_history},
                              -logfile => $self->{option}->{logfile},
                              -extension => $self->{option}->{suffix},
                             )
    or report SuikaWiki::DB::Util::Error
         -type => 'DB_OPEN',
         -object => $self, method => q(new),
         file => $self->{option}->{directory};
  $self->{db_hash} = \%db;
  1;
}

sub get ($$$) {
  my ($self, $prop, $key) = @_;
  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }
  $self->{db_hash}->{ $self->__name2name ($key) };
}

sub set ($$$$) {
  my ($self, $prop, $key => $value) = @_;
  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }
  if (not $self->{lock} or $self->{lock}->writable) {
    $self->{db_hash}->{ $self->__name2name ($key) } = $value;
  } else {
    report SuikaWiki::DB::Util::Error
      -type => 'KEY_SAVE_LOCKED', 
      -object => $self, method => 'set',
      key => $key,
      prop => $prop;
  }
}

sub exist ($$$) {
  my ($self, $prop, $key) = @_;
  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }
  CORE::exists $self->{db_hash}->{ $self->__name2name ($key) };
}

sub delete ($$$) {
  my ($self, $prop, $key) = @_;
  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }
  if (not $self->{lock} or $self->{lock}->writable) {
    CORE::delete $self->{db_hash}->{ $self->__name2name ($key) };
  } else {
    report SuikaWiki::DB::Util::Error
      -type => 'KEY_SAVE_LOCKED', 
      -object => $self, method => 'delete',
      key => $key,
      prop => $prop;
  }
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }
  map {[split /\Q$Sep\E/o, $_]}
  $self->{db_instance}->list_items ({ns => $self->__name2ns ($opt{-ns}||[]),
                                     type => ($opt{-type} eq 'ns'?'ns':'key'),
                                     recursive => $opt{-recursive}});
}

sub __name2name ($$) {
  my ($self, $key) = @_;
  if (ref $key and @$key == 0) {
    $key = $self->{option}->{root_key};
  }
  local $Error::Depth = $Error::Depth + 1;
  report SuikaWiki::DB::Util::Error
    -type => 'KEY_INVALID_NAME', key => $key,
    -object => $self, method => '__name2name',
    unless $self->__check_name ($key);
  join $Sep, @$key;
}

sub __name2ns ($$) {
  my ($self, $key) = @_;
  return '' if scalar @$key == 0 || (scalar @$key == 1 && $key->[0] eq '');
  local $Error::Depth = $Error::Depth + 1;
  report SuikaWiki::DB::Util::Error
    -type => 'KEY_INVALID_NS_NAME', key => $key,
    -object => $self, method => '__name2ns'
    unless $self->__check_name ($key);
  $key = $self->__name2name ($key) . $Sep;
  $key eq $Sep ? undef : $key;
}

sub __check_name ($$) {
  my ($self, $key) = @_;
  return 0 unless ref $key;
  return 0 if @$key == 0;
  for (@$key) {
    return 0 unless $_;  # '' or 0 or undef
    return 0 if index ($_, $Sep) > -1;
    return 0 if $_ eq $Self || $_ eq $Parent;
  }
  return 1;
}

sub ___close_prop ($$) {
  # no-op
}

sub close ($;%) {
  my $self = shift;
  untie %{$self->{db_hash}};
  delete $self->{db_instance};
  delete $self->{db_hash};
  delete $self->{opened};
  $self->{lock}->unlock if $self->{lock};
  report SuikaWiki::DB::Util::Error
    -type => 'DB_CLOSED',
    -object => $self, method => 'close';
}

=head1 METHODS

This module provides common interface of SuikaWiki WikiDatabase
modules. See C<SuikaWiki::DB>.

=head2 CONSTRUCTOR'S OPTIONS

@@ TBD

=head1 EXAMPLE

  ## Get sub (child) namespaces in $ns
  @ns = $db->keys ($prop_name, -ns => $ns, -type => 'ns', -recursive => 0);

  ## Get child keys in $ns
  @key = $db->keys ($prop_name, -ns => $ns, -type => 'key', -recursive => 0);

  ## Get descendant (child and grandchild and ...) keys in $ns
  @key = $db->keys ($prop_name, -ns => $ns, -type => 'key', -recursive => 1);

  ## This DOES NOT work as intended in current implementation...
  @ns = $db->keys ($prop_name, -ns => $ns, -type => 'ns', -recursive => 1);

=head1 LICENSE

Copyright 2003-2004 Wakaba <[email protected]>.  All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: 2004/02/14 10:59:18 $
1	wakaba	1.1
2			=head1 NAME
3
4			SuikaWiki::DB::FileSystem::YukiWikiDBNS --- SuikaWiki WikiDatabase: WikiDatabase interface wrapper for Yuki::YukiWikiDBNS
5
6			=head1 DESCRIPTION
7
8			This module wrappes Yuki::YukiWikiDBNS (directory structuring extended
9			version of Yuki::YukiWikiDB2) for WikiDatabase common interface of
10			SuikaWiki.
11
12			This module is part of SuikaWiki.
13
14			=cut
15
16			package SuikaWiki::DB::FileSystem::YukiWikiDBNS;
17	wakaba	1.2	use strict;
18	wakaba	1.9	our $VERSION = do{my @r=(q$Revision: 1.8 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
19	wakaba	1.1	require SuikaWiki::DB::Util;
20			require Yuki::YukiWikiDBNS;
21	wakaba	1.6	push our @ISA, 'SuikaWiki::DB::Util::template';
22	wakaba	1.1	my $Self = '.';
23			my $Parent = '..';
24			my $Sep = '//';
25			my $DB_Module = q(Yuki::YukiWikiDBNS);
26
27			sub new ($%) {
28	wakaba	1.6	my $self = shift->SUPER::new (@_);
29			$self->{option} = {@_};
30			$self;
31			}
32
33			sub ___open_prop ($$) {
34			my ($self, $opt) = @_;
35			return "0 but true" if defined $self->{db_instance};
36			local $Error::Depth = $Error::Depth + 1;
37	wakaba	1.1	my %db;
38	wakaba	1.6	$self->{db_instance} = tie (%db, $DB_Module => $self->{option}->{directory},
39	wakaba	1.3	-lock => 0, ## Yuki::YukiWikiDBNS's lock is buggy
40	wakaba	1.6	-backup => $self->{option}->{use_history},
41			-logfile => $self->{option}->{logfile},
42			-extension => $self->{option}->{suffix},
43	wakaba	1.1	)
44	wakaba	1.6	or report SuikaWiki::DB::Util::Error
45			-type => 'DB_OPEN',
46			-object => $self, method => q(new),
47			file => $self->{option}->{directory};
48	wakaba	1.1	$self->{db_hash} = \%db;
49	wakaba	1.6	1;
50	wakaba	1.1	}
51
52			sub get ($$$) {
53			my ($self, $prop, $key) = @_;
54	wakaba	1.6	unless ($self->{opened}->{$prop}) {
55			local $Error::Depth = $Error::Depth + 1;
56			$self->open_prop (prop => $prop);
57			}
58	wakaba	1.2	$self->{db_hash}->{ $self->__name2name ($key) };
59	wakaba	1.1	}
60
61			sub set ($$$$) {
62			my ($self, $prop, $key => $value) = @_;
63	wakaba	1.6	unless ($self->{opened}->{$prop}) {
64			local $Error::Depth = $Error::Depth + 1;
65			$self->open_prop (prop => $prop);
66			}
67			if (not $self->{lock} or $self->{lock}->writable) {
68	wakaba	1.3	$self->{db_hash}->{ $self->__name2name ($key) } = $value;
69			} else {
70	wakaba	1.6	report SuikaWiki::DB::Util::Error
71			-type => 'KEY_SAVE_LOCKED',
72			-object => $self, method => 'set',
73			key => $key,
74			prop => $prop;
75	wakaba	1.3	}
76	wakaba	1.1	}
77
78			sub exist ($$$) {
79			my ($self, $prop, $key) = @_;
80	wakaba	1.6	unless ($self->{opened}->{$prop}) {
81			local $Error::Depth = $Error::Depth + 1;
82			$self->open_prop (prop => $prop);
83			}
84	wakaba	1.5	CORE::exists $self->{db_hash}->{ $self->__name2name ($key) };
85	wakaba	1.1	}
86
87			sub delete ($$$) {
88			my ($self, $prop, $key) = @_;
89	wakaba	1.6	unless ($self->{opened}->{$prop}) {
90			local $Error::Depth = $Error::Depth + 1;
91			$self->open_prop (prop => $prop);
92			}
93			if (not $self->{lock} or $self->{lock}->writable) {
94	wakaba	1.5	CORE::delete $self->{db_hash}->{ $self->__name2name ($key) };
95	wakaba	1.3	} else {
96	wakaba	1.6	report SuikaWiki::DB::Util::Error
97			-type => 'KEY_SAVE_LOCKED',
98			-object => $self, method => 'delete',
99			key => $key,
100			prop => $prop;
101	wakaba	1.3	}
102	wakaba	1.1	}
103
104			sub keys ($$;%) {
105			my ($self, $prop, %opt) = @_;
106	wakaba	1.6	unless ($self->{opened}->{$prop}) {
107			local $Error::Depth = $Error::Depth + 1;
108			$self->open_prop (prop => $prop);
109			}
110			map {[split /\Q$Sep\E/o, $_]}
111	wakaba	1.3	$self->{db_instance}->list_items ({ns => $self->__name2ns ($opt{-ns}\|\|[]),
112			type => ($opt{-type} eq 'ns'?'ns':'key'),
113			recursive => $opt{-recursive}});
114	wakaba	1.1	}
115
116			sub __name2name ($$) {
117			my ($self, $key) = @_;
118	wakaba	1.9	if (ref $key and @$key == 0) {
119			$key = $self->{option}->{root_key};
120			}
121	wakaba	1.6	local $Error::Depth = $Error::Depth + 1;
122			report SuikaWiki::DB::Util::Error
123	wakaba	1.7	-type => 'KEY_INVALID_NAME', key => $key,
124	wakaba	1.6	-object => $self, method => '__name2name',
125	wakaba	1.3	unless $self->__check_name ($key);
126	wakaba	1.6	join $Sep, @$key;
127	wakaba	1.1	}
128
129			sub __name2ns ($$) {
130			my ($self, $key) = @_;
131	wakaba	1.3	return '' if scalar @$key == 0 \|\| (scalar @$key == 1 && $key->[0] eq '');
132	wakaba	1.6	local $Error::Depth = $Error::Depth + 1;
133			report SuikaWiki::DB::Util::Error
134	wakaba	1.7	-type => 'KEY_INVALID_NS_NAME', key => $key,
135	wakaba	1.6	-object => $self, method => '__name2ns'
136	wakaba	1.3	unless $self->__check_name ($key);
137	wakaba	1.1	$key = $self->__name2name ($key) . $Sep;
138	wakaba	1.3	$key eq $Sep ? undef : $key;
139	wakaba	1.1	}
140
141			sub __check_name ($$) {
142			my ($self, $key) = @_;
143	wakaba	1.5	return 0 unless ref $key;
144	wakaba	1.9	return 0 if @$key == 0;
145	wakaba	1.1	for (@$key) {
146			return 0 unless $_; # '' or 0 or undef
147			return 0 if index ($_, $Sep) > -1;
148			return 0 if $_ eq $Self \|\| $_ eq $Parent;
149			}
150			return 1;
151			}
152
153	wakaba	1.6	sub ___close_prop ($$) {
154			# no-op
155			}
156
157			sub close ($;%) {
158	wakaba	1.1	my $self = shift;
159			untie %{$self->{db_hash}};
160	wakaba	1.6	delete $self->{db_instance};
161			delete $self->{db_hash};
162			delete $self->{opened};
163	wakaba	1.3	$self->{lock}->unlock if $self->{lock};
164	wakaba	1.6	report SuikaWiki::DB::Util::Error
165			-type => 'DB_CLOSED',
166			-object => $self, method => 'close';
167	wakaba	1.1	}
168
169			=head1 METHODS
170
171			This module provides common interface of SuikaWiki WikiDatabase
172			modules. See C<SuikaWiki::DB>.
173
174			=head2 CONSTRUCTOR'S OPTIONS
175
176			@@ TBD
177
178	wakaba	1.8	=head1 EXAMPLE
179
180			## Get sub (child) namespaces in $ns
181			@ns = $db->keys ($prop_name, -ns => $ns, -type => 'ns', -recursive => 0);
182
183			## Get child keys in $ns
184			@key = $db->keys ($prop_name, -ns => $ns, -type => 'key', -recursive => 0);
185
186			## Get descendant (child and grandchild and ...) keys in $ns
187			@key = $db->keys ($prop_name, -ns => $ns, -type => 'key', -recursive => 1);
188
189			## This DOES NOT work as intended in current implementation...
190			@ns = $db->keys ($prop_name, -ns => $ns, -type => 'ns', -recursive => 1);
191
192	wakaba	1.1	=head1 LICENSE
193
194	wakaba	1.7	Copyright 2003-2004 Wakaba <[email protected]>. All rights reserved.
195	wakaba	1.1
196			This program is free software; you can redistribute it and/or
197			modify it under the same terms as Perl itself.
198
199			=cut
200
201	wakaba	1.9	1; # $Date: 2004/02/14 10:59:18 $