=head1 NAME

SuikaWiki::DB::Hash --- SuikaWiki WikiDatabase: WikiDatabase interface wrapper for hash

=head1 DESCRIPTION

This module wrappes perl's hash with WikiDatabase common interface of
SuikaWiki.  It is useful for tied hash.

This module is part of SuikaWiki.

=cut

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

sub new ($%) {
  
  my ($class, %o) = @_;
  my $self = bless {}, $class;
  if ($o{-lock}) {
    $self->{lock} = SuikaWiki::DB::Util->new_lock ($o{-lock});
    $self->{lock}->lock;
  }
  $self->{db_hash} = &{$o{constructor} || sub {return {}}} ($self, \%o);
  unless ($self->{db_hash}) {
    report SuikaWiki::DB::Util::Error 
      -type => 'DB_OPEN',
      -object => $self, method => 'new';
  }
  $self->{has_exist} = defined $o{has_exist} ? $o{has_exist} : 1;
  $self;
}

sub get ($$$) {
  my ($self, $prop, $key) = @_;
  $self->___validate_name ($key);
  $self->{db_hash}->{join $;, @$key};
}

sub set ($$$$) {
  my ($self, $prop, $key => $value) = @_;
  $self->___validate_name ($key);
  $self->{db_hash}->{join $;, @$key} = $value;
}

sub exist ($$$) {
  my ($self, $prop, $key) = @_;
  $self->___validate_name ($key);
  if ($self->{has_exist}) {
    return CORE::exists $self->{db_hash}->{join $;, @$key};
  } else {
    return CORE::defined $self->{db_hash}->{join $;, @$key} ? 1 : 0;
  }
}

sub delete ($$$) {
  my ($self, $prop, $key) = @_;
  $self->___validate_name ($key);
  CORE::delete $self->{db_hash}->{join $;, @$key};
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  $self->___validate_name ($opt{-ns}, error_type => 'KEY_INVALID_NS_NAME');
  my $prefix = join $;, @{$opt{-ns}};
  my $prefix_length = length $prefix;
  $prefix .= $; if $prefix_length;
  return CORE::map {[$_]} 
         CORE::grep {substr ($_, 0, $prefix_length) eq $prefix}
         CORE::keys %{$self->{db_hash}};
}

sub close ($) {
  my $self = shift;
  ($self->{destructor} or sub { 1 })->($self)
    or report SuikaWiki::DB::Util::Error 
         -type => 'DB_CLOSE',
         -object => $self, method => 'close';
  $self->{db_hash} = undef;
  $self->{lock}->unlock if $self->{lock};
  $self->{lock} = undef;
}
	   
sub DESTROY ($) {
  my $self = shift;
  $self->close if $self->{db_hash};
}

sub ___validate_name ($$;%) {
  my ($self, $key, %opt) = @_;
  if (ref $key) {
    my $ok = 1;
    for (@$key) {
      if (index ($key, $;) > -1) {
        $ok = 0;
        last;
      }
    }
    return if $ok;
  }
  local $Error::Depth = $Error::Depth + 1;
  report SuikaWiki::DB::Util::Error
    -type => $opt{error_type} || 'KEY_INVALID_NAME',
    -object => $self, method => '___validate_name',
    key => $key;
}

=head1 METHODS

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

=head1 SEE ALSO

C<SuikaWiki::DB>.

=head1 AUTHOR

Wakaba <w@suika.fam.cx>.

=head1 LICENSE

Copyright AUTHOR 2003.

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

=cut

1; # $Date: 2004/11/08 09:57:49 $