DB/FileSystem/SuikaWikiMetaInfo09.pm


=head1 NAME

SuikaWiki::DB::FileSystem::SuikaWikiMetaInfo09 --- SuikaWiki WikiDatabase: SuikaWikiMetaInfo/0.9 one-file meta properties database

=head1 DESCRIPTION

This module provides SuikaWiki WikiDatabase interface to SuikaWikiMetaInfo/0.9
format of database.  It can keep keys with multiple properties into
one file.  It is originally implemented as supplemental database of
Yuki::YukiWikiDBMeta.

This module is part of SuikaWiki.

=cut

package SuikaWiki::DB::FileSystem::SuikaWikiMetaInfo09;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.7 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require SuikaWiki::DB::Util;
push our @ISA, 'SuikaWiki::DB::Util::template';
my $Sep = '//';
my $Self = '.';
my $Parent = '..';

sub new ($%) {
  my $self = shift->SUPER::new (@_);
  my %opt = @_;
  $self->{directory} = $opt{directory}
    or report SuikaWiki::DB::Util::Error
         -type => 'DB_METHOD_PARAMETER_REQUIRED',
         -object => $self, method => 'new',
         parameter => 'directory';
  $self->{directory} .= '/' unless substr ($self->{directory}, -1, 1) eq '/';
  $self->{prefix} = $opt{prefix} || 'mt--';
  $self->{suffix} = $opt{suffix} || '.dat';
  $self;
}

sub __encode_base16 ($$) {
  my ($self, $s) = @_;
  $s =~ s/(.)/sprintf '%02X', ord $1/ges;
  $s;
}
sub __decode_base16 ($$) {
  my ($self, $s) = @_;
  $s =~ s/([0-9A-Fa-f]{2})/chr hex $1/ge;
  $s;
}

sub ___open_prop ($$) {
  my ($self, $opt) = @_;
  local $Error::Depth = $Error::Depth + 1;
  my $file = $self->{directory}
            .$self->{prefix}
            .$self->__encode_base16 ($opt->{prop})
            .$self->{suffix};
  unless (-e $file) {
    $self->{db_hash}->{$opt->{prop}} = {};
  } else {
    CORE::open DB, '<', $file 
            or report SuikaWiki::DB::Util::Error
                      -type => 'STOP_DB_PROP_CANT_OPEN', file => $file,
                      msg => $!, prop => $opt->{prop},
                      -object => $self, method => '__read_meta';
    binmode DB;
    local $/ = undef;
    my $val = <DB>;
    CORE::close DB;
    
    if ($val =~ s!^\#\?SuikaWikiMetaInfo/0.9[^\x02]*\x02!!s) {
      $self->{db_hash}->{$opt->{prop}} = {map {split /\x1F/, $_, 2}
                                          split /\x1E/, $val};
    } elsif (length $val) {
      report SuikaWiki::DB::Util::Error
        -type => 'DB_UNSUPPORTED_FORMAT', file => $file,
        method => '__read_meta', -object => $self,
        prop => $opt->{prop};
    } else {  ## Blank file
      $self->{db_hash}->{$opt->{prop}} = {};
    }
  }
  $self->{prop_modified}->{$opt->{prop}} = 0;
}

sub ___close_prop ($$) {
  my ($self, $opt) = @_;
  local $Error::Depth = $Error::Depth + 1;
  unless ($self->{prop_modified}->{$opt->{prop}}) {
    report SuikaWiki::DB::Util::Error
      -type => 'INFO_DB_PROP_NOT_MODIFIED',
      -object => $self, method => '___close_prop',
      prop => $opt->{prop};
    return;
  }
  if ($self->{lock} and not $self->{lock}->locked) {
    $self->{lock}->lock
      or report SuikaWiki::DB::Util::Error
           -type => 'LOCK_START', method => '__write_meta',
           -object => $self, prop => $opt->{prop};
  }
  report SuikaWiki::DB::Util::Error 
    -type => 'DB_READ_ONLY', method => '___close_prop'
    -object => $self,
    if $self->{lock} and not $self->{lock}->writable;
  my $file = $opt->{prop};
  $file = $self->{directory}.$self->{prefix}.$self->__encode_base16 ($file)
         .$self->{suffix};
  
  my $temp = $file.'.'.time.'.tmp';
  CORE::open FILE, '>', $temp
    or report SuikaWiki::DB::Util::Error
         -type => 'STOP_DB_PROP_CANT_SAVE', msg => $!,
         method => '___close_prop', file => $file,
         prop => $opt->{prop}, -object => $self;
  binmode FILE;
  print FILE "#?SuikaWikiMetaInfo/0.9\n\x02"
            .join "\x1E",
             map {
               my ($n, $v) = ($_, $self->{db_hash}->{$opt->{prop}}->{$_});
               for ($n, $v) {s/([\x02\x1C-\x1F])/sprintf '\\x%02X', ord $1/ge}
               $n."\x1F".$v;
             }
             grep {length $self->{db_hash}->{$opt->{prop}}->{$_}}
             keys %{$self->{db_hash}->{$opt->{prop}}};
  CORE::close FILE;
  if (-e $file) {
    unlink $file or report SuikaWiki::DB::Util::Error
                      -type => 'STOP_DB_PROP_CANT_SAVE', file => $file,
                      method => '___close_prop (unlink)',
                      msg => $!, prop => $opt->{prop},
                      -object => $self;
  }
  rename $temp => $file
    or report SuikaWiki::DB::Util::Error
         -type => 'STOP_DB_PROP_CANT_SAVE', file => $file,
         method => '___close_prop (rename)',
         msg => $!, prop => $opt->{prop},
         -object => $self;
  $self->{prop_modified}->{$opt->{prop}} = 0;
  report SuikaWiki::DB::Util::Error
    -type => 'INFO_DB_PROP_WROTE',
    -object => $self, method => '___close_prop',
    file => $file, prop => $opt->{prop};
  CORE::delete $self->{db_hash}->{$opt->{prop}};
}

sub __name2name ($$) {
  my ($self, $key) = @_;
  join $Sep, @$key;
}

sub __check_name ($$) {
  my ($self, $key) = @_;
  return 0 unless ref $key;
  for (@$key) {
    return 0 unless $_;  # '' or 0 or undef
    return 0 if index ($_, $Sep) > -1;
    return 0 if $_ eq $Self || $_ eq $Parent;
  }
  return 1;  
}

sub get ($$$) {
  my ($self, $prop, $key) = @_;
  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }
  $self->{db_hash}->{$prop}->{ $self->__name2name ($key) };
}

sub set ($$$$) {
  my ($self, $prop, $key => $value) = @_;
  report SuikaWiki::DB::Util::Error 
    -type => 'KEY_INVALID_NAME',
    -object => $self, method => 'set',
    prop => $prop, key => $key
    unless $self->__check_name ($key);
  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }
  $self->{prop_modified}->{$prop} = 1;
  $self->{db_hash}->{$prop}->{ $self->__name2name ($key) } = $value;
}

sub exist ($$$) {
  my ($self, $prop, $key) = @_;
  return 0 unless $self->__check_name ($key);
  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }
  CORE::exists $self->{db_hash}->{$prop}->{ $self->__name2name ($key) };
}

sub delete ($$$) {
  my ($self, $prop, $key) = @_;
  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }
  $self->{prop_modified}->{$prop} = 1;
  CORE::delete $self->{db_hash}->{$prop}->{ $self->__name2name ($key) };
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  unless ($self->{opened}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    $self->open_prop (prop => $prop);
  }
  my $ns = $self->__name2name ($opt{-ns});
  $ns .= $Sep if length $ns;
  my $ns_l = length $ns;
  my @result;
  for (CORE::keys %{$self->{db_hash}->{$prop}}) {
    ## Namespace matchs
    if (substr ($_, 0, $ns_l) eq $ns) {
      ## Child or grandchild in recursive mode
      if ($opt{-recursive} || not (index ($_, $Sep) > $ns_l - 1)) {
        push @result, $_;
      }
    }
  }
  return map {[split /\Q$Sep\E/, $_]} @result;
}

# close: Inherited

# DESTROY: Inherited

=head1 METHODS

This module provides common interface of SuikaWiki WikiDatabase
modules. See C<SuikaWiki::DB>.

=head1 AUTHOR

Wakaba <[email protected]>.

=head1 LICENSE

Copyright 2003-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/02/08 08:54:52 $
1	wakaba	1.1
2			=head1 NAME
3
4			SuikaWiki::DB::FileSystem::SuikaWikiMetaInfo09 --- SuikaWiki WikiDatabase: SuikaWikiMetaInfo/0.9 one-file meta properties database
5
6			=head1 DESCRIPTION
7
8			This module provides SuikaWiki WikiDatabase interface to SuikaWikiMetaInfo/0.9
9			format of database. It can keep keys with multiple properties into
10			one file. It is originally implemented as supplemental database of
11			Yuki::YukiWikiDBMeta.
12
13			This module is part of SuikaWiki.
14
15			=cut
16
17			package SuikaWiki::DB::FileSystem::SuikaWikiMetaInfo09;
18	wakaba	1.2	use strict;
19	wakaba	1.8	our $VERSION=do{my @r=(q$Revision: 1.7 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
20	wakaba	1.1	require SuikaWiki::DB::Util;
21	wakaba	1.6	push our @ISA, 'SuikaWiki::DB::Util::template';
22	wakaba	1.1	my $Sep = '//';
23			my $Self = '.';
24			my $Parent = '..';
25
26			sub new ($%) {
27	wakaba	1.6	my $self = shift->SUPER::new (@_);
28			my %opt = @_;
29			$self->{directory} = $opt{directory}
30			or report SuikaWiki::DB::Util::Error
31			-type => 'DB_METHOD_PARAMETER_REQUIRED',
32			-object => $self, method => 'new',
33			parameter => 'directory';
34	wakaba	1.3	$self->{directory} .= '/' unless substr ($self->{directory}, -1, 1) eq '/';
35	wakaba	1.6	$self->{prefix} = $opt{prefix} \|\| 'mt--';
36			$self->{suffix} = $opt{suffix} \|\| '.dat';
37	wakaba	1.1	$self;
38			}
39
40			sub __encode_base16 ($$) {
41			my ($self, $s) = @_;
42	wakaba	1.3	$s =~ s/(.)/sprintf '%02X', ord $1/ges;
43	wakaba	1.1	$s;
44			}
45			sub __decode_base16 ($$) {
46			my ($self, $s) = @_;
47	wakaba	1.3	$s =~ s/([0-9A-Fa-f]{2})/chr hex $1/ge;
48	wakaba	1.1	$s;
49			}
50
51	wakaba	1.6	sub ___open_prop ($$) {
52			my ($self, $opt) = @_;
53			local $Error::Depth = $Error::Depth + 1;
54			my $file = $self->{directory}
55			.$self->{prefix}
56			.$self->__encode_base16 ($opt->{prop})
57			.$self->{suffix};
58	wakaba	1.1	unless (-e $file) {
59	wakaba	1.6	$self->{db_hash}->{$opt->{prop}} = {};
60	wakaba	1.1	} else {
61	wakaba	1.6	CORE::open DB, '<', $file
62			or report SuikaWiki::DB::Util::Error
63			-type => 'STOP_DB_PROP_CANT_OPEN', file => $file,
64			msg => $!, prop => $opt->{prop},
65			-object => $self, method => '__read_meta';
66	wakaba	1.1	binmode DB;
67			local $/ = undef;
68			my $val = <DB>;
69	wakaba	1.6	CORE::close DB;
70	wakaba	1.1
71			if ($val =~ s!^\#\?SuikaWikiMetaInfo/0.9[^\x02]*\x02!!s) {
72	wakaba	1.6	$self->{db_hash}->{$opt->{prop}} = {map {split /\x1F/, $_, 2}
73			split /\x1E/, $val};
74	wakaba	1.1	} elsif (length $val) {
75	wakaba	1.6	report SuikaWiki::DB::Util::Error
76			-type => 'DB_UNSUPPORTED_FORMAT', file => $file,
77			method => '__read_meta', -object => $self,
78			prop => $opt->{prop};
79	wakaba	1.1	} else { ## Blank file
80	wakaba	1.6	$self->{db_hash}->{$opt->{prop}} = {};
81	wakaba	1.1	}
82			}
83	wakaba	1.6	$self->{prop_modified}->{$opt->{prop}} = 0;
84	wakaba	1.1	}
85
86	wakaba	1.6	sub ___close_prop ($$) {
87			my ($self, $opt) = @_;
88			local $Error::Depth = $Error::Depth + 1;
89			unless ($self->{prop_modified}->{$opt->{prop}}) {
90			report SuikaWiki::DB::Util::Error
91			-type => 'INFO_DB_PROP_NOT_MODIFIED',
92			-object => $self, method => '___close_prop',
93			prop => $opt->{prop};
94			return;
95			}
96	wakaba	1.4	if ($self->{lock} and not $self->{lock}->locked) {
97	wakaba	1.3	$self->{lock}->lock
98	wakaba	1.6	or report SuikaWiki::DB::Util::Error
99			-type => 'LOCK_START', method => '__write_meta',
100			-object => $self, prop => $opt->{prop};
101			}
102			report SuikaWiki::DB::Util::Error
103			-type => 'DB_READ_ONLY', method => '___close_prop'
104			-object => $self,
105	wakaba	1.4	if $self->{lock} and not $self->{lock}->writable;
106	wakaba	1.6	my $file = $opt->{prop};
107	wakaba	1.1	$file = $self->{directory}.$self->{prefix}.$self->__encode_base16 ($file)
108			.$self->{suffix};
109
110			my $temp = $file.'.'.time.'.tmp';
111	wakaba	1.6	CORE::open FILE, '>', $temp
112			or report SuikaWiki::DB::Util::Error
113			-type => 'STOP_DB_PROP_CANT_SAVE', msg => $!,
114			method => '___close_prop', file => $file,
115			prop => $opt->{prop}, -object => $self;
116	wakaba	1.1	binmode FILE;
117			print FILE "#?SuikaWikiMetaInfo/0.9\n\x02"
118			.join "\x1E",
119			map {
120	wakaba	1.6	my ($n, $v) = ($_, $self->{db_hash}->{$opt->{prop}}->{$_});
121	wakaba	1.1	for ($n, $v) {s/([\x02\x1C-\x1F])/sprintf '\\x%02X', ord $1/ge}
122			$n."\x1F".$v;
123			}
124	wakaba	1.6	grep {length $self->{db_hash}->{$opt->{prop}}->{$_}}
125			keys %{$self->{db_hash}->{$opt->{prop}}};
126			CORE::close FILE;
127	wakaba	1.1	if (-e $file) {
128	wakaba	1.6	unlink $file or report SuikaWiki::DB::Util::Error
129			-type => 'STOP_DB_PROP_CANT_SAVE', file => $file,
130			method => '___close_prop (unlink)',
131			msg => $!, prop => $opt->{prop},
132			-object => $self;
133	wakaba	1.1	}
134			rename $temp => $file
135	wakaba	1.6	or report SuikaWiki::DB::Util::Error
136			-type => 'STOP_DB_PROP_CANT_SAVE', file => $file,
137			method => '___close_prop (rename)',
138			msg => $!, prop => $opt->{prop},
139			-object => $self;
140			$self->{prop_modified}->{$opt->{prop}} = 0;
141			report SuikaWiki::DB::Util::Error
142			-type => 'INFO_DB_PROP_WROTE',
143			-object => $self, method => '___close_prop',
144			file => $file, prop => $opt->{prop};
145			CORE::delete $self->{db_hash}->{$opt->{prop}};
146	wakaba	1.1	}
147
148			sub __name2name ($$) {
149			my ($self, $key) = @_;
150	wakaba	1.6	join $Sep, @$key;
151	wakaba	1.1	}
152
153			sub __check_name ($$) {
154			my ($self, $key) = @_;
155	wakaba	1.5	return 0 unless ref $key;
156	wakaba	1.1	for (@$key) {
157			return 0 unless $_; # '' or 0 or undef
158			return 0 if index ($_, $Sep) > -1;
159			return 0 if $_ eq $Self \|\| $_ eq $Parent;
160			}
161			return 1;
162			}
163
164			sub get ($$$) {
165			my ($self, $prop, $key) = @_;
166	wakaba	1.6	unless ($self->{opened}->{$prop}) {
167			local $Error::Depth = $Error::Depth + 1;
168			$self->open_prop (prop => $prop);
169			}
170	wakaba	1.1	$self->{db_hash}->{$prop}->{ $self->__name2name ($key) };
171			}
172
173			sub set ($$$$) {
174			my ($self, $prop, $key => $value) = @_;
175	wakaba	1.6	report SuikaWiki::DB::Util::Error
176			-type => 'KEY_INVALID_NAME',
177			-object => $self, method => 'set',
178			prop => $prop, key => $key
179	wakaba	1.1	unless $self->__check_name ($key);
180	wakaba	1.6	unless ($self->{opened}->{$prop}) {
181			local $Error::Depth = $Error::Depth + 1;
182			$self->open_prop (prop => $prop);
183			}
184			$self->{prop_modified}->{$prop} = 1;
185	wakaba	1.1	$self->{db_hash}->{$prop}->{ $self->__name2name ($key) } = $value;
186			}
187
188			sub exist ($$$) {
189			my ($self, $prop, $key) = @_;
190			return 0 unless $self->__check_name ($key);
191	wakaba	1.6	unless ($self->{opened}->{$prop}) {
192			local $Error::Depth = $Error::Depth + 1;
193			$self->open_prop (prop => $prop);
194			}
195	wakaba	1.5	CORE::exists $self->{db_hash}->{$prop}->{ $self->__name2name ($key) };
196	wakaba	1.1	}
197
198			sub delete ($$$) {
199			my ($self, $prop, $key) = @_;
200	wakaba	1.6	unless ($self->{opened}->{$prop}) {
201			local $Error::Depth = $Error::Depth + 1;
202			$self->open_prop (prop => $prop);
203			}
204			$self->{prop_modified}->{$prop} = 1;
205	wakaba	1.5	CORE::delete $self->{db_hash}->{$prop}->{ $self->__name2name ($key) };
206	wakaba	1.1	}
207
208			sub keys ($$;%) {
209			my ($self, $prop, %opt) = @_;
210	wakaba	1.6	unless ($self->{opened}->{$prop}) {
211			local $Error::Depth = $Error::Depth + 1;
212			$self->open_prop (prop => $prop);
213			}
214	wakaba	1.8	my $ns = $self->__name2name ($opt{-ns});
215			$ns .= $Sep if length $ns;
216	wakaba	1.1	my $ns_l = length $ns;
217			my @result;
218	wakaba	1.5	for (CORE::keys %{$self->{db_hash}->{$prop}}) {
219	wakaba	1.4	## Namespace matchs
220	wakaba	1.1	if (substr ($_, 0, $ns_l) eq $ns) {
221			## Child or grandchild in recursive mode
222	wakaba	1.8	if ($opt{-recursive} \|\| not (index ($_, $Sep) > $ns_l - 1)) {
223	wakaba	1.1	push @result, $_;
224			}
225			}
226			}
227			return map {[split /\Q$Sep\E/, $_]} @result;
228			}
229
230	wakaba	1.6	# close: Inherited
231
232			# DESTROY: Inherited
233	wakaba	1.1
234			=head1 METHODS
235
236			This module provides common interface of SuikaWiki WikiDatabase
237			modules. See C<SuikaWiki::DB>.
238
239			=head1 AUTHOR
240
241			Wakaba <[email protected]>.
242
243			=head1 LICENSE
244
245	wakaba	1.7	Copyright 2003-2004 Wakaba <[email protected]>. All rights reserved.
246	wakaba	1.1
247			This program is free software; you can redistribute it and/or
248			modify it under the same terms as Perl itself.
249
250			=cut
251
252	wakaba	1.8	1; # $Date: 2004/02/08 08:54:52 $