#! /usr/bin/perl
#
# almob.cgi
# 携帯用写真表示CGI
#
# 1.004  : 2/6/08 : 画像を縮小しないオプションを追加
# 1.003  : 1/30/08 : リンクにaccesskeyを追加
# 1.002  : 12/22/07 : リストファイル無しの場合の表示順オプションを追加
# 1.001  : 11/19/07 : 縮小画像ファイルサイズ制限機能を追加
# 1.0  : 11/11/07 : Created
#
# http://www.hidekik.com/
#
# $Id: almob.cgi,v 1.9 2008/02/06 04:38:27 Hideki Kanayama Exp $
# Copyright(c) 2007-2008 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;

my $setupfile = "almob_setup.pl";
my $adminpwd="adminpwd.txt";

# このスクリプト名
my $script = basename($0);

my $version='1.004';
my $lastupdatedyear='2008';

my $charset = 'Shift_JIS';

my $lang = 0;

#### 環境設定　ここから ##############

# 元画像があるディレクトリ（almob.cgiからみた相対パス）
our $imagedir = ".";

# 縮小画像を格納するディレクトリ（almob.cgiからみた相対パス）
our $thumbsdir = "thumb";

# 縮小画像を作成 1:する 0:しない
our $shrink_en = 1;

# アルバムのリストファイル。写真のファイル名、タイトル、コメントをこの中に書く
# 1:有効 0:無効
our $listfile_en = 1;
our $listfile = "album.lst";

# リストファイルが無い場合の画像表示順 1:最新順 0:アルファベット順
our $nolist_order = 0;

# 戻り先のリンク。 （almob.cgiから見た相対パスとファイル名、絶対パス、httpからの指定でも可）
our $back_en = 1;
our $back = "../..";
our $back_name = '戻る';

# アルバムタイトルの設定
our $title_en = 1;
our $title_color = "#000000";
our $title_size = '+2';
our $title_face = '';

# 縮小画像サイズ
our $target_width = 240;
our $target_height = 240;

# 縮小画像のフォーマット 0:jpg, 1:gif, 2:png
our $format = 1;

# ファイルサイズリミット 1:有効 0:無効
our $size_limit_en = 1;
our $size_limit = 25;

# コメントの位置 0:写真の上 1:写真の下
our $comment_loc = 0;

# 管理人リンク 0:off 1:on
our $adminlink_en = 1;

#### 環境設定　ここまで ##############

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

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

%in=&postprocess(%in);

if (! -e "$adminpwd"){
    if ($in{mode} eq 'wradminpwd'){
	&wradminpwd;
    } else {
	&setadminpwd;
    }
}

my @ext = qw(jpg gif png);

if ($in{mode} eq 'setup'){
    &setupform;
} elsif ($in{mode} eq 'makesetup'){
    &makesetup;
} else {
    &dispphoto;
}

exit;

sub dispphoto {
    my @filelist;
    my @newlist;
    my $image;
    my $previmage;
    my $nextimage;
    my $title;
    my $line;
    my $comment;
    my $nexttitle;
    my $prevtitle;
    my $prevcomment;
    my $photoimage;
    my $phototitle;
    my $photocomment;
    my $nextcomment;
    my $prevlink;
    my $nextlink;
    if (!open(FILE,"< $listfile") or $listfile_en == 0){
	opendir(IMGDIR,"$imagedir") or &error("ディレクトリ$imagedirが開けません。");
	@filelist = grep !/^\./, readdir IMGDIR;
	closedir(IMGDIR);
	@newlist = (          grep /\.jpe?g$/i, @filelist);
	@newlist = (@newlist, grep /\.gif$/i,   @filelist);
	@newlist = (@newlist, grep /\.png$/i,   @filelist);
	if ($nolist_order){
	    @filelist = sort {(stat("$imagedir/$b"))[9] <=> (stat("$imagedir/$a"))[9]} @newlist;
	} else {
	    @filelist = sort @newlist;
	}
	&error("画像ファイルが${imagedir}にありません。<br>画像ファイルを${imagedir}に置くか、リストファイルを作成し、設定を正しくしてください。") if ($#filelist == -1);
	if ($in{image} eq ''){
	    $image = $filelist[0];
	    $previmage = '';
	    $nextimage = $filelist[1];
	} else {
	    $image = $in{image};
	    my $hitnum;
	    foreach (@filelist){
		last if (/^$in{image}$/);
		$hitnum++;
	    }
	    $previmage = $filelist[$hitnum-1] unless ($hitnum == 0);
	    $nextimage = $filelist[$hitnum+1] unless ($hitnum >= $#filelist);
	}
	$title = $image;
    } else {
	flock FILE, 2;
	@filelist = <FILE>;
	close(FILE);
	chomp(@filelist);
	@filelist = grep !/^\s*$/, @filelist;
	@filelist = grep !/^\s*,/, @filelist;
	@filelist = grep !/^\s*#/, @filelist;
	if ($in{image} eq '') {
	    $line = $filelist[0];
	    ($image,$title,$comment)=split(/,/,$line);
	    $line = $filelist[1];
	    ($nextimage,$nexttitle,$nextcomment)=split(/,/,$line);
	} else {
	    my $i=0;
	    foreach (@filelist){
		($image,$title,$comment)=split(/,/);
		if ($image eq $in{image}){
		    ($nextimage,$nexttitle,$nextcomment)=split(/,/,$filelist[$i+1]);
		    ($previmage,$prevtitle,$prevcomment)=split(/,/,$filelist[$i-1]) unless ($i == 0);
		    last;
		}
		$i++;
	    }
	}
    }
    $title = $image if ($title eq '');
    $nexttitle = $nextimage if ($nexttitle eq '');
    $prevtitle = $previmage if ($prevtitle eq '');
    
    my ($body,$path,$exx) = fileparse("$image",'\.\w+');

    my $imagefile = "$imagedir/$image";
    if ((! -e $imagefile) and $listfile_en == 0){
	&error("${imagefile}が見つかりません。<br><a href=\"$script?mode=setup\">管理用</a>からセットアップ、またはリストファイルを修正してください。");
    } elsif (! -e "$imagefile"){
	&error("${imagefile}が見つかりません。<br>$imagedirに置くか、リストファイル内のファイル名を修正してください。");
    }

    &htmlhead($title);
    
    if ($title_en){
	print "<center><font size=\"$title_size\" color=\"$title_color\" face=\"$title_face\">$title</font><p>\n";
    }
    
    print "<a href=\"$back\">$back_name</a> " if ($back_en);
    print "<a href=\"$script\">最新</a>" if ($nolist_order and $listfile_en == 0);
    print "<p>\n" if ($back_en or $nolist_order);

    if ($comment_loc == 0) {
	&comment_disp("$comment");
    }

    if ($shrink_en == 0){
	print "<img src=\"$imagefile\" border=0 style=\"border:0px\"><br>\n";
    } else {
	if (! -e "$thumbsdir"){
	    mkdir "$thumbsdir" or &error("$thumbsdirを作成できません。");
	}

	my $im;
	$image =~ /\.jpe?g$/i and $im = GD::Image->newFromJpeg($imagefile);
	$image =~ /\.gif$/i   and $im = GD::Image->newFromGif($imagefile);
	$image =~ /\.png$/i   and $im = GD::Image->newFromPng($imagefile);
	
	my ($width, $height) = $im->getBounds();
	
	my $new_width;
	my $new_height;
	if ($width > $target_width or $height > $target_height){
	    my $width_shrink  = $target_width  / $width;
	    my $height_shrink = $target_height / $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;
	}
	
	my $thumbsbody = "${body}_${new_width}x${new_height}";
	my $thumbimage = "$thumbsdir/$thumbsbody.$ext[$format]";
	if (! -e "$thumbimage"){
	    &genimage($im,$new_width,$new_height,$width,$height,$thumbimage);
	}
	my $kbyte = -s "$thumbimage"; # get file size
	if ($kbyte > $size_limit * 1024 and $size_limit_en){
	    my $size_ratio = sqrt(($size_limit*1024)/$kbyte);
	    my $new_width2 = int($new_width * $size_ratio);
	    my $new_height2 = int($new_height * $size_ratio);
	    $thumbsbody = "${body}_${new_width2}x${new_height2}";
	    $thumbimage = "$thumbsdir/$thumbsbody.$ext[$format]";
	    if (! -e "$thumbimage"){
		&genimage($im,$new_width2,$new_height2,$width,$height,$thumbimage);
	    }
	}
	
	undef $im;
	
	print "<img src=\"$thumbimage\" border=0 style=\"border:0px\" width=\"$new_width\" height=\"$new_height\"><br>\n";
    }
    
    if ($comment_loc == 1) {
	&comment_disp("$comment<br>");
    }
    
    if ($previmage eq '') {
	$prevlink="$back";
	$prevtitle = "トップへ";
    } else {
	$prevlink = "$script?image=$previmage";
    }
    if ($nextimage eq '') {
	$nextlink="$back";
	$nexttitle = "トップへ";
    } else {
	$nextlink = "$script?image=$nextimage";
    }

    print qq{<a href="$prevlink" accesskey="4">←$prevtitle</a>\n};
    print qq{<a href="$nextlink" accesskey="6">$nexttitle→</a><br>\n};
    
    if ($adminlink_en) {
	print qq{<a href="$script?mode=setup">管理用</a></center>};
    }
    
    &htmltail;
}

sub comment_disp {
    my $comment = shift;

    print "$comment<br>\n";
}

sub postprocess {
    my (%in) = @_;
    my $key;
    my $value;

    while (($key,$value)=each %in){
	next if ($key =~ /^upfile/);
	my $br = "<br>";
	
	if ($key !~ /^comment/){
	    $value =~ s/</&lt;/g;
	    $value =~ s/>/&gt;/g;
	}
	if ($value =~ /\r\n/) { $value =~ s/\r\n/$br/g; }
	if ($value =~ /\n/) { $value =~ s/\n/$br/g; }
	if ($value =~ /\r/) { $value =~ s/\r/$br/g; }
	if ($value =~ /,/) { $value =~ s/,/&\#44;/g; }
	
	$in{"$key"}=$value;
    }
    return(%in);
}

sub makecrypt {
    my $plain = shift;
    my $salt = join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64];
    my $result = crypt($plain,$salt) or crypt($plain,'$1$'.$salt.'$');
    return $result;
}

sub checkcrypt {
    my ($pwd,$encpwd)=@_;
    return(crypt($pwd,$encpwd) eq "$encpwd" or &checkadmin($pwd));
}

sub checkadmin {
    my $pwd = shift;
    
    if (open(FILE,"< $adminpwd")){
	my $filepwd = <FILE>;
	close(FILE);
	my $inpwd = crypt($pwd,$filepwd);
	return ("$inpwd" eq "$filepwd");
    } else {
	&error('パスワードファイルが存在しません');
    }
    
}
sub setadminpwd {
    
    &htmlhead('管理者用パスワードを入力してください');
    
    print "<form name=\"setpwd\" action=\"$script\" method=\"post\">\n";
    
    if ($in{mode} eq 'setup'){
	print "<center>管理者用パスワードを入力してください。<br>\n";
	print "<input type=password name=\"pwd\" size=20>\n";
	print "<input type=submit name=\"sub\" value=\"入力\"><br>\n";
	print "<input type=hidden name=\"mode\" value=\"setup\">\n";
    } else {
	print "<center>管理者用パスワードを設定してください。<br>\n";
	print "<input type=input name=\"pwd\" size=20>\n";
	print "<input type=submit name=\"sub\" value=\"設定\">\n";
	print "<input type=hidden name=\"mode\" value=\"wradminpwd\">\n";
    }
    print "</form>";
    print "</center>\n";
    
    &htmltail;
}

sub wradminpwd {

    my $plain = $q->param('pwd');
    my $passwd = &makecrypt($plain);
    
    if (open(FILE,"> $adminpwd")){
	print FILE "$passwd";
	close(FILE);
    } else {
	&error('パスワードファイル作成に失敗しました');
    }
    
    print "Location: $script\n\n";
}

sub setupform {

    my $inpwd = $q->param('pwd');
    &setadminpwd if ($inpwd eq '');
    &error('管理用パスワードが違います。') unless &checkadmin($inpwd);

    my @listfile_check;
    my @nolist_order_check;
    my @title_check;
    my @back_check;
    my @target_check;
    my @adminlink_check;
    my @comment_loc_check;
    my @format_check;
    my @size_limit_check;
    my @shrink_check;
    $listfile_check[$listfile_en] = "checked";
    $nolist_order_check[$nolist_order] = "checked";
    $title_check[$title_en] = "checked";
    $back_check[$back_en] = "checked";
    $adminlink_check[$adminlink_en] = "checked";
    $comment_loc_check[$comment_loc] = "checked";
    $format_check[$format] = "checked";
    $size_limit_check[$size_limit_en] = "checked";
    $shrink_check[$shrink_en] = "checked";

    &htmlhead('管理人セットアップ');

    print "<form name=\"makesetup\" action=\"$script\" method=\"post\">\n";
    print "<input type=hidden name=\"mode\" value=\"makesetup\">\n";
    print "<input type=hidden name=\"pwd\" value=\"$in{pwd}\">\n";
    
    print <<END;
<ul>
	<li>管理用リンクを非表\示にしている場合は、$script?mode=setupからパスワードを入力してこのページに入ってください。</li>
	<li><font color=red>数字やカラー指定は必ず半角で指定してください。全角やブランクだとＣＧＩが起動しなくなります。</font>万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。</li>
	</ul>

<hr>
<b>画像ディレクトリ</b><br>
ＣＧＩディレクトリからみた相対パス。（almob.cgiからみた相対パス）<br>
<input type=text name="imagedir" value="$imagedir" size=30>
<hr>

<b>縮小画像ディレクトリ</b><br>
ＣＧＩディレクトリからみた相対パス。（almob.cgiからみた相対パス）<br>
<input type=text name="thumbsdir" value="$thumbsdir" size=30>
<hr>

<b>縮小画像作成</b><br>
<input type=radio name=shrink_en value=1 $shrink_check[1]>作成する
<input type=radio name=shrink_en value=0 $shrink_check[0]>作成しない<br>
<hr>

<b>リストファイル</b><br>
<input type=radio name=listfile_en value=1 $listfile_check[1]>有効
<input type=radio name=listfile_en value=0 $listfile_check[0]>無効<br>
アルバムのリストファイル。写真のファイル名、タイトル、コメントをこのファイルに書く。<br>
<input type=text name="listfile" value="$listfile" size=30><br>
リストファイルが無効、または存在しない場合の画像表\示順<br>
<input type=radio name=nolist_order value=1 $nolist_order_check[1]>最新順
<input type=radio name=nolist_order value=0 $nolist_order_check[0]>アルファベット順<br>
<hr>

<b>アルバムタイトル</b><br>
<input type=radio name=title_en value=1 $title_check[1]>表\示
<input type=radio name=title_en value=0 $title_check[0]>非表\示<br>
色：color=<input type=text name="title_color" value="$title_color" size=8>
サイズ：size=<input type=text name="title_size" value="$title_size" size=8>
フォント：face=<input type=text name="title_face" value="$title_face" size=8>
<hr>

<b>「戻る」リンク</b><br>
<input type=radio name=back_en value=1 $back_check[1]>表\示
<input type=radio name=back_en value=0 $back_check[0]>非表\示<br>
戻り先のリンク（$scriptからみた相対パスとファイル名、絶対パス、httpからの指定でも可）<br>
<input type=text name=back value=\"$back\" size=30><br>
リンク名
<input type=text name=back_name value=\"$back_name\" size=30>
<hr>

<b>表\示写真サイズ</b><br>
アスペクト比（縦横費）を維持したまま縮小します。<br>
幅<input type=text name=target_width value=$target_width size=5>
高さ<input type=text name=target_height value=$target_height size=5><br>
<hr>

<b>表\示写真フォーマット</b><br>
表\示のために元写真から上記設定サイズに縮小し、設定フォーマットで作成します。<br>
<input type=radio name=format value=0 $format_check[0]>jpg
<input type=radio name=format value=1 $format_check[1]>gif
<input type=radio name=format value=2 $format_check[2]>png
<hr>

<b>縮小写真ファイルサイズ制限</b><br>
縮小写真のファイルサイズを制限します。縮小率を設定ファイルサイズ以下になるように自動修正します。多少誤差が出る場合もあります。<br>
<input type=radio name=size_limit_en value=1 $size_limit_check[1]>有効
<input type=radio name=size_limit_en value=0 $size_limit_check[0]>無効<br>
<input type=text name=size_limit value="$size_limit" size=5>KB
<hr>

<b>コメントの位置</b><br>
<input type=radio name=comment_loc value=0 $comment_loc_check[0]>写真の上
<input type=radio name=comment_loc value=1 $comment_loc_check[1]>写真の下
<hr>

<b>管理人リンク</b><br>
<input type=radio name=adminlink_en value=1 $adminlink_check[1]>あり
<input type=radio name=adminlink_en value=0 $adminlink_check[0]>なし
<hr>

END

    print "<input type=submit name=\"sub\" value=\"設定\">";
print "</form>";

&htmltail;

}

###########################################################################
# Setup files write #######################################################
###########################################################################
sub makesetup {

    my $inpwd = $q->param('pwd');
    &setadminpwd if ($inpwd eq '');
    &error('管理用パスワードが違います。') unless &checkadmin($inpwd);

    foreach (keys(%in)){
	$in{$_} =~ s/<br>/\n/g;
	$in{$_} =~ s/&#44;/,/g;
	$in{$_} =~ s/&lt;/</g;
	$in{$_} =~ s/&gt;/>/g;
    }

    open(SETUP,"> $setupfile");
    print SETUP <<END;
#### 環境設定　ここから ##############

# 画像があるディレクトリ（almob.cgiからみた相対パス）
\$imagedir = "$in{imagedir}";

# 縮小画像を格納するディレクトリ（almob.cgiからみた相対パス）
\$thumbsdir = "$in{thumbsdir}";

# 縮小画像を作成 1:する 0:しない
\$shrink_en = $in{shrink_en};

# アルバムのリストファイル。写真のファイル名、タイトル、コメントをこの中に書く
# 1:有効 0:無効
\$listfile_en = $in{listfile_en};
\$listfile = "$in{listfile}";

# リストファイルが無い場合の画像表示順 1:最新順 0:アルファベット順
\$nolist_order = $in{nolist_order};

# 戻り先のリンク。 （almob.cgiから見た相対パスとファイル名、絶対パス、httpからの指定でも可）
\$back_en = $in{back_en};
\$back = "$in{back}";
\$back_name = '$in{back_name}';

# アルバムタイトルの設定
\$title_en = $in{title_en};
\$title='$in{title}';
\$title_color="$in{title_color}";
\$title_size='$in{title_size}';
\$title_face='$in{title_face}';

# 縮小画像のサイズ
\$target_width = $in{target_width};
\$target_height = $in{target_height};

# 縮小画像のフォーマット 0:jpg, 1:gif, 2:png
\$format = $in{format};

# ファイルサイズリミット 1:有効 0:無効
\$size_limit_en = $in{size_limit_en};
\$size_limit = $in{size_limit};

# コメントの位置 0:写真の上 1:写真の下
\$comment_loc = $in{comment_loc};

# 管理人リンク 0:off 1:on
\$adminlink_en = $in{adminlink_en};

#### 環境設定　ここまで ##############

1;

END

    close(SETUP);

    print "Location: $script\n\n";
}

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

sub htmlhead {
  
  my $title = shift;

  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>\n";
}

sub htmltail {
    undef $q;
    my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang];
    print "<center><hr>\n";
    print "<i>almob.cgi Ver. $version\n";
    print "Copyright(C) 2007-$lastupdatedyear, <a href=\"$mysite\">hidekik.com</a></i></center>\n";
    print "</body></html>\n";
    exit;
}

sub genimage {
    my ($im,$new_width,$new_height,$width,$height,$thumbimage) = @_;
    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, "> $thumbimage")){
	&error ("縮小画像ファイル作成に失敗しました。");
    }
    binmode(IMAGE);
    if ($format == 0){
	print IMAGE $target_im->jpeg(85);
    } elsif ($format == 1) {
	print IMAGE $target_im->gif();
    } else {
	print IMAGE $target_im->png();
    }
    close(IMAGE);
    undef $target_im;
}