#! /usr/bin/perl
#
# rszim3.cgi
# 画像ファイル表示＋リサイズ＋ダウンロード
#
# 1.002 : 1/14/07 : 画像処理速度を更に改善、jpegのtruecolorとqualityを指定
# 1.001 : 10/27/06 : 画像処理速度を改善
# 1.0 : 8/25/06 : Created.
#
# $Id: rszim3.cgi,v 1.3 2007/01/13 20:01:08 Hideki Kanayama Exp $
# Copyright(c) 2006-2007, Hideki Kanayama, All rights reserved.

use Archive::Zip;
use CGI::Carp qw(fatalsToBrowser);
use Cwd;
use File::Basename;
use CGI qw(:cgi-lib);
use strict;
use GD;

my $script= basename($0);
my $version = "1.002";
my $updatedyear = "2007";

my $lang = 0;
my $charset = ('Shift_JIS', 'ISO-8859-1')[$lang];

my $prefix = 'rszim3';
my $zipfile = "$prefix$$.zip";

my $setupfile = "rszim3_setup.pl";

#### Environment setup from here ####################

# 公開するファイルがあるディレクトリ
# A directory to be disclosed
our $dldir = "files";

# 自動作成されたサムネイルを保存するディレクトリ
our $thumb_dir = "rszim3_thumbs";

# リサイズされた画像を保存するのテンポラリディレクトリ
our $tmpdir = 'tmpfiles';

# $zipdirにあるテンポラリ.zipファイルを削除するまでの時間（分）
# Expiratoin time to delete zip files in the temporary file
our $expire = 60;

# タイトル
# title
our $title = 'リサイズイメージ３';

# ページトップに表示するＨＴＭＬ
our $head_html = '<center><h3>リサイズイメージ３</h3></center>';

# 1ページ表示行数
# number to be displayed in one page
our $num_in_a_page = 12;

# トップページ画像表示サイズリミット(pixel)
our $default_x = 200;
our $default_y = 200;

# 一行に表示する画像の数
our $cols = 3;

# ファイル時刻表示
our $datedisp_en = 0;

# 戻るリンク
# back link
our $back = ('戻る','Back')[$lang];
our $backlink = "..";

# リサイズページで表示する幅サイズ
our $orig_image_pix = 320;

#### Environment setup till here ####################

my $zipdir = $tmpdir;
my $default_pw = 100;
my $default_ph = 100;
my $default_rw = 50;
my $default_rh = 50;
my $default_ar = 50;

require "$setupfile" if (-e "$setupfile");

my $q = new CGI;
my $cgierror = $q->cgi_error;
&error($cgierror) if ($cgierror);
my %in = $q->Vars;

if (! -d $zipdir) {
    mkdir ($zipdir);
}

opendir(DLDIR, "$dldir") or &error(("ディレクトリ$dldirが存在しません","Cannot open directory:$dldir")[$lang]);
my @filelist = sort grep !/^\./, readdir DLDIR;
closedir(DLDIR);
my @imagelist;
@imagelist = grep /\.jpe?g$/i, @filelist;
@imagelist = (@imagelist, grep /\.gif$/i,   @filelist);
@imagelist = (@imagelist, grep /\.png$/i,   @filelist);
@imagelist = (@imagelist, grep /\.gd$/i,    @filelist);
@imagelist = (@imagelist, grep /\.gd2$/i,   @filelist);
@filelist = (@imagelist);
unshift(@filelist,'dummy');

if ($in{mode} eq 'resize'){
    &resize;
} elsif ($in{mode} eq 'delete_image'){
    &delete_image;
} elsif ($in{mode} eq 'makezip'){
    &makezip;
} elsif ($in{mode} eq 'idlepage'){
    &idlepage;
} else {
    &display;
}

exit;

sub cleanup {
    &delete_zip;
    &delete_image_auto;
}

sub makezip {

    my $zip = Archive::Zip->new();
    my $member;
    
    chdir($tmpdir);
    my $i=0;
    my $eachfile;
    my @images = split /,/, $in{images};
    foreach (@images){
	$member = $zip->addFile("$_");
    }
    
    my $status = $zip->writeToFileNamed("$zipfile");
    if ($status != 'AZ_OK') {
	unlink("$zipfile") if (-e "$zipfile");
	&error(("$zipfileが作成されません","Cannot make $zipfile")[$lang]) 
	}
    rename "$zipfile", "$zipdir/$zipfile";
    chdir($zipdir);
    print "Location: $zipdir/$zipfile\n\n";
    
}


sub display {
    &cleanup;
    
    my $from;
    if (! exists $in{from}) {
	$from = 1;
    } else {
	$from = $in{from};
    }
    my $to;
    if (! exists $in{to}){
	$to = $num_in_a_page;
    } else {
	$to = $in{to};
    }

    &beginning($from,$to);

    print qq(<a href="$backlink">$back</a>\n);
    print "<hr>\n";
    print qq|<form name="selectfile" action="$script" method="post">\n|;
    print qq|<input type=hidden name=mode value=idlepage>\n|;
    my $alldownload_name = ('チェックした分をまとめてリサイズダウンロード','Download all')[$lang];
    my $allon_name = ('全部オン','All on')[$lang];
    my $alloff_name = ('全部オフ','All off')[$lang];
    print qq|<input type=submit name=dlbutton value="$alldownload_name"><p>\n|;
    &listlink($from,$to);
    print "<p>\n";
    print qq|<input type=checkbox name=allon onClick="allcheck()">$allon_name\n|;
    print qq|<input type=checkbox name=alloff onClick="allrelease()">$alloff_name<br>\n|;
    
    print qq(<table cols=$cols border=0>);

    my $i;
    for ($i=1;$i<=$#filelist;$i++){
	if ($i < $from or $i > $to) {
	    next;
	}

	if (($i-$from)%$cols == 0){
	    print "<tr>\n";
	}
	print "<td align=\"left\" valign=\"top\">\n";

	my $dlfile = $filelist[$i];
	chomp($dlfile);
	my $dllistfile = "$dldir/$dlfile";
	
	my ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$dllistfile");

	my $size;
	if ($d_size > 1048576){
	    $size = sprintf("%.1fMB",$d_size/1048576);
	} elsif ($d_size > 1024){
	    $size = sprintf("%.1fkB",$d_size/1024);
	} else {
	    $size = sprintf("%dB",$d_size);
	}
	
	my $checkname = "check_$i";
	
	print qq|<input type=checkbox name="$checkname" onClick="release()">|;
	print "$i, <a href=\"$script?mode=idlepage&filename=$dlfile\">";
	print "$dlfile";
	print "</a> ($size)<br>";
	print "<a href=\"$script?mode=idlepage&filename=$dlfile\">";

	my ($im,$width,$height) = &openimage($dlfile);
	my ($new_width, $new_height) = &getnewsize($width,$height);

	my ($body,$path,$suffix) = fileparse("$dlfile",'\.\w+');
	my $new_image = "$thumb_dir/$body" . "_${new_width}x${new_height}" . "$suffix";

	print qq(<img src=\");
	&makeimage($dlfile, $im, $width, $height, $new_width, $new_height);
        print qq(\" border=0>\n);

	print "</a>";
	print "<br>\n";

	if ($datedisp_en) {
	    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime($d_mtime);
	    my $update;
	    if ($lang) {
		$update = sprintf("%02s:%02s %s/%s/%s",$hour,$min,$mon+1,$mday,$year+1900);
	    } else {
		$update = sprintf("%s年%s月%s日%02s時%02s分",$year+1900,$mon+1,$mday,$hour,$min);
	    }
	    
	    print " <font color=\"gray\">$update</font>\n";
	}

	print "</td>\n";
	if (($i-$from)%$cols == $cols-1){
	    print "</tr>\n";
	}

    }

    print qq(</table>);
    
    print "<p>\n";
    &listlink($from,$to);
    print qq|<p><input type=submit name=dlbutton value="$alldownload_name">\n|;
    print "</form>\n";
    
    &ending;
}

sub beginning {
    my ($from,$to) = @_;
    print $q->header(-type=>'text/html', -charset=>"$charset");
    print "<html>";
    print <<HEADPRINT;
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=$charset">
<TITLE>$title</TITLE>
<STYLE type="text/css">
  A:link {text-decoration: none}
  A:visited {text-decoration: none}
  A:active {text-decoration: none}
</style>
HEADPRINT
	
   &jsset($from,$to) if ($in{mode} eq '');
    
    print "</HEAD>\n";
    
    print "<BODY TEXT=\"#000000\" bgcolor=\"#ffffff\" LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";

    print "$head_html\n";
}

sub ending {
    my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang];
    print "<hr>\n";
    print qq|<div align="right"><i>rszim3.cgi Ver. $version<br>Copyright(c) 2006-$updatedyear, <a href="$mysite" target="_blank">hidekik.com</a></i></div>\n|;
    print "</body>";
    print "</html>";
}


sub error {
    &beginning;
    print "<br><center>$_[0]</center>\n";
    &ending;
    exit;
}

sub jsset {
    my ($from,$to) = @_;
    my (@locallist) = @filelist;
    shift(@locallist);
   
    print <<JSDISP1;
<script language="JavaScript">
function allcheck(){
if (document.selectfile.allon.checked==1){
	document.selectfile.alloff.checked=0;
JSDISP1

    my $localfile;
    my $i=1;
    my $check;
    foreach $localfile (@locallist){
	if ($i >= $from and $i <= $to) {
	    $check = "check_$i";
	    print "		document.selectfile.$check.checked=1;\n";
	}
	$i++;
    }

    print "	}\n";
    print "}\n";

print <<JSDISP2;
function allrelease(){
	if (document.selectfile.alloff.checked==1){
		document.selectfile.allon.checked=0;
JSDISP2

$i=1;
foreach $localfile (@locallist){
	if ($i >= $from and $i <= $to) {
	    $check = "check_$i";
	    print "		document.selectfile.$check.checked=0;\n";
	}
	$i++;
}

print "	}\n";
print "}\n";

print <<JSDISP3;
function release(){
	document.selectfile.allon.checked=0;
	document.selectfile.alloff.checked=0;
}
</script>
JSDISP3

}

sub listlink {
    my ($from, $to) = @_;
    my $i;
    for ($i=1;$i<=$#filelist;$i+=$num_in_a_page){
	my $end = $i + $num_in_a_page - 1;
	if ($end > $#filelist) {
	    $end = $#filelist;
	}
	print qq(<a href="$script?from=$i&to=$end">);
	print $i . '-' . $end;
	print "</a> ";
    }
    print "<br>\n";
}

sub getnewsize {
    my ($width, $height) = @_;
    my $new_width;
    my $new_height;
    if ($width > $default_x or $height > $default_y){
	my $width_shrink  = $default_x  / $width;
	my $height_shrink = $default_y / $height;
	my $shrink_ratio;
	if ($width_shrink < $height_shrink){
	    $shrink_ratio = $width_shrink;
	} else {
	    $shrink_ratio = $height_shrink;
	}
	$new_width  = int($width  * $shrink_ratio);
	$new_height = int($height * $shrink_ratio);
    } else {
	$new_width  = $width;
	$new_height = $height;
    }
    return ($new_width, $new_height);
}

sub makeimage {
    my ($imagefile,$im,$width,$height, $new_width, $new_height) = @_;

    my ($body,$path,$suffix) = fileparse("$imagefile",'\.\w+');
    my $new_image = "$thumb_dir/$body" . "_${new_width}x${new_height}" . "$suffix";
    
    if (! -e "$new_image"){

	my $target_im = new GD::Image($new_width,$new_height,1);
	$target_im->copyResized($im,0,0,0,0,$new_width,$new_height,
				$width,$height);

	if (! -d "$thumb_dir") {
	    mkdir ("$thumb_dir") or &error("$thumb_dirを作成できません。");
	}
	unless (open(IMAGE, "> $new_image")){
	    &error (("テンポラリファイル作成に失敗しました。",'Failed to create a temporary file')[$lang]);
	}
	binmode(IMAGE);
	if ($suffix =~ /\.jpe?g$/i){
	    print IMAGE $target_im->jpeg(85);
	} elsif ($suffix =~ /\.gif$/i) {
	    print IMAGE $target_im->gif();
	} elsif ($suffix =~ /\.png$/i) {
	    print IMAGE $target_im->png();
	} elsif ($suffix =~ /\.gd$/i) {
	    print IMAGE $target_im->gd();
	} elsif ($suffix =~ /\.gd2$/i) {
	    print IMAGE $target_im->gd2();
	}
	close(IMAGE);
	chmod (0666,$new_image);
	undef $target_im;
    }
    print "$new_image";

}

sub openimage {
    my $imagefile = shift;
    my ($body,$path,$suffix) = fileparse("$imagefile",'\.\w+');
    $imagefile = "$dldir/$imagefile";
    my $im;
    my $target_type = $q->param('target_type');
    if ($suffix =~ /\.jpe?g$/i){
	$im = GD::Image->newFromJpeg($imagefile,1);
    } elsif ($suffix =~ /\.gif$/i) {
	$im = GD::Image->newFromGif($imagefile);
    } elsif ($suffix =~ /\.png$/i) {
	$im = GD::Image->newFromPng($imagefile);
    } elsif ($suffix =~ /\.gd$/i) {
	$im = GD::Image->newFromgd($imagefile);
    } elsif ($suffix =~ /\.gd2$/i) {
	$im = GD::Image->newFromgd2($imagefile);
    } else {
	print (("<center>$suffixはサポートされていません。</center>","<center>$suffix is not supported</center>")[$lang]);
	exit;
    }
    unless ($im) {
	print (("<center>$imagefileが正常に開けません</center>","<center>Could not open $imagefile.</center>")[$lang]);
	exit;
    }
    
    my ($width, $height) = $im->getBounds();
    return ($im, $width, $height);
}

sub delete_image_auto {
    my @imglist = &getimagelist($tmpdir);
    my $imgfile;
    my $now = time;
    foreach $imgfile (@imglist){
	my ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$tmpdir/$imgfile");
	if ($now > $d_mtime + $expire * 60){
	    unlink("$tmpdir/$imgfile");
	}
    }
}

sub delete_image {
    my @images = split /,/, $in{images};
    my @deleted;
    foreach (@images){
	if (-e "$tmpdir/$_") {
	    unlink "$tmpdir/$_";
	    push (@deleted,$_);
	}
    }
    print $q->header(-charset=>$charset);
    print "<center>";
    &backbutton;
    print "<p>";
    my $deleted = join ',', @deleted;
    if ($#deleted > -1) {
	print (("$deletedを削除しました。","Deleted $deleted.")[$lang]);
    } else {
	print (("$in{images}は存在しませんでした。","There are no $in{images}.")[$lang]);
    }
    print "<p>";
    &backbutton;
    print "</center>";
    exit;
}

sub idlepage {
    &cleanup;
    &beginning;

    print "<center>\n";
    print "<p>";
    print qq(<a href="$script">$titleへ</a>\n);
    print "<p>\n";
    print (("この画像のサイズを変更します。","Resizing the following image.")[$lang]);

    print "<p>\n";
    print qq(<form name="inform" action="$script" method=post>\n);

    my @images;
    if ($in{filename} ne ''){
	@images = split /,/, $in{filename};
    } else {
	foreach (keys(%in)){
	    if ($in{$_} eq 'on'){
		next if ($_ eq 'allon' || $_ eq 'alloff');
		/check_(\d\d*)/;
		push(@images,$filelist[$1]);
	    }
	}
    }

    foreach my $imagefile (@images) {
	if (! -e "$dldir/$imagefile") {
	    print (("$dldir/$imagefileが開けません。","Cannot open $dldir/$imagefile.")[$lang]);
	    exit;
	}
	my ($body,$path,$suffix) = fileparse("$imagefile",'\.\w+');
	my ($im, $width, $height) = &openimage($imagefile);

	my $actual_width;
	my $actual_height;
	if ($width > $orig_image_pix or $height > $orig_image_pix){
	    my $width_shrink  = $orig_image_pix  / $width;
	    my $height_shrink = $orig_image_pix / $height;
	    my $shrink_ratio;
	    if ($width_shrink < $height_shrink){
		$shrink_ratio = $width_shrink;
	    } else {
		$shrink_ratio = $height_shrink;
	    }
	    $actual_width  = int($width  * $shrink_ratio);
	    $actual_height = int($height * $shrink_ratio);
	} else {
	    $actual_width  = $width;
	    $actual_height = $height;
	}

	print (("元サイズ: 幅=$width, 高さ=$height<br>\n","Original size: Width=$width, Height=$height<br>\n")[$lang]);
	print qq(<a href="$dldir/$imagefile" target="_blank">);
	print qq(<img src="$dldir/$imagefile" width="$actual_width" height="$actual_height" border=0>);
	print qq(</a><p>\n);

    }

    print qq(<br>);

    print qq(<table cols=1 width="10%" border=0 align=center>\n);
    print qq(<tr><td nowrap>\n);
    print qq(<input type=radio name=target_type value=xy_pixel checked> \n);
    print (('幅','Width pixel')[$lang]);
    print qq(<input type=text size=5 name=target_pw value=$default_pw>pixel \n);
    print (('高さ','Height pixel')[$lang]);
    print qq(<input type=text size=5 name=target_ph value=$default_ph>pixel<br>\n);

    print qq(<input type=radio name=target_type value=xy_ratio> \n);
    print (('幅変換率','Width ratio')[$lang]);
    print qq(<input type=text size=5 name=target_rw value=$default_rw>% \n);
    print (('高さ変換率','Height ratio')[$lang]);
    print qq(<input type=text size=5 name=target_rh value=$default_rh>%<br>\n);

    print qq(<input type=radio name=target_type value=area_ratio> \n);
    print (('面積変換率','Area ratio')[$lang]);
    print qq(<input type=text size=5 name=target_rarea value=$default_ar>%<br>\n);

    print qq(<br><input type="submit" name="go" value=\");
    print (('変換する','Convert')[$lang]);
    print qq(\" >\n);
    print qq(</td></tr>\n);
    print qq(</table>\n);
    print "</center>\n";
    print qq(<input type=hidden name=mode value=resize>);
    my $allfiles = join ",", @images;
    print qq(<input type=hidden name=filename value=$allfiles>);
    print qq(</form>\n);
    &ending;
}

sub resize {
    my $i;
    my $target_type = $in{target_type};
    if ($target_type ne 'xy_pixel' and 
	$target_type ne 'xy_ratio' and
	$target_type ne 'area_ratio'){
	&error((('変換方法を選択してください。','Please select conversion type')[$lang]));
    }

    &beginning;
    print "<center>";
    print (("保存は画像をクリックして別ウィンドウで保存するか、右クリックでメニューから保存してください。","Please save photo with right click on a image, or simply click the image and do it on a separate window.")[$lang]);
    print "<br>\n";
    print (("まとめてアーカイブされた.zipでダウンロードする場合は、画像を削除する前にこのページ一番下の「まとめてzip fileでダウンロードする」をクリックしてください。","If you want to download with a .zip file, please click \"Download as a zip file\" in the bottom of this page before deleting the images.")[$lang]);
    print "<p>\n";
    print (("サーバー上に変換後の画像ファイルが作成されているので個別に消す場合は「このファイルをサーバーから削除する」をクリックしてください。またまとめて全部消す場合はこのページ一番下にある「変換後の全ての画像をサーバ上から削除する」をクリックしてください。ここで削除しなくてもファイルは一定時間後に自動的に削除されます。","The converted files are generated in the server. If you want to delete them from the server individually, please click \"Delete this file on the server\". If you want to delete all of them at once, please click \"Delete all converted files from the server\" link. If you remember file names, you can delete the files by $script?mode=delete_image&images=filename,filename,.... The files will be deleted automatically some time later.")[$lang]);
    print "<br>\n";
    &backbutton;
    print "</center>";

    my @new_imagefiles;
    foreach my $imagefile (split /,/, $in{filename}) {
	my $image = basename($imagefile);
	$image =~ s/^.+[\/\\]([^\/\\]+)$/$1/; #just in case
	my ($body,$path,$suffix) = fileparse("$image",'\.\w+');
	my ($im, $width, $height) = &openimage($imagefile);
	my ($new_width, $new_height);
	if ($target_type eq 'xy_pixel'){
	    ($new_width, $new_height) = (int($in{target_pw}), int($in{target_ph}));
	} elsif ($target_type eq 'xy_ratio'){
	    ($new_width, $new_height) = (int($width*$in{target_rw}/100), int($height*$in{target_rh}/100));
	} elsif ($target_type eq 'area_ratio'){
	    ($new_width, $new_height) = (int($width*sqrt($in{target_rarea}/100)), int($height*sqrt($in{target_rarea}/100)));
	} else {
	    print (("無効なサイズ選択です。","Invalid size selectoin")[$lang]);
	    exit;
	}

	my $new_image_body =  lc($body) . "_${new_width}x${new_height}" . lc($suffix);
	my $new_image = "$tmpdir/$new_image_body";

	push(@new_imagefiles,$new_image_body);

	my $target_im = new GD::Image($new_width,$new_height,1);
	$target_im->copyResized($im,0,0,0,0,$new_width,$new_height,
				$width,$height);

	if (! -d "$tmpdir"){
	    mkdir $tmpdir;
	}
	unless (open(IMAGE, "> $new_image")){
	    print (("テンポラリファイル作成に失敗しました。",'Failed to create a temporary file')[$lang]);
	    exit;
	}
	binmode(IMAGE);
	if ($suffix =~ /\.jpe?g$/i){
	    print IMAGE $target_im->jpeg(90);  # specify quality
	} elsif ($suffix =~ /\.gif$/i) {
	    print IMAGE $target_im->gif();
	} elsif ($suffix =~ /\.png$/i) {
	    print IMAGE $target_im->png();
	} elsif ($suffix =~ /\.gd$/i) {
	    print IMAGE $target_im->gd();
	} elsif ($suffix =~ /\.gd2$/i) {
	    print IMAGE $target_im->gd2();
	}
	close(IMAGE);
	chmod (0666,$new_image);

	print "<center>\n";
	print "$new_image_body<br>\n";
	print "width=$new_width, height=$new_height<br>\n";
	my $dellink_mes = ("このファイルをサーバーから削除する","Delete this image file from the server")[$lang];
	print qq(<a href="$script?mode=delete_image&images=$new_image_body">$dellink_mes</a><br>\n);
#	print qq(<a href="$new_image" target="_blank"><img src="$script?mode=dispimage&image=$new_image_body" border=0></a><p>\n);
	print qq(<a href="$new_image" target="_blank"><img src="$new_image" border=0></a><p>\n);
	print "</center>\n";
    }

    my $new_imagefiles = join ",", @new_imagefiles;

    my $delmes = ("変換後の全ての画像をサーバ上から削除する","Delete all converted images from server")[$lang];
    print "<center>";
    print qq(<a href="$script?mode=delete_image&images=$new_imagefiles">$delmes</a><p>\n);
    my $archive_mes = ("まとめてzip fileでダウンロードする","Download as a zip file")[$lang];
    print qq(<a href="$script?mode=makezip&images=$new_imagefiles">$archive_mes</a><br>\n);
    &backbutton;
    print "</center>";
    &ending;
}

sub delete_zip {
    opendir(ZIPDIR, "$zipdir") or &error(("ディレクトリ$zipdirが開けません","Cannot open $zipdir")[$lang]);
    my @ziplist = grep /^$prefix.*\.zip$/, readdir ZIPDIR;
    closedir(ZIPDIR);
    
    my $zipfile;
    my $now = time;
    foreach $zipfile (@ziplist){
	my ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$zipdir/$zipfile");
	if ($now > $d_mtime + $expire * 60){
	    unlink("$zipdir/$zipfile");
	}
    }
}

sub backbutton {
    my $back = ('戻る','Back')[$lang];
    print "<form><input type=button value=\"$back\" onClick=\"history.back()\"></form>\n";
}

sub getimagelist {
    my $dir = shift;
    opendir(DLDIR, "$dir") or &error(("ディレクトリ$dirが存在しません","Cannot open directory:$dir")[$lang]);
    my @filelist = sort grep !/^\./, readdir DLDIR;
    closedir(DLDIR);
    my @imagelist;
    @imagelist = grep /\.jpe?g$/i, @filelist;
    @imagelist = (@imagelist, grep /\.gif$/i,   @filelist);
    @imagelist = (@imagelist, grep /\.png$/i,   @filelist);
    @imagelist = (@imagelist, grep /\.gd$/i,    @filelist);
    @imagelist = (@imagelist, grep /\.gd2$/i,   @filelist);

    return @imagelist;
}