#! /usr/bin/perl
#
# imlist2.cgi
# サムネイル自動作成＋画像一覧表示
#
# 2.004 : 5/2/08 : 表示順をソートするよう修正
# 2.003 : 12/21/07 : 表示更新順オプションを追加
# 2.002 : 7/11/07 : tableタグを修正
# 2.001 : 6/24/07 : サムネイルを自動作成しないオプションを追加
# 2.0 : 1/15/06 : imlist.cgiにトップランダム機能を追加
#
# http://www.hidekik.com/
#
# $Id: imlist2.cgi,v 1.9 2008/05/02 03:22:46 Hideki Kanayama Exp $
# Copyright(c) 2006-2008, Hideki Kanayama, All rights reserved.

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 = "2.004";
my $updatedyear = "2008";

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

my $setupfile = "imlist_setup.pl";

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

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

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

# タイトル
# title
our $title = '画像一覧２';

# ページトップに表示するＨＴＭＬ
our $head_html = '<center><h3>画像一覧２</h3></center>';

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

# 表示順 1:最新順 0:トップランダム、他アルファベット順
our $listorder = 0;

# サムネイル自動作成 1:on 0:off
our $thumb_en = 1;

# サムネイルの画像サイズリミット(pixel)
our $default_x = 200;
our $default_y = 200;

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

# 番号表示 1:表示 0:非表示
our $numdisp_en = 0;

# ファイル名表示 1:表示 0:非表示
our $filename_en = 0;

# ファイルサイズ表示 1:表示 0:非表示
our $filesize_en = 0;

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

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

#### 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;

opendir(IMDIR, "$imdir") or &error(("ディレクトリ$imdirが存在しません","Cannot open directory:$imdir")[$lang]);
my @filelist = sort grep !/^\./, readdir IMDIR;
closedir(IMDIR);
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 =  sort @imagelist;
if ($listorder){
    @filelist = sort {(stat("$imdir/$b"))[9] <=> (stat("$imdir/$a"))[9]} @filelist;
}
my $orignum = $#filelist+1;

&display;

exit;

sub display {
    
    my @newlist;
    my $i;
    if (exists $in{from} and exists $in{to}){
	my $from = $in{from};
	my $to = $in{to};
	if ($from < 1){
	    $from = 1;
	    $to = $from + $num_in_a_page - 1;
	}
	if ($to > $orignum){
	    $to = $orignum;
	}
	@newlist = @filelist[$from-1 .. $to-1];
    } else {
	if ($listorder){
	    @newlist = @filelist[0 .. $num_in_a_page-1];
	} else {
	    for ($i=0;$i<$num_in_a_page;$i++){
		my $newnum = $#filelist+1;
		push @newlist, splice @filelist, rand $newnum, 1;
	    }
	}
    }

    &beginning;

    print "$head_html\n";

    print "<center>\n";
    print qq(<a href="$backlink">$back</a><p>\n) if ($backlink_en);
#    print "<hr>\n";
    &listlink;
    print "</center>\n";
    print "<p>\n";
    
    print qq(<table cols=$cols border=0 align=center>\n);

    my $trdone = 0;
    for ($i=0;$i<$num_in_a_page;$i++){

	next unless (exists $newlist[$i]);

	my $imfile = $newlist[$i];
	if ($i%$cols == 0){
	    $trdone = 0;
	    print "<tr>\n";
	}
	print "<td align=\"center\" valign=\"top\">\n";

	chomp($imfile);
	my $dllistfile = "$imdir/$imfile";
	
	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);
	}
	
	print "$i, " if ($numdisp_en);
	print "<a href=\"$dllistfile\" target=\"_blank\">$imfile</a> " if ($filename_en);
	print "($size)" if ($filesize_en);
	print "<br>";
	print "<a href=\"$dllistfile\" target=\"_blank\">";

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

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

	print qq(<img src=\");
	&makeimage($imfile, $im, $width, $height, $new_width, $new_height);
        print qq(\" border=0 width=\"$new_width\" height=\"$new_height\">\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%$cols == $cols-1){
	    print "</tr>\n";
	    $trdone = 1;
	}

    }

    print "</tr>\n" if ($trdone == 0);
    print qq(</table>);
    
    print "<p>\n";
    print "<center>\n";
    &listlink;
    print "</center>\n";
    
#    print "<hr>\n";
    &ending;
}

sub beginning {
    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
	
    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>imlist2.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 listlink {
    my $i;
    my $from = $in{from};
    my $to = $in{to};
    if ($from < 1){
	$from = 1;
	$to = $from + $num_in_a_page - 1;
    }
    if (exists $in{from} and exists $in{to}){
	print qq(<b>$from-);
	my $current_to = $from+$num_in_a_page-1;
	if ($current_to > $orignum) {$current_to = $orignum;}
	print qq($current_to</b><br>);
	my $prevfrom = $from - $num_in_a_page;
	my $prevto = $from - 1;
	my $nextfrom = $from + $num_in_a_page;
	my $nextto = $to + $num_in_a_page;
	if ($prevfrom >= 1){
	    print qq(<a href="$script?from=$prevfrom&to=$prevto">&lt;-Prev</a>\n);
	}
	if ($nextfrom <= $orignum){
	    if ($nextto > $orignum) {$nextto = $orignum;}
	    print qq(<a href="$script?from=$nextfrom&to=$nextto">Next-&gt;</a>\n);
	}
	print "<p>\n";
    }
    if ($listorder){
	print qq(<a href="$script">最新</a><br>);
    } else {
	print qq(<a href="$script">random</a><br>);
    }
    for ($i=1;$i<=$orignum;$i+=$num_in_a_page){
	my $end = $i + $num_in_a_page - 1;
	if ($end > $orignum) {
	    $end = $orignum;
	}
	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 + 0.5);
	$new_height = int($height * $shrink_ratio + 0.5);
    } else {
	$new_width  = $width;
	$new_height = $height;
    }
    return ($new_width, $new_height);
}

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

    my $new_image;
    if ($thumb_en){
	my ($body,$path,$suffix) = fileparse("$imagefile",'\.\w+');
	$new_image = "$thumb_dir/$body" . "_${new_width}x${new_height}" . "$suffix";
    
	if ((! -e "$new_image") or (-z "$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;
	}
    } else {
	$new_image = "$imdir/$imagefile";
    }
    print "$new_image";
}

sub openimage {
    my $imagefile = shift;
    my ($body,$path,$suffix) = fileparse("$imagefile",'\.\w+');
    $imagefile = "$imdir/$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);
}