- 追加された行はこの色です。
- 削除された行はこの色です。
RIGHT:&tag(クラス,設計,フレームワーク,CGI);
*目次 [#zf7e2b15]
#contents
----
#lsx(new=true);
*関連 [#se5e42f2]
#lsx(tag=FlyweightFactory,new=true,except=^FlyweightFactory(/.*)?$)
検索:FlyweightFactory
*FlyweightFactory周辺のタグ [#tc936eee]
#tag(0,FlyweightFactory)
*FlyweightFactoryとは [#g800cfe7]
RIGHT:[[:t/FlyweightFactory]]
[[CGI/FlyweightFactory]]
シングルトン。
ファイルを扱うクラス。DBMSの役目を持つ。
オブジェクトの永続化（ファイル化）と復帰を行うクラス。
**参考 [#y989716e]
#lsx(prefix=フレームワーク,new=true)
**インデックス [#we60b271]
***インデックス更新時 [#n3c3c3ad]
インデックス更新時、オブジェクトから属性値を得て、すべてのインデックスを更新。
キー（属性値）→{オブジェクトID}
オブジェクトIDの1つを削除したり、追加したり、
インデックスの更新＝各インデックスから削除・追加すること
***インデックス [#ofb342e8]
インデックスに含めるもの、インデックスのキーにするものはインデックス作成側が決める。固定。
キー毎に複数作成。
オブジェクトID→永続化されたオブジェクト名（ファイル名）も含む。
インデックス更新時はインデックス自身の更新日時も更新。
キーは
-オブジェクトID
-永続化時のファイル名（ほとんどの場合、オブジェクトIDと同じ）
-クラス名
-ページ名（Unicode）
-他
***インデックス作成に必要なものは [#lb38e030]
-オブジェクト1つ以上
-インデックスに含める情報は何か？
これは固定。インデックス側が決める。
-オブジェクトID→ファイル名
オブジェクトIDをファイル名に変換するルールはあるが、ルールだけではオブジェクトID→ファイル名はできないので、データとしても残す。
（ファイル名が重複して末尾に連番を付けたときなどに必要）
***インデックスは1つのキーで複数のオブジェクトが得られるからこそ効率がいい [#cf5abaf5]
***インデックスの更新日時 [#l9d65773]
オブジェクトID→更新日時（1対1）
ファイル名→ファイルの更新日時（ファイル拡張子.idxmtime）でいい。
比較相手もファイルの更新日時なので。
**DB [#t19652ce]
Data::Dumperで。
----
***データベースの使われ方 [#sfbac316]
-クラス名 → オブジェクトのリスト または 空リスト （下位クラスのオブジェクト含む）
-（キー名（属性名），値）の集合 → オブジェクトのリスト または 空リスト （キー名には「オブジェクトID」を含む）
-オブジェクトのリスト → 戻り値なし（インデックス更新）
-全オブジェクトのインデックス更新（未更新分のみ）
-全オブジェクトのインデックス更新（本当にすべてのオブジェクト分）
**プロトタイプ [#e92021e3]
package FlyweightFactory;
use strict;
use warnings;
use Storable qw/lock_nstore lock_retrieve/;
use Safe;
#use Toolkit;
use Fcntl qw/:flock/;
my %Index;
$Index{classname} = {};
$Index{mtime} = {};
$Index{file} = {};
$Index{class} = {};
$Index{id} = {};
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
{
die;
}
sub Singleton
{
my $class = shift;
if (not defined $instance){
$instance = bless I(), $class;
}
$instance;
}
sub I
{
{};
}
# クラス名 → オブジェクトのリスト または 空リスト （下位クラスのオブジェクト含む）
# 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;
}
# （キー名（属性名），値）の集合 → オブジェクトのリスト または 空リスト （キー名には「オブジェクトID」を含む）
# FindObjects({key, value}) -> @Obj
sub FindObjects
{
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;
}
# FetchObject('key=value,key=value') -> @Obj
sub FetchObject
{
my $self = shift;
my($keyvalue) = @_;
my @ret;
my @keyvalue_list = split /, */, $keyvalue;
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;
}
# オブジェクトのリスト → 戻り値なし（インデックス更新）
# UpdateIndexes(@Obj)
sub UpdateIndexes
{
my $self = shift;
my(@object) = @_;
foreach my $obj (@object){
if ($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;
}
# 全オブジェクトのインデックス更新（本当にすべてのオブジェクト分）
# 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;
}
sub _StoreObject
{
my $self = shift;
my($obj, $filename) = @_;
### assert:defined $obj
### assert:$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 _FetchObject
{
my $self = shift;
my($filename) = @_;
### assert:$filename
my $obj;
# lock_retrieve $filename;
{
open my $fh, '<', $filename or die $!;
flock $fh, LOCK_SH;
my $file = join '', <$fh>;
close $fh;
$obj = $safe->reval($file);
}
$obj;
}
1;
