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.6 $=~/\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 ($$) {
  require SuikaWiki::DB::Util::Lock;
  return SuikaWiki::DB::Util::Lock->new (%{$_[1]});
}

=back

=cut

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

sub new ($;%) {
  my ($class, %opt) = @_;
  my $self = bless {}, $class;
  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 DESTROY ($) {
  my $self = shift;
  local $Error::Depth = $Error::Depth + 1;
  $self->close if $self->{opened};
}

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: 2003/12/06 02:19:36 $
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.7	our $VERSION=do{my @r=(q$Revision: 1.6 $=~/\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			require SuikaWiki::DB::Util::Lock;
33			return SuikaWiki::DB::Util::Lock->new (%{$_[1]});
34			}
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			if ($opt{-lock}) {
47			$self->{lock} = SuikaWiki::DB::Util->new_lock ($opt{-lock});
48			}
49			$self->{event}->{error} = [sub {
50			my ($self, $event) = @_;
51			if ( $event->{error}->{-def}->{level} eq 'fatal'
52			or $event->{error}->{-def}->{level} eq 'stop') {
53			# no-op
54			} elsif ($event->{error}->{-def}->{level} eq 'warn') {
55			warn $event->{error}->stringify;
56			$event->{cancel} = 1;
57			} else {
58			#warn $event->{error}->stringify; ## DEBUG
59			$event->{cancel} = 1;
60			}
61			}];
62			$self;
63			}
64
65			sub DESTROY ($) {
66			my $self = shift;
67	wakaba	1.6	local $Error::Depth = $Error::Depth + 1;
68	wakaba	1.5	$self->close if $self->{opened};
69			}
70
71			sub open_prop ($;%) {
72			my ($self, %opt) = @_;
73			return "0 but true" if $self->{opened}->{$opt{prop}};
74			if ($self->{lock} and not $self->{lock}->locked) {
75			$self->{lock}->lock
76			or report SuikaWiki::DB::Util::Error
77			-type => 'LOCK_START',
78			-object => $self, method => 'open_prop';
79			}
80			$self->___open_prop (\%opt);
81			$self->{opened}->{$opt{prop}} = 1;
82			report SuikaWiki::DB::Util::Error
83			-type => 'INFO_DB_PROP_OPENED',
84			-object => $self, method => 'open_prop',
85			prop => $opt{prop};
86			1;
87			}
88
89			sub ___open_prop ($$) {
90			my ($self, $opt) = @_;
91			local $Error::Depth = $Error::Depth + 1;
92			report SuikaWiki::DB::Util::Error
93			-type => 'DB_METHOD_NOT_IMPLEMENTED',
94			method => '___open_prop',
95			-object => $self,
96			prop => $opt->{prop};
97			}
98
99			sub close_prop ($;%) {
100			my ($self, %opt) = @_;
101			return "0 but true" unless $self->{opened}->{$opt{prop}};
102			$self->___close_prop (\%opt);
103			$self->{opened}->{$opt{prop}} = 0;
104			report SuikaWiki::DB::Util::Error
105			-type => 'INFO_DB_PROP_CLOSED',
106			-object => $self, method => 'close_prop',
107			prop => $opt{prop};
108			1;
109			}
110
111			sub ___close_prop ($$) {
112			my ($self, $opt) = @_;
113			local $Error::Depth = $Error::Depth + 1;
114			report SuikaWiki::DB::Util::Error
115			-type => 'DB_METHOD_NOT_IMPLEMENTED',
116			method => '___close_prop',
117			-object => $self,
118			prop => $opt->{prop};
119			}
120
121			sub close ($;%) {
122			my ($self, %opt) = @_;
123			{local $Error::Depth = $Error::Depth + 1;
124			for (CORE::keys %{$self->{opened}\|\|{}}) {
125			$self->close_prop (prop => $_);
126			}}
127	wakaba	1.6	delete $self->{opened};
128	wakaba	1.5	$self->{lock}->unlock if $self->{lock};
129			report SuikaWiki::DB::Util::Error
130			-type => 'DB_CLOSED',
131			method => 'close', -object => $self;
132			}
133
134			sub get ($$$;%) {
135			my ($self, $prop, $key, %opt) = @_;
136			report SuikaWiki::DB::Util::Error
137			-type => 'DB_METHOD_NOT_IMPLEMENTED',
138			method => 'get',
139			-object => $self;
140			}
141
142			sub set ($$$$;%) {
143			my ($self, $prop, $key => $value, %opt) = @_;
144			report SuikaWiki::DB::Util::Error
145			-type => 'DB_METHOD_NOT_IMPLEMENTED',
146			method => 'set',
147			-object => $self;
148			}
149
150			sub exist ($$$;%) {
151			my ($self, $prop, $key, %opt) = @_;
152			report SuikaWiki::DB::Util::Error
153			-type => 'DB_METHOD_NOT_IMPLEMENTED',
154			method => 'exist',
155			-object => $self;
156			}
157
158			sub delete ($$$;%) {
159			my ($self, $prop, $key, %opt) = @_;
160			report SuikaWiki::DB::Util::Error
161			-type => 'DB_METHOD_NOT_IMPLEMENTED',
162			method => 'delete',
163			-object => $self;
164			}
165
166			sub keys ($$;%) {
167			my ($self, $prop, %opt) = @_;
168			report SuikaWiki::DB::Util::Error
169			-type => 'DB_METHOD_NOT_IMPLEMENTED',
170			method => 'delete',
171			-object => $self;
172			}
173	wakaba	1.2
174	wakaba	1.5	sub ___report_error ($$) {
175			my ($self, $err) = @_;
176	wakaba	1.7	my $event = {cancel => 0, name => 'error', error => $err};
177	wakaba	1.5	for (@{$self->{event}->{error}}) {
178			$_->($self, $event);
179			return if $event->{cancel};
180			}
181			$err->throw;
182			}
183	wakaba	1.2
184	wakaba	1.5	=head1 SEE ALSO
185	wakaba	1.2
186	wakaba	1.5	L<SuikaWiki::DB>, L<SuikaWiki::DB::Util::Lock>
187	wakaba	1.2
188			=head1 LICENSE
189
190	wakaba	1.5	Copyright 2003 Wakaba <w@suika.fam.cx>
191	wakaba	1.2
192			This program is free software; you can redistribute it and/or
193			modify it under the same terms as Perl itself.
194
195			=cut
196
197	wakaba	1.7	1; # $Date: 2003/12/06 02:19:36 $