SuikaWiki/DB/Hash.pm


=head1 NAME

SuikaWiki::DB::Hash --- SuikaWiki WikiDatabase: WikiDatabase interface wrapper for hash

=head1 DESCRIPTION

This module wrappes perl's hash with WikiDatabase common interface of
SuikaWiki.  It is useful for tied hash.

This module is part of SuikaWiki.

=cut

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

sub new ($%) {
  
  my ($class, %o) = @_;
  my $self = bless {}, $class;
  if ($o{-lock}) {
    $self->{lock} = SuikaWiki::DB::Util->new_lock ($o{-lock});
    $self->{lock}->lock;
  }
  $self->{db_hash} = &{$o{constructor} || sub {return {}}} ($self, \%o);
  unless ($self->{db_hash}) {
    report SuikaWiki::DB::Util::Error 
      -type => 'DB_OPEN',
      -object => $self, method => 'new';
  }
  $self->{has_exist} = defined $o{has_exist} ? $o{has_exist} : 1;
  $self;
}

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

sub set ($$$$) {
  my ($self, $prop, $key => $value) = @_;
  $self->___validate_name ($key);
  $self->{db_hash}->{join $;, @$key} = $value;
}

sub exist ($$$) {
  my ($self, $prop, $key) = @_;
  $self->___validate_name ($key);
  if ($self->{has_exist}) {
    return CORE::exists $self->{db_hash}->{join $;, @$key};
  } else {
    return CORE::defined $self->{db_hash}->{join $;, @$key} ? 1 : 0;
  }
}

sub delete ($$$) {
  my ($self, $prop, $key) = @_;
  $self->___validate_name ($key);
  CORE::delete $self->{db_hash}->{join $;, @$key};
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  $self->___validate_name ($opt{-ns}, error_type => 'KEY_INVALID_NS_NAME');
  my $prefix = join $;, @{$opt{-ns}};
  my $prefix_length = length $prefix;
  $prefix .= $; if $prefix_length;
  return CORE::map {[$_]} 
         CORE::grep {substr ($_, 0, $prefix_length) eq $prefix}
         CORE::keys %{$self->{db_hash}};
}

sub close ($) {
  my $self = shift;
  ($self->{destructor} or sub { 1 })->($self)
    or report SuikaWiki::DB::Util::Error 
         -type => 'DB_CLOSE',
         -object => $self, method => 'close';
  $self->{db_hash} = undef;
  $self->{lock}->unlock if $self->{lock};
  $self->{lock} = undef;
}
           
sub DESTROY ($) {
  my $self = shift;
  $self->close if $self->{db_hash};
}

sub ___validate_name ($$;%) {
  my ($self, $key, %opt) = @_;
  if (ref $key) {
    my $ok = 1;
    for (@$key) {
      if (index ($key, $;) > -1) {
        $ok = 0;
        last;
      }
    }
    return if $ok;
  }
  local $Error::Depth = $Error::Depth + 1;
  report SuikaWiki::DB::Util::Error
    -type => $opt{error_type} || 'KEY_INVALID_NAME',
    -object => $self, method => '___validate_name',
    key => $key;
}

=head1 METHODS

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

=head1 SEE ALSO

C<SuikaWiki::DB>.

=head1 AUTHOR

Wakaba <w@suika.fam.cx>.

=head1 LICENSE

Copyright AUTHOR 2003.

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

=cut

1; # $Date: 2003/12/06 02:19:09 $
1	wakaba	1.1
2			=head1 NAME
3
4			SuikaWiki::DB::Hash --- SuikaWiki WikiDatabase: WikiDatabase interface wrapper for hash
5
6			=head1 DESCRIPTION
7
8			This module wrappes perl's hash with WikiDatabase common interface of
9			SuikaWiki. It is useful for tied hash.
10
11			This module is part of SuikaWiki.
12
13			=cut
14
15			package SuikaWiki::DB::Hash;
16	wakaba	1.2	use strict;
17	wakaba	1.6	our $VERSION=do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
18	wakaba	1.1	require SuikaWiki::DB::Util;
19	wakaba	1.5	push our @ISA, 'SuikaWiki::DB::Util::template';
20	wakaba	1.1
21			sub new ($%) {
22	wakaba	1.5
23	wakaba	1.1	my ($class, %o) = @_;
24			my $self = bless {}, $class;
25			if ($o{-lock}) {
26	wakaba	1.3	$self->{lock} = SuikaWiki::DB::Util->new_lock ($o{-lock});
27	wakaba	1.1	$self->{lock}->lock;
28			}
29	wakaba	1.2	$self->{db_hash} = &{$o{constructor} \|\| sub {return {}}} ($self, \%o);
30	wakaba	1.1	unless ($self->{db_hash}) {
31	wakaba	1.5	report SuikaWiki::DB::Util::Error
32			-type => 'DB_OPEN',
33			-object => $self, method => 'new';
34	wakaba	1.1	}
35			$self->{has_exist} = defined $o{has_exist} ? $o{has_exist} : 1;
36			$self;
37			}
38
39			sub get ($$$) {
40			my ($self, $prop, $key) = @_;
41	wakaba	1.5	$self->___validate_name ($key);
42			$self->{db_hash}->{join $;, @$key};
43	wakaba	1.1	}
44
45			sub set ($$$$) {
46			my ($self, $prop, $key => $value) = @_;
47	wakaba	1.5	$self->___validate_name ($key);
48			$self->{db_hash}->{join $;, @$key} = $value;
49	wakaba	1.1	}
50
51			sub exist ($$$) {
52			my ($self, $prop, $key) = @_;
53	wakaba	1.5	$self->___validate_name ($key);
54			if ($self->{has_exist}) {
55			return CORE::exists $self->{db_hash}->{join $;, @$key};
56	wakaba	1.1	} else {
57	wakaba	1.5	return CORE::defined $self->{db_hash}->{join $;, @$key} ? 1 : 0;
58	wakaba	1.1	}
59			}
60
61			sub delete ($$$) {
62			my ($self, $prop, $key) = @_;
63	wakaba	1.5	$self->___validate_name ($key);
64			CORE::delete $self->{db_hash}->{join $;, @$key};
65	wakaba	1.1	}
66
67			sub keys ($$;%) {
68			my ($self, $prop, %opt) = @_;
69	wakaba	1.6	$self->___validate_name ($opt{-ns}, error_type => 'KEY_INVALID_NS_NAME');
70			my $prefix = join $;, @{$opt{-ns}};
71	wakaba	1.5	my $prefix_length = length $prefix;
72			$prefix .= $; if $prefix_length;
73			return CORE::map {[$_]}
74			CORE::grep {substr ($_, 0, $prefix_length) eq $prefix}
75			CORE::keys %{$self->{db_hash}};
76	wakaba	1.1	}
77
78			sub close ($) {
79			my $self = shift;
80	wakaba	1.4	($self->{destructor} or sub { 1 })->($self)
81	wakaba	1.5	or report SuikaWiki::DB::Util::Error
82			-type => 'DB_CLOSE',
83			-object => $self, method => 'close';
84	wakaba	1.1	$self->{db_hash} = undef;
85	wakaba	1.3	$self->{lock}->unlock if $self->{lock};
86			$self->{lock} = undef;
87	wakaba	1.1	}
88
89			sub DESTROY ($) {
90			my $self = shift;
91			$self->close if $self->{db_hash};
92			}
93
94	wakaba	1.5	sub ___validate_name ($$;%) {
95			my ($self, $key, %opt) = @_;
96			if (ref $key) {
97			my $ok = 1;
98			for (@$key) {
99			if (index ($key, $;) > -1) {
100			$ok = 0;
101			last;
102			}
103			}
104			return if $ok;
105			}
106			local $Error::Depth = $Error::Depth + 1;
107			report SuikaWiki::DB::Util::Error
108			-type => $opt{error_type} \|\| 'KEY_INVALID_NAME',
109			-object => $self, method => '___validate_name',
110			key => $key;
111			}
112
113	wakaba	1.1	=head1 METHODS
114
115			This module provides common interface of SuikaWiki WikiDatabase
116			modules. See C<SuikaWiki::DB>.
117
118	wakaba	1.2	=head1 SEE ALSO
119
120			C<SuikaWiki::DB>.
121
122	wakaba	1.1	=head1 AUTHOR
123
124			Wakaba <w@suika.fam.cx>.
125
126			=head1 LICENSE
127
128	wakaba	1.2	Copyright AUTHOR 2003.
129	wakaba	1.1
130			This program is free software; you can redistribute it and/or
131			modify it under the same terms as Perl itself.
132
133			=cut
134
135	wakaba	1.6	1; # $Date: 2003/12/06 02:19:09 $