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.2 $=~/\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->{error} = SuikaWiki::DB::Util->error_handler;
  $self->{db_hash} = &{$o{constructor} || sub {return {}}} ($self, \%o);
  unless ($self->{db_hash}) {
    $self->{error}->raise (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) {
    $self->{error}->raise (type => 'KEY_INVALID_NAME', key => $key);
  } else {
    $self->{db_hash}->{$key->[0]};
  }
}

sub set ($$$$) {
  my ($self, $prop, $key => $value) = @_;
  if (scalar @$key > 1) {
    $self->{error}->raise (type => 'KEY_INVALID_NAME', key => $key);
  } else {
    $self->{db_hash}->{$key->[0]} = $value;
  }
}

sub exist ($$$) {
  my ($self, $prop, $key) = @_;
  if (scalar @$key > 1) {
    $self->{error}->raise (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) {
    $self->{error}->raise (type => 'KEY_INVALID_NAME', key => $key);
  } else {
    delete $self->{db_hash}->{$key->[0]};
  }
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  if (scalar @{$opt{ns}} > 1) {
    $self->{error}->raise (type => 'KEY_INVALID_NAME', key => $opt{ns});
  } else {
    return map {[$_]} keys %{$self->{db_hash}};
  }
}

sub close ($) {
  my $self = shift;
  &{$self->{destructor} || sub { 1 }} ($self)
    or $self->{error}->raise (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 <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/08/06 02:54:40 $
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.3	our $VERSION=do{my @r=(q$Revision: 1.2 $=~/\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			$self->{error} = SuikaWiki::DB::Util->error_handler;
28	wakaba	1.2	$self->{db_hash} = &{$o{constructor} \|\| sub {return {}}} ($self, \%o);
29	wakaba	1.1	unless ($self->{db_hash}) {
30			$self->{error}->raise (type => 'DB_OPEN');
31			}
32			$self->{has_exist} = defined $o{has_exist} ? $o{has_exist} : 1;
33			$self;
34			}
35
36			sub get ($$$) {
37			my ($self, $prop, $key) = @_;
38			if (scalar @$key > 1) {
39			$self->{error}->raise (type => 'KEY_INVALID_NAME', key => $key);
40			} else {
41			$self->{db_hash}->{$key->[0]};
42			}
43			}
44
45			sub set ($$$$) {
46			my ($self, $prop, $key => $value) = @_;
47			if (scalar @$key > 1) {
48			$self->{error}->raise (type => 'KEY_INVALID_NAME', key => $key);
49			} else {
50			$self->{db_hash}->{$key->[0]} = $value;
51			}
52			}
53
54			sub exist ($$$) {
55			my ($self, $prop, $key) = @_;
56			if (scalar @$key > 1) {
57			$self->{error}->raise (type => 'KEY_INVALID_NAME', key => $key);
58			} else {
59			if ($self->{has_exist}) {
60			return exist $self->{db_hash}->{$key->[0]};
61			} else {
62			return defined $self->{db_hash}->{$key->[0]} ? 1 : 0;
63			}
64			}
65			}
66
67			sub delete ($$$) {
68			my ($self, $prop, $key) = @_;
69			if (scalar @$key > 1) {
70			$self->{error}->raise (type => 'KEY_INVALID_NAME', key => $key);
71			} else {
72			delete $self->{db_hash}->{$key->[0]};
73			}
74			}
75
76			sub keys ($$;%) {
77			my ($self, $prop, %opt) = @_;
78			if (scalar @{$opt{ns}} > 1) {
79	wakaba	1.2	$self->{error}->raise (type => 'KEY_INVALID_NAME', 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			&{$self->{destructor} \|\| sub { 1 }} ($self)
88			or $self->{error}->raise (type => 'DB_CLOSE');
89			$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 <w@suika.fam.cx>.
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.3	1; # $Date: 2003/08/06 02:54:40 $