目次 †
- -
関連 †
検索:FlyweightFactory
FlyweightFactory周辺のタグ †
ArrayFlyweightFactoryとは †
CGI/FlyweightFactory[?]
PageFactoryとは †
シングルトン。
ファイルを扱うクラス。DBMSの役目を持つ。
オブジェクトの永続化(ファイル化)と復帰を行うクラス。
参考 †
インデックス †
インデックス更新時 †
インデックス更新時、オブジェクトから属性値を得て、すべてのインデックスを更新。
キー(属性値)→{オブジェクトID}
オブジェクトIDの1つを削除したり、追加したり、
インデックスの更新=各インデックスから削除・追加すること
インデックス †
インデックスに含めるもの、インデックスのキーにするものはインデックス作成側が決める。固定。
キー毎に複数作成。
オブジェクトID→永続化されたオブジェクト名(ファイル名)も含む。
インデックス更新時はインデックス自身の更新日時も更新。
キーは
インデックス作成に必要なものは †
- オブジェクト1つ以上
- インデックスに含める情報は何か?
これは固定。インデックス側が決める。 - オブジェクトID→ファイル名
オブジェクトIDをファイル名に変換するルールはあるが、ルールだけではオブジェクトID→ファイル名はできないので、データとしても残す。
(ファイル名が重複して末尾に連番を付けたときなどに必要)
インデックスは1つのキーで複数のオブジェクトが得られるからこそ効率がいい †
インデックスの更新日時 †
オブジェクトID→更新日時(1対1)
ファイル名→ファイルの更新日時(ファイル拡張子.idxmtime)でいい。
比較相手もファイルの更新日時なので。
DB †
Data::Dumperで。
データベースの使われ方 †
- クラス名 → オブジェクトのリスト または 空リスト (下位クラスのオブジェクト含む)
- (キー名(属性名),値)の集合 → オブジェクトのリスト または 空リスト (キー名には「オブジェクトID」を含む)
- オブジェクトのリスト → 戻り値なし(インデックス更新)
- 全オブジェクトのインデックス更新(未更新分のみ)
- 全オブジェクトのインデックス更新(本当にすべてのオブジェクト分)
プロトタイプ †
package FlyweightFactory; package PageFactory;
use strict; use warnings;
use POSIX; use Storable qw/lock_nstore lock_retrieve/; use Safe; use Toolkit;
my %Index; $Index{classname} = {}; $Index{mtime} = {}; $Index{file} = {}; $Index{class} = {}; $Index{id} = {}; # BEGIN { # @AnyDBM_File::ISA = qw/DB_File GDBM_File NDBM_File/; # } # use AnyDBM_File;
sub new my $safe = new Safe; # because of opcodes used in "use strict": $safe->permit(qw(:default require)); local $Storable::Deparse = 1; local $Storable::Eval = sub { $safe->reval($_[0]) };
my $instance = undef;
sub _New { my $class = shift; my $self = {}; bless $self, $class;
my $class = shift;
my $self = {};
bless $self, $class;
}
sub Singleton {
my $class = shift;
if (not defined $instance){
$instance = $class->_New();
}
$instance;
}
# クラス名 → オブジェクトのリスト または 空リスト (下位クラスのオブジェクト含む) # FetchObjects(ClassName) -> @Obj sub FetchObjects_ByClassName { my $self = shift; my($class) = @_; my @ret = (); foreach my $obj_id (@{$Index{classname}->{$class}}){ push @ret, retrieve($obj_id); } @ret;
my $self = shift;
my($class) = @_;
my $index = $self->Retrieve_Index('index.db');
my @ret = ();
foreach my $obj_id (keys %{$index->{class}->{$class}}){
push @ret, $self->Retrieve($obj_id);
}
@ret;
}
# (キー名(属性名),値)の集合 → オブジェクトのリスト または 空リスト (キー名には「オブジェクトID」を含む) # FindObjects({key, value}) -> @Obj sub FindObjects # # 引数はOR条件の集合。 # # FetchObjects({key, value}) -> @Obj # sub FetchObjects # { # my $self = shift; # my($keyvalue) = @_; # # my $index = $self->Retrieve_Index('index.db'); # # my @ret = (); # foreach my $key (keys %{$keyvalue}){ # my $value = $keyvalue->{$key}; # foreach my $obj_id (keys %{$index->{$key}->{$value}}){ # my $obj = $self->Retrieve($obj_id); # if ($obj){ # push @ret, $obj; # } # } # } # # my %h = (); # return grep { not $h{$_}++ } @ret; # }
# 引数はAND条件の集合。 # FetchObjects({key, value}) -> @Obj sub FetchObjects { my $self = shift; my($keyvalue) = @_; my @ret; my($key, $value); while (($key, $value) = each %{$keyvalue}){ my @ret_part = (); foreach my $obj_id (@{$Index{$key}->{$value}}){ my $obj = retrieve($obj_id); if ($obj){ push @ret_part, retrieve($obj_id); } } @ret = intersection(\@ret, \@ret_part); } @ret;
my $self = shift;
my($keyvalue) = @_;
### assert:ref $keyvalue eq 'HASH'
my @ret;
my $index = $self->Retrieve_Index('index.db');
@ret = ();
{
my($key, $value) = each %{$keyvalue};
delete $keyvalue->{$key};
foreach my $obj_id (keys %{$index->{$key}->{$value}}){
my $obj = $self->Retrieve($obj_id);
if ($obj){
push @ret, $obj;
}
}
}
foreach my $key (keys %{$keyvalue}){
my $value = $keyvalue->{$key};
my @ret_part = ();
foreach my $obj_id (keys %{$index->{$key}->{$value}}){
my $obj = $self->Retrieve($obj_id);
if ($obj){
push @ret_part, $obj;
}
}
@ret = (@ret == 0) ? @ret_part : $self->Intersection(\@ret, \@ret_part);
}
@ret;
}
# FetchObject('key=value,key=value') -> @Obj sub FetchObject sub InitializeIndex { my $self = shift; my($keyvalue) = @_; my @keyvalue_list = split /, */, $keyvalue; my @ret; my($key, $value); while (($key, $value) = split /=/, shift(@keyvalue_list)){ ### assert:$key and $value my @ret_part = (); foreach my $obj_id (@{$Index{$key}->{$value}}){ my $obj = retrieve($obj_id); if ($obj){ push @ret_part, retrieve($obj_id); } } @ret = intersection(\@ret, \@ret_part); } @ret;
my $self = shift;
my $index = {
mtime => {},
file => {},
class => {},
id => {},
};
$self->Store_Index($index, 'index.db');
}
# UpdateIndexesForce(@Obj) sub UpdateIndexesForce {
my $self = shift;
my(@object) = @_;
my $index = $self->Retrieve_Index('index.db');
foreach my $obj (@object){
### assert:exists $obj->{id}
### assert:exists $obj->{mtime}
### assert:exists $obj->{class}
{
my $key = $obj->{id};
$index->{id}->{$key} = {$obj->{id} => undef};
}
{
my $key = $obj->{mtime};
$index->{mtime}->{$key} = {$obj->{id} => undef};
}
{
my $key = $obj->{class};
$index->{class}->{$key} = {$obj->{id} => undef};
}
}
$self->Store_Index($index, 'index.db');
undef;
}
# オブジェクトのリスト → 戻り値なし(インデックス更新) # UpdateIndexes(@Obj) sub UpdateIndexes { my $self = shift; my(@object) = @_; foreach my $obj (@object){ if ($obj->{mtime} > $Index{mtime}->{$obj->{id}}){ $self->UpdateIndexesForce($obj); } } undef;
my $self = shift;
my(@object) = @_;
my $index = $self->Retrieve_Index('index.db');
foreach my $obj (@object){
### assert:exists $obj->{mtime}
### assert:exists $obj->{id}
if (exists $index->{mtime}->{$obj->{id}} and $obj->{mtime} > $index->{mtime}->{$obj->{id}}){
$self->UpdateIndexesForce($obj);
}
}
undef;
}
# UpdateIndexesForce(@Obj) sub UpdateIndexesForce { my $self = shift; my(@object) = @_; foreach my $obj (@object){ { my $idx = $Index{file}; my $key = $obj->{file}; my @id = grep {$_ ne $obj->{id}} split(/, */, $idx->{$key}); unshift @id, $obj->{id}; $idx->{$key} = join(',', $obj->{id}); } { my $idx = $Index{class}; my $key = $obj->{class}; my @id = grep {$_ ne $obj->{id}} split(/, */, $idx->{$key}); unshift @id, $obj->{id}; $idx->{$key} = join(',', $obj->{id}); } } undef; }
# 全オブジェクトのインデックス更新(未更新分のみ) # UpdateAllIndex() sub UpdateAllIndex { my $self = shift; { #全てのオブジェクトを得る my($obj_id); while ((undef, $obj_id) = each %{$Index{id}}){ my $obj = retrieve($obj_id); #更新日時がインデックスのそれよりも新しいオブジェクトについてインデックス作成 if ($obj->{mtime} > $Index{mtime}->{$obj->{id}}){ $self->UpdateIndexesForce($obj); } } } undef;
my $self = shift;
{
#全てのオブジェクトを得る
my $index = $self->Retrieve_Index('index.db');
my($obj_id);
while (($obj_id, undef) = each %{$index->{id}}){
my $obj = $self->Retrieve($obj_id);
#更新日時がインデックスのそれよりも新しいオブジェクトについてインデックス作成
if (exists $index->{mtime}->{$obj->{id}} and $obj->{mtime} > $index->{mtime}->{$obj->{id}}){
$self->UpdateIndexesForce($obj);
}
}
}
undef;
}
# 全オブジェクトのインデックス更新(本当にすべてのオブジェクト分) # UpdateAllIndexForce() sub UpdateAllIndexForce { my $self = shift; { #全てのオブジェクトを得る my($obj_id); while ((undef, $obj_id) = each %{$Index{id}}){ #それぞれのインデックス作成 my $obj = retrieve($obj_id); $self->UpdateIndexesForce($obj); } } undef;
my $self = shift;
{
#全てのオブジェクトを得る
my $index = $self->Retrieve_Index('index.db');
my($obj_id);
while (($obj_id, undef) = each %{$index->{id}}){
#それぞれのインデックス作成
my $obj = $self->Retrieve($obj_id);
$self->UpdateIndexesForce($obj);
}
}
undef;
}
sub dump sub Store { my($arg) = @_; use Data::Dumper; return Dumper($arg);
my $self = shift;
my($obj) = @_;
### assert:defined $obj
### assert:exists $obj->{id} && defined $obj->{id}
# lock_nstore $obj, $self->_Id2NewFilename($obj->{id});
{
use Data::Dumper qw/Dumper/;
$Data::Dumper::Indent = 3;
$Data::Dumper::Terse = 1;
open my $fh, '>', $self->_Id2NewFilename($obj->{id}) or die $!;
flock $fh, LOCK_EX;
print $fh Dumper $obj;
close $fh;
}
$self->UpdateIndexesForce($obj);
undef;
}
sub Retrieve {
my $self = shift;
my($filename) = @_;
### assert:$filename
my $obj;
# lock_retrieve $filename;
{
### Retieve from:$filename
open my $fh, '<', $filename or die $!;
flock $fh, LOCK_SH;
my $fc = join '', <$fh>;
close $fh;
$obj = $safe->reval($fc);
}
$obj;
}
sub _Id2NewFilename {
my $self = shift;
my($id) = @_;
my $filename = $id;
#TODO:既存IDの場合、そのファイル名を返す。そうでない場合は存在しないファイル名を返す。
#TODO:そのファイルが既存だったとき、さらに新しい名を返す。
$filename;
}
sub Store_Index {
my $self = shift;
my($obj, $filename) = @_;
### assert:defined $obj
### assert:defined $filename
# lock_nstore $obj, $filename;
{
use Data::Dumper qw/Dumper/;
$Data::Dumper::Indent = 3;
$Data::Dumper::Terse = 1;
open my $fh, '>', $filename or die $!;
flock $fh, LOCK_EX;
print $fh Dumper $obj;
close $fh;
}
undef;
}
sub Retrieve_Index {
my $self = shift;
my($filename) = @_;
### assert:$filename
my $obj;
# lock_retrieve $filename;
{
open my $fh, '<', $filename or die $!;
flock $fh, LOCK_SH;
my $fc = join '', <$fh>;
close $fh;
$obj = $safe->reval($fc);
}
$obj;
}
#FIXME:移動 sub Intersection {
my $self = shift;
### assert:ref $_[0] eq 'ARRAY'
### assert:ref $_[1] eq 'ARRAY'
my %h = ();
$h{$_} = undef foreach @{$_[1]};
return grep { exists $h{$_} } @{$_[0]};
}
1;