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.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require SuikaWiki::DB::Util;

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}) {
    throw SuikaWiki::DB::Util::Error type => 'DB_OPEN';
  }
  $self->{has_exist} = defined $o{has_exist} ? $o{has_exist} : 1;
  $self;
}

sub get ($$$) {
  my ($self, $prop, $key) = @_;
  if (scalar @$key > 1) {
    throw SuikaWiki::DB::Util::Error type => 'KEY_INVALID_NAME', -key => $key;
  } else {
    $self->{db_hash}->{$key->[0]};
  }
}

sub set ($$$$) {
  my ($self, $prop, $key => $value) = @_;
  if (scalar @$key > 1) {
    throw SuikaWiki::DB::Util::Error type => 'KEY_INVALID_NAME', -key => $key;
  } else {
    $self->{db_hash}->{$key->[0]} = $value;
  }
}

sub exist ($$$) {
  my ($self, $prop, $key) = @_;
  if (scalar @$key > 1) {
    throw SuikaWiki::DB::Util::Error type => 'KEY_INVALID_NAME', -key => $key;
  } else {
    if ($self->{has_exist}) {
      return exist $self->{db_hash}->{$key->[0]};
    } else {
      return defined $self->{db_hash}->{$key->[0]} ? 1 : 0;
    }
  }
}

sub delete ($$$) {
  my ($self, $prop, $key) = @_;
  if (scalar @$key > 1) {
    throw SuikaWiki::DB::Util::Error type => 'KEY_INVALID_NAME', -key => $key;
  } else {
    delete $self->{db_hash}->{$key->[0]};
  }
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  if (scalar @{$opt{ns}} > 1) {
    throw SuikaWiki::DB::Util::Error type => 'KEY_INVALID_NS_NAME',
                                     -key => $opt{ns};
  } else {
    return map {[$_]} keys %{$self->{db_hash}};
  }
}

sub close ($) {
  my $self = shift;
  ($self->{destructor} or sub { 1 })->($self)
    or throw SuikaWiki::DB::Util::Error type => 'DB_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};
}

=head1 METHODS

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

=head1 SEE ALSO

C<SuikaWiki::DB>.

=head1 AUTHOR

Wakaba <[email protected]>.

=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/10/05 11:54:03 $
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.4	our $VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
18	wakaba	1.1	require SuikaWiki::DB::Util;
19
20			sub new ($%) {
21			my ($class, %o) = @_;
22			my $self = bless {}, $class;
23			if ($o{-lock}) {
24	wakaba	1.3	$self->{lock} = SuikaWiki::DB::Util->new_lock ($o{-lock});
25	wakaba	1.1	$self->{lock}->lock;
26			}
27	wakaba	1.2	$self->{db_hash} = &{$o{constructor} \|\| sub {return {}}} ($self, \%o);
28	wakaba	1.1	unless ($self->{db_hash}) {
29	wakaba	1.4	throw SuikaWiki::DB::Util::Error type => 'DB_OPEN';
30	wakaba	1.1	}
31			$self->{has_exist} = defined $o{has_exist} ? $o{has_exist} : 1;
32			$self;
33			}
34
35			sub get ($$$) {
36			my ($self, $prop, $key) = @_;
37			if (scalar @$key > 1) {
38	wakaba	1.4	throw SuikaWiki::DB::Util::Error type => 'KEY_INVALID_NAME', -key => $key;
39	wakaba	1.1	} else {
40			$self->{db_hash}->{$key->[0]};
41			}
42			}
43
44			sub set ($$$$) {
45			my ($self, $prop, $key => $value) = @_;
46			if (scalar @$key > 1) {
47	wakaba	1.4	throw SuikaWiki::DB::Util::Error type => 'KEY_INVALID_NAME', -key => $key;
48	wakaba	1.1	} else {
49			$self->{db_hash}->{$key->[0]} = $value;
50			}
51			}
52
53			sub exist ($$$) {
54			my ($self, $prop, $key) = @_;
55			if (scalar @$key > 1) {
56	wakaba	1.4	throw SuikaWiki::DB::Util::Error type => 'KEY_INVALID_NAME', -key => $key;
57	wakaba	1.1	} else {
58			if ($self->{has_exist}) {
59			return exist $self->{db_hash}->{$key->[0]};
60			} else {
61			return defined $self->{db_hash}->{$key->[0]} ? 1 : 0;
62			}
63			}
64			}
65
66			sub delete ($$$) {
67			my ($self, $prop, $key) = @_;
68			if (scalar @$key > 1) {
69	wakaba	1.4	throw SuikaWiki::DB::Util::Error type => 'KEY_INVALID_NAME', -key => $key;
70	wakaba	1.1	} else {
71			delete $self->{db_hash}->{$key->[0]};
72			}
73			}
74
75			sub keys ($$;%) {
76			my ($self, $prop, %opt) = @_;
77			if (scalar @{$opt{ns}} > 1) {
78	wakaba	1.4	throw SuikaWiki::DB::Util::Error type => 'KEY_INVALID_NS_NAME',
79			-key => $opt{ns};
80	wakaba	1.1	} else {
81			return map {[$_]} keys %{$self->{db_hash}};
82			}
83			}
84
85			sub close ($) {
86			my $self = shift;
87	wakaba	1.4	($self->{destructor} or sub { 1 })->($self)
88			or throw SuikaWiki::DB::Util::Error type => 'DB_CLOSE';
89	wakaba	1.1	$self->{db_hash} = undef;
90	wakaba	1.3	$self->{lock}->unlock if $self->{lock};
91			$self->{lock} = undef;
92	wakaba	1.1	}
93
94			sub DESTROY ($) {
95			my $self = shift;
96			$self->close if $self->{db_hash};
97			}
98
99			=head1 METHODS
100
101			This module provides common interface of SuikaWiki WikiDatabase
102			modules. See C<SuikaWiki::DB>.
103
104	wakaba	1.2	=head1 SEE ALSO
105
106			C<SuikaWiki::DB>.
107
108	wakaba	1.1	=head1 AUTHOR
109
110			Wakaba <[email protected]>.
111
112			=head1 LICENSE
113
114	wakaba	1.2	Copyright AUTHOR 2003.
115	wakaba	1.1
116			This program is free software; you can redistribute it and/or
117			modify it under the same terms as Perl itself.
118
119			=cut
120
121	wakaba	1.4	1; # $Date: 2003/10/05 11:54:03 $