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
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	package SuikaWiki::DB::Util;
16	use strict;
17	our $VERSION=do{my @r=(q$Revision: 1.8 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
18	our $Err;
19	require SuikaWiki::DB::Util::Error;
20
21	=head1 FUNCTIONS
22
23	=over 4
24
25	=item $locker = SuikaWiki::DB::Util->new_lock ($options)
26
27	Returns new locker object (SuikaWiki::DB::Util::Lock instance).
28
29	=cut
30
31	sub new_lock ($$) {
32	eval qq{ require $_[1]->{-module} } or die $@;
33	return $_[1]->{-module}->new (%{$_[1]});
34	}
35
36	=back
37
38	=cut
39
40	## 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	$self->___init (%opt);
47	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	sub ___init ($%) {}
67
68	sub DESTROY ($) {
69	my $self = shift;
70	local $Error::Depth = $Error::Depth + 1;
71	$self->close if $self->{opened};
72	}
73
74	sub open ($;%) {
75	shift->{opened} ? "0 but true" : 0;
76	}
77
78	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	delete $self->{opened};
135	$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
181	sub ___report_error ($$) {
182	my ($self, $err) = @_;
183	my $event = {cancel => 0, name => 'error', error => $err};
184	for (@{$self->{event}->{error}}) {
185	$_->($self, $event);
186	return if $event->{cancel};
187	}
188	$err->throw;
189	}
190
191	=head1 SEE ALSO
192
193	L<SuikaWiki::DB>, L<SuikaWiki::DB::Util::Lock>
194
195	=head1 LICENSE
196
197	Copyright 2003 Wakaba <w@suika.fam.cx>
198
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	1; # $Date: 2004/03/19 11:23:55 $