Web 上の画像をリサイズする perl-script を書いた

非常に重い腰をやっとこさあげて drk7jp のモバイルサイトを作りました。2007 年頃に作らなきゃと思ってから全然進まず、2008 年に mt4i で誤魔化しつつ放置してきました。

XHTML で頑張ってテンプレート書いたので、モバイルで http://www.drk7.jp/ へアクセスするといい感じに表示されるはずです。

モバイルネタの詳細はまた別エントリで話すとして、開発途中で当然のように画像縮小を処理する機能が必要となりました。いまさら MT のプラグインを各モチベーションもないので、MT 再構築時にプラグインでモバイル向けの画像を出力する方式ではなく、汎用性の高い画像変換スクリプト方式で行くことにしました。

画像変換手段としては perl なら GD::Image / Image::Magick / Imager / Image::Imlib2 の４つくらいが考えられますが、既にベンチマークした結果がネットで手に入ります。

Webから画像をとってきてリサイズする処理のベンチマーク (Yusukebe::Tech)

Image::Magick と Imager と Image::Imlib2 のこと - 日々のこと

ベンチマーク詳細は各サイトをご覧いただくとして、Image::Imlib2 が圧倒的に高速であることが判ります。そんなわけで変換スクリプトのエンジンは Image::Imlib2 できまりです。

そんなわけでできたのがコレ。非常にシンプルでかつ高速に動作するはずです。

Web 上の画像をリサイズする perl スクリプト

スクリプトの機能

・画像の縮小機能
・変換した画像のキャッシュ機能
・変換対象のドメイン指定機能（これで不正利用アクセスをある程度防ぐことが可能です）
・ある程度のエラー制御。エラー時には 1px の画像を返す。
・動作条件は Image::Imlib2 が入っている環境じゃないと動きません。

http://・・・/imgresize.cgi?w=$width&h=$height&q=$quality&u=$imageurl

・w=$width　リサイズ後の横ピクセル数。省略可能。省略時には 200 px
・h=$heigh　リサイズ後の縦ピクセル数。省略可能。省略時には 200 px
・width と height の扱いは、縮小時にその範囲を超えないように制御するもの。元画像の縦横比率は維持する
・q=$quality　縮小後の保存時の画質。1 - 100 まで選択可能。値のチェックは特にしていない。
・u=$imageurl　元画像の URL

#!/usr/bin/perl -w

use strict;
use LWP::UserAgent;
use Image::Imlib2;
use Digest::MD5 qw(md5 md5_hex md5_base64);

my $default  = 'http://www.drk7.jp/MT/m/img/spacer.gif';
my $cachedir = '/home/apache/drk7.jp/MT/m/cache/';
my $domain   = '(?:drk7.jp|rakuten.co.jp|amazon.co.jp|amazon.com)';

main();

########################################
## メイン
########################################
sub main {
    my $url     = '';
    my $width   = 200;
    my $height  = 200;
    my $quality = 30;
    my $convflg = 0;

    # query 解析
    my @query = split( /&/, $ENV{'QUERY_STRING'} );
    for (@query) {
        my @splited = split( /=/, $_ );
        if ( index( $splited[0], "u" ) != -1 ) {
            $url = $splited[1];
        }
        elsif ( index( $splited[0], "w" ) != -1 ) {
            $width = $splited[1];
        }
        elsif ( index( $splited[0], "h" ) != -1 ) {
            $height = $splited[1];
        }
        elsif ( index( $splited[0], "q" ) != -1 ) {
            $quality = $splited[1];
        }
    }

    # domainチェック
    return &err() if $url !~ /$domain/;

    # 拡張子エラー＆gif拡張子はjpgへ変換
    my ($suffix) = $url =~ /.+\.(.+?)$/;
    $suffix  = lc $suffix;
    $convflg = 1 if $suffix eq 'gif';
    $suffix  = 'jpg' if $suffix =~ /(?:jpeg|jpg|gif)$/;
    if ( $suffix !~ /(?:jpg|gif|png|bmp)$/ ) {
        return &err();
    }

    # キャッシュチェック
    my $md5       = md5_hex($url);
    my $cachefile = "$cachedir$md5.$suffix";
    return cache($cachefile) if -f $cachefile;

    # 画像取得
    my $ua = LWP::UserAgent->new;
    my $res = $ua->request( HTTP::Request->new( GET => $url ) );
    return &err() unless $res->is_success;
    my $data = $res->content;

    # 取得画像をいったんファイルへ落とす
    my $workfile = "$cachedir$md5.tmp.$suffix";
    open my $fh, '>', $workfile;
    binmode $fh;
    print $fh $data;
    close $fh;

    # リサイズ
    eval {
        my $img      = Image::Imlib2->load($workfile);
        my $t_width  = $width;
        my $t_height = $height;

        # gif の場合はjpgへコンバートする
        $img->image_set_format("jpeg") if $convflg;

        # 元サイズの方が小さいとき
        if ( $img->width < $t_width && $img->height < $t_height ) {
            $t_width  = $img->width;
            $t_height = $img->height;
        }

        # 横幅が大きいとき
        elsif ( $t_width / $t_height < $img->width / $img->height ) {
            $t_width  = $width;
            $t_height = $t_width / $img->width * $img->height;
        }

        # 縦幅が大きいとき
        else {
            $t_height = $height;
            $t_width  = $t_height / $img->height * $img->width;
        }
        $img = $img->create_scaled_image( $t_width, $t_height );
        $img->set_quality($quality);
        $img->save($cachefile);
        unlink $workfile;

        return cache($cachefile) if -f $cachefile;
    };
    &err() if $@;
}

########################################
## キャッシュレスポンス
########################################
sub cache {
    my $cachefile = shift;

    my ($type) = $cachefile =~ /.+\.(.+?)$/;
    open my $fh, '<', $cachefile;
    binmode $fh;
    my $data = do { local $/; <$fh> };
    close $fh;
    my $len = length($data);
    print "Content-type: image/$type\n";
    print "Content-length: $len\n\n";
    print $data;
}

########################################
## エラーの場合のレスポンス
########################################
sub err {
    my $ua   = LWP::UserAgent->new;
    my $res  = $ua->request( HTTP::Request->new( GET => $default ) );
    my $data = $res->content;
    my $type = $res->header('content-type');
    my $len  = $res->header('content-length');
    print "Content-type: $type\n";
    print "Content-length: $len\n\n";
    print $data;
}

このスクリプトは改変自由です。コピペってご自由にご利用ください。
久々に perl でスクリプト書いたので感覚が若干鈍ってたのが残念で仕方がありません・・・(´Д⊂ ﾓｳﾀﾞﾒﾎﾟ