#! /usr/bin/perl
#
# imdl.cgi
# 画像ファイル表示＋ダウンロード
#
# 1.006 : 1/14/07 : jpegのサムネイルの画質を改善
# 1.005 : 10/27/06 : 画像処理速度を改善
# 1.004 : 10/26/06 : zipファイル格納ディレクトリを指定できるように修正
# 1.003 : 10/10/06 : ダウンロード合計ファイルサイズリミットを追加
# 1.002 : 6/27/06 : サムネイル画像ファイルを自動作成するように修正
# 1.001 : 6/26/06 : 一行に表示する画像の数の設定を追加
# 1.0 : 6/25/06 : Created.
#
# http://www.hidekik.com/
#
# $Id: imdl.cgi,v 1.10 2007/01/13 20:32:28 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.006";
my $updatedyear = "2007";

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

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

my $setupfile = "imdl_setup.pl";

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

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

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

# zipファイル格納ディレクトリ。CGIから見た相対パス。
our $zipdir = ".";

# $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 = "..";

# ダウンロードするファイルの合計サイズのリミット(MB)
our $size_limit = 20;

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

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

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

&error(("ディレクトリ$zipdirが存在しません","Cannot open directory:$zipdir")[$lang]) if (! -d $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 'download'){
    &makezip;
} else {
    &display;
}

exit;

sub makezip {
    my $zip = Archive::Zip->new();
    my $member;
    
    my $i=0;
    my $eachfile;
    my $totalsize;
    foreach (keys(%in)){
	if ($in{$_} eq 'on'){
	    next if ($_ eq 'allon' || $_ eq 'alloff');
	    /check_(\d\d*)/;
	    $eachfile = $filelist[$1];
	    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("$dldir/$eachfile");
	    $totalsize += $d_size;
	    if ($totalsize > $size_limit * 1048576){
		undef $zip;
		&error("ダウンロードしようとしている合計ファイルサイズが${size_limit}MBを超えています。");
	    }
	    $member = $zip->addFile("$dldir/$eachfile","$eachfile");
	}
    }
    
    my $status = $zip->writeToFileNamed("$zipdir/$zipfile");
    if ($status != 'AZ_OK') {
	unlink("$zipdir/$zipfile") if (-e "$zipdir/$zipfile");
	&error(("$zipdir/$zipfileが作成されません","Cannot create $zipdir/$zipfile")[$lang]) 
	}
    print "Location: $zipdir/$zipfile\n\n";
    
}

sub display {
    
    opendir(ZIPDIR, "$zipdir") or &error(("ディレクトリ$zipdirが開けません","Cannot open $zipdir")[$lang]);
    my @ziplist = grep /^$prefix.*\.zip$/, readdir ZIPDIR;
    closedir(ZIPDIR);
    
    my $zipfile;
    my $now = time;
    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);
    foreach $zipfile (@ziplist){
	($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");
	}
	
    }
    
    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 "$head_html\n";

    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=download>\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";
	
	($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=\"$dllistfile\" target=\"_blank\">";
	print "$dlfile";
	print "</a> ($size)<br>";
	print "<a href=\"$dllistfile\" target=\"_blank\">";

	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";
    
    print "<hr>\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";

}

sub ending {
    my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang];
    print qq|<div align="right"><i>imdl.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);
}