DB/FileSystem/YukiWikiDBNS.pm


=head1 NAME

SuikaWiki::DB::FileSystem::YukiWikiDBNS --- SuikaWiki WikiDatabase: WikiDatabase interface wrapper for Yuki::YukiWikiDBNS

=head1 DESCRIPTION

This module wrappes Yuki::YukiWikiDBNS (directory structuring extended
version of Yuki::YukiWikiDB2) for WikiDatabase common interface of
SuikaWiki.

This module is part of SuikaWiki.

=cut

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

sub new ($%) {
  my ($class, %o) = @_;
  my $self = bless {}, $class;
  $self->{error} = SuikaWiki::DB::Util->error_handler;
  if ($o{-lock}) {
    $self->{lock} = SuikaWiki::DB::Util->new_lock ($o{-lock});
    $self->{lock}->lock
      or $self->{error}->raise (type => 'LOCK_START', method => 'new');
  }
  my %db;
  $self->{db_instance} = tie (%db, $DB_Module => $o{directory},
                              -lock => 0, ## Yuki::YukiWikiDBNS's lock is buggy
                              -backup => $o{use_history},
                              -logfile => $o{logfile},
                              -extension => $o{suffix},
                             )
    or $self->{error}->raise (type => 'DB_OPEN',
                              method => q(new),
                              file => $o{directory});
  $self->{db_hash} = \%db;
  $self;
}

sub get ($$$) {
  my ($self, $prop, $key) = @_;
  $self->{db_hash}->{ $self->__name2name ($key) };
}

sub set ($$$$) {
  my ($self, $prop, $key => $value) = @_;
  if ($self->{lock}->writable) {
    $self->{db_hash}->{ $self->__name2name ($key) } = $value;
  } else {
    $self->{error}->raise (type => 'KEY_SAVE_LOCKED', key => $key,
                           prop => $prop);
  }
}

sub exist ($$$) {
  my ($self, $prop, $key) = @_;
  exist $self->{db_hash}->{ $self->__name2name ($key) };
}

sub delete ($$$) {
  my ($self, $prop, $key) = @_;
  if ($self->{lock}->writable) {
    delete $self->{db_hash}->{ $self->__name2name ($key) };
  } else {
    $self->{error}->raise (type => 'KEY_SAVE_LOCKED', key => $key,
                           prop => $prop);
  }
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  map {[split /\Q$Sep\E/, $_]}
  $self->{db_instance}->list_items ({ns => $self->__name2ns ($opt{-ns}||[]),
                                     type => ($opt{-type} eq 'ns'?'ns':'key'),
                                     recursive => $opt{-recursive}});
}

sub __name2name ($$) {
  my ($self, $key) = @_;
  $self->{error}->raise (type => 'KEY_INVALID_NAME', key => $key) 
    unless $self->__check_name ($key);
  join '//', @$key;
}

sub __name2ns ($$) {
  my ($self, $key) = @_;
  return '' if scalar @$key == 0 || (scalar @$key == 1 && $key->[0] eq '');
  $self->{error}->raise (type => 'KEY_INVALID_NS_NAME', key => $key)
    unless $self->__check_name ($key);
  $key = $self->__name2name ($key) . $Sep;
  $key eq $Sep ? undef : $key;
}

sub __check_name ($$) {
  my ($self, $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 close ($) {
  my $self = shift;
  untie %{$self->{db_hash}};
  $self->{db_instance} = undef;
  $self->{db_hash} = undef;
  $self->{lock}->unlock if $self->{lock};
  $self->{lock} = undef;
  $self->{error}->raise (type => 'DB_CLOSED', method => 'close');
}

sub DESTROY ($) {
  my $self = shift;
  $self->close if $self->{db_instance};
  $self->{error}->raise (type => 'DB_DESTROY', method => 'DESTROY');
}

=head1 METHODS

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

=head2 CONSTRUCTOR'S OPTIONS

@@ TBD

=head1 AUTHOR

Wakaba <[email protected]>.

=head1 LICENSE

Copyright 2003 Wakaba <[email protected]>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: 2003/08/06 02:54:40 $
1	wakaba	1.1
2			=head1 NAME
3
4			SuikaWiki::DB::FileSystem::YukiWikiDBNS --- SuikaWiki WikiDatabase: WikiDatabase interface wrapper for Yuki::YukiWikiDBNS
5
6			=head1 DESCRIPTION
7
8			This module wrappes Yuki::YukiWikiDBNS (directory structuring extended
9			version of Yuki::YukiWikiDB2) for WikiDatabase common interface of
10			SuikaWiki.
11
12			This module is part of SuikaWiki.
13
14			=cut
15
16			package SuikaWiki::DB::FileSystem::YukiWikiDBNS;
17	wakaba	1.2	use strict;
18	wakaba	1.3	our $VERSION = do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
19	wakaba	1.1	require SuikaWiki::DB::Util;
20			require Yuki::YukiWikiDBNS;
21			my $Self = '.';
22			my $Parent = '..';
23			my $Sep = '//';
24			my $DB_Module = q(Yuki::YukiWikiDBNS);
25
26			sub new ($%) {
27			my ($class, %o) = @_;
28			my $self = bless {}, $class;
29	wakaba	1.3	$self->{error} = SuikaWiki::DB::Util->error_handler;
30	wakaba	1.1	if ($o{-lock}) {
31	wakaba	1.3	$self->{lock} = SuikaWiki::DB::Util->new_lock ($o{-lock});
32			$self->{lock}->lock
33			or $self->{error}->raise (type => 'LOCK_START', method => 'new');
34	wakaba	1.1	}
35			my %db;
36			$self->{db_instance} = tie (%db, $DB_Module => $o{directory},
37	wakaba	1.3	-lock => 0, ## Yuki::YukiWikiDBNS's lock is buggy
38	wakaba	1.1	-backup => $o{use_history},
39			-logfile => $o{logfile},
40			-extension => $o{suffix},
41			)
42	wakaba	1.2	or $self->{error}->raise (type => 'DB_OPEN',
43			method => q(new),
44			file => $o{directory});
45	wakaba	1.1	$self->{db_hash} = \%db;
46			$self;
47			}
48
49			sub get ($$$) {
50			my ($self, $prop, $key) = @_;
51	wakaba	1.2	$self->{db_hash}->{ $self->__name2name ($key) };
52	wakaba	1.1	}
53
54			sub set ($$$$) {
55			my ($self, $prop, $key => $value) = @_;
56	wakaba	1.3	if ($self->{lock}->writable) {
57			$self->{db_hash}->{ $self->__name2name ($key) } = $value;
58			} else {
59			$self->{error}->raise (type => 'KEY_SAVE_LOCKED', key => $key,
60			prop => $prop);
61			}
62	wakaba	1.1	}
63
64			sub exist ($$$) {
65			my ($self, $prop, $key) = @_;
66	wakaba	1.2	exist $self->{db_hash}->{ $self->__name2name ($key) };
67	wakaba	1.1	}
68
69			sub delete ($$$) {
70			my ($self, $prop, $key) = @_;
71	wakaba	1.3	if ($self->{lock}->writable) {
72			delete $self->{db_hash}->{ $self->__name2name ($key) };
73			} else {
74			$self->{error}->raise (type => 'KEY_SAVE_LOCKED', key => $key,
75			prop => $prop);
76			}
77	wakaba	1.1	}
78
79			sub keys ($$;%) {
80			my ($self, $prop, %opt) = @_;
81	wakaba	1.3	map {[split /\Q$Sep\E/, $_]}
82			$self->{db_instance}->list_items ({ns => $self->__name2ns ($opt{-ns}\|\|[]),
83			type => ($opt{-type} eq 'ns'?'ns':'key'),
84			recursive => $opt{-recursive}});
85	wakaba	1.1	}
86
87			sub __name2name ($$) {
88			my ($self, $key) = @_;
89			$self->{error}->raise (type => 'KEY_INVALID_NAME', key => $key)
90	wakaba	1.3	unless $self->__check_name ($key);
91	wakaba	1.1	join '//', @$key;
92			}
93
94			sub __name2ns ($$) {
95			my ($self, $key) = @_;
96	wakaba	1.3	return '' if scalar @$key == 0 \|\| (scalar @$key == 1 && $key->[0] eq '');
97	wakaba	1.1	$self->{error}->raise (type => 'KEY_INVALID_NS_NAME', key => $key)
98	wakaba	1.3	unless $self->__check_name ($key);
99	wakaba	1.1	$key = $self->__name2name ($key) . $Sep;
100	wakaba	1.3	$key eq $Sep ? undef : $key;
101	wakaba	1.1	}
102
103			sub __check_name ($$) {
104			my ($self, $key) = @_;
105			for (@$key) {
106			return 0 unless $_; # '' or 0 or undef
107			return 0 if index ($_, $Sep) > -1;
108			return 0 if $_ eq $Self \|\| $_ eq $Parent;
109			}
110			return 1;
111			}
112
113			sub close ($) {
114			my $self = shift;
115			untie %{$self->{db_hash}};
116			$self->{db_instance} = undef;
117			$self->{db_hash} = undef;
118	wakaba	1.3	$self->{lock}->unlock if $self->{lock};
119			$self->{lock} = undef;
120			$self->{error}->raise (type => 'DB_CLOSED', method => 'close');
121	wakaba	1.1	}
122
123			sub DESTROY ($) {
124			my $self = shift;
125			$self->close if $self->{db_instance};
126	wakaba	1.3	$self->{error}->raise (type => 'DB_DESTROY', method => 'DESTROY');
127	wakaba	1.1	}
128
129			=head1 METHODS
130
131			This module provides common interface of SuikaWiki WikiDatabase
132			modules. See C<SuikaWiki::DB>.
133
134			=head2 CONSTRUCTOR'S OPTIONS
135
136			@@ TBD
137
138			=head1 AUTHOR
139
140			Wakaba <[email protected]>.
141
142			=head1 LICENSE
143
144			Copyright 2003 Wakaba <[email protected]>
145
146			This program is free software; you can redistribute it and/or
147			modify it under the same terms as Perl itself.
148
149			=cut
150
151	wakaba	1.3	1; # $Date: 2003/08/06 02:54:40 $