DB/Logical/WithStruct.pm


=head1 NAME

SuikaWiki::DB::Logical::WithStruct - "Structured cache" binded database

=head1 DESCRIPTION


This module is part of SuikaWiki.

=cut

package SuikaWiki::DB::Logical::WithStruct;
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, %opt) = @_;
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    my $db = $self->{prop}->{$prop}->{-db};
    unless ($opt{struct}) {
      return $db->get ($prop, $key, %opt);
    } else {
      my $sprop = $prop.'__struct_cache';
      unless ($self->{opened}->{$sprop}) {
        $self->open_prop (prop => $sprop);
      }
      my $sdb = $self->{prop}->{$sprop}->{-db};
      my $sdata = $sdb->get ($sprop, $key, %opt);
      if ($db->_content_id ($prop, $key, %opt) eq $sdata->{content_id}) {
        return $sdata->{value};
      } else {
        $sdb->delete ($sprop, $key, %opt);
        return undef;
      }
    }
  } else {
    return undef;
  }
}

sub set ($$$$;%) {
  my ($self, $prop, $key => $value, %opt) = @_;
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    my $db = $self->{prop}->{$prop}->{-db};
    my $sprop = $prop.'__struct_cache';
    unless ($self->{opened}->{$sprop}) {
      $self->open_prop (prop => $sprop);
    }
    my $sdb = $self->{prop}->{$sprop}->{-db};
    unless ($opt{struct}) {
      $sdb->delete ($sprop, $key);
      return $db->set ($prop, $key => $value, %opt);
    } else {
      return $sdb->set ($sprop,
                        $key => {content_id => $db->_content_id ($prop, $key),
                                 value => $value}, %opt);
    }
  } else {
    report SuikaWiki::DB::Util::Error
      -type => 'KEY_SAVE',
      -object => $self, method => 'set',
      prop => $prop, key => $key;
  }
}

sub exist ($$$;%) {
  my ($self, $prop, $key, %opt) = @_;
  $prop .= '__struct_cache' if $opt{struct};
  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 ($prop, $key, %opt);
  } else {
    return 0;
  }
}

sub delete ($$$;%) {
  my ($self, $prop, $key, %opt) = @_;
  $prop .= '__struct_cache' if $opt{struct};
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    return $self->{prop}->{$prop}->{-db}->delete ($prop, $key, %opt);
  }
}

sub keys ($$;%) {
  my ($self, $prop, %opt) = @_;
  $prop .= '__struct_cache' if $opt{struct};
  if ($self->{prop}->{$prop}) {
    local $Error::Depth = $Error::Depth + 1;
    unless ($self->{opened}->{$prop}) {
      $self->open_prop (prop => $prop);
    }
    return $self->{prop}->{$prop}->{-db}->keys ($prop, %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.

=back

=cut

sub _set_prop_db ($$$) {
  my ($self, $prop, $db_and_opt) = @_;
  $self->{prop}->{$prop} = $db_and_opt;
  $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 ___open_prop ($$) {
  my ($self, $opt) = @_;
  return "0 but true" if defined $self->{prop}->{$opt->{prop}}->{-db};
  local $Error::Depth = $Error::Depth + 2;
  report SuikaWiki::DB::Util::Error
    -type => 'STOP_DB_PROP_CANT_OPEN__NOT_DEFINED',
    -object => $self, method => 'open_prop',
    prop => $opt->{prop}
    and return 0
    unless $self->{prop}->{$opt->{prop}}->{-db} or
           $self->{prop}->{$opt->{prop}}->{-db_open};
  $self->{prop}->{$opt->{prop}}->{-db} 
    ||= $self->{prop}->{$opt->{prop}}->{-db_open}->(metadb => $self);
  if ($opt->{prop} !~ /__struct_cache$/) {
    report SuikaWiki::DB::Util::Error
      -type => 'STOP_DB_PROP_CANT_OPEN__REQUIRED_METHOD_NOT_DEFINED',
      -object => $self, method => 'open_prop',
      prop => $opt->{prop}, method_name => '_content_id'
      and return 0
      unless $self->{prop}->{$opt->{prop}}->{-db}->can ('_content_id');
  }
  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;
}

=back

=head1 LICENSE

Copyright 2003-2004 Wakaba <[email protected]>.  All rights reserved.

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::WithStruct - "Structured cache" binded database
5
6			=head1 DESCRIPTION
7
8
9
10			This module is part of SuikaWiki.
11
12			=cut
13
14			package SuikaWiki::DB::Logical::WithStruct;
15			use strict;
16			our $VERSION=do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
17			require SuikaWiki::DB::Util;
18			push our @ISA, 'SuikaWiki::DB::Util::template';
19
20			# new: inherited
21
22			sub get ($$$;%) {
23			my ($self, $prop, $key, %opt) = @_;
24			if ($self->{prop}->{$prop}) {
25			local $Error::Depth = $Error::Depth + 1;
26			unless ($self->{opened}->{$prop}) {
27			$self->open_prop (prop => $prop);
28			}
29			my $db = $self->{prop}->{$prop}->{-db};
30			unless ($opt{struct}) {
31			return $db->get ($prop, $key, %opt);
32			} else {
33			my $sprop = $prop.'__struct_cache';
34			unless ($self->{opened}->{$sprop}) {
35			$self->open_prop (prop => $sprop);
36			}
37			my $sdb = $self->{prop}->{$sprop}->{-db};
38			my $sdata = $sdb->get ($sprop, $key, %opt);
39			if ($db->_content_id ($prop, $key, %opt) eq $sdata->{content_id}) {
40			return $sdata->{value};
41			} else {
42			$sdb->delete ($sprop, $key, %opt);
43			return undef;
44			}
45			}
46			} else {
47			return undef;
48			}
49			}
50
51			sub set ($$$$;%) {
52			my ($self, $prop, $key => $value, %opt) = @_;
53			if ($self->{prop}->{$prop}) {
54			local $Error::Depth = $Error::Depth + 1;
55			unless ($self->{opened}->{$prop}) {
56			$self->open_prop (prop => $prop);
57			}
58			my $db = $self->{prop}->{$prop}->{-db};
59			my $sprop = $prop.'__struct_cache';
60			unless ($self->{opened}->{$sprop}) {
61			$self->open_prop (prop => $sprop);
62			}
63			my $sdb = $self->{prop}->{$sprop}->{-db};
64			unless ($opt{struct}) {
65			$sdb->delete ($sprop, $key);
66			return $db->set ($prop, $key => $value, %opt);
67			} else {
68			return $sdb->set ($sprop,
69			$key => {content_id => $db->_content_id ($prop, $key),
70			value => $value}, %opt);
71			}
72			} else {
73			report SuikaWiki::DB::Util::Error
74			-type => 'KEY_SAVE',
75			-object => $self, method => 'set',
76			prop => $prop, key => $key;
77			}
78			}
79
80			sub exist ($$$;%) {
81			my ($self, $prop, $key, %opt) = @_;
82			$prop .= '__struct_cache' if $opt{struct};
83			if ($self->{prop}->{$prop}) {
84			local $Error::Depth = $Error::Depth + 1;
85			unless ($self->{opened}->{$prop}) {
86			$self->open_prop (prop => $prop);
87			}
88			return $self->{prop}->{$prop}->{-db}->exist ($prop, $key, %opt);
89			} else {
90			return 0;
91			}
92			}
93
94			sub delete ($$$;%) {
95			my ($self, $prop, $key, %opt) = @_;
96			$prop .= '__struct_cache' if $opt{struct};
97			if ($self->{prop}->{$prop}) {
98			local $Error::Depth = $Error::Depth + 1;
99			unless ($self->{opened}->{$prop}) {
100			$self->open_prop (prop => $prop);
101			}
102			return $self->{prop}->{$prop}->{-db}->delete ($prop, $key, %opt);
103			}
104			}
105
106			sub keys ($$;%) {
107			my ($self, $prop, %opt) = @_;
108			$prop .= '__struct_cache' if $opt{struct};
109			if ($self->{prop}->{$prop}) {
110			local $Error::Depth = $Error::Depth + 1;
111			unless ($self->{opened}->{$prop}) {
112			$self->open_prop (prop => $prop);
113			}
114			return $self->{prop}->{$prop}->{-db}->keys ($prop, %opt);
115			} else {
116			return ();
117			}
118			}
119
120			# close: Inherited
121
122			=head1 METHODS
123
124			This module provides common interface of SuikaWiki WikiDatabase
125			modules. See documentation of C<SuikaWiki::DB>.
126
127			In addition, this module implements additional methods.
128
129			=over 4
130
131			=item _set_prop_db ($prop_name, {options})
132
133			Addosiates actual database with property name of this logical (virtual)
134			database, or remove its association by specifying C<undef> instead of
135			C<{options}>.
136
137			Options:
138
139			=over 4
140
141			=item -db => $database_instance (REQUIRED)
142
143			Instance of database module, which implements common WikiDatabase interface.
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			$db_and_opt->{-db_close} \|\|= sub {
153			my %opt = @_;
154			local $Error::Depth = $Error::Depth + 1;
155			$opt{prop_info}->{-db}->close_prop (prop => $opt{prop_info}->{-prop});
156			};
157			}
158
159			sub ___open_prop ($$) {
160			my ($self, $opt) = @_;
161			return "0 but true" if defined $self->{prop}->{$opt->{prop}}->{-db};
162			local $Error::Depth = $Error::Depth + 2;
163			report SuikaWiki::DB::Util::Error
164			-type => 'STOP_DB_PROP_CANT_OPEN__NOT_DEFINED',
165			-object => $self, method => 'open_prop',
166			prop => $opt->{prop}
167			and return 0
168			unless $self->{prop}->{$opt->{prop}}->{-db} or
169			$self->{prop}->{$opt->{prop}}->{-db_open};
170			$self->{prop}->{$opt->{prop}}->{-db}
171			\|\|= $self->{prop}->{$opt->{prop}}->{-db_open}->(metadb => $self);
172			if ($opt->{prop} !~ /__struct_cache$/) {
173			report SuikaWiki::DB::Util::Error
174			-type => 'STOP_DB_PROP_CANT_OPEN__REQUIRED_METHOD_NOT_DEFINED',
175			-object => $self, method => 'open_prop',
176			prop => $opt->{prop}, method_name => '_content_id'
177			and return 0
178			unless $self->{prop}->{$opt->{prop}}->{-db}->can ('_content_id');
179			}
180			1;
181			}
182
183			sub ___close_prop ($$) {
184			my ($self, $opt) = @_;
185			return "0 but true" unless $self->{opened}->{$opt->{prop}};
186			local $Error::Depth = $Error::Depth + 2;
187			$self->{prop}->{$_}->{-db_close}->(metadb => $self,
188			prop_info => $self->{prop}->{$_});
189			delete $self->{prop}->{$_}->{-db}
190			if $self->{prop}->{$_}->{-db_open};
191			1;
192			}
193
194			=back
195
196			=head1 LICENSE
197
198			Copyright 2003-2004 Wakaba <[email protected]>. All rights reserved.
199
200			This program is free software; you can redistribute it and/or
201			modify it under the same terms as Perl itself.
202
203			=cut
204
205			1; # $Date: 2003/12/06 02:19:09 $