=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.9 $=~/\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 <w@suika.fam.cx>.  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/04/01 04:45:06 $