#!/usr/local/bin/perl
################################################################################
# 清き一票！（投票用）
# Ver 2.1
# Copyright(C) futomi 2001 - 2004
# http://www.futomi.com/
###############################################################################
use strict;
require './config.cgi';
require './jcode.pl';
use Time::Local;
use CGI;
my $q = new CGI;
my $Mode = $q->param('mode');

#設定
my $ADMINPASSWORD = &config::ADMINPASSWORD;
my $GRAPHIMAGEURL = &config::GRAPHIMAGEURL;
my $CONFIRMFLAG = &config::CONFIRMFLAG;
my $MultiAnsFlag = &config::MultiAnsFlag;
my $IP_LOCK_SEC = &config::IP_LOCK_SEC;
my $ExpireDate = &config::ExpireDate;
my $ExpireErrMsg = &config::ExpireErrMsg;
my $ResultPrintFlag = &config::ResultPrintFlag;
my $REDIRECTFLAG = &config::REDIRECTFLAG;
my $REDIRECTURL = &config::REDIRECTURL;
my $GRAPHMAXLENGTH = &config::GRAPHMAXLENGTH;
my $GRAPHLINECOLOR1 = &config::GRAPHLINECOLOR1;
my $GRAPHLINECOLOR2 = &config::GRAPHLINECOLOR2;
my $MAXLISTNUM = &config::MAXLISTNUM;
my $HANDLEMAXLENGTH = &config::HANDLEMAXLENGTH;
my $COMMENTMAXLENGTH = &config::COMMENTMAXLENGTH;
my $CHECKHANDLE = &config::CHECKHANDLE;
my $CHECKCOMMENT = &config::CHECKCOMMENT;
my $LOGDIR = &config::LOGDIR;
my $NameAttribute = &config::NameAttribute;

#このCGIのURLを取得する
my $ThisCgiUrl = $q->url();
my $AbsoluteUrl = $q->url(-absolute=>1);
my $ThisFileName = $q->url(-relative=>1);

#タイムスタンプを取得する
my $TimeStamp = &GetTimeStamp;

######################################################################
#メインルーチン
######################################################################

#ログファイルのチェック
#もしログファイルがなければ作成する。
unless (-e "${LOGDIR}/votelog.cgi") {
	open(VOTELOG, ">${LOGDIR}/votelog.cgi") || &ErrorPrint("ログファイル ${LOGDIR}/votelog.cgi を作成できませんでした。ディレクトリ ${LOGDIR} のパーミッションを見直してください。");
	close(VOTELOG);
}

#管理者モードかどうかのチェック
my $AdminFlag = &AdminCheck;
#投票期限をチェック
#管理者モードの場合にはチェックしない
unless($AdminFlag) {
	if($TimeStamp > $ExpireDate) {
		&ErrorPrint("$ExpireErrMsg");
	}
}

if($Mode eq 'confirm') {
	&InputCheck;		# ハンドルとコメントの必須、文字数をチェック
	&PrintConfirm;		# 確認画面を出力する
} elsif($Mode eq 'vote') {
	unless($MultiAnsFlag) {
		&CookieAcceptCheck;	# Cookieを受けるけられるかのチェック
	}
	unless($CONFIRMFLAG) {
		&InputCheck;		# ハンドルとコメントの必須、文字数をチェック
	}
	&Loging;			# ログに書き込む
	&Redirect;			# リダイレクトする
} else {
	&PrintForm;			# 投票フォームを出力する
}



######################################################################
#サブルーチン
######################################################################

sub AdminCheck {
	my %cookies = &GetCookie;
	my $cookie_pass  = $cookies{'adminpass'};
	if($cookie_pass eq '') {
		return 0;
	}
	my $salt;
	if($cookie_pass =~ /^\$1\$([^\$]+)\$/) {
		$salt = $1;
	} else {
		$salt = substr($cookie_pass, 0, 2);
	}
	my $pass = crypt($ADMINPASSWORD, $salt);
	if($pass eq $cookie_pass) {
		return 1;
	} else {
		return 0;
	}
}

sub InputCheck {
	my $Handle = $q->param('handle');
	my $Comment = $q->param('comment');
	if($CHECKHANDLE) {
		unless($Handle) {&ErrorPrint("ハンドルは必須です。");}
	}
	if($CHECKCOMMENT) {
		unless($Comment) {&ErrorPrint("コメントは必須です。");}
	}
	my $CommentLength = length($Comment);
	my $HandleLength = length($Handle);
	if($CommentLength > $COMMENTMAXLENGTH) {
		&ErrorPrint("コメントは、半角$COMMENTMAXLENGTH文字以内でお願いします。");
	}
	if($HandleLength > $HANDLEMAXLENGTH) {
		&ErrorPrint("ハンドルは、半角$HANDLEMAXLENGTH文字以内でお願いします。");
	}
}


sub AnalyzeData {
	open(VOTELOG, "${LOGDIR}/votelog.cgi") || &ErrorPrint("ログファイル ${LOGDIR}/votelog.cgi をオープンできませんでした。");
	if(my $result = &Lock(*VOTELOG)) {
		&ErrorPrint("只今、混雑しております。しばらくお待ちください。: $result");
	}
	my %ValueCount = ();
	while(<VOTELOG>) {
		chomp;
		my ($Date, $IpAddress, $CookieValue, $ValueListString) = split(/,/);
		my @ValueList = split(/\:\:/, $ValueListString);
		for my $ValueBuff (@ValueList) {
			$ValueCount{$ValueBuff} ++;
		}
	}
	close(VOTELOG);
	return %ValueCount;
}

sub GetResultList {
	my %ValueCount = &AnalyzeData;
	my $Order = 1;
	my $PrintOrder = 1;
	my $PreOrder = 0;
	my $PreCount = 0;
	my $GraphLength;
	my $Sum = 0;
	for my $Value (keys %ValueCount) {
		$Sum += $ValueCount{$Value};
	}
	my $ResultString;
	$ResultString .= '<table border="0" cellspacing="1">';
	$ResultString .= '<tr>';
	$ResultString .= '<td class=ListHeader>順位</td>';
	$ResultString .= '<td class=ListHeader>項目</td>';
	$ResultString .= '<td class=ListHeader>投票数</td>';
	$ResultString .= '<td class=ListHeader>グラフ</td>';
	$ResultString .= '</tr>';
	$ResultString .= "\n";
	foreach my $Value (ValueSort(\%ValueCount)) {
		my $Rate = int($ValueCount{$Value} * 1000 / $Sum) / 10;
		my $GraphLength = int($GRAPHMAXLENGTH * $Rate / 100);

		if($PreCount == $ValueCount{$Value}) {
			$PrintOrder = $PreOrder;
		} else {
			$PrintOrder = $Order;
		}

		if($Order % 2 == 1) {
			$ResultString .= "<tr bgcolor=\"$GRAPHLINECOLOR1\">";
		} else {
			$ResultString .= "<tr bgcolor=\"$GRAPHLINECOLOR2\">";
		}
		$ResultString .= "<td align=\"center\">$PrintOrder</td>";
		$ResultString .= "<td>$Value</td>";
		$ResultString .= "<td align=\"right\">$ValueCount{$Value}</td>";
		$ResultString .= "<td align=\"left\"><img src=\"$GRAPHIMAGEURL\" width=\"$GraphLength\" height=\"10\"> <font size=\"-1\">($Rate%)</font></td>";
		$ResultString .= "</tr>\n";
		$Order ++;
		$PreOrder = $PrintOrder;
		$PreCount = $ValueCount{$Value};
	}
	$ResultString .= '</table>';
	$ResultString .= "\n";
	return $ResultString, $Sum;
}


sub Loging {
	my $Comment = $q->param('comment');
	my $Handle = $q->param('handle');
	$Comment = &MakeSecure($Comment);
	$Handle = &MakeSecure($Handle);
	$Comment = &UnifyReturnCode($Comment);
	$Handle = &UnifyReturnCode($Handle);
	$Comment =~ s/\n/<br>/g;
	$Handle =~ s/\n/<br>/g;

	my @Values = $q->param($NameAttribute);
	my $SelectedNum;
	$SelectedNum = @Values;
	unless($SelectedNum) {
		&ErrorPrint("何か選択して下さい。");
	}
	open(VOTELOG, "+<${LOGDIR}/votelog.cgi") || &ErrorPrint("ログファイル ${LOGDIR}/votelog.cgi をオープンできませんでした。");
	if(my $result = &Lock(*VOTELOG)) {
		&ErrorPrint("只今、混雑しております。しばらくお待ちください。: $result");
	}
	#Cookieによる二重投稿のチェック
	unless($MultiAnsFlag) {
		unless(&CookieDoubleCheck) {
 			&ErrorPrint('二重投稿はできません。(1)');
		}
	}
	#IPアドレスによる二重投稿のチェック。
	#エントリーがなければ、リストに追加する。
	#また古いIPアドレス情報も削除する
	if(&CheckIpList($ENV{'REMOTE_ADDR'}, time)) {
 		&ErrorPrint('二重投稿はできません。(2)');
	}
	#ログ行を生成
	my $LogString;
	$LogString .= "$TimeStamp,";		#ログ書込時間を追加
	$LogString .= "$ENV{'REMOTE_ADDR'},";	#IPアドレスを追加
	$LogString .= "$TimeStamp-$ENV{'REMOTE_ADDR'},";	#Cookie値を追加
	#投票値を追加
 	for my $ValueString (@Values) {
		&jcode::convert(\$ValueString, "sjis");
		$LogString .= "$ValueString\:\:";
	}
	$LogString =~ s/\:\:$/,/;
	$LogString .= "$Handle,$Comment";

	seek(VOTELOG, 0, 2);
	print VOTELOG "$LogString\n";
	close(VOTELOG);


}

sub CheckIpList {
	my($remote_addr, $epoch) = @_;
	unless(-e "${LOGDIR}/iplist.cgi") {
		open(IPLIST, ">${LOGDIR}/iplist.cgi") || &ErrorPrint("ログファイル ${LOGDIR}/iplist.cgi を生成できませんでした。ディレクトリ ${LOGDIR} のパーミッションを確認して下さい。");
		close(IPLIST);
	}
	open(IPLIST, "+<${LOGDIR}/iplist.cgi") || &ErrorPrint("ログファイル ${LOGDIR}/iplist.cgi をオープンできませんでした。");
	if(my $result = &Lock(*IPLIST)) {
		&ErrorPrint("只今、混雑しております。しばらくお待ちください。: $result");
	}
	my %ip_list;
	while(<IPLIST>) {
		chomp;
		my($ip, $acc_epoch) = split(/\t/);
		if($epoch - $acc_epoch > $IP_LOCK_SEC) {
			next;
		}
		$ip_list{$ip} = $acc_epoch;
	}
	if(exists $ip_list{$remote_addr}) {
		close(IPLIST);
		return 1;
	} else {
		$ip_list{$remote_addr} = $epoch;
	}
	seek(IPLIST, 0, 0);
	truncate(IPLIST, 0);
	for my $key (keys %ip_list) {
		print IPLIST "${key}\t$ip_list{$key}\n";
	}
	close(IPLIST);
	return 0;
}

sub CookieAcceptCheck {
	my %CookieList = &GetCookie;
	unless($CookieList{'CookieAcceptFlag'}) {
		&ErrorPrint("お使いのブラウザーがCookieを受け付けないと投票できません。");
	}
}


sub CookieDoubleCheck {
	my %Cookie = &GetCookie;
	if($Cookie{$NameAttribute}) {
		return 0;
	} else {
		return 1;
	}
}


sub GetTimeStamp {
	my($sec, $min, $hour, $mday, $month, $year) = localtime;
	if($sec < 10) {$sec = "0$sec";}
	if($min < 10) {$min = "0$min";}
	if($hour < 10) {$hour = "0$hour";}
	if($mday < 10) {$mday = "0$mday";}
	$month ++;
	if($month < 10) {$month = "0$month";}
	$year += 1900;
	my $TimeStamp = $year.$month.$mday.$hour.$min.$sec;
	return $TimeStamp;
}


# リダイレクトする
sub Redirect {
	my $Redirect;
	if($REDIRECTFLAG) {
		$Redirect = $REDIRECTURL;
	} else {
		$Redirect = $ThisCgiUrl;
	}

	unless($MultiAnsFlag) {
		my $CookiePath = $AbsoluteUrl;
		$CookiePath =~ s/\/$ThisFileName//;
		my $CookieHeaderString = &SetCookie($NameAttribute, "$TimeStamp-$ENV{'REMOTE_ADDR'}", $ExpireDate, $ENV{'HTTP_HOST'}, $CookiePath);
		print "$CookieHeaderString\n";
	}
	if($ENV{'HTTP_USER_AGENT'} =~ /MSIE/i) {
		print "Location: $Redirect\n\n";
	} else {
		print "Content-type: text/html; charset=Shift_JIS\n";
		print "\n";
		print "<html>\n";
		print "<head><META HTTP-EQUIV=\"Refresh\" CONTENT=\"0; URL=$Redirect\"></head>\n";
		print "<body><a href=\"$Redirect\">こちら</a>をクリックして下さい。</body>\n";
		print "</html>\n";
		print "\n";
	}
}

sub MakeSecure {
	my($String) = @_;
	&jcode::convert(\$String, "sjis");
	$String =~ s/,/，/g;
	$String =~ s/</&lt;/g;
	$String =~ s/>/&gt;/g;
	$String =~ s/\"/&quot;/g;
	return $String;
}


# 確認画面を出力する
sub PrintConfirm {
	my @Values = $q->param($NameAttribute);
	my $Comment = $q->param('comment');
	my $Handle = $q->param('handle');
	$Comment = &MakeSecure($Comment);
	$Handle = &MakeSecure($Handle);
	my $CommentForPrint = &UnifyReturnCode($Comment);
	my $HandleForPrint = &UnifyReturnCode($Handle);
	$CommentForPrint =~ s/\n/<br>/g;
	$HandleForPrint =~ s/\n/<br>/g;

	my $SelectedNum;
	$SelectedNum = @Values;
	unless($SelectedNum) {
		&ErrorPrint("何か選択して下さい。");
	}

	my $HiddenTags = '<input type="hidden" name="mode" value="vote">';
	$HiddenTags .= "<input type=\"hidden\" name=\"handle\" value=\"$Handle\">\n";
	$HiddenTags .= "<input type=\"hidden\" name=\"comment\" value=\"$Comment\">\n";
	my $ValueForPrint;
	for my $ValueBuff (@Values) {
		$HiddenTags .= "<input type=\"hidden\" name=\"$NameAttribute\" value=\"$ValueBuff\">\n";
		$ValueForPrint .= "$ValueBuff&nbsp;";
	}
	$ValueForPrint =~ s/&nbsp;$//g;
	open(CONFIRMTEMP, "./template/confirm.html") || &ErrorPrint("確認用テンプレートファイル ./template/confirm.html をオープンできませんでした。");
	my $CgiUrlHit = 0;
	my $HiddenHit = 0;
	my $HtmlString;
	while(my $LineBuff = <CONFIRMTEMP>) {
		chomp $LineBuff;
		if($LineBuff =~ /<!--cgiurl-->/) {
			$LineBuff =~ s/<!--cgiurl-->/$ThisCgiUrl/;
			$CgiUrlHit = 1;
		}
		if($LineBuff =~ /<!--hidden-->/) {
			$LineBuff =~ s/<!--hidden-->/$HiddenTags/;
			$HiddenHit = 1;
		}
		if($LineBuff =~ /<!--value-->/) {
			$LineBuff =~ s/<!--value-->/$ValueForPrint/;
		}

		$LineBuff =~ s/<!--comment-->/$CommentForPrint/;
		$LineBuff =~ s/<!--handle-->/$HandleForPrint/;
		$HtmlString .= "$LineBuff\n";
	}
	close(CONFIRMTEMP);
	unless($CgiUrlHit) {
		&ErrorPrint("確認用テンプレートファイル ./template/confirm.html に「&lt;!--cgiurl--&gt;」が記載されていません。");
	}
	unless($HiddenHit) {
		&ErrorPrint("確認用テンプレートファイル ./template/confirm.html に「&lt;!--hidden--&gt;」が記載されていません。");
	}
	print "Content-type: text/html; charset=Shift_JIS\n";
	print "\n";
	print $HtmlString;
}


# 投票フォームを出力する
sub PrintForm {
	my $HiddenTags;
	if($CONFIRMFLAG) {
		$HiddenTags .= '<input type="hidden" name="mode" value="confirm">';
	} else {
		$HiddenTags .= '<input type="hidden" name="mode" value="vote">';
	}

	my($GraphString, $Sum);
	if($ResultPrintFlag || $AdminFlag) {
		($GraphString, $Sum) = &GetResultList;
	}
	my $html = &ReadTemplate("./template/vote.html");
	my $CgiUrlHit = 0;
	my $HiddenHit = 0;
	my $NameHit = 0;
	my $FormString;
	if($html =~ /<!--cgiurl-->/) {
		$html =~ s/<!--cgiurl-->/$ThisCgiUrl/g;
		$CgiUrlHit = 1;
	}
	if($html =~ /<!--hidden-->/) {
		$html =~ s/<!--hidden-->/$HiddenTags/g;
		$HiddenHit = 1;
	}
	if($html =~ /name\s*=\s*\"*$NameAttribute\"*/) {
		$NameHit = 1;
	}

	my $ExpireString = substr($ExpireDate, 0, 4).'年'.substr($ExpireDate, 4, 2).'月'.substr($ExpireDate, 6, 2).'日　'.substr($ExpireDate, 8, 2).':'.substr($ExpireDate, 10, 2).':'.substr($ExpireDate, 12, 2);
	$html =~ s/<!--expire-->/$ExpireString/g;

	if($ResultPrintFlag || $AdminFlag) {
		$html =~ s/<!--sum-->/$Sum/g;
		$html =~ s/<!--graph-->/$GraphString/g;
	}
	unless($CgiUrlHit) {
		&ErrorPrint("投票用テンプレートファイル ./template/vote.html に「&lt;!--cgiurl--&gt;」が記載されていません。");
	}
	unless($HiddenHit) {
		&ErrorPrint("投票用テンプレートファイル ./template/vote.html に「&lt;!--hidden--&gt;」が記載されていません。");
	}
	unless($NameHit) {
		&ErrorPrint("投票用テンプレートファイル ./template/vote.html に「name=\"$NameAttribute\"」が記載されていません。");
	}

	my $Now = time;
	my $CookiePath = $AbsoluteUrl;
	$CookiePath =~ s/\/$ThisFileName//;
	my $CookieHeaderString = &SetCookie('CookieAcceptFlag', $Now, '', $ENV{'HTTP_HOST'}, $CookiePath);
	print "Content-type: text/html; charset=Shift_JIS\n";
	print "$CookieHeaderString\n";
	print "\n";
	print $html;
	exit;
}

sub ReadTemplate {
	my($template) = @_;
	my $size = -s $template;
	if(!open(IN, "$template")) {
		&ErrorPrint("テンプレートファイル <tt>$template</tt> をオープンできませんでした。 : $!");
	}
	binmode(IN);
	my $filestr;
	sysread(IN, $filestr, $size);
	close(IN);
	$filestr = &UnifyReturnCode($filestr);
	return $filestr;
}

sub ErrorPrint {
	my($message) = @_;
	my $html = &ReadTemplate("./template/error.html");
	$html =~ s/<!--message-->/$message/ig;
	print $q->header(-type=>'text/html; charset=Shift_JIS');
	print $html;
	exit;
}


sub ErrorPrint2 {
	my($message) = @_;
	print $q->header(-type=>'text/html; charset=Shift_JIS');
	print "$message\n";
	exit;
}

sub Lock {
	local(*FILE) = @_;
	eval{flock(FILE, 2)};
	if($@) {
		return $!;
	} else {
		return '';
	}
}

sub GetCookie {
	my @CookieList = split(/\; /, $ENV{'HTTP_COOKIE'});
	my %Cookie = ();
	for my $key (@CookieList) {
		my ($CookieName, $CookieValue) = split(/=/, $key);
		$CookieValue =~ s/\+/ /g;
		$CookieValue =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C",hex($1))/eg;
		$Cookie{$CookieName} = $CookieValue;
	}
	return %Cookie;
}

sub SetCookie {
	my($CookieName, $CookieValue, $ExpireDate, $Domain, $Path) = @_;

	# URLエンコード
	$CookieValue =~ s/([^\w\=\& ])/'%' . unpack("H2", $1)/eg;
	$CookieValue =~ tr/ /+/;

	my $CookieHeaderString;
	$CookieHeaderString .= "Set-Cookie: $CookieName=$CookieValue\;";
	if($ExpireDate) {
		my @MonthString = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
					'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
		my @WeekString = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
		my $ExYear = substr($ExpireDate, 0, 4);	$ExYear -= 1900;
		my $ExMonth = substr($ExpireDate, 4, 2);	$ExMonth =~ s/^0//;	$ExMonth --;
		my $ExDay = substr($ExpireDate, 6, 2);		$ExDay =~ s/^0//;
		my $ExHour = substr($ExpireDate, 8, 2);	$ExHour =~ s/^0//;
		my $ExMin = substr($ExpireDate, 10, 2);	$ExMin =~ s/^0//;
		my $ExSec = substr($ExpireDate, 12, 2);	$ExSec =~ s/^0//;
		my $time = timelocal($ExSec, $ExMin, $ExHour, $ExDay, $ExMonth, $ExYear);
		my($sec, $min, $hour, $monthday, $month, $year, $weekday) = gmtime($time);
		$year += 1900;
		$month = $MonthString[$month];
		if($monthday < 10) {$monthday = '0'.$monthday;}
		if($sec < 10) {$sec = '0'.$sec;}
		if($min < 10) {$min = '0'.$min;}
		if($hour < 10) {$hour = '0'.$hour;}
		my $GmtString = "$WeekString[$weekday], $monthday-$month-$year $hour:$min:$sec GMT";
 		$CookieHeaderString .= " expires=$GmtString\;";
	}
	if($Domain) {
		$CookieHeaderString .= " domain=$Domain;";
	}
	if($Path) {
		$CookieHeaderString .= " path=$Path;";
	}
	return $CookieHeaderString;
}


# 連想配列を値（value）でソートした連想配列を返す
sub ValueSort {
	my $x = shift;
	my %array=%$x;
	return sort {$array{$b} <=> $array{$a};} keys %array;
}


# 改行コードを \n に統一
sub UnifyReturnCode {
	my($String) = @_;
	$String =~ s/\x0D\x0A/\n/g;
	$String =~ s/\x0D/\n/g;
	$String =~ s/\x0A/\n/g;
	return $String;
}