#!/usr/local/bin/perl
#============================================================================================================
#
# 画像サイズ変換CGI(i.cgi)
# i.cgi
# ---------------------------------------------
# 2004.2.13 start
#------------------------------------------------------------------------------------------------------------
#
# resize ; 画像のリサイズ
# check ; 端末の判別
# error ; エラー出力
#
#============================================================================================================
use strict;
BEGIN{
my($path,$lib);
$| = 1;
$path = $ENV{'SCRIPT_FILENAME'};
$path =~ m|(.+)/|o;
$path = "$1/module";
$lib = "$1/lib";
unshift(@INC,$lib);
unshift(@INC,$path);
require('qin.pl');
require('isildur.pl');
require('melkor.pl');
}
CGImain();
EndOfCGI();
#------------------------------------------------------------------------------------------------------------
#
# 画像のリサイズ変換
# -------------------------------------------
# 引 数：なし
# 戻り値：なし
#
#------------------------------------------------------------------------------------------------------------
sub CGImain
{
my $Q = new QIN;
my $I = new ISILDUR;
my $M = new MELKOR;
my ($IMG,$ext,$num,$mx,$my,$p,$x,$x2,$y,$y2,@Arg);
my ($buffer,$data,$filename,$src,$dst,$type,$path);
@Arg = split(/\//,$ENV{'PATH_INFO'});
$M->Set('MODE',0); # モードはread
$M->Set('BBS',$Arg[1]); # bbs名
$M->Set('KEY',$Arg[2]); # key
$M->Set('AGENT',1);
$M->MakeAnyPath();
error($M,$I,999) if(!$I->Load($M));
error($M,$I,'画像が存在しません') if(!$Arg[1] or !$Arg[2] or !$Arg[3]);
error($M,$I,'画像が存在しません') if(!-e $M->Get('PATH-BBS0').'/img/'.$M->Get('KEY')."/$Arg[3]");
$Q->LoadInit($M,$I);
if ($Q->Check('LOADAVG')){
require('fatima.pl');
if(FATIMA->new($Q)->check){
error($M,$I,602);
}
}
$data = $M->Get('DATA');
$path = $ENV{'SCRIPT_FILENAME'} || './';
$path =~ m|(.+)/|o;
$path = $1.'/cache';
$filename = crypt(substr(time,0,-8),substr($$,0,-2)); # 仮ファイル名生成
$filename =~ tr|./|__|;
($num,$ext) = split(/\./,$Arg[3]);
my $r = [$Q->getsize($M,$ext,$num)];
my ($c,$switch) = check($Q,$M,$num,$ext);
$type = $c->[2];
unless($switch){
my $rd;
my $wt;
$src = $M->Get('PATH-BBS0').'/img/'.$M->Get('KEY')."/$Arg[3]";
eval{
require File::Copy;
File::Copy->import(qw(copy));
copy($src,"$path/$filename.$type") or die;
};
if($@){
error($M,$I,"IOエラーが発生しました
$@");
}
$type = 'jpeg' if $type eq 'jpg' or $type eq '';
print "Content-type: image/$type\n\n";
}
elsif(-x "$data/repng2jpeg" and ($type eq 'jpg' or $type eq 'png')){
$src = $M->Get('PATH-BBS0').'/img/'.$M->Get('KEY')."/$Arg[3]";
$dst = "$path/$filename.$type";
if($r->[0] > $c->[0] or $r->[1] > $c->[1]){
$x2 = $c->[0] / $r->[0];
$y2 = $c->[1] / $r->[1];
($x2 < $y2) ? ($p = $x2) : ($p = $y2);
$r->[0] = int ($r->[0] * $p);
$r->[1] = int ($r->[1] * $p);
}
$ENV{'PATH'} = "/usr/bin:/usr/local/bin";
eval{
open(SYSTEM,"| $data/repng2jpeg $src $dst $r->[0] $r->[1] 90") or
die "Exec error: $! $?\n";
close(SYSTEM) or die "Exec error: $! $?\n";
};
if(length $@ > 0){
error($M,$I,"repng2jpegの実行が失敗しました
$@");
}
$type = 'jpeg' if $type eq 'jpg' or $type eq '';
print "Content-type: image/$type\n\n";
}
else{
eval{
require Image::Magick;
my $err;
my $src = $M->Get('PATH-BBS0').'/img/'.$M->Get('KEY')."/$Arg[3]";
$IMG = Image::Magick->new; # オブジェクト作成
$IMG->Read($src);
($x,$y) = $IMG->Get('width','height');
my $base = $x > $y ? 1 : 0; # 横長かどうか
my $spec = $c->[1] > $c->[0] ? 1 : 0; # 携帯が縦長か
my $geometry = $base & $spec ? $c->[1] : $c->[0];
$err = $IMG->Scale(geometry => $geometry) and die $err; # 比率による縮小
($x,$y) = $IMG->Get('width','height');
if($base){
$err = $IMG->Rotate(degrees => 90) and die $err;
}
$err = $IMG->Trim and die $err;
$err = $IMG->Write("$path/$filename.$type") and die $err; # 仮ファイル作成
};
if(length $@ > 0){
error($M,$I,"Image::Magickの実行が失敗しました
$@");
}
$type = 'jpeg' if $type eq 'jpg' or $type eq '';
print "Content-type: image/$type\n\n";
}
$type = 'jpg' if $type eq 'jpeg';
eval{ chmod(0666,"$path/$filename.$type"); };
open(my $fh,"<$path/$filename.$type") or
die "Can't open file($filename.$type): $!\n"; # 仮ファイルを開く
binmode($fh);
binmode(STDOUT);
print $buffer while (read($fh,$buffer,1024)); # 標準出力
close($fh);
unlink("$path/$filename.$type") or die "Can't open file: $!\n";
}
#------------------------------------------------------------------------------------------------------------
#
# 端末判別
# -------------------------------------------
# 引 数：$Q,$M : モジュール
# $num : ファイル番号
# $ext : ファイル拡張子
# 戻り値：$x : 幅
# $y : 高
# $type : 出力する拡張子
#
#------------------------------------------------------------------------------------------------------------
sub check
{
my ($Q,$M,$num,$ext) = @_;
my ($x,$y,$n);
my $ua = $ENV{'HTTP_USER_AGENT'};
my $table = SpecTable();
my %pdx;
while(my($key,$carrer) = each %$table){
if(index($ua,$key) >= 0){
while(my($key,$spec) = each %$carrer){
if(index($ua,$key) >= 0){
$spec->[2] = 'jpg' if $ext eq 'jpg';
if($spec->[2] eq 'gif,png'){
$spec->[2] = $ext eq 'gif' ? 'gif' : 'png';
}
return ($spec,1);
}
}
}
}
return ([$Q->getsize($M,$ext,$num),$ext],0);
}
#------------------------------------------------------------------------------------------------------------
#
# エラー表示
# -------------------------------------------
# 引 数：$M : モジュール
# 戻り値：なし
#
#------------------------------------------------------------------------------------------------------------
sub error
{
require('aragorn.pl');
require('denethor.pl');
require('elrond.pl');
require('thorin.pl');
my ($M,$I,$error) = @_;
my $A = new ARAGORN;
my $D = new DENETHOR;
my $E = new ELROND;
my $O;
my $T = new THORIN;
my ($back,$bbsPath,$ver);
$D->Load($M); # バナーロード
if ($error =~ /^\d+$/){ # SETTING読み込み
require('orald.pl');
$O = new ORALD;
$O->Load($M);
$O->Print($T,$M,$error,$M->Get('AGENT')); # エラー表示
exit;
}
$ver = $M->Get('VERSION');
$E->PrintHTMLHeadA($T,$M,$M->Get('AGENT'),'',$A->GetSubject(),'Shift_JIS'); # ヘッダ出力
$E->PrintHTMLBodyA($T,$I,$M->Get('AGENT')); # BODY出力
$D->Print($T,$M,100,2);
$T->Print("$error
\n");
$bbsPath = $M->Get('PATH-BBS1') . '/i/';
$T->Print("板 "); # mindexに戻る
$back = $ENV{'HTTP_REFERER'};
$T->Print("前
"); # 前表示
$T->Print("$ver