世界のナベアツにさまざまな方法で挑戦するのが流行っているようなので，便乗してみる．
入力された画像から認識された顔の数が，3の倍数か3のつく数字のときだけ顔がアホっぽくなります．
CGI の実装言語は Perl，顔認識は Image::ObjectDetectモジュール (OpenCV の cvHaarDetectObjects)，画像処理は Imagerモジュール，実装は以下の各サイトを参考にしました．
参考というかほぼ丸パクリなので，むしろ一番大変だったのはレンタルサーバに root 権限無しで OpenCV インストールするところだったかも．その辺の話は気が向いたら書く．
以下ソース:
#!/usr/bin/perl -T
use strict;
use lib "/home/swk/local/lib/perl";
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use LWP::UserAgent;
use Imager;
use Image::ObjectDetect;
my $tmpdir = "/home/swk/www/nabeatsucv/tmp";
my $cascade = '/home/swk/local/share/opencv/haarcascades/haarcascade_frontalface_alt2.xml';
my $nabeatsu_photo = '/home/swk/www/nabeatsucv/nabeatsu.jpg';
my $q = new CGI;
my $ua = LWP::UserAgent->new(timeout => 15);
my $tmpf = "$tmpdir/$$";
my $uri = $ENV{PATH_INFO};
$uri =~ s/^\///;
$uri .= '?' . $ENV{QUERY_STRING} if $ENV{QUERY_STRING};
my $res = $ua->get($uri, ':content_file' => $tmpf);
die "failed to retrieve $uri: $res->code" unless $res->is_success;
my $type = $res->header('Content-Type');
die 'not a image' unless $type =~ /^image\//;
my $image = Imager->new->read(file => $tmpf);
my $detector = Image::ObjectDetect->new($cascade);
my @faces = $detector->detect($tmpf);
unlink $tmpf;
if (&is_aho(scalar @faces)) {
my $aho = Imager->new->read(file => $nabeatsu_photo);
foreach my $face (@faces) {
my $aho_scaled =
$aho->scale(xpixels => $face->{width}, ypixels => $face->{height});
$image->paste(left => $face->{x}, top => $face->{y},
src => $aho_scaled);
}
} else {
foreach my $face (@faces) {
$image->box(
xmin => $face->{x},
ymin => $face->{y},
xmax => $face->{x} + $face->{width},
ymax => $face->{y} + $face->{height},
color => 'red',
filled => 0,
);
}
}
my $jpg;
$image->write(data => \$jpg, type => 'jpeg');
print $q->header(
-type => 'image/jpeg',
-content_length => length($jpg)
);
print $jpg;
sub is_aho
{
my ($n) = @_;
return ($n % 3 == 0) || ($n =~ /3/);
}
(追記) せっかくなので元ネタ的なものをリストアップしてみる．
最終更新時間: 2009-01-04 15:28