DB/FileSystem/LeafProp.pm


=head1 NAME

SuikaWiki::DB::FileSystem::LeafProp

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

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 ($self->{data}->{$path}) {
    return $self->{data}->{$path};
  } elsif (-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 $self->{data}->{$path} = $Parser->parse_text (scalar <$file>);
  } else {
    return $self->{data}->{$path} = $Parser->parse_text ('');
  }
}

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);

  report SuikaWiki::DB::Util::Error
    -type => 'STOP_SET_INVALID_VALUE',
    key => $key, prop => $prop,
    -object => $self, method => 'set',
    value => $val
    unless ref $val and $val->isa ('Message::Markup::SuikaWikiConfig20::Node');

  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->stringify;
  $self->{data}->{$path} = $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/04/17 04:15:39 $
1	wakaba	1.1
2			=head1 NAME
3
4			SuikaWiki::DB::FileSystem::LeafProp
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::LeafProp;
26			use strict;
27			our $VERSION=do{my @r=(q$Revision: 1.2 $=~/\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			use Message::Markup::SuikaWikiConfig20::Parser;
32			my $Parser = new Message::Markup::SuikaWikiConfig20::Parser;
33
34			sub get ($$$;%) {
35			my ($self, $prop, $key, %opt) = @_;
36			report SuikaWiki::DB::Util::Error
37			-type => 'KEY_INVALID_NAME', key => $key,
38			-object => $self, method => 'get'
39			unless $opt{no_key_check} or
40			$self->__check_key (key => $key);
41
42			unless ($self->{opened}->{$prop}) {
43			local $Error::Depth = $Error::Depth + 1;
44			$self->open_prop (prop => $prop);
45			}
46
47			my $path = $self->__key2filepath (key => $key);
48
49			if ($self->{data}->{$path}) {
50			return $self->{data}->{$path};
51			} elsif (-e $path) {
52			my $file = new IO::File $path, '<'
53			or report SuikaWiki::DB::Util::Error
54			-type => 'FILE_READ_FAILURE',
55			-object => $self, method => 'get',
56			file => $path, msg => $!;
57			binmode $file;
58			local $/ = undef;
59			return $self->{data}->{$path} = $Parser->parse_text (scalar <$file>);
60			} else {
61			return $self->{data}->{$path} = $Parser->parse_text ('');
62			}
63			}
64
65			sub set ($$$$;%) {
66			my ($self, $prop, $key, $val, %opt) = @_;
67			report SuikaWiki::DB::Util::Error
68			-type => 'KEY_INVALID_NAME', key => $key,
69			-object => $self, method => 'set'
70			unless $opt{no_key_check} or
71			$self->__check_key (key => $key);
72
73			report SuikaWiki::DB::Util::Error
74			-type => 'STOP_SET_INVALID_VALUE',
75			key => $key, prop => $prop,
76			-object => $self, method => 'set',
77			value => $val
78			unless ref $val and $val->isa ('Message::Markup::SuikaWikiConfig20::Node');
79
80			unless ($self->{opened}->{$prop}) {
81			local $Error::Depth = $Error::Depth + 1;
82			$self->open_prop (prop => $prop);
83			}
84
85			if ($self->{lock} and not $self->{lock}->writable) {
86			report SuikaWiki::DB::Util::Error
87			-type => 'KEY_SAVE_LOCKED',
88			-object => $self, method => 'set',
89			key => $key,
90			prop => $prop;
91			return 0;
92			}
93
94			$self->__make_directory (directory => $self->__key2dirpath (fullkey => $key));
95			my $path = $self->__key2filepath (key => $key);
96			my $file = new IO::File $path, '>'
97			or report SuikaWiki::DB::Util::Error
98			-type => 'FILE_WRITE_FAILURE',
99			-object => $self, method => 'set',
100			file => $path, msg => $!;
101			binmode $file;
102			print $file $val->stringify;
103			$self->{data}->{$path} = $val;
104			close $file;
105			1;
106			}
107
108			=head1 LICENSE
109
110			Copyright 2004 Wakaba <[email protected]>. All rights reserved.
111
112			This program is free software; you can redistribute it and/or
113			modify it under the same terms as Perl itself.
114
115			=cut
116
117			1; # $Date: 2004/04/17 04:15:39 $