DB/FileSystem/Count.pm


=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.3 $=~/\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 <[email protected]>.  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/05/01 03:52:52 $
1	wakaba	1.1
2			=head1 NAME
3
4			SuikaWiki::DB::FileSystem::Base
5
6			=head1 SYNOPSIS
7
8			package Example::WikiDBModule;
9			push our @ISA, 'SuikaWiki::DB::FileSystem::Base';
10
11			sub ... {
12
13			}
14
15			...
16
17			=head1 DESCRIPTION
18
19
20
21			This module is part of SuikaWiki.
22
23			=cut
24
25			package SuikaWiki::DB::FileSystem::Count;
26			use strict;
27	wakaba	1.4	our $VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
28	wakaba	1.1	require SuikaWiki::DB::FileSystem::Base;
29			push our @ISA, 'SuikaWiki::DB::FileSystem::Base';
30			use IO::File;
31
32			sub get ($$$;%) {
33			my ($self, $prop, $key, %opt) = @_;
34			report SuikaWiki::DB::Util::Error
35			-type => 'KEY_INVALID_NAME', key => $key,
36			-object => $self, method => 'get'
37			unless $opt{no_key_check} or
38			$self->__check_key (key => $key);
39
40			unless ($self->{opened}->{$prop}) {
41			local $Error::Depth = $Error::Depth + 1;
42			$self->open_prop (prop => $prop);
43			}
44
45	wakaba	1.4	my $skey = join "\x00", @$key;
46			if ($self->{data}->{$skey}) {
47			return $self->{data}->{$skey};
48	wakaba	1.1	}
49
50			my $path = $self->__key2filepath (key => $key);
51
52			if (-e $path) {
53			my $file = new IO::File $path, '<'
54			or report SuikaWiki::DB::Util::Error
55			-type => 'FILE_READ_FAILURE',
56			-object => $self, method => 'get',
57			file => $path, msg => $!;
58			local $/ = "\x0A";
59	wakaba	1.3	while (defined (my $line = <$file>)) {
60			$line =~ tr/\x0A\x0D//d;
61			my ($value, $uri) = split /\x09/, $line, 2;
62	wakaba	1.4	$self->{data}->{$skey}->{$uri} += $value + 0;
63	wakaba	1.1	}
64	wakaba	1.4	$self->{data_original}->{$skey} = {%{$self->{data}->{$skey} \|\| {}}};
65			return $self->{data}->{$skey};
66	wakaba	1.1	} else {
67	wakaba	1.4	$self->{data_original}->{$skey} = {};
68			return $self->{data}->{$skey} = {};
69	wakaba	1.1	}
70			}
71
72			sub set ($$$$;%) {
73			my ($self, $prop, $key, $val, %opt) = @_;
74			report SuikaWiki::DB::Util::Error
75			-type => 'KEY_INVALID_NAME', key => $key,
76			-object => $self, method => 'set'
77			unless $opt{no_key_check} or
78			$self->__check_key (key => $key);
79
80			unless ($self->{opened}->{$prop}) {
81			local $Error::Depth = $Error::Depth + 1;
82			$self->open_prop (prop => $prop);
83			}
84
85			if (not $self->{lock} or $self->{lock}->writable) {
86			my $dirpath = $self->__key2dirpath (fullkey => $key);
87			unless ($self->{option}->{auto_mkdir} or -d $dirpath) {
88	wakaba	1.3	report SuikaWiki::DB::Util::Error
89			-type => 'FILE_WRITE_FAILURE__NO_DIR',
90			-object => $self, method => 'set',
91			file => $dirpath;
92			return 0;
93	wakaba	1.1	}
94			$self->__make_directory (directory => $dirpath);
95
96			my $path = $self->__key2filepath (key => $key);
97			my $file = new IO::File $path, '>'
98			or report SuikaWiki::DB::Util::Error
99			-type => 'FILE_WRITE_FAILURE',
100			-object => $self, method => 'set',
101			file => $path, msg => $!;
102			for (sort {$val->{$b} <=> $val->{$a} or $a cmp $b} keys %$val) {
103			print $file $val->{$_} + 0, "\x09", $_, "\x0A" if $val->{$_};
104			}
105			close $file;
106	wakaba	1.2	$self->{data}->{join "\x00", @$key} = $val;
107			$self->{data_original}->{join "\x00", @$key} = {%$val};
108	wakaba	1.1	return 1;
109			} elsif ($self->{lock} and $self->{lock}->appendable) {
110			my $dirpath = $self->__key2dirpath (fullkey => $key);
111			unless ($self->{option}->{auto_mkdir} or -d $dirpath) {
112			return "0 but true";
113			}
114			$self->__make_directory (directory => $dirpath);
115
116	wakaba	1.2	unless ($self->{data_original}->{join "\x00", @$key}) {
117	wakaba	1.1	$self->get ($prop, $key, %opt, no_key_check => 1);
118			}
119			my %diff = %$val;
120	wakaba	1.2	my %old = %{$self->{data_original}->{join "\x00", @$key}};
121	wakaba	1.1	for (keys %old) {
122			$diff{$_} -= $old{$_};
123			}
124
125			my $path = $self->__key2filepath (key => $key);
126			my $file = new IO::File $path, '>>'
127			or report SuikaWiki::DB::Util::Error
128			-type => 'FILE_WRITE_FAILURE',
129			-object => $self, method => 'set',
130			file => $path, msg => $!;
131			for (keys %diff) {
132			print $file $diff{$_} + 0, "\x09", $_, "\x0A" if $diff{$_};
133			}
134			close $file;
135	wakaba	1.2	$self->{data}->{join "\x00", @$key} = $val;
136			$self->{data_original}->{join "\x00", @$key} = {%$val};
137	wakaba	1.1	return 1;
138			} else {
139			report SuikaWiki::DB::Util::Error
140			-type => 'KEY_SAVE_LOCKED',
141			-object => $self, method => 'set',
142			key => $key,
143			prop => $prop;
144			return 0;
145			}
146			}
147
148			=head1 LICENSE
149
150			Copyright 2004 Wakaba <[email protected]>. All rights reserved.
151
152			This program is free software; you can redistribute it and/or
153			modify it under the same terms as Perl itself.
154
155			=cut
156
157	wakaba	1.4	1; # $Date: 2004/05/01 03:52:52 $