SuikaWiki/DB/Util.pm


=head1 NAME

SuikaWiki::DB::Util --- SuikaWiki WikiDatabase: WikiDatabase modules common utilities

=head1 DESCRIPTION

This module provides some functions expected to be useful for most WikiDatabase
implememtation modules.

This module is part of SuikaWiki.

=cut

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

=head1 FUNCTIONS

=over 4

=item $locker = SuikaWiki::DB::Util->new_lock ($options)

Returns new locker object (SuikaWiki::DB::Util::Lock instance).

=cut

sub new_lock ($$) {
  eval qq{ require $_[1]->{-module} } or die $@;
  return $_[1]->{-module}->new (%{$_[1]});
}

=back

=cut

## Template for SuikaWiki::DB::* WikiDatabase modules
package SuikaWiki::DB::Util::template;

sub new ($;%) {
  my ($class, %opt) = @_;
  my $self = bless {}, $class;
  $self->___init (%opt);
  if ($opt{-lock}) {
    $self->{lock} = SuikaWiki::DB::Util->new_lock ($opt{-lock});
  }
  $self->{event}->{error} = [sub {
    my ($self, $event) = @_;
    if (   $event->{error}->{-def}->{level} eq 'fatal'
        or $event->{error}->{-def}->{level} eq 'stop') {
      # no-op
    } elsif ($event->{error}->{-def}->{level} eq 'warn') {
      warn $event->{error}->stringify;
      $event->{cancel} = 1;
    } else {
      #warn $event->{error}->stringify; ## DEBUG
      $event->{cancel} = 1;
    }
  }];
  $self;
}

sub ___init ($%) {}

sub DESTROY ($) {
  my $self = shift;
  local $Error::Depth = $Error::Depth + 1;
  $self->close if $self->{opened};
}

sub open ($;%) {
  shift->{opened} ? "0 but true" : 0;
}

sub open_prop ($;%) {
  my ($self, %opt) = @_;
  return "0 but true" if $self->{opened}->{$opt{prop}};
  if ($self->{lock} and not $self->{lock}->locked) {
    $self->{lock}->lock
      or report SuikaWiki::DB::Util::Error
           -type => 'LOCK_START', 
           -object => $self, method => 'open_prop';
  }
  $self->___open_prop (\%opt);
  $self->{opened}->{$opt{prop}} = 1;
  report SuikaWiki::DB::Util::Error
    -type => 'INFO_DB_PROP_OPENED',
    -object => $self, method => 'open_prop',
    prop => $opt{prop};
  1;
}

sub ___open_prop ($$) {
  my ($self, $opt) = @_; 
  local $Error::Depth = $Error::Depth + 1;
  report SuikaWiki::DB::Util::Error
    -type => 'DB_METHOD_NOT_IMPLEMENTED',
    method => '___open_prop',
    -object => $self,
    prop => $opt->{prop};  
}

sub close_prop ($;%) {
  my ($self, %opt) = @_;
  return "0 but true" unless $self->{opened}->{$opt{prop}};
  $self->___close_prop (\%opt);
  $self->{opened}->{$opt{prop}} = 0;
  report SuikaWiki::DB::Util::Error
    -type => 'INFO_DB_PROP_CLOSED',
    -object => $self, method => 'close_prop',
    prop => $opt{prop};
  1;
}

sub ___close_prop ($$) {
  my ($self, $opt) = @_;
  local $Error::Depth = $Error::Depth + 1;
  report SuikaWiki::DB::Util::Error
    -type => 'DB_METHOD_NOT_IMPLEMENTED',
    method => '___close_prop',
    -object => $self,
    prop => $opt->{prop};
}

sub close ($;%) {
  my ($self, %opt) = @_;
  {local $Error::Depth = $Error::Depth + 1;
  for (CORE::keys %{$self->{opened}||{}}) {
    $self->close_prop (prop => $_);
  }}
  delete $self->{opened};
  $self->{lock}->unlock if $self->{lock};
  report SuikaWiki::DB::Util::Error
    -type => 'DB_CLOSED',
    method => 'close', -object => $self;
}

sub get ($$$;%) {
  my ($self, $prop, $key, %opt) = @_;
  report SuikaWiki::DB::Util::Error
    -type => 'DB_METHOD_NOT_IMPLEMENTED',
    method => 'get',
    -object => $self;
}

sub set ($$$$;%) {
  my ($self, $prop, $key => $value, %opt) = @_;
  report SuikaWiki::DB::Util::Error
    -type => 'DB_METHOD_NOT_IMPLEMENTED',
    method => 'set',
    -object => $self;
}

sub exist ($$$;%) {
  my ($self, $prop, $key, %opt) = @_;
  report SuikaWiki::DB::Util::Error
    -type => 'DB_METHOD_NOT_IMPLEMENTED',
    method => 'exist',
    -object => $self;
}

sub delete ($$$;%) {
  my ($self, $prop, $key, %opt) = @_;
  report SuikaWiki::DB::Util::Error
    -type => 'DB_METHOD_NOT_IMPLEMENTED',
    method => 'delete',
    -object => $self;
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  report SuikaWiki::DB::Util::Error
    -type => 'DB_METHOD_NOT_IMPLEMENTED',
    method => 'delete',
    -object => $self;
}

sub ___report_error ($$) {
  my ($self, $err) = @_;
  my $event = {cancel => 0, name => 'error', error => $err};
  for (@{$self->{event}->{error}}) {
    $_->($self, $event);
    return if $event->{cancel};
  }
  $err->throw;
}

=head1 SEE ALSO

L<SuikaWiki::DB>, L<SuikaWiki::DB::Util::Lock>

=head1 LICENSE

Copyright 2003 Wakaba <w@suika.fam.cx>

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

=cut

1; # $Date: 2004/03/19 11:23:55 $
1	wakaba	1.1
2	wakaba	1.2	=head1 NAME
3
4			SuikaWiki::DB::Util --- SuikaWiki WikiDatabase: WikiDatabase modules common utilities
5
6			=head1 DESCRIPTION
7
8			This module provides some functions expected to be useful for most WikiDatabase
9			implememtation modules.
10
11			This module is part of SuikaWiki.
12
13			=cut
14
15	wakaba	1.1	package SuikaWiki::DB::Util;
16	wakaba	1.2	use strict;
17	wakaba	1.9	our $VERSION=do{my @r=(q$Revision: 1.8 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
18	wakaba	1.1	our $Err;
19	wakaba	1.4	require SuikaWiki::DB::Util::Error;
20	wakaba	1.1
21	wakaba	1.2	=head1 FUNCTIONS
22	wakaba	1.1
23			=over 4
24
25	wakaba	1.2	=item $locker = SuikaWiki::DB::Util->new_lock ($options)
26	wakaba	1.1
27			Returns new locker object (SuikaWiki::DB::Util::Lock instance).
28
29			=cut
30
31			sub new_lock ($$) {
32	wakaba	1.8	eval qq{ require $_[1]->{-module} } or die $@;
33			return $_[1]->{-module}->new (%{$_[1]});
34	wakaba	1.1	}
35
36			=back
37
38			=cut
39
40	wakaba	1.5	## Template for SuikaWiki::DB::* WikiDatabase modules
41			package SuikaWiki::DB::Util::template;
42
43			sub new ($;%) {
44			my ($class, %opt) = @_;
45			my $self = bless {}, $class;
46	wakaba	1.9	$self->___init (%opt);
47	wakaba	1.5	if ($opt{-lock}) {
48			$self->{lock} = SuikaWiki::DB::Util->new_lock ($opt{-lock});
49			}
50			$self->{event}->{error} = [sub {
51			my ($self, $event) = @_;
52			if ( $event->{error}->{-def}->{level} eq 'fatal'
53			or $event->{error}->{-def}->{level} eq 'stop') {
54			# no-op
55			} elsif ($event->{error}->{-def}->{level} eq 'warn') {
56			warn $event->{error}->stringify;
57			$event->{cancel} = 1;
58			} else {
59			#warn $event->{error}->stringify; ## DEBUG
60			$event->{cancel} = 1;
61			}
62			}];
63			$self;
64			}
65
66	wakaba	1.9	sub ___init ($%) {}
67
68	wakaba	1.5	sub DESTROY ($) {
69			my $self = shift;
70	wakaba	1.6	local $Error::Depth = $Error::Depth + 1;
71	wakaba	1.5	$self->close if $self->{opened};
72			}
73
74	wakaba	1.9	sub open ($;%) {
75			shift->{opened} ? "0 but true" : 0;
76			}
77
78	wakaba	1.5	sub open_prop ($;%) {
79			my ($self, %opt) = @_;
80			return "0 but true" if $self->{opened}->{$opt{prop}};
81			if ($self->{lock} and not $self->{lock}->locked) {
82			$self->{lock}->lock
83			or report SuikaWiki::DB::Util::Error
84			-type => 'LOCK_START',
85			-object => $self, method => 'open_prop';
86			}
87			$self->___open_prop (\%opt);
88			$self->{opened}->{$opt{prop}} = 1;
89			report SuikaWiki::DB::Util::Error
90			-type => 'INFO_DB_PROP_OPENED',
91			-object => $self, method => 'open_prop',
92			prop => $opt{prop};
93			1;
94			}
95
96			sub ___open_prop ($$) {
97			my ($self, $opt) = @_;
98			local $Error::Depth = $Error::Depth + 1;
99			report SuikaWiki::DB::Util::Error
100			-type => 'DB_METHOD_NOT_IMPLEMENTED',
101			method => '___open_prop',
102			-object => $self,
103			prop => $opt->{prop};
104			}
105
106			sub close_prop ($;%) {
107			my ($self, %opt) = @_;
108			return "0 but true" unless $self->{opened}->{$opt{prop}};
109			$self->___close_prop (\%opt);
110			$self->{opened}->{$opt{prop}} = 0;
111			report SuikaWiki::DB::Util::Error
112			-type => 'INFO_DB_PROP_CLOSED',
113			-object => $self, method => 'close_prop',
114			prop => $opt{prop};
115			1;
116			}
117
118			sub ___close_prop ($$) {
119			my ($self, $opt) = @_;
120			local $Error::Depth = $Error::Depth + 1;
121			report SuikaWiki::DB::Util::Error
122			-type => 'DB_METHOD_NOT_IMPLEMENTED',
123			method => '___close_prop',
124			-object => $self,
125			prop => $opt->{prop};
126			}
127
128			sub close ($;%) {
129			my ($self, %opt) = @_;
130			{local $Error::Depth = $Error::Depth + 1;
131			for (CORE::keys %{$self->{opened}\|\|{}}) {
132			$self->close_prop (prop => $_);
133			}}
134	wakaba	1.6	delete $self->{opened};
135	wakaba	1.5	$self->{lock}->unlock if $self->{lock};
136			report SuikaWiki::DB::Util::Error
137			-type => 'DB_CLOSED',
138			method => 'close', -object => $self;
139			}
140
141			sub get ($$$;%) {
142			my ($self, $prop, $key, %opt) = @_;
143			report SuikaWiki::DB::Util::Error
144			-type => 'DB_METHOD_NOT_IMPLEMENTED',
145			method => 'get',
146			-object => $self;
147			}
148
149			sub set ($$$$;%) {
150			my ($self, $prop, $key => $value, %opt) = @_;
151			report SuikaWiki::DB::Util::Error
152			-type => 'DB_METHOD_NOT_IMPLEMENTED',
153			method => 'set',
154			-object => $self;
155			}
156
157			sub exist ($$$;%) {
158			my ($self, $prop, $key, %opt) = @_;
159			report SuikaWiki::DB::Util::Error
160			-type => 'DB_METHOD_NOT_IMPLEMENTED',
161			method => 'exist',
162			-object => $self;
163			}
164
165			sub delete ($$$;%) {
166			my ($self, $prop, $key, %opt) = @_;
167			report SuikaWiki::DB::Util::Error
168			-type => 'DB_METHOD_NOT_IMPLEMENTED',
169			method => 'delete',
170			-object => $self;
171			}
172
173			sub keys ($$;%) {
174			my ($self, $prop, %opt) = @_;
175			report SuikaWiki::DB::Util::Error
176			-type => 'DB_METHOD_NOT_IMPLEMENTED',
177			method => 'delete',
178			-object => $self;
179			}
180	wakaba	1.2
181	wakaba	1.5	sub ___report_error ($$) {
182			my ($self, $err) = @_;
183	wakaba	1.7	my $event = {cancel => 0, name => 'error', error => $err};
184	wakaba	1.5	for (@{$self->{event}->{error}}) {
185			$_->($self, $event);
186			return if $event->{cancel};
187			}
188			$err->throw;
189			}
190	wakaba	1.2
191	wakaba	1.5	=head1 SEE ALSO
192	wakaba	1.2
193	wakaba	1.5	L<SuikaWiki::DB>, L<SuikaWiki::DB::Util::Lock>
194	wakaba	1.2
195			=head1 LICENSE
196
197	wakaba	1.5	Copyright 2003 Wakaba <w@suika.fam.cx>
198	wakaba	1.2
199			This program is free software; you can redistribute it and/or
200			modify it under the same terms as Perl itself.
201
202			=cut
203
204	wakaba	1.9	1; # $Date: 2004/03/19 11:23:55 $