=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::Count;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require SuikaWiki::DB::FileSystem::Base;
push our @ISA, 'SuikaWiki::DB::FileSystem::Base';
use IO::File;

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

  my $skey = join "\x00", @$key;
  if ($self->{data}->{$skey}) {
    return $self->{data}->{$skey};
  }

  my $path = $self->__key2filepath (key => $key);

  if (-e $path) {
    my $file = new IO::File $path, '<'
      or report SuikaWiki::DB::Util::Error
         -type => 'FILE_READ_FAILURE',
         -object => $self, method => 'get',
         file => $path, msg => $!;
    local $/ = "\x0A";
    while (defined (my $line = <$file>)) {
      $line =~ tr/\x0A\x0D//d;
      my ($value, $uri) = split /\x09/, $line, 2;
      $self->{data}->{$skey}->{$uri} += $value + 0;
    }
    $self->{data_original}->{$skey} = {%{$self->{data}->{$skey} || {}}};
    return $self->{data}->{$skey};
  } else {
    $self->{data_original}->{$skey} = {};
    return $self->{data}->{$skey} = {};
  }
}

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

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

  if (not $self->{lock} or $self->{lock}->writable) {
    my $dirpath = $self->__key2dirpath (fullkey => $key);
    unless ($self->{option}->{auto_mkdir} or -d $dirpath) {
      report SuikaWiki::DB::Util::Error
        -type => 'FILE_WRITE_FAILURE__NO_DIR',
        -object => $self, method => 'set',
        file => $dirpath;
      return 0;
    }
    $self->__make_directory (directory => $dirpath);

    my $path = $self->__key2filepath (key => $key);
    my $file = new IO::File $path, '>'
      or report SuikaWiki::DB::Util::Error
         -type => 'FILE_WRITE_FAILURE',
         -object => $self, method => 'set',
         file => $path, msg => $!;
    for (sort {$val->{$b} <=> $val->{$a} or $a cmp $b} keys %$val) {
      print $file $val->{$_} + 0, "\x09", $_, "\x0A" if $val->{$_};
    }
    close $file;
    $self->{data}->{join "\x00", @$key} = $val;
    $self->{data_original}->{join "\x00", @$key} = {%$val};
    return 1;
  } elsif ($self->{lock} and $self->{lock}->appendable) {
    my $dirpath = $self->__key2dirpath (fullkey => $key);
    unless ($self->{option}->{auto_mkdir} or -d $dirpath) {
      return "0 but true";
    }
    $self->__make_directory (directory => $dirpath);

    unless ($self->{data_original}->{join "\x00", @$key}) {
      $self->get ($prop, $key, %opt, no_key_check => 1);
    }
    my %diff = %$val;
    my %old = %{$self->{data_original}->{join "\x00", @$key}};
    for (keys %old) {
      $diff{$_} -= $old{$_};
    }

    my $path = $self->__key2filepath (key => $key);
    my $file = new IO::File $path, '>>'
      or report SuikaWiki::DB::Util::Error
         -type => 'FILE_WRITE_FAILURE',
         -object => $self, method => 'set',
         file => $path, msg => $!;
    for (keys %diff) {
      print $file $diff{$_} + 0, "\x09", $_, "\x0A" if $diff{$_};
    }
    close $file;
    $self->{data}->{join "\x00", @$key} = $val;
    $self->{data_original}->{join "\x00", @$key} = {%$val};
    return 1;
  } else {
    report SuikaWiki::DB::Util::Error
      -type => 'KEY_SAVE_LOCKED', 
      -object => $self, method => 'set',
      key => $key,
      prop => $prop;
    return 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 $