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