=head1 NAME

SuikaWiki::DB::Logical::WithStruct - "Structured cache" binded database

=head1 DESCRIPTION



This module is part of SuikaWiki.

=cut

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

# new: inherited

sub get ($$$;%) {
  my ($self, $prop, $key, %opt) = @_;
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    my $db = $self->{prop}->{$prop}->{-db};
    unless ($opt{struct}) {
      return $db->get ($prop, $key, %opt);
    } else {
      my $sprop = $prop.'__struct_cache';
      unless ($self->{opened}->{$sprop}) {
        $self->open_prop (prop => $sprop);
      }
      my $sdb = $self->{prop}->{$sprop}->{-db};
      my $sdata = $sdb->get ($sprop, $key, %opt);
      if ($db->_content_id ($prop, $key, %opt) eq $sdata->{content_id}) {
        return $sdata->{value};
      } else {
        $sdb->delete ($sprop, $key, %opt);
        return undef;
      }
    }
  } else {
    return undef;
  }
}

sub set ($$$$;%) {
  my ($self, $prop, $key => $value, %opt) = @_;
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    my $db = $self->{prop}->{$prop}->{-db};
    my $sprop = $prop.'__struct_cache';
    unless ($self->{opened}->{$sprop}) {
      $self->open_prop (prop => $sprop);
    }
    my $sdb = $self->{prop}->{$sprop}->{-db};
    unless ($opt{struct}) {
      $sdb->delete ($sprop, $key);
      return $db->set ($prop, $key => $value, %opt);
    } else {
      return $sdb->set ($sprop,
                        $key => {content_id => $db->_content_id ($prop, $key),
                                 value => $value}, %opt);
    }
  } else {
    report SuikaWiki::DB::Util::Error
      -type => 'KEY_SAVE',
      -object => $self, method => 'set',
      prop => $prop, key => $key;
  }
}

sub exist ($$$;%) {
  my ($self, $prop, $key, %opt) = @_;
  $prop .= '__struct_cache' if $opt{struct};
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    return $self->{prop}->{$prop}->{-db}->exist ($prop, $key, %opt);
  } else {
    return 0;
  }
}

sub delete ($$$;%) {
  my ($self, $prop, $key, %opt) = @_;
  $prop .= '__struct_cache' if $opt{struct};
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    return $self->{prop}->{$prop}->{-db}->delete ($prop, $key, %opt);
  }
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  $prop .= '__struct_cache' if $opt{struct};
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    return $self->{prop}->{$prop}->{-db}->keys ($prop, %opt);
  } else {
    return ();
  }
}

# close: Inherited

=head1 METHODS

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

In addition, this module implements additional methods.

=over 4

=item _set_prop_db ($prop_name, {options})

Addosiates actual database with property name of this logical (virtual)
database, or remove its association by specifying C<undef> instead of
C<{options}>.

Options:

=over 4

=item -db => $database_instance (REQUIRED)

Instance of database module, which implements common WikiDatabase interface.

=back

=cut

sub _set_prop_db ($$$) {
  my ($self, $prop, $db_and_opt) = @_;
  $self->{prop}->{$prop} = $db_and_opt;
  $db_and_opt->{-db_close} ||= sub {
    my %opt = @_;
    local $Error::Depth = $Error::Depth + 1;
    $opt{prop_info}->{-db}->close_prop (prop => $opt{prop_info}->{-prop});
  };
}

sub ___open_prop ($$) {
  my ($self, $opt) = @_;
  return "0 but true" if defined $self->{prop}->{$opt->{prop}}->{-db};
  local $Error::Depth = $Error::Depth + 2;
  report SuikaWiki::DB::Util::Error
    -type => 'STOP_DB_PROP_CANT_OPEN__NOT_DEFINED',
    -object => $self, method => 'open_prop',
    prop => $opt->{prop}
    and return 0
    unless $self->{prop}->{$opt->{prop}}->{-db} or
           $self->{prop}->{$opt->{prop}}->{-db_open};
  $self->{prop}->{$opt->{prop}}->{-db} 
    ||= $self->{prop}->{$opt->{prop}}->{-db_open}->(metadb => $self);
  if ($opt->{prop} !~ /__struct_cache$/) {
    report SuikaWiki::DB::Util::Error
      -type => 'STOP_DB_PROP_CANT_OPEN__REQUIRED_METHOD_NOT_DEFINED',
      -object => $self, method => 'open_prop',
      prop => $opt->{prop}, method_name => '_content_id'
      and return 0
      unless $self->{prop}->{$opt->{prop}}->{-db}->can ('_content_id');
  }
  1;
}

sub ___close_prop ($$) {
  my ($self, $opt) = @_;
  return "0 but true" unless $self->{opened}->{$opt->{prop}};
  local $Error::Depth = $Error::Depth + 2;
  $self->{prop}->{$_}->{-db_close}->(metadb => $self, 
                                     prop_info => $self->{prop}->{$_});
  delete $self->{prop}->{$_}->{-db}
    if $self->{prop}->{$_}->{-db_open};
  1;
}

=back

=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/11/08 10:01:36 $