DB/FileSystem/LeafFile.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::LeafFile;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.8 $=~/\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 $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 => $!;
    binmode $file;
    local $/ = undef;
    return scalar <$file>;
  } else {
    return undef;
  }
}

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

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

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

  $self->__make_directory (directory => $self->__key2dirpath (fullkey => $key));
  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 => $!;
  binmode $file;
  print $file $val;
  close $file;
  1;
}

=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/03/19 11:23:55 $
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::LeafFile;
26			use strict;
27			our $VERSION=do{my @r=(q$Revision: 1.8 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
28			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			my $path = $self->__key2filepath (key => $key);
46
47			if (-e $path) {
48			my $file = new IO::File $path, '<'
49			or report SuikaWiki::DB::Util::Error
50			-type => 'FILE_READ_FAILURE',
51			-object => $self, method => 'get',
52			file => $path, msg => $!;
53			binmode $file;
54			local $/ = undef;
55			return scalar <$file>;
56			} else {
57			return undef;
58			}
59			}
60
61			sub set ($$$$;%) {
62			my ($self, $prop, $key, $val, %opt) = @_;
63
64			unless ($self->{opened}->{$prop}) {
65			local $Error::Depth = $Error::Depth + 1;
66			$self->open_prop (prop => $prop);
67			}
68
69			if ($self->{lock} and not $self->{lock}->writable) {
70			report SuikaWiki::DB::Util::Error
71			-type => 'KEY_SAVE_LOCKED',
72			-object => $self, method => 'set',
73			key => $key,
74			prop => $prop;
75			return 0;
76			}
77
78			$self->__make_directory (directory => $self->__key2dirpath (fullkey => $key));
79			my $path = $self->__key2filepath (key => $key);
80			my $file = new IO::File $path, '>'
81			or report SuikaWiki::DB::Util::Error
82			-type => 'FILE_WRITE_FAILURE',
83			-object => $self, method => 'set',
84			file => $path, msg => $!;
85			binmode $file;
86			print $file $val;
87			close $file;
88			1;
89			}
90
91			=head1 LICENSE
92
93			Copyright 2004 Wakaba <[email protected]>. All rights reserved.
94
95			This program is free software; you can redistribute it and/or
96			modify it under the same terms as Perl itself.
97
98			=cut
99
100			1; # $Date: 2004/03/19 11:23:55 $