弁当屋は嘘をつく

※2005/04/22 Fri 11:07:57 に再編集されました。
※2004/11/01 Mon 11:43:34に再編集されました。

MMORPG

うさだBlog / ls@usada's Workshop
現在のMMORPGの中でまともなものがないと言っているように見える。
これを読むと、「ではどんなものがまともなMMORPGなのか」と考えてしまうが、書いてる本人はそこに言及することはなく投げっぱなし。

弁当屋

食事時になったが弁当屋から昼食が届いてなかったので、電話をしてみた。
「今出たところです」
ああ、定番のセリフだなあ。
ちょっとネガティブだった気分が少しだけほんわり。

藤田田氏死去

http://www.asahi.com/obituaries/update/0426/001.html
藤田田氏が死んでしまった。
私が知っている藤田田氏は「成毛ちゃんを育てた男」と言う印象ばかりなんですが、あー。謎の個人商会、藤田田商店はどうなるんでしょうかねえ。日本マクドナルドが毎年多額の顧問料を上納している謎の企業で、この不透明な会計のおかげで日本マクドナルドの上場が遅れたとかなんとか、ってこれはちゆ12歳からの受け売りか。
一つの時代が終わった……のか？
さあて、次は成毛ちゃんか（不謹慎）。

■

• メカフリークス―メカフェチ映画大図鑑 (Million mook―新映画宝庫)
• よつばと! (2) (電撃コミックス)（あずまきよひこ）

O/Rマッピングの続き

PerlでのO/Rマッピングはないんだろうか、などと考えてしまい、ちょっとググったけど見つからない。
やれやれ。もしかして自分で作るしかないのか？
ってな訳で、下記のようなものを作ってみた。途中だけど。

package OR::Mapping;
use strict;
our $VERSION = '0.1';
our $dbh = undef;
our $all_tables = 'all_tables';
our $all_columns = 'all_columns';
our %object_cache = ();

our $table_column = undef;

=head1 導入

PostgreSQLを使用することを考えています。

導入に先立って、二つのVIEWを作成してください。

VIEW:all_columns

SELECT pg_class.relname AS "table", pg_attribute.attname AS "column" FROM pg_class, pg_attribute WHERE ((((pg_class.relkind = 'r'::"char") AND (pg_attribute.attnum > 0)) AND (pg_attribute.attrelid = pg_class.oid)) AND (pg_class.relname !~~ 'pg_%'::text)) ORDER BY pg_class.relname, pg_attribute.attnum

VIEW:all_tables

SELECT DISTINCT all_columns."table" FROM all_columns ORDER BY all_columns."table"

=cut

sub dbh {
	my $invocant = shift;
	@_ and $dbh = shift;
	return $dbh;
}

sub new {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	unless ( $object_cache{$id} ) {
		my $class = ref $invocant;
		$class ||= $invocant;
		( my $table = $id ) =~ s/\d+$//;
		my $self = bless [$table, $id]=>$class;
		$self->is_entry($id) or $self->entry;
		$object_cache{$id} = $self;
	}
	return $object_cache{$id};
}

sub load_object {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	unless ( $object_cache{$id} ) {
		my $class = ref $invocant;
		$class ||= $invocant;
		( my $table = $id ) =~ s/\d+$//;
		my $self = bless [$table, $id]=>$class;
		$self->is_entry($id) or return undef;
		$object_cache{$id} = $self;
	}
	return $object_cache{$id};
}

sub new_object {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	unless ( $object_cache{$id} ) {
		my $class = ref $invocant;
		$class ||= $invocant;
		( my $table = $id ) =~ s/\d+$//;
		my $self = bless [$table, $id]=>$class;
		$self->is_entry($id) and return undef;
		$self->entry;
		$object_cache{$id} = $self;
	}
	return $object_cache{$id};
}

sub entry {
	my $self = shift;
	my $table = $self->table;
	my $id = $self->id;
	return $dbh->do("INSERT INTO $table ( id ) VALUES ( ? )", undef, $id);
}

sub is_entry {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	( my $table = $id ) =~ s/\d+$//;
	my $sth = $dbh->prepare("SELECT id FROM $table WHERE id=?");
	$sth->execute($id);
	my $count = 0;
	while ( $sth->fetch ) { ++ $count; }
	return $count;
}

sub param {
	my $self = shift;
	my @param_list_column = $self->param_list_colulmn;
	my @param_list_table = $self->param_list_table;

	# 引数なしで呼び出した場合。
	@_ or return @param_list_column, @param_list_table;
	
}

sub param_write_column {
	my ( $self, $param, $value ) = @_;
	my $id = $self->id;
	my $table = $self->table;
	return $dbh->do("UPDATE $table SET $param=? WHERE id=?", undef, $value, $id);
}

sub param_write_table {
	my ( $self, $param, @value ) = @_;
	my $id = $self->id;
	my $column = $self->table;
	my $table = $param.'2'.$column;
	$table_column->{$table} or $table = $column.'2'.$param;
	$table_column->{$table} or return undef;
	$dbh->do("DELETE FROM $table WHERE $column=?", undef, $id);
	my $sth = $dbh->prepare("INSERT INTO $table ( $column, $param ) VALUES ( ?, ? )");
	my $count = 0;
	foreach ( @value ) { $sth->execute($id ,$_); ++ $count; }
	$sth->finish;
	return $count;
}

sub param_read_column {
	my ( $self, $param ) = @_;
	my $id = $self->id;
	my $table = $self->table;
	
}


sub param_list {
	my $self = shift;
	return $self->param_list_column, $self->param_list_table;
}

sub param_list_column {
	my $self = shift;
	$table_column or $self->table_column;
	return keys %{$table_column->{$self->table}});
}

sub param_list_table {
	my $self = shift;
	$table_column or $self->table_column;
	my $table = $self->table;
	my @table = grep { $_ ne $table } grep { /$table/ } keys %{$table_column};
	map { s/^$table\d// } @table;
	map { s/\d$table$// } @table;
	return @table;
}

sub id {
	return shift->[1];
}

sub table {
	return shift->[0];
}

sub table_column {
	my $self = shift;
	$table_column = {};
	my $sth = $dbh->prepare("SELECT column FROM $all_columns");
	$sth->execute();
	my ( $table, $column ) = ();
	my $rc = $sth->bind_columns(\$table, \$column);
	while ( $sth->fetch ) {
		$table_column->{$table}->{$column} = 1;
	}
	$sth->finish;
}

ごちゃごちゃ言いたくはないけれど。
特定のルールにのっとってPostgreSQLのテーブルを作成すると、それをPerlが読み取って一部テーブルのレコードをオブジェクトとして扱えるようにするものです。
継承して機能追加したり、テーブルを限定したり、入力規則を付与したりすることを主眼に置いています。

※2005/04/22 Fri 11:07:57 に再編集されました。
※2004/11/01 Mon 11:43:34に再編集されました。

MMORPG

うさだBlog / ls@usada's Workshop
現在のMMORPGの中でまともなものがないと言っているように見える。
これを読むと、「ではどんなものがまともなMMORPGなのか」と考えてしまうが、書いてる本人はそこに言及することはなく投げっぱなし。

弁当屋

食事時になったが弁当屋から昼食が届いてなかったので、電話をしてみた。
「今出たところです」
ああ、定番のセリフだなあ。
ちょっとネガティブだった気分が少しだけほんわり。

藤田田氏死去

http://www.asahi.com/obituaries/update/0426/001.html
藤田田氏が死んでしまった。
私が知っている藤田田氏は「成毛ちゃんを育てた男」と言う印象ばかりなんですが、あー。謎の個人商会、藤田田商店はどうなるんでしょうかねえ。日本マクドナルドが毎年多額の顧問料を上納している謎の企業で、この不透明な会計のおかげで日本マクドナルドの上場が遅れたとかなんとか、ってこれはちゆ12歳からの受け売りか。
一つの時代が終わった……のか？
さあて、次は成毛ちゃんか（不謹慎）。

■

• メカフリークス―メカフェチ映画大図鑑 (Million mook―新映画宝庫)
• よつばと! (2) (電撃コミックス)（あずまきよひこ）

O/Rマッピングの続き

PerlでのO/Rマッピングはないんだろうか、などと考えてしまい、ちょっとググったけど見つからない。
やれやれ。もしかして自分で作るしかないのか？
ってな訳で、下記のようなものを作ってみた。途中だけど。

package OR::Mapping;
use strict;
our $VERSION = '0.1';
our $dbh = undef;
our $all_tables = 'all_tables';
our $all_columns = 'all_columns';
our %object_cache = ();

our $table_column = undef;

=head1 導入

PostgreSQLを使用することを考えています。

導入に先立って、二つのVIEWを作成してください。

VIEW:all_columns

SELECT pg_class.relname AS "table", pg_attribute.attname AS "column" FROM pg_class, pg_attribute WHERE ((((pg_class.relkind = 'r'::"char") AND (pg_attribute.attnum > 0)) AND (pg_attribute.attrelid = pg_class.oid)) AND (pg_class.relname !~~ 'pg_%'::text)) ORDER BY pg_class.relname, pg_attribute.attnum

VIEW:all_tables

SELECT DISTINCT all_columns."table" FROM all_columns ORDER BY all_columns."table"

=cut

sub dbh {
	my $invocant = shift;
	@_ and $dbh = shift;
	return $dbh;
}

sub new {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	unless ( $object_cache{$id} ) {
		my $class = ref $invocant;
		$class ||= $invocant;
		( my $table = $id ) =~ s/\d+$//;
		my $self = bless [$table, $id]=>$class;
		$self->is_entry($id) or $self->entry;
		$object_cache{$id} = $self;
	}
	return $object_cache{$id};
}

sub load_object {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	unless ( $object_cache{$id} ) {
		my $class = ref $invocant;
		$class ||= $invocant;
		( my $table = $id ) =~ s/\d+$//;
		my $self = bless [$table, $id]=>$class;
		$self->is_entry($id) or return undef;
		$object_cache{$id} = $self;
	}
	return $object_cache{$id};
}

sub new_object {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	unless ( $object_cache{$id} ) {
		my $class = ref $invocant;
		$class ||= $invocant;
		( my $table = $id ) =~ s/\d+$//;
		my $self = bless [$table, $id]=>$class;
		$self->is_entry($id) and return undef;
		$self->entry;
		$object_cache{$id} = $self;
	}
	return $object_cache{$id};
}

sub entry {
	my $self = shift;
	my $table = $self->table;
	my $id = $self->id;
	return $dbh->do("INSERT INTO $table ( id ) VALUES ( ? )", undef, $id);
}

sub is_entry {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	( my $table = $id ) =~ s/\d+$//;
	my $sth = $dbh->prepare("SELECT id FROM $table WHERE id=?");
	$sth->execute($id);
	my $count = 0;
	while ( $sth->fetch ) { ++ $count; }
	return $count;
}

sub param {
	my $self = shift;
	my @param_list_column = $self->param_list_colulmn;
	my @param_list_table = $self->param_list_table;

	# 引数なしで呼び出した場合。
	@_ or return @param_list_column, @param_list_table;
	
}

sub param_write_column {
	my ( $self, $param, $value ) = @_;
	my $id = $self->id;
	my $table = $self->table;
	return $dbh->do("UPDATE $table SET $param=? WHERE id=?", undef, $value, $id);
}

sub param_write_table {
	my ( $self, $param, @value ) = @_;
	my $id = $self->id;
	my $column = $self->table;
	my $table = $param.'2'.$column;
	$table_column->{$table} or $table = $column.'2'.$param;
	$table_column->{$table} or return undef;
	$dbh->do("DELETE FROM $table WHERE $column=?", undef, $id);
	my $sth = $dbh->prepare("INSERT INTO $table ( $column, $param ) VALUES ( ?, ? )");
	my $count = 0;
	foreach ( @value ) { $sth->execute($id ,$_); ++ $count; }
	$sth->finish;
	return $count;
}

sub param_read_column {
	my ( $self, $param ) = @_;
	my $id = $self->id;
	my $table = $self->table;
	
}


sub param_list {
	my $self = shift;
	return $self->param_list_column, $self->param_list_table;
}

sub param_list_column {
	my $self = shift;
	$table_column or $self->table_column;
	return keys %{$table_column->{$self->table}});
}

sub param_list_table {
	my $self = shift;
	$table_column or $self->table_column;
	my $table = $self->table;
	my @table = grep { $_ ne $table } grep { /$table/ } keys %{$table_column};
	map { s/^$table\d// } @table;
	map { s/\d$table$// } @table;
	return @table;
}

sub id {
	return shift->[1];
}

sub table {
	return shift->[0];
}

sub table_column {
	my $self = shift;
	$table_column = {};
	my $sth = $dbh->prepare("SELECT column FROM $all_columns");
	$sth->execute();
	my ( $table, $column ) = ();
	my $rc = $sth->bind_columns(\$table, \$column);
	while ( $sth->fetch ) {
		$table_column->{$table}->{$column} = 1;
	}
	$sth->finish;
}

ごちゃごちゃ言いたくはないけれど。
特定のルールにのっとってPostgreSQLのテーブルを作成すると、それをPerlが読み取って一部テーブルのレコードをオブジェクトとして扱えるようにするものです。
継承して機能追加したり、テーブルを限定したり、入力規則を付与したりすることを主眼に置いています。

※2005/04/22 Fri 11:07:57 に再編集されました。
※2004/11/01 Mon 11:43:34に再編集されました。

MMORPG

うさだBlog / ls@usada's Workshop
現在のMMORPGの中でまともなものがないと言っているように見える。
これを読むと、「ではどんなものがまともなMMORPGなのか」と考えてしまうが、書いてる本人はそこに言及することはなく投げっぱなし。

弁当屋

食事時になったが弁当屋から昼食が届いてなかったので、電話をしてみた。
「今出たところです」
ああ、定番のセリフだなあ。
ちょっとネガティブだった気分が少しだけほんわり。

藤田田氏死去

http://www.asahi.com/obituaries/update/0426/001.html
藤田田氏が死んでしまった。
私が知っている藤田田氏は「成毛ちゃんを育てた男」と言う印象ばかりなんですが、あー。謎の個人商会、藤田田商店はどうなるんでしょうかねえ。日本マクドナルドが毎年多額の顧問料を上納している謎の企業で、この不透明な会計のおかげで日本マクドナルドの上場が遅れたとかなんとか、ってこれはちゆ12歳からの受け売りか。
一つの時代が終わった……のか？
さあて、次は成毛ちゃんか（不謹慎）。

■

• メカフリークス―メカフェチ映画大図鑑 (Million mook―新映画宝庫)
• よつばと! (2) (電撃コミックス)（あずまきよひこ）

O/Rマッピングの続き

PerlでのO/Rマッピングはないんだろうか、などと考えてしまい、ちょっとググったけど見つからない。
やれやれ。もしかして自分で作るしかないのか？
ってな訳で、下記のようなものを作ってみた。途中だけど。

package OR::Mapping;
use strict;
our $VERSION = '0.1';
our $dbh = undef;
our $all_tables = 'all_tables';
our $all_columns = 'all_columns';
our %object_cache = ();

our $table_column = undef;

=head1 導入

PostgreSQLを使用することを考えています。

導入に先立って、二つのVIEWを作成してください。

VIEW:all_columns

SELECT pg_class.relname AS "table", pg_attribute.attname AS "column" FROM pg_class, pg_attribute WHERE ((((pg_class.relkind = 'r'::"char") AND (pg_attribute.attnum > 0)) AND (pg_attribute.attrelid = pg_class.oid)) AND (pg_class.relname !~~ 'pg_%'::text)) ORDER BY pg_class.relname, pg_attribute.attnum

VIEW:all_tables

SELECT DISTINCT all_columns."table" FROM all_columns ORDER BY all_columns."table"

=cut

sub dbh {
	my $invocant = shift;
	@_ and $dbh = shift;
	return $dbh;
}

sub new {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	unless ( $object_cache{$id} ) {
		my $class = ref $invocant;
		$class ||= $invocant;
		( my $table = $id ) =~ s/\d+$//;
		my $self = bless [$table, $id]=>$class;
		$self->is_entry($id) or $self->entry;
		$object_cache{$id} = $self;
	}
	return $object_cache{$id};
}

sub load_object {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	unless ( $object_cache{$id} ) {
		my $class = ref $invocant;
		$class ||= $invocant;
		( my $table = $id ) =~ s/\d+$//;
		my $self = bless [$table, $id]=>$class;
		$self->is_entry($id) or return undef;
		$object_cache{$id} = $self;
	}
	return $object_cache{$id};
}

sub new_object {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	unless ( $object_cache{$id} ) {
		my $class = ref $invocant;
		$class ||= $invocant;
		( my $table = $id ) =~ s/\d+$//;
		my $self = bless [$table, $id]=>$class;
		$self->is_entry($id) and return undef;
		$self->entry;
		$object_cache{$id} = $self;
	}
	return $object_cache{$id};
}

sub entry {
	my $self = shift;
	my $table = $self->table;
	my $id = $self->id;
	return $dbh->do("INSERT INTO $table ( id ) VALUES ( ? )", undef, $id);
}

sub is_entry {
	my $invocant = shift;
	my $id = shift;
	$id or return undef;
	( my $table = $id ) =~ s/\d+$//;
	my $sth = $dbh->prepare("SELECT id FROM $table WHERE id=?");
	$sth->execute($id);
	my $count = 0;
	while ( $sth->fetch ) { ++ $count; }
	return $count;
}

sub param {
	my $self = shift;
	my @param_list_column = $self->param_list_colulmn;
	my @param_list_table = $self->param_list_table;

	# 引数なしで呼び出した場合。
	@_ or return @param_list_column, @param_list_table;
	
}

sub param_write_column {
	my ( $self, $param, $value ) = @_;
	my $id = $self->id;
	my $table = $self->table;
	return $dbh->do("UPDATE $table SET $param=? WHERE id=?", undef, $value, $id);
}

sub param_write_table {
	my ( $self, $param, @value ) = @_;
	my $id = $self->id;
	my $column = $self->table;
	my $table = $param.'2'.$column;
	$table_column->{$table} or $table = $column.'2'.$param;
	$table_column->{$table} or return undef;
	$dbh->do("DELETE FROM $table WHERE $column=?", undef, $id);
	my $sth = $dbh->prepare("INSERT INTO $table ( $column, $param ) VALUES ( ?, ? )");
	my $count = 0;
	foreach ( @value ) { $sth->execute($id ,$_); ++ $count; }
	$sth->finish;
	return $count;
}

sub param_read_column {
	my ( $self, $param ) = @_;
	my $id = $self->id;
	my $table = $self->table;
	
}


sub param_list {
	my $self = shift;
	return $self->param_list_column, $self->param_list_table;
}

sub param_list_column {
	my $self = shift;
	$table_column or $self->table_column;
	return keys %{$table_column->{$self->table}});
}

sub param_list_table {
	my $self = shift;
	$table_column or $self->table_column;
	my $table = $self->table;
	my @table = grep { $_ ne $table } grep { /$table/ } keys %{$table_column};
	map { s/^$table\d// } @table;
	map { s/\d$table$// } @table;
	return @table;
}

sub id {
	return shift->[1];
}

sub table {
	return shift->[0];
}

sub table_column {
	my $self = shift;
	$table_column = {};
	my $sth = $dbh->prepare("SELECT column FROM $all_columns");
	$sth->execute();
	my ( $table, $column ) = ();
	my $rc = $sth->bind_columns(\$table, \$column);
	while ( $sth->fetch ) {
		$table_column->{$table}->{$column} = 1;
	}
	$sth->finish;
}

ごちゃごちゃ言いたくはないけれど。
特定のルールにのっとってPostgreSQLのテーブルを作成すると、それをPerlが読み取って一部テーブルのレコードをオブジェクトとして扱えるようにするものです。
継承して機能追加したり、テーブルを限定したり、入力規則を付与したりすることを主眼に置いています。