昔ながらのPerl/CGIではデータをテキストファイルに保存しているわけだが、データの肥大化が原因なのか、動作が遅くなってきた。
その対策として、データをスリムアップするとか処理を効率化するとかが考えられるが、この際モダンな感じでデータの保存をMySQLに保以降してみてはどうだろうかと思った。

目標

• 昔ながらの「<>」区切りテキスト(UTF-8)を自動でMySQLに保存する(これまでのデータの移行)
• MySQLに保存されたデータを取り出す
• MySQLのデータを更新する(今回は行わない)

準備

MySQLにデータベース「mysqltest」をutf8_general_ciで作成。一般ユーザID:test、pass:testpassで利用できるように設定。

テスト用に小規模なデータを作成。掲示板のログファイルを想定。

形式は

通し番号<>名前<>書き込み内容

とする。
bbsdata.txt

1<>名無し<>てすと
2<>ななーし<>てすとー
3<>anonimous<>test

スクリプトを作成

ちょっと遠回しなスクリプトだけど、気にしない。

mysqltest.pl(データ移行)

use DBI;
my $mysqldb = 'DBI:mysql:mysqltest';
my $mysqluser = 'test';
my $mysqlpass = 'testpass';
my $data = 'bbsdata';
my $datafile = "./$data.txt";
my @dataarray = ('no','name','content');
my @datatypearray = ('int','text','text');

my @filedata;
open(DATA,"$datafile") || die("error:$datafile");
chomp(@filedata=<DATA>);
close(DATA);

my @datalist;
foreach(@filedata){
    my @tmp = split(/<>/, $_);
    my %data;
    foreach(@dataarray){
        $data{$_} = shift(@tmp);
    }
    push(@datalist,\%data);
}

my $dbh = DBI->connect($mysqldb,$mysqluser,$mysqlpass);

my @sql;
$sql[0] = "create table $data (";
my $fields;
my @values;
for(my $i=0; $i <= $#dataarray; $i++ ){
    $sql[0] .= "$dataarray[$i] $datatypearray[$i]";
    $fields .= $dataarray[$i];
    if($i == $#dataarray){
        $sql[0] .= ');';
    }else{
        $sql[0] .= ', ';
        $fields .= ',';
    }
}

for(my $j=0; $j <= $#datalist; $j++ ){
    my $tmp;
    for(my $i=0; $i <= $#dataarray; $i++ ){
        if($datatypearray[$i] eq 'text'){
            $tmp .= $dbh->quote($datalist[$j]->{$dataarray[$i]});
        }else{
            $tmp .= $datalist[$j]->{$dataarray[$i]};
        }
        if($i == $#dataarray){
        }else{
            $tmp .= ',';
        }
    }
    $sql[1+$j] = "insert into $data ($fields) values ($tmp);";
}

print "$fields\n";
print "$sql[0]\n";
print "$sql[1]\n";
print "$sql[2]\n";

foreach(@sql){
    my $sth = $dbh->prepare($_);
    $sth->execute;
    $sth->finish;
}

$dbh->disconnect;

mysqltest2.pl(データ読込)

use DBI;
my $mysqldb = 'DBI:mysql:mysqltest';
my $mysqluser = 'test';
my $mysqlpass = 'testpass';

my $data = 'bbsdata';
my @dataarray = ('no','name','content');

my $dbh = DBI->connect($mysqldb,$mysqluser,$mysqlpass);

my $sql = "select * from $data;";

my $sth = $dbh->prepare($sql);
$sth->execute;
while(my $ref = $sth->fetchrow_hashref){
    foreach(@dataarray){
        print "$_ = $ref->{$_},";
    }
    print "\n";
}
$sth->finish;

$dbh->disconnect;

実行結果

# perl mysqltest.pl
no,name,content
create table bbsdata (no int, name text, content text);
insert into bbsdata (no,name,content) values (1,"名無し","てすと");
insert into bbsdata (no,name,content) values (2,"ななーし","てすとー");

# perl mysqltest2.pl
no,name,content
select * from bbsdata
no = 1,name = 名無し,content = てすと,
no = 2,name = ななーし,content = てすとー,
no = 3,name = anonimous,content = test,

課題

とりあえずここまではうまくいった。

あとは実際のCGIを最小限の変更で動作させられるかどうか…

前回の課題の解決に挑戦。

Cent OS 6サーバ上でCGIとして動作させる

画像生成の部品として使用しているキャラクターなんとか機のパーツは、ファイル名がそのまま表示名になる仕様であり、日本語になっている。
FTPソフトで転送した際に文字化けを起こしていたので、Cent OS 6のファイルシステムに合わせてUTF-8に変更して転送する設定にした。
また、スクリプトから日本語でファイル名を直接指定しているので、スクリプト自体も文字コードをUTF-8にして保存する。
これであっさりとサーバ上で動作した。
せっかくなので、実行するとHTTPヘッダと画像データのバイナリを標準出力に書き込む動作に変更し、昔のアクセスカウンターのようにimgタグで呼び出す仕様にしてみた。

色をランダムに選択

これに関してはこれができることを意識してもともとスクリプトを書いていたので、簡単に終了。

スクリプト全文

#!/usr/bin/perl
use Imager;
local $basedir = './data/default';
local @layers = (
'accessory_back',
'hair_back',
'hair_back_accessory',
'body_back',
'accessory_underwear',
'body_front',
'body_front_color',
'accessory_middle_back',
'head',
'accessory_middle_front',
'face_back',
'hair_front',
'hair_front_accessory',
'face_front',
'eye',
'accessory_front'
);
local %colorgloup = (
'head'				=> 'body',
'face_back'			=> '',
'face_front'			=> '',
'eye'				=> 'eye',
'hair_back'			=> 'hair',
'hair_front'			=> 'hair',
'hair_back_accessory'		=> '',
'hair_front_accessory'		=> '',
'body_back'			=> 'body',
'body_front'			=> '',
'body_front_color'		=> 'cloth',
'accessory_underwear'		=> '',
'accessory_middle_back'		=> '',
'accessory_middle_front'	=> '',
'accessory_back'		=> '',
'accessory_front'		=> ''
);
my %charaparts = (
'head'				=> '普通な顔1.png',
'face_back'			=> '素.png',
'face_front'			=> '素.png',
'eye'				=> '普通な目1.png',
'hair_back'			=> 'ロング.png',
'hair_front'			=> 'ナチュラル.png',
'hair_back_accessory'		=> 'ツインテール(長).png',
'hair_front_accessory'		=> '',
'body_back'			=> 'サマードレス1.png',
'body_front'			=> '',
'body_front_color'		=> 'サマードレス1.png',
'accessory_underwear'		=> '',
'accessory_middle_back'		=> '',
'accessory_middle_front'	=> '',
'accessory_back'		=> '',
'accessory_front'		=> ''
);
local %colormatrixorigin = (
'blue' =>   [	[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'purple' => [	[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'red' =>   [	[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'yellow' => [	[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'green' => [	[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'water' => [	[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'black' => [	[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'white' => [	[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'dummy' => [	[ 1	, 0	, 0	, 0	],
		[ 0	, 1	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ]
);
my @colorlist =  keys(%colormatrixorigin);
my %colormatrix = (
'eye'	=> $colormatrixorigin{$colorlist[int(rand(@colorlist))]},
'hair'	=> $colormatrixorigin{$colorlist[int(rand(@colorlist))]},
'cloth'	=> $colormatrixorigin{$colorlist[int(rand(@colorlist))]},
'body'	=> $colormatrixorigin{'dummy'},
);
my $imager = Imager->new(xsize => 300,ysize => 400, channels => 4);
$imager = &makechara($imager,\%charaparts,\%colormatrix);
my $data;
$imager->write(data => \$data, type => 'png') or die $imager->errstr;
binmode STDOUT;
print "Content-type: image/png\n";
print "Pragma: no-cache\n\n";
print $data;
sub makechara{
	(my $imager,my $charapartsref,my $colormatrixref) = @_;
	my $imagertmp = Imager->new(xsize => 300,ysize => 400, channels => 4);
	foreach(@layers){
		unless($charapartsref->{$_}){next;}
		$imagertmp->read( file => "$basedir/$_/$charapartsref->{$_}" ) or die $imagertmp->errstr;
		if($colormatrix{$colorgloup{$_}}){
			$imagertmp = $imagertmp->convert(matrix => $colormatrixref->{$colorgloup{$_}});
		}
		$imager->rubthrough( src => $imagertmp, tx => 0, ty =>0);
	}
	return $imager;
}

結果

↓リロードしたら色が変わるはず

今後の課題

• 本当はローカル(windows)とサーバ(linux)を同一スクリプトで動かしたい。スクリプト・ファイルシステム・テキストファイル内の文字コードを自動で判別して変換してくれるライブラリだかモジュールだかがあるんじゃないかと思ったが、ちょっと探したところ見つけられなかった。ローカルではShift-JISで動かして、サーバにFTPで転送する際にUTF-8に変換されるように設定するという方法もある…のか？
• パーツのランダム選択機能はどうしようか。ディレクトリ内のファイルリストを作ってランダムで選ぶ　or　別途パーツリストを作ってそこから選択で検討。後者を選ぶなら、ついでにパーツの名称とファイル名の変換テーブルも作ってファイルをリネームすればもう一つの問題も解決できるが、パーツフォルダはそのままで本家キャラクターなんとか機と互換する状態にしたいとも思う。
• ところでこれって、ユーザがブラウザ上でパーツを選びべるようにして、Ajaxとかでプレビュー画像を随時更新すればWeb版キャラクターなんとか機になるんじゃないかと思ったら、すでにJavaScript版が公開されていた。当然この用途ならJavaScriptの方が効率的だよなぁ…あとFlashもアリか。

Perlで画像処理をしたいと思った。

目標

• キャラクターなんとか機の画像合成部分の動作をPerlで実装する(パーツの選択とかはスクリプト内で手打ちする)
• Win7のStrawberry Perlx64版で動作する
• Cent OS 6Webサーバ上でCGIとして動作する(本エントリ内では実現しない)

「キャラクターなんとか機」とは、素材として収録されている透過PNG画像を組み合わせ、さらに色の変更を行い、人物のいわゆる「立ち絵」を生成するプログラムである。

Perlでの画像処理ライブラリの有名どころはGD・ImageMagick・Imagerの３つのようだ。
StrawberryPerlにはGDとImagerがはじめから入っていたので、とりあえずImagerを使ってみることにした。
(StrawberryPerlにImageMagickインストールするのがうまくいかなかった。)

CentOS6にImagerをインストール

参考サイト
#yum list installed
してみると、
giflib.i686                                             4.1.6-3.1.el6
libjpeg.i686                                            6b-46.el6
libpng.i686                                             2:1.2.49-1.el6_2
なんだはいってるじゃん
ってことで
#cpan -i Imager
ずらずらーっと流れて結構時間かかって、
#perl -MImager -e 'print join ", ", sort keys %Imager::formats'
bmp, ifs, pnm, raw, tga
あれっ
あ、よく見てなかった。develがいるのか。
#yum install libjpeg-devel
#yum install libpng-devel
#yum install giflib-devel
で、
#cpan
cpan> force install Imager
#perl -MImager -e 'print join ", ", sort keys %Imager::formats'
bmp, gif, ifs, jpeg, png, pnm, raw, tga
よし、OK

追記。stringを使いたい場合


#yum install freetype-devel
#cpan
cpan> force install Imager

スクリプトを作成

スクリプト自体の参考

キャラクターなんとか機の動作の参考１

キャラクターなんとか機の動作の参考２

色の変更については、日本語の情報が見つけられなかったのでCPANで確認した。

げげ、行列の乗算なんて長らくやってない。どうやるんだったかな…

use Imager;
my @layers = (
'accessory_back',
'hair_back',
'hair_back_accessory',
'body_back',
'accessory_underwear',
'body_front',
'body_front_color',
'accessory_middle_back',
'head',
'accessory_middle_front',
'face_back',
'hair_front',
'hair_front_accessory',
'face_front',
'eye',
'accessory_front'
);
my %colorgloup = (
'head'				=> 'body',
'face_back'			=> '',
'face_front'			=> '',
'eye'				=> 'eye',
'hair_back'			=> 'hair',
'hair_front'			=> 'hair',
'hair_back_accessory'		=> '',
'hair_front_accessory'		=> '',
'body_back'			=> 'body',
'body_front'			=> '',
'body_front_color'		=> 'cloth',
'accessory_underwear'		=> '',
'accessory_middle_back'		=> '',
'accessory_middle_front'	=> '',
'accessory_back'		=> '',
'accessory_front'		=> ''
);
my %charaparts = (
'head'				=> '普通な顔1.png',
'face_back'			=> '素.png',
'face_front'			=> '素.png',
'eye'				=> '普通な目1.png',
'hair_back'			=> 'セミロング.png',
'hair_front'			=> 'ナチュラル.png',
'hair_back_accessory'		=> 'ツインテール(長).png',
'hair_front_accessory'		=> '',
'body_back'			=> 'セーラー服1.png',
'body_front'			=> 'セーラー服1.png',
'body_front_color'		=> 'セーラー服1.png',
'accessory_underwear'		=> '',
'accessory_middle_back'		=> '',
'accessory_middle_front'	=> '',
'accessory_back'		=> '',
'accessory_front'		=> ''
);
my %colormatrixorigin = (
'blue'	=> [	[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'pur'	=> [	[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'red'	=> [	[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'yel'	=> [	[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'grn'	=> [	[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'wtr'	=> [	[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'blk'	=> [	[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'wht'	=> [	[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'dummy'	=> [	[ 1	, 0	, 0	, 0	],
		[ 0	, 1	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ]
);
my %colormatrix = (
'eye'	=> $colormatrixorigin{'blk'},
'hair'	=> $colormatrixorigin{'red'},
'cloth'	=> $colormatrixorigin{'blue'},
'body'	=> $colormatrixorigin{'dummy'},
);
my $imager = Imager->new(xsize => 300,ysize => 400, channels => 4);
my $imagertmp = Imager->new(xsize => 300,ysize => 400, channels => 4);
my $counter = 0;
foreach(@layers){
	$counter++;
	unless($charaparts{$_}){next;}
	$imagertmp->read( file => "data/default/$_/$charaparts{$_}" ) or die $imagertmp->errstr;
	if($colormatrix{$colorgloup{$_}}){
		$imagertmp = $imagertmp->convert(matrix => $colormatrix{$colorgloup{$_}});
	}
	$imager->rubthrough( src => $imagertmp, tx => 0, ty =>0);
}
$imager->write( file => 'imagertest.png')or die $imager->errstr;

今のところは動作確認なので、もっとシンプルに書けるんじゃないか、なんてことは気にしない。

結果

なんかでた。

今後の課題

• 現状ではサーバ上で動作しない。パーツのファイル名が日本語であることが原因か。
• パーツや色をランダムに選択して大量生成する機能がほしい