#! /usr/bin/perl
#
# rszim2.cgi
#
# Resizing images, display and make a zip file.
# イメージファイルをリサイズして表示、zip作成
#
# 2.002 : 1/14/07 : Jpegファイルの画質を改善
# 2.001 : 1/12/07 : リサイズ後の画像表示を高速化
# 2.0 : 2/13/06 : Created as a non-upload version
#
# $Id: rszim2.cgi,v 1.2 2007/01/12 04:14:02 Hideki Kanayama Exp $
# Copyright(c) 2006-2007, Hideki Kanayama, All rights reserved

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

my $lastupdatedyear = 2007;
my $version = "2.002";

my $script = basename($0);

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

my $setupfile = "rszim2_setup.pl";

###
our $backname = ("戻る","back")[$lang];
our $back = "../rszim.html";

our $body_width = 100;
our $title = 'Resize Image';
our $bgcolor = 'white';

our $imagedir = 'origfiles';
our $tmpdir = 'tmpfiles';

our $orig_image_pix = 320;
###

my $prefix = 'rszim';
my $zipfile = "$prefix$$.zip";
my $zipdir = $tmpdir;
my $expire = 60;

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 = CGI->new;
my $cgierror = $q->cgi_error;
&error($cgierror) if ($cgierror);
my %in = $q->Vars;

if (! -d "$imagedir") {
    &error(("$imagedirが存在しません。元画像が入っているディレクトリを指定してください。","Cannot open $imagedir. Please specify the directory which original images contain.")[$lang]);
}

if ("$imagedir" eq "$tmpdir") {
    &error(("$imagedirと$tmpdirは別なディレクトリに設定してください。$tmpdir内のファイルは一定時間後に自動削除されます。","$tmpdir is not allowed to be the same directory as $imagedir. The contents in the $tmpdir will be deleted automatically.")[$lang]);
}

if (! -d "$tmpdir"){
    mkdir $tmpdir;
    chmod 0777, $tmpdir;
}

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

sub cleanup {
    &delete_zip;
    &delete_image_auto;
}

sub getimagelist {
    my $dir = shift;
    opendir(DLDIR, "$dir") or &error(("ディレクトリ$imagedirが存在しません","Cannot open directory:$imagedir")[$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;
}

sub listpage {
    &cleanup;
    my @imagelist = &getimagelist($imagedir);
    &htmlhead($title);

    print "<p>";
    print qq(<a href="$back">$backname</a>\n);
    print "<p>\n";
    print "<ul>\n";
    foreach (@imagelist){
	print qq(<li><a href="$script?filename=$_">$_</a></li>\n);
    }
    print "</ul>\n";
    &htmltail;
}

sub idlepage {
    &cleanup;
    &htmlhead($title);

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

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

    foreach my $imagefile (split /,/, $in{filename}) {
	if (! -e "$imagedir/$imagefile") {
	    print (("$imagedir/$imagefileが開けません。","Cannot open $imagedir/$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="$imagedir/$imagefile" target="_blank">);
	print qq(<img src="$imagedir/$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>);
    print qq(<input type=hidden name=filename value=$in{filename}>);
    print qq(</form>\n);
    &htmltail;
}

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]));
    }

    &htmlhead($title);
    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 "<p>\n";
    print (("サーバー上に変換後の画像ファイルが作成されているので個別に消す場合は「このファイルをサーバーから削除する」をクリックしてください。またまとめて全部消す場合はこのページ一番下にある「変換後の全ての画像をサーバ上から削除する」をクリックしてください。変換後のファイル名を覚えていれば後から$script?mode=delete_image&images=filename,filename,...で削除できます。ここで削除しなくてもファイルは一定時間後に自動的に削除されます。","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 "<p>\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 "<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);
	
	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(80);
	} 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="$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>";
    &htmltail;
}

sub openimage {
    my $imagefile = shift;
    my ($body,$path,$suffix) = fileparse("$imagefile",'\.\w+');
    $imagefile = "$imagedir/$imagefile";
    my $im;
    my $image_type;
    my $target_type = $q->param('target_type');
    if ($suffix =~ /\.jpe?g$/i){
	$im = GD::Image->newFromJpeg($imagefile,1);
	$image_type = 'jpg';
    } elsif ($suffix =~ /\.gif$/i) {
	$im = GD::Image->newFromGif($imagefile);
	$image_type = 'gif';
    } elsif ($suffix =~ /\.png$/i) {
	$im = GD::Image->newFromPng($imagefile);
	$image_type = 'png';
    } elsif ($suffix =~ /\.gd$/i) {
	$im = GD::Image->newFromgd($imagefile);
	$image_type = 'gd';
    } elsif ($suffix =~ /\.gd2$/i) {
	$im = GD::Image->newFromgd2($imagefile);
	$image_type = 'gd2';
    } 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 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 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 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 backbutton {
    my $back = ('戻る','Back')[$lang];
    print "<form><input type=button value=\"$back\" onClick=\"history.back()\"></form>\n";
}

sub htmlhead {
  
  my $title = shift;
  
  my $bgimage = "bgcolor=\"$bgcolor\"";

  print $q->header(-charset=>$charset);
  print "<html>\n";
  print "<HEAD>\n";
  print "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=$charset\">\n";
  print "<TITLE>$title</TITLE>\n";
  print "</HEAD>\n";
  print "<BODY TEXT=\"#000000\" $bgimage LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
  print "<table cols=1 border=0 width=\"${body_width}%\" style=\"border:0px\" align=center><tr><td style=\"border:0px;background-color:transparent\" >\n";
  
}

sub htmltail {
    my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang];
  print "<div align=\"right\"><i>$script Ver. $version</i></div>\n";
  print "<div align=\"right\"><i>Copyright(C) 2005-$lastupdatedyear, <a href=\"$mysite\" target=\"_blank\">hidekik.com</a></i></div>\n";
  print "</td></tr></table></body></html>\n";
}

sub error {
    my ($msg) = shift;
    &htmlhead($msg);
    print "<br><center>$msg</center>\n";
    &htmltail;
    exit;
}