/[pub]/suikawiki/script/lib/SuikaWiki/DB/FileSystem/YukiWikiDBNS.pm
Suika

Contents of /suikawiki/script/lib/SuikaWiki/DB/FileSystem/YukiWikiDBNS.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations) (download)
Tue Nov 25 12:41:16 2003 UTC (22 years, 9 months ago) by wakaba
Branch: MAIN
Changes since 1.3: +26 -15 lines
Throw exception instead of old error raising interface

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.4 our $VERSION = do{my @r=(q$Revision: 1.3 $=~/\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     if ($o{-lock}) {
30 wakaba 1.3 $self->{lock} = SuikaWiki::DB::Util->new_lock ($o{-lock});
31     $self->{lock}->lock
32 wakaba 1.4 or throw SuikaWiki::DB::Util::Error
33     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.4 or throw SuikaWiki::DB::Util::Error
43     type => 'DB_OPEN',
44     -method => q(new),
45     -file => $o{directory};
46 wakaba 1.1 $self->{db_hash} = \%db;
47     $self;
48     }
49    
50     sub get ($$$) {
51     my ($self, $prop, $key) = @_;
52 wakaba 1.2 $self->{db_hash}->{ $self->__name2name ($key) };
53 wakaba 1.1 }
54    
55     sub set ($$$$) {
56     my ($self, $prop, $key => $value) = @_;
57 wakaba 1.3 if ($self->{lock}->writable) {
58     $self->{db_hash}->{ $self->__name2name ($key) } = $value;
59     } else {
60 wakaba 1.4 throw SuikaWiki::DB::Util::Error
61     type => 'KEY_SAVE_LOCKED',
62     -key => $key,
63     -prop => $prop;
64 wakaba 1.3 }
65 wakaba 1.1 }
66    
67     sub exist ($$$) {
68     my ($self, $prop, $key) = @_;
69 wakaba 1.2 exist $self->{db_hash}->{ $self->__name2name ($key) };
70 wakaba 1.1 }
71    
72     sub delete ($$$) {
73     my ($self, $prop, $key) = @_;
74 wakaba 1.3 if ($self->{lock}->writable) {
75     delete $self->{db_hash}->{ $self->__name2name ($key) };
76     } else {
77 wakaba 1.4 throw SuikaWiki::DB::Util::Error
78     type => 'KEY_SAVE_LOCKED',
79     -key => $key,
80     -prop => $prop;
81 wakaba 1.3 }
82 wakaba 1.1 }
83    
84     sub keys ($$;%) {
85     my ($self, $prop, %opt) = @_;
86 wakaba 1.3 map {[split /\Q$Sep\E/, $_]}
87     $self->{db_instance}->list_items ({ns => $self->__name2ns ($opt{-ns}||[]),
88     type => ($opt{-type} eq 'ns'?'ns':'key'),
89     recursive => $opt{-recursive}});
90 wakaba 1.1 }
91    
92     sub __name2name ($$) {
93     my ($self, $key) = @_;
94 wakaba 1.4 throw SuikaWiki::DB::Util::Error
95     type => 'KEY_INVALID_NAME', -key => $key
96 wakaba 1.3 unless $self->__check_name ($key);
97 wakaba 1.1 join '//', @$key;
98     }
99    
100     sub __name2ns ($$) {
101     my ($self, $key) = @_;
102 wakaba 1.3 return '' if scalar @$key == 0 || (scalar @$key == 1 && $key->[0] eq '');
103 wakaba 1.4 throw SuikaWiki::DB::Util::Error
104     type => 'KEY_INVALID_NS_NAME', -key => $key
105 wakaba 1.3 unless $self->__check_name ($key);
106 wakaba 1.1 $key = $self->__name2name ($key) . $Sep;
107 wakaba 1.3 $key eq $Sep ? undef : $key;
108 wakaba 1.1 }
109    
110     sub __check_name ($$) {
111     my ($self, $key) = @_;
112     for (@$key) {
113     return 0 unless $_; # '' or 0 or undef
114     return 0 if index ($_, $Sep) > -1;
115     return 0 if $_ eq $Self || $_ eq $Parent;
116     }
117     return 1;
118     }
119    
120     sub close ($) {
121     my $self = shift;
122     untie %{$self->{db_hash}};
123     $self->{db_instance} = undef;
124     $self->{db_hash} = undef;
125 wakaba 1.3 $self->{lock}->unlock if $self->{lock};
126     $self->{lock} = undef;
127 wakaba 1.4 throw SuikaWiki::DB::Util::Error
128     type => 'DB_CLOSED',
129     -method => 'close';
130 wakaba 1.1 }
131    
132     sub DESTROY ($) {
133     my $self = shift;
134     $self->close if $self->{db_instance};
135 wakaba 1.4 throw SuikaWiki::DB::Util::Error
136     type => 'DB_DESTROY',
137     -method => 'DESTROY';
138 wakaba 1.1 }
139    
140     =head1 METHODS
141    
142     This module provides common interface of SuikaWiki WikiDatabase
143     modules. See C<SuikaWiki::DB>.
144    
145     =head2 CONSTRUCTOR'S OPTIONS
146    
147     @@ TBD
148    
149     =head1 AUTHOR
150    
151     Wakaba <[email protected]>.
152    
153     =head1 LICENSE
154    
155     Copyright 2003 Wakaba <[email protected]>
156    
157     This program is free software; you can redistribute it and/or
158     modify it under the same terms as Perl itself.
159    
160     =cut
161    
162 wakaba 1.4 1; # $Date: 2003/10/05 11:54:03 $

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24