:/X/PageFactory のバックアップの現在との差分(No.28)

• バックアップ一覧
• 差分 を表示
• 現在との差分 を表示
• ソース を表示
• バックアップ を表示
• :/X/PageFactory へ行く。

• -

オブジェクトの永続化（ファイル化）と復帰を行うクラス。

インデックス †

インデックス更新時 †

インデックス更新時、オブジェクトから属性値を得て、すべてのインデックスを更新。

キー（属性値）→{オブジェクトID}
オブジェクトIDの1つを削除したり、追加したり、

インデックスの更新＝各インデックスから削除・追加すること

インデックス †

インデックスに含めるもの、インデックスのキーにするものはインデックス作成側が決める。固定。

キー毎に複数作成。
オブジェクトID→永続化されたオブジェクト名（ファイル名）も含む。

インデックス更新時はインデックス自身の更新日時も更新。

キーは

• オブジェクトID
• 永続化時のファイル名（ほとんどの場合、オブジェクトIDと同じ）
• クラス名
• ページ名（Unicode）
• 他

インデックス作成に必要なものは †

• オブジェクト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;

# BEGIN {
# 	@AnyDBM_File::ISA = qw/DB_File GDBM_File NDBM_File/;
# }
# use AnyDBM_File;

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;

	my $class = shift;

	if (not defined $instance){

		$instance = $class->_New();

	}

	$instance;

}

# クラス名　→　オブジェクトのリスト　または　空リスト　（下位クラスのオブジェクト含む）
# FetchObjects(ClassName) -> @Obj
sub FetchObjects_ByClassName
{
	my $self = shift;
	my($class) = @_;
	
	my $index = $self->Retrieve_Index('index.db');
	
	my @ret = ();
	foreach my $obj_id (@{$index->{class}->{$class}}){
		push @ret, $self->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 $index = $self->Retrieve_Index('index.db');
	
	my @ret;
	my($key, $value);
	while (($key, $value) = each %{$keyvalue}){
		my @ret_part = ();
		foreach my $obj_id (@{$index->{$key}->{$value}}){
			my $obj = $self->Retrieve($obj_id);
			if ($obj){
				push @ret_part, $self->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 $index = $self->Retrieve_Index('index.db');
	
	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 = $self->Retrieve($obj_id);
			if ($obj){
				push @ret_part, $self->Retrieve($obj_id);
			}
		}
		@ret = intersection(\@ret, \@ret_part);
	}
	
	@ret;

	my $self = shift;

	my $index = {

		mtime => {},

		file => {},

		class => {},

		id => {},

	};

	$self->Store_Index($index, 'index.db');

}

sub InitializeIndex
# UpdateIndexesForce(@Obj)
sub UpdateIndexesForce
{
	my $self = shift;
	
	my $index = {
		mtime => {},
		file => {},
		class => {},
		id => {},
	};
	$self->Store_Index($index, 'index.db');

	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) = @_;
	
	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;

	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) = @_;
	
	my $index = $self->Retrieve_Index('index.db');
	
	foreach my $obj (@object){
		### assert:exists $obj->{file}
		### assert:exists $obj->{id}
		### assert:exists $obj->{mtime}
		### assert:exists $obj->{class}
		{
			my $idx = $index->{file};
			my $key = $obj->{id};
			my @id = exists $idx->{$key} ? grep {$_ ne $obj->{id}} split(/, */, $idx->{$key}) : ();
			unshift @id, $obj->{file};
			$idx->{$key} = join(',', @id);
		}
		{
			my $idx = $index->{class};
			my $key = $obj->{id};
			my @id = exists $idx->{$key} ? grep {$_ ne $obj->{id}} split(/, */, $idx->{$key}) : ();
			unshift @id, $obj->{class};
			$idx->{$key} = join(',', @id);
		}
	}
	$self->Store_Index($index, 'index.db');
	
	undef;
}

# 全オブジェクトのインデックス更新（未更新分のみ）
# UpdateAllIndex()
sub UpdateAllIndex
{
	my $self = shift;
	
	{
		#全てのオブジェクトを得る
		my $index = $self->Retrieve_Index('index.db');
		
		my($obj_id);
		while ((undef, $obj_id) = 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;

	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 $index = $self->Retrieve_Index('index.db');
		
		my($obj_id);
		while ((undef, $obj_id) = each %{$index->{id}}){
			#それぞれのインデックス作成
			my $obj = $self->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 Store
{
	my $self = shift;
	my($obj) = @_;
	### assert:defined $obj
	### assert:exists $obj->{id} && defined $obj->{id}
	
# 	lock_nstore $obj, $obj->{file};
	{
		use Data::Dumper qw/Dumper/;
		$Data::Dumper::Indent = 3;
		$Data::Dumper::Terse = 1;
		if (not defined $obj->{file}){
			$obj->{file} = $self->_Id2NewFilename($obj->{id});
		}
		open my $fh, '>', $obj->{file} or die $!;
		flock $fh, LOCK_EX;
		print $fh Dumper $obj;
		close $fh;
	}
	
	$self->UpdateIndexesForce($obj);
	
	undef;

	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;
	

	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;

	{

		### 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:ファイルが既存だったときの新名
	
	$filename;

	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
	

	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;

	{

		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;
	

	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;

	{

		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;