JAMADAM.COM

Perl - サムネイル自動生成をモジュールにしてみた

Initial post: 2008.05.16 | Last modified: 2008.05.16

以前作ったサムネイルの自動生成CGIをモジュール化してみた。もともと小さなプログラムだったので、途中何度も「やる意味あんのか？」っていう、コンセプトレベルで結構悩んだ。でも結果的には割と理にかなった構造になった気がする。そして、前回書いたAUTOLOADによる継承委譲もつかってみた。

package NT::Image::Magick::Thumbnail;
use strict;
use warnings;
use Image::Magick;

### -----------------------------------------
### コンストラクタ
### -----------------------------------------
sub new {
    
    my $class = shift;
    my $self = {
        magick => Image::Magick->new,
        file => undef,
        cache_dir => undef,
        max_width => 800,
        max_height => 800,
        @_};
    
    bless $self, $class;
    $self->Read($self->{file});
    
    return $self;
}

### -----------------------------------------
### 継承をメンバ変数magickに適用
### -----------------------------------------
sub AUTOLOAD {
    
    no strict;
    my $self = shift;
    my $type = ref($self);
    my $name = $AUTOLOAD; $name =~ s/.*://;
    
    return $self->{magick}->$name(@_);
}

### -----------------------------------------
### 画像リサイズ & キャッシュ出力
### -----------------------------------------
sub make {
    
    my $self = shift;
    my %args = (
        width => 0, 
        height => 0, 
        @_);
    
    if (my $cache_name = $self->cacheExists(%args)) {
        
        $self->Read($cache_name);
    }
    
    else {
        
        my ($width, $height) = $self->Get('width', 'height');
        
        ### 引数取得
        my $target_width = ($args{width} or 0);
        my $target_height = ($args{height} or 0);
        
        ### アスペクト比保持
        $target_height  ||= ($height * $target_width) / $width;
        $target_width   ||= ($width * $target_height) / $height;
        
        ### 上限判定
        $target_width = $self->{max_width} if ($target_width > $self->{max_width});
        $target_height = $self->{max_height} if ($target_height > $self->{max_height});
        
        ### 四捨五入と0回避
        $target_width = (int($target_width + 0.5) or 1);
        $target_height = (int($target_height + 0.5) or 1);
        
        ### リサイズ
        $self->Resize(width => $target_width, height => $target_height);
        
        ### キャッシュ出力
        if ($self->{cache_dir}) {
            
            my $cache_name = $self->getCacheName(%args);
            
            if (open(CACHE, "> ". $cache_name)) {
                
                binmode(CACHE);
                $self->Write(file => ¥*CACHE, filename => $cache_name);
                close(CACHE);
            }
        }
    }
}

### -----------------------------------------
### キャッシュ存在確認
### -----------------------------------------
sub cacheExists {
    
    my $self = shift;
    my %args = (
        width => 0, 
        height => 0, 
        @_);
    
    my $name = $self->getCacheName(%args);
    return (-e $name) ? $name : undef;
}

### -----------------------------------------
### キャッシュ名を得る
### -----------------------------------------
sub getCacheName {
    
    my $self = shift;
    my %args = (
        width => 0, 
        height => 0, 
        @_);
    
    if ($self->{cache_dir}) {
        
        my $new_query = '';
        $new_query = ($args{width}) ? 'x='. $args{width} : '';
        $new_query .= ($args{height}) ? '&y='. $args{height} : '';
        $new_query =~ s/^&//;
        
        my ($name, $ext) = ($self->{file} =~ /^(.+)¥.([^.]+)$/);
        return sprintf("%s/%s.%s.%s", $self->{cache_dir}, $name, $new_query, $ext);
    }
    
    return;
}

return 1;

使い方

#!/usr/bin/perl -w

### -----------------------------------------
### 初期設定
### -----------------------------------------
my $org_dir = '';
my $cache_dir = 'cache';
my $max_width = 800;
my $max_height = 800;
### -----------------------------------------

use strict;
use warnings;
use NT::Image::Magick::Thumbnail;
use CGI;

my $q = new CGI(); 

my %args = (
    width => scalar $q->param('x'), 
    height => scalar $q->param('y'));

### ソース
my $org_path = $org_dir. './'. $q->param('f');
-e $org_path or die 'file not found';

my $image = 
    NT::Image::Magick::Thumbnail->new(
        file => $org_path, 
        cache_dir => $cache_dir,
        max_width => $max_width, 
        max_height => $max_height
    );

if (! &binary_out($image->getCacheName(%args), $image->Get('mime'))) {
    
    $image->make(%args);
    
    my ($format, $mime) = $image->Get('magick', 'mime');
    
    ### ヘッダ出力
    print 'Content-type: '. $mime. "¥n¥n";
    
    binmode(STDOUT);
    $image->Write($format. ':-');
}

exit(0);

### -----------------------------------------
### 汎用バイナリ出力
### -----------------------------------------
sub binary_out {
    
    if (open(IN, $_[0])) {
        
        print "Content-Type: $_[1]¥n¥n";
        
        binmode(IN);
        binmode(STDOUT);
        
        read(IN, my $buf, -s $_[0]);
        print $buf;
        close(IN);
        
        return 1;
    }
    
    return 0;
}

以前書いたとおりのhtaccessを使えば、2回目以降CGIの起動がないので速いです。

ちなみに、このサンプルコードのために生まれて初めてCGI.pmを使ってみた。やっぱ、あるものは使うべきなのか。

[2008/05/16追記]

モジュールのほうでキャッシュ機能を活用してるので、実はこれだけでよかったりする。

#!/usr/bin/perl -w

### -----------------------------------------
### 初期設定
### -----------------------------------------
my $org_dir = '';
my $cache_dir = 'cache';
my $max_width = 800;
my $max_height = 800;
### -----------------------------------------

use strict;
use warnings;
use NT::Image::Magick::Thumbnail;
use CGI;

my $q = new CGI();

my $org_path = $org_dir. './'. $q->param('f');
-e $org_path or die 'file not found';

my $image = 
    NT::Image::Magick::Thumbnail->new(
        file => $org_path, 
        cache_dir => $cache_dir,
        max_width => $max_width, 
        max_height => $max_height
    );

$image->make(
    width => scalar $q->param('x'), 
    height => scalar $q->param('y'));

my ($format, $mime) = $image->Get('magick', 'mime');
print 'Content-type: '. $mime. "¥n¥n";
binmode(STDOUT);
$image->Write($format. ':-');

exit(0);

画像サムネイル自動生成機能つけてみた

Initial post: 2007.07.19 | Last modified: 2007.07.19

高速化第二弾。もはやサーバ側で何やっても大差ない気がしてきました。体感速度の重さはCSSが汚すぎるのと画像がデカ過ぎる辺りに問題が。最近のエントリーに添付する画像は全部、横800pxという馬鹿みたいにデカいのをブラウザに縮小させてたんですが、150pxのサムネイルを自動生成するようにしました。

mod_rewriteで気の利いた仕組みにしてみました。sample.jpgというのが元画像。sample.jpg?x=150とすると横150pxにして出力する。実はここまでは数日前から運用してたのですが、Perlの処理が重いのか、SpeedyCGIに任せて起動時間削減しても逆に重くなりました。という訳で、今日からキャッシュ機構を取り入れ、2度目以降のアクセス時にはPerlを一切使わない仕組みにしました。まだちゃんと動作してるか不安なので、詳細は後日。

- 2007.7.20追記 -
resize.cgi。実際は画像以外も扱うので、ちょっとだけ複雑。

#!/usr/bin/perl -w

### -----------------------------------------
### ディレクトリ構造
### -----------------------------------------
### 画像ルート
### ┣ resize.cgi
### ┣ image1.jpg
### ┣ image2.jpg
### ┣ image3.gif
### ┣ ...
### ┣ キャッシュディレクトリ
###    ┣ image1.x=100.jpg
###    ┣ image2.y=100.jpg
###    ┣ image3.x=100.gif
###    ┣ image3.x=100&y=200.gif
###    ┣ ...

### -----------------------------------------
### 初期設定
### -----------------------------------------
my $org_dir = '';
my $cache_dir = 'cache';
my $default_width = undef;
my $default_height = undef;
my $max_width = 800;
my $max_height = 800;
### -----------------------------------------

use strict;
use warnings;
use HTTP_util; # 自前
use Image::Magick;

our %QUERY = &HTTP_util::read_query($ENV{'QUERY_STRING'});

$QUERY{'f'} or die 'file not found';

my ($name, $ext) = ($QUERY{'f'} =~ /^(.+)\.([^.]+)$/);
my $new_query = ($ENV{'QUERY_STRING'} =~ /^f=.+?&(.+)/)[0];
my $cache_path = sprintf('%s/%s.%s.%s', $cache_dir, $name, $new_query, $ext);

&binary_out($cache_path) or &resize_image($cache_path);

### -----------------------------------------
### 汎用バイナリ出力
### -----------------------------------------
sub binary_out {
    
    if (open(IN, $_[0])) {
        
        print &HTTP_util::get_http_header(tpl_name => $QUERY{'f'});
        
        binmode(IN);
        binmode(STDOUT);
        
        read(IN, my $buf, -s $_[0]);
        print $buf;
        close(IN);
        
        return 1;
    }
    
    return 0;
}

### -----------------------------------------
### 画像リサイズ出力 & キャッシュ出力
### -----------------------------------------
sub resize_image {
    
    ### ソース
    my $org_path = $org_dir. './'. $QUERY{'f'};
    -e $org_path or die 'file not found';
    
    my $image = Image::Magick->new; $image->Read($org_path);
    my ($width, $height, $format) = $image->Get('width', 'height', 'magick');
    
    ### 引数取得
    my $target_width = ($QUERY{'x'} or $default_width or 0);
    my $target_height = ($QUERY{'y'} or $default_height or 0);
    
    ### アスペクト比保持
    $target_height  ||= ($height * $target_width) / $width;
    $target_width   ||= ($width * $target_height) / $height;
    
    ### 上限判定
    $target_width = $max_width if ($target_width > $max_width);
    $target_height = $max_height if ($target_height > $max_height);
    
    ### 四捨五入と0回避
    $target_width = (int($target_width + 0.5) or 1);
    $target_height = (int($target_height + 0.5) or 1);
    
    ### リサイズ
    $image->Resize(width => $target_width, height => $target_height);
    
    ### ヘッダ出力
    print &HTTP_util::get_http_header(tpl_name => $QUERY{'f'});
    
    ### -----------------------------------------
    ### ユーザー出力
    ### -----------------------------------------
    binmode(STDOUT);
    $image->Write($format. ':-');
    
    ### -----------------------------------------
    ### キャッシュ出力
    ### -----------------------------------------
    if (open(CACHE, "> $_[0]")) {
        
        binmode(CACHE);
        $image->Write(file => \*CACHE, filename => $cache_dir);
        close(CACHE);
    }
    
    undef $image;
    
    return 1;
}

画像ルートに.htaccess。通常はそのままファイルにアクセス。クエリー指定があるならキャッシュファイル名を生成して書き換え。ファイルの存在確認のうえ、なければresize.cgiに書き換え。一応動いてるっぽいけど、かなり自信なし。

RewriteEngine On
RewriteCond %{REQUEST_FILENAME} !cache/[^\/]+$
RewriteCond %{REQUEST_FILENAME} !resize.cgi$
RewriteCond %{QUERY_STRING} .
RewriteRule (\w+)\.(\w+)$ cache/$1.%{QUERY_STRING}.$2 [E=ORG:$1.$2,C]
RewriteCond %{REQUEST_FILENAME} !-f
RewriteRule (.+) ?f=%{ENV:ORG}&%{QUERY_STRING}

Sun	Mon	Tue	Wed	Thu	Fri	Sat
			1	2	3	4
5	6	7	8	9	10	11
12	13	14	15	16	17	18
19	20	21	22	23	24	25
26	27	28	29	30

Stripe Calendar

Entry: Perl - サムネイル自動生成をモジュールにしてみた

Perl - サムネイル自動生成をモジュールにしてみた

Entry: 画像サムネイル自動生成機能つけてみた

画像サムネイル自動生成機能つけてみた

ウィジェットメニュー

カレンダー

最近の記事

コメント

その他

管理者実験用

Googleで検索

JAMADAM.COM

Stripe Calendar

Entry: Perl - サムネイル自動生成をモジュールにしてみた

Perl - サムネイル自動生成をモジュールにしてみた

Entry: 画像サムネイル自動生成機能つけてみた

画像サムネイル自動生成機能つけてみた

ウィジェットメニュー

検索

カレンダー

最近の記事

コメント

キーワード

その他

管理者実験用

Googleで検索