=head1 NAME

SuikaWiki::DB::FileSystem::Base

=head1 SYNOPSIS

  package Example::WikiDBModule;
  push our @ISA, 'SuikaWiki::DB::FileSystem::Base';

  sub ... {
    
  }
  
  ...

=head1 DESCRIPTION



This module is part of SuikaWiki.

=cut

package SuikaWiki::DB::FileSystem::Base;
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';
require File::Spec;
require IO::Dir;
use File::Path;

sub ___open_prop ($$) {
  shift->{opened} ? "0 but true" : 0;
}
sub ___close_prop ($$) {
  "0 but true";
}

sub keys ($$%) {
  my ($self, $prop, %opt) = @_;
  report SuikaWiki::DB::Util::Error
    -type => 'KEY_INVALID_NS_NAME', key => $opt{-ns},
    -object => $self, method => 'keys'
    unless $opt{no_key_check} or
           $self->__check_key (key => $opt{-ns} ||= [], allow_empty => 1);

  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }

  my @result;

 ## TODO: -recursive  
 ## TODO: ghost (eg. prefix-nonbase16-suffix)
  my $dir = $self->__key2dirpath (key => $opt{-ns});
  tie my %dir, 'IO::Dir', $dir;
  if (($opt{-type} ||= 'key') eq 'key') {
    for (grep -f File::Spec->rel2abs ($_, $dir),
         grep /^$self->{option}->{file_prefix_reg}/,
         grep /$self->{option}->{file_suffix_reg}$/, keys %dir) {
      my $keyname = $self->__filename2keyname (filename => $_);
      push @result, [@{$opt{-ns}}, $keyname] if length $keyname;
    }
  } else {
    for (grep -d File::Spec->rel2abs ($_, $dir),
         grep /^$self->{option}->{directory_prefix_reg}/,
         grep /$self->{option}->{directory_suffix_reg}$/, keys %dir) {
      my $keyname = $self->__dirname2keyns (dirname => $_);
      push @result, [@{$opt{-ns}}, $keyname] if length $keyname;
    }
  }
  
  @result;
}

sub exist ($$$%) {
  my ($self, $prop, $key, %opt) = @_;

  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }

  return 0 unless $opt{no_key_check} or $self->__check_key (key => $key);

  if (($opt{-type} ||= 'key') eq 'key') {
    my $path = $self->__key2filepath (key => $key);
    return -f $path;
  } else {
    my $path = $self->__key2dirpath (key => $key);
    return -d $path;
  }
}

sub delete ($$%) {
  my ($self, $prop, $key, %opt) = @_;
  report SuikaWiki::DB::Util::Error
    -type => 'KEY_INVALID_NAME', key => $key,
    -object => $self, method => 'delete'
    unless $opt{no_key_check} or
           $self->__check_key (key => $key);

  if ($self->{lock} and not $self->{lock}->writable) {
    report SuikaWiki::DB::Util::Error
      -type => 'KEY_SAVE_LOCKED', 
      -object => $self, method => 'delete',
      key => $key,
      prop => $prop;
    return 0;
  }

  if (($opt{-type} ||= 'key') eq 'key') {
    my $path = $self->__key2filepath (key => $key);
    return "0 but true" unless -e $path;
    unlink $path or
      report SuikaWiki::DB::Util::Error
        -type => 'FILE_REMOVE_FAILURE',
        -object => $self, method => 'delete',
        key => $key,
        file => $path,
        msg => $!;
    return 1;
  } else {
    report SuikaWiki::DB::Util::Error
      -type => 'DB_METHOD_NOT_IMPLEMENTED',
      method => 'delete',
      -object => $self;
    return 0;
  }
}

=head1 INTERNAL METHODS

This module provides some internal methods that might be useful
in other WikiDatabase module which is derived from this base module.

Derived modules are able to override these methods as long as
method input and output interface is kept.

=cut

sub ___init ($%) {
  my ($self, %opt) = @_;
  for (qw/base_directory root_file/) {
    $self->{option}->{$_} = defined $opt{$_} ? $opt{$_} : '';
  }
  for (qw/directory_prefix directory_suffix file_prefix file_suffix/) {
    $self->{option}->{$_} = defined $opt{$_} ? $opt{$_} : '';
    $self->{option}->{$_.'_reg'} = defined $opt{$_.'_reg'} ? $opt{$_.'_reg'} :
                                  qr/\Q$self->{option}->{$_}\E/;
  }
  for (qw/root_key auto_mkdir/) {
    $self->{option}->{$_} = $opt{$_};
  }
}

=item 1/0 = $db->__check_key (key => $key)

Check whether given key is valid or not.

=cut

sub __check_key ($%) {
  my ($self, %opt) = @_;
  return 0 unless ref $opt{key};
  if (@{$opt{key}} == 0) {
    return 1 if $opt{allow_empty};
    return 1 if defined $self->{option}->{root_file} or
                $self->{option}->{root_key};
    return 0;
  }
  for (@{$opt{key}}) {
    return 0 unless defined $_ and length $_;  # '' or 0 or undef
  }
  return 1;
}

=item $path = $db->__key2filepath (key => $key)

Converts key into file name path.  This internal method does not
check whether key is valid or not.

=cut

sub __key2filepath ($%) {
  my ($self, %opt) = @_;
  if (@{$opt{key}} != 0) {
    File::Spec->catfile (
      $self->{option}->{base_directory},
      (map {$self->__keyns2dirname (keyns => $_)}
           @{$opt{key}}[0..$#{$opt{key}}-1]),
      $self->__keyname2filename (keyname => $opt{key}->[-1]),
    );
  } else {
    if ($self->{option}->{root_key}) {
      File::Spec->catfile (
        $self->{option}->{base_directory},
        (map {$self->__keyns2dirname (keyns => $_)}
             @{$self->{option}->{root_key}}[0..$#{$self->{option}->{root_key}}-1]),
        $self->__keyname2filename (keyname => $self->{option}->{root_key}->[-1]),
      );
    } else {
      File::Spec->rel2abs ($self->{option}->{root_file},
                           $self->{option}->{base_directory});
    }
  }
}

=item $path = $db->__key2dirpath (key => $key)

Converts key (assumed as key namespace) into directory name path.  
This internal method does not check whether key is valid or not.

=cut

sub __key2dirpath ($%) {
  my ($self, %opt) = @_;
  my $key = $opt{key} || [@{$opt{fullkey}}[0..$#{$opt{fullkey}}-1]];
  File::Spec->catdir (
    $self->{option}->{base_directory},
    (map {$self->__keyns2dirname (keyns => $_)} @$key),
  );
}

=item $dirname = $db->__keyns2dirname (keyns => $keyns)

Converts key namespace (a component in key other than last one) into
directory component name.

=cut

sub __keyns2dirname ($%) {
  my ($self, %opt) = @_;
  $self->{option}->{directory_prefix} .
  $self->__encode_base16 ($opt{keyns}) .
  $self->{option}->{directory_suffix};
}

=item $keyns = $db->__dirname2keyns (dirname => $dirname)

Converts directory component name into key namespace component name.
Note that directory name is not validated before converted
(ie. directory name that does not match to
C<I<prefix>I<base16ed-keyns>I<suffix>> will not raise error).

=cut

sub __dirname2keyns ($%) {
  my ($self, %opt) = @_;
  my $s = $opt{dirname};
  $s =~ s/^$self->{option}->{directory_prefix_reg}//;
  $s =~ s/$self->{option}->{directory_suffix_reg}$//;
  $self->__decode_base16 ($s);
}

=item $filename = $db->__keyname2filename (keyname => $keyname)

Converts key name (last component in key) into file name 
(not including directory path).

=cut

sub __keyname2filename ($%) {
  my ($self, %opt) = @_;
  $self->{option}->{file_prefix} .
  $self->__encode_base16 ($opt{keyname}) .
  $self->{option}->{file_suffix};
}

=item $keyname = $db->__filename2keyname (filename => $filename)

Converts file name into key name.
Note that file name is not validated before converted
(ie. file name that does not match to
C<I<prefix>I<base16ed-keyname>I<suffix>> will not raise error).

=cut

sub __filename2keyname ($%) {
  my ($self, %opt) = @_;
  my $s = $opt{filename};
  $s =~ s/^$self->{option}->{file_prefix_reg}//;
  $s =~ s/$self->{option}->{file_suffix_reg}$//;
  $self->__decode_base16 ($s);
}

=item $base16 = $db->__encode_base16 ($string)

Encodes C<$string> in base 16.

=cut

sub __encode_base16 ($$) {
  my (undef, $s) = @_;
## TODO: utf8 support
  $s =~ s/(.)/sprintf '%02X', ord $1/ges;
  $s;
}

=item $string = $db->__decode_base16 ($base16)

Decodes C<$base16> which is encoded in base 16.

=cut

sub __decode_base16 ($$) {
  my (undef, $s) = @_;
  $s =~ s/([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;
## TODO: utf8 support
  $s;
}

sub __make_directory ($%) {
  my ($self, %opt) = @_;
  return "0 but true" if -d $opt{directory};
  eval {
    mkpath $opt{directory}, 0, $opt{directory_permission};
    1;
  } or do {
    local $Error::Depth = $Error::Depth + 1;
    report SuikaWiki::DB::Util::Error
      -type => 'DIR_MAKE_FAILURE',
      -object => $self, method => '__make_directory',
      dir => $opt{directory},
      msg => $@;
    0;
  };
}

=head1 LICENSE

Copyright 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/06/03 06:38:48 $