SuikaWiki/DB/Logical.pm


=head1 NAME

SuikaWiki::DB::Logical --- SuikaWiki WikiDatabase: Logical database consists of multiple datasources

=head1 DESCRIPTION

This module provides a logical database implementation.  It does not itself have
physical datasource at all.  With database property name asspcoatopms, multiple 
database instances that have common WikiDatabase interface can be used as 
datasources.

This module is part of SuikaWiki.

=cut

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

# new: inherited

sub get ($$$) {
  my ($self, $prop, $key) = @_;
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    return $self->{prop}->{$prop}->{-db}->get 
      ($self->{prop}->{$prop}->{-prop}->($self, $prop, $key),
       $self->{prop}->{$prop}->{-key_mapper}->($self, $key));
  } else {
    return undef;
  }
}

sub set ($$$$) {
  my ($self, $prop, $key => $value) = @_;
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    $self->{prop}->{$prop}->{-db}->set
      ($self->{prop}->{$prop}->{-prop}->($self, $prop, $key),
       $self->{prop}->{$prop}->{-key_mapper}->($self, $key) => $value);
  } else {
    report SuikaWiki::DB::Util::Error
      -type => 'KEY_SAVE',
      -object => $self, method => 'set',
      prop => $prop, key => $key;
  }
}

sub exist ($$$) {
  my ($self, $prop, $key) = @_;
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    return $self->{prop}->{$prop}->{-db}->exist
      ($self->{prop}->{$prop}->{-prop}->($self, $prop, $key),
       $self->{prop}->{$prop}->{-key_mapper}->($self, $key));
  } else {
    return 0;
  }
}

sub delete ($$$) {
  my ($self, $prop, $key) = @_;
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    $self->{prop}->{$prop}->{-db}->delete
      ($self->{prop}->{$prop}->{-prop}->($self, $prop, $key),
       $self->{prop}->{$prop}->{-key_mapper}->($self, $key));
  }
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    $opt{-ns} = $self->{prop}->{$prop}->{-key_mapper}->($self, $opt{-ns});
    return
      map {$self->{prop}->{$prop}->{-key_rev_mapper}->($self, $_)}
      $self->{prop}->{$prop}->{-db}->keys
      ($self->{prop}->{$prop}->{-prop}->($self, $prop, undef), %opt);
  } else {
    return ();
  }
}

# close: Inherited

=head1 METHODS

This module provides common interface of SuikaWiki WikiDatabase
modules. See documentation of C<SuikaWiki::DB>.

In addition, this module implements additional methods.

=over 4

=item _set_prop_db ($prop_name, {options})

Addosiates actual database with property name of this logical (virtual)
database, or remove its association by specifying C<undef> instead of
C<{options}>.

Options:

=over 4

=item -db => $database_instance (REQUIRED)

Instance of database module, which implements common WikiDatabase interface.

=item -prop => sub ($self, $prop_name, $key) {property_name} (Default: sub {$prop_name})

Property name used to access to $database_instance.  With this option,
different property name from datasource's one can be used,
eg. maps $prop_name eq 'subdb_foo' to $property_name eq 'foo'.

=item -key_mapper => sub ($self, $key) {key} (Default: sub {$key})

Mapper from this virtual database's keyname to sub database's one.

=item -key_rev_mapper => sub ($self, $key) (Default: sub {$key})

Mapper from sub database's keyname to this virtual database's keyname.

Note that -key_mapper (-key_rev_mapper ($key)) need not equal to $key,
although it seems an unusual case.

=back

=cut

sub _set_prop_db ($$$) {
  my ($self, $prop, $db_and_opt) = @_;
  $self->{prop}->{$prop} = $db_and_opt;
  $db_and_opt->{-prop} ||= sub {$prop};
  $db_and_opt->{-key_mapper} ||= \&__default_key_mapper;
  $db_and_opt->{-key_rev_mapper} ||= \&__default_key_rev_mapper;
  $db_and_opt->{-db_close} ||= sub {
    my %opt = @_;
    local $Error::Depth = $Error::Depth + 1;
    $opt{prop_info}->{-db}->close_prop (prop => $opt{prop_info}->{-prop});
  };
}

sub __default_key_mapper ($$) {
  #my ($self, $key) = @_;
  #$key;
  $_[1];
}
sub __default_key_rev_mapper ($$) {
  #my ($self, $key) = @_;
  #$key;
  $_[1];
}

sub ___open_prop ($$) {
  my ($self, $opt) = @_;
  return "0 but true" if defined $self->{prop}->{$opt->{prop}}->{-db};
  local $Error::Depth = $Error::Depth + 2;
  $self->{prop}->{$opt->{prop}}->{-db} 
    = $self->{prop}->{$opt->{prop}}->{-db_open}->(metadb => $self);
  1;
}

sub ___close_prop ($$) {
  my ($self, $opt) = @_;
  return "0 but true" unless $self->{opened}->{$opt->{prop}};
  local $Error::Depth = $Error::Depth + 2;
  $self->{prop}->{$_}->{-db_close}->(metadb => $self, 
                                     prop_info => $self->{prop}->{$_});
  delete $self->{prop}->{$_}->{-db}
    if $self->{prop}->{$_}->{-db_open};
  1;
}

sub _do ($$$;@) {
  my ($self, $prop, $method) = (shift, shift, shift);
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    
    my $m = $self->{prop}->{$prop}->{-db}->can ($method);
    if ($m) {
      unshift @_, $self->{prop}->{$prop}->{-db};
      goto &$m;
      return;
    } else {
      my $m = $self->{prop}->{$prop}->{-db}->can ('_do');
      if ($m) {
        unshift @_, $self->{prop}->{$prop}->{-db},
                    $self->{prop}->{$prop}->{-prop}
                         ->($self, $prop, undef, method => $method),
                    $method;
        goto &$m;
        return;
      }
    }
    report SuikaWiki::DB::Util::Error
      -type => 'DB_METHOD_NOT_IMPLEMENTED',
      method => $method,
      -object => $self,
      prop => $prop;
  } else {
    report SuikaWiki::DB::Util::Error
      -type => 'PROP_NOT_OPENED',
      method => $method,
      -object => $self,
      prop => $prop;
  }
}

=back

=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:09 $
1	wakaba	1.1
2			=head1 NAME
3
4			SuikaWiki::DB::Logical --- SuikaWiki WikiDatabase: Logical database consists of multiple datasources
5
6			=head1 DESCRIPTION
7
8			This module provides a logical database implementation. It does not itself have
9			physical datasource at all. With database property name asspcoatopms, multiple
10			database instances that have common WikiDatabase interface can be used as
11			datasources.
12
13			This module is part of SuikaWiki.
14
15			=cut
16
17			package SuikaWiki::DB::Logical;
18	wakaba	1.2	use strict;
19	wakaba	1.5.2.1	our $VERSION=do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
20	wakaba	1.1	require SuikaWiki::DB::Util;
21	wakaba	1.5	push our @ISA, 'SuikaWiki::DB::Util::template';
22	wakaba	1.1
23	wakaba	1.5	# new: inherited
24	wakaba	1.1
25			sub get ($$$) {
26			my ($self, $prop, $key) = @_;
27			if ($self->{prop}->{$prop}) {
28	wakaba	1.5	local $Error::Depth = $Error::Depth + 1;
29			unless ($self->{opened}->{$prop}) {
30			$self->open_prop (prop => $prop);
31			}
32	wakaba	1.1	return $self->{prop}->{$prop}->{-db}->get
33	wakaba	1.5.2.1	($self->{prop}->{$prop}->{-prop}->($self, $prop, $key),
34	wakaba	1.5	$self->{prop}->{$prop}->{-key_mapper}->($self, $key));
35	wakaba	1.1	} else {
36			return undef;
37			}
38			}
39
40			sub set ($$$$) {
41			my ($self, $prop, $key => $value) = @_;
42			if ($self->{prop}->{$prop}) {
43	wakaba	1.5	local $Error::Depth = $Error::Depth + 1;
44			unless ($self->{opened}->{$prop}) {
45			$self->open_prop (prop => $prop);
46			}
47	wakaba	1.1	$self->{prop}->{$prop}->{-db}->set
48	wakaba	1.5.2.1	($self->{prop}->{$prop}->{-prop}->($self, $prop, $key),
49	wakaba	1.5	$self->{prop}->{$prop}->{-key_mapper}->($self, $key) => $value);
50	wakaba	1.1	} else {
51	wakaba	1.5	report SuikaWiki::DB::Util::Error
52			-type => 'KEY_SAVE',
53			-object => $self, method => 'set',
54			prop => $prop, key => $key;
55	wakaba	1.1	}
56			}
57
58			sub exist ($$$) {
59			my ($self, $prop, $key) = @_;
60			if ($self->{prop}->{$prop}) {
61	wakaba	1.5	local $Error::Depth = $Error::Depth + 1;
62			unless ($self->{opened}->{$prop}) {
63			$self->open_prop (prop => $prop);
64			}
65	wakaba	1.1	return $self->{prop}->{$prop}->{-db}->exist
66	wakaba	1.5.2.1	($self->{prop}->{$prop}->{-prop}->($self, $prop, $key),
67	wakaba	1.5	$self->{prop}->{$prop}->{-key_mapper}->($self, $key));
68	wakaba	1.1	} else {
69			return 0;
70			}
71			}
72
73			sub delete ($$$) {
74			my ($self, $prop, $key) = @_;
75			if ($self->{prop}->{$prop}) {
76	wakaba	1.5	local $Error::Depth = $Error::Depth + 1;
77			unless ($self->{opened}->{$prop}) {
78			$self->open_prop (prop => $prop);
79			}
80	wakaba	1.1	$self->{prop}->{$prop}->{-db}->delete
81	wakaba	1.5.2.1	($self->{prop}->{$prop}->{-prop}->($self, $prop, $key),
82	wakaba	1.5	$self->{prop}->{$prop}->{-key_mapper}->($self, $key));
83	wakaba	1.1	}
84			}
85
86			sub keys ($$;%) {
87			my ($self, $prop, %opt) = @_;
88			if ($self->{prop}->{$prop}) {
89	wakaba	1.5	local $Error::Depth = $Error::Depth + 1;
90			unless ($self->{opened}->{$prop}) {
91			$self->open_prop (prop => $prop);
92			}
93			$opt{-ns} = $self->{prop}->{$prop}->{-key_mapper}->($self, $opt{-ns});
94	wakaba	1.1	return
95	wakaba	1.5	map {$self->{prop}->{$prop}->{-key_rev_mapper}->($self, $_)}
96	wakaba	1.1	$self->{prop}->{$prop}->{-db}->keys
97	wakaba	1.5.2.1	($self->{prop}->{$prop}->{-prop}->($self, $prop, undef), %opt);
98	wakaba	1.1	} else {
99			return ();
100			}
101			}
102
103	wakaba	1.5	# close: Inherited
104	wakaba	1.1
105			=head1 METHODS
106
107			This module provides common interface of SuikaWiki WikiDatabase
108			modules. See documentation of C<SuikaWiki::DB>.
109
110			In addition, this module implements additional methods.
111
112			=over 4
113
114			=item _set_prop_db ($prop_name, {options})
115
116			Addosiates actual database with property name of this logical (virtual)
117			database, or remove its association by specifying C<undef> instead of
118			C<{options}>.
119
120			Options:
121
122			=over 4
123
124			=item -db => $database_instance (REQUIRED)
125
126			Instance of database module, which implements common WikiDatabase interface.
127
128	wakaba	1.5.2.1	=item -prop => sub ($self, $prop_name, $key) {property_name} (Default: sub {$prop_name})
129	wakaba	1.1
130			Property name used to access to $database_instance. With this option,
131			different property name from datasource's one can be used,
132			eg. maps $prop_name eq 'subdb_foo' to $property_name eq 'foo'.
133
134	wakaba	1.5.2.1	=item -key_mapper => sub ($self, $key) {key} (Default: sub {$key})
135	wakaba	1.1
136			Mapper from this virtual database's keyname to sub database's one.
137
138			=item -key_rev_mapper => sub ($self, $key) (Default: sub {$key})
139
140			Mapper from sub database's keyname to this virtual database's keyname.
141
142			Note that -key_mapper (-key_rev_mapper ($key)) need not equal to $key,
143			although it seems an unusual case.
144
145			=back
146
147			=cut
148
149			sub _set_prop_db ($$$) {
150			my ($self, $prop, $db_and_opt) = @_;
151			$self->{prop}->{$prop} = $db_and_opt;
152	wakaba	1.5.2.1	$db_and_opt->{-prop} \|\|= sub {$prop};
153	wakaba	1.1	$db_and_opt->{-key_mapper} \|\|= \&__default_key_mapper;
154			$db_and_opt->{-key_rev_mapper} \|\|= \&__default_key_rev_mapper;
155	wakaba	1.5	$db_and_opt->{-db_close} \|\|= sub {
156			my %opt = @_;
157			local $Error::Depth = $Error::Depth + 1;
158			$opt{prop_info}->{-db}->close_prop (prop => $opt{prop_info}->{-prop});
159			};
160	wakaba	1.1	}
161
162			sub __default_key_mapper ($$) {
163			#my ($self, $key) = @_;
164			#$key;
165			$_[1];
166			}
167			sub __default_key_rev_mapper ($$) {
168			#my ($self, $key) = @_;
169			#$key;
170			$_[1];
171			}
172
173	wakaba	1.5	sub ___open_prop ($$) {
174			my ($self, $opt) = @_;
175			return "0 but true" if defined $self->{prop}->{$opt->{prop}}->{-db};
176			local $Error::Depth = $Error::Depth + 2;
177			$self->{prop}->{$opt->{prop}}->{-db}
178			= $self->{prop}->{$opt->{prop}}->{-db_open}->(metadb => $self);
179			1;
180			}
181
182			sub ___close_prop ($$) {
183			my ($self, $opt) = @_;
184			return "0 but true" unless $self->{opened}->{$opt->{prop}};
185			local $Error::Depth = $Error::Depth + 2;
186			$self->{prop}->{$_}->{-db_close}->(metadb => $self,
187			prop_info => $self->{prop}->{$_});
188			delete $self->{prop}->{$_}->{-db}
189			if $self->{prop}->{$_}->{-db_open};
190			1;
191	wakaba	1.3	}
192
193	wakaba	1.5.2.1	sub _do ($$$;@) {
194			my ($self, $prop, $method) = (shift, shift, shift);
195			if ($self->{prop}->{$prop}) {
196			local $Error::Depth = $Error::Depth + 1;
197			unless ($self->{opened}->{$prop}) {
198			$self->open_prop (prop => $prop);
199			}
200
201			my $m = $self->{prop}->{$prop}->{-db}->can ($method);
202			if ($m) {
203			unshift @_, $self->{prop}->{$prop}->{-db};
204			goto &$m;
205			return;
206			} else {
207			my $m = $self->{prop}->{$prop}->{-db}->can ('_do');
208			if ($m) {
209			unshift @_, $self->{prop}->{$prop}->{-db},
210			$self->{prop}->{$prop}->{-prop}
211			->($self, $prop, undef, method => $method),
212			$method;
213			goto &$m;
214			return;
215			}
216			}
217			report SuikaWiki::DB::Util::Error
218			-type => 'DB_METHOD_NOT_IMPLEMENTED',
219			method => $method,
220			-object => $self,
221			prop => $prop;
222			} else {
223			report SuikaWiki::DB::Util::Error
224			-type => 'PROP_NOT_OPENED',
225			method => $method,
226			-object => $self,
227			prop => $prop;
228			}
229			}
230
231	wakaba	1.1	=back
232
233			=head1 LICENSE
234
235			Copyright 2003 Wakaba <w@suika.fam.cx>
236
237			This program is free software; you can redistribute it and/or
238			modify it under the same terms as Perl itself.
239
240			=cut
241
242	wakaba	1.5.2.1	1; # $Date: 2003/12/06 02:19:09 $