作者: chirumiru
日時: 2003/7/31(12:05)
こんにちわ,
Penelotty,改めchirumiruです♪

夏休みの課題(個人的に課した)に『アンケート投票・集計プログラム』をつくりました,
ちょっと自信作なんですが,いつまでも1人で悦に入っているよりみなさんのご意見,ご感想をいただいたらよりいっそう,励み・習熟度のレベルアップにつながると思い投稿しました.

多分Perl5の機能を使うともっとソフィスティーケッドなスクリプトになるんでしょうが,
そこまでのレベルアップもこの夏休みの課題として.

投票していただいた方のご意見を乱数表示するため,スタックを3つ使っていいます,
ファイル名,タイトルはCGI起動時に引数で渡します.

これはchiruの運営する変態ファンサイト,“愛に御用心”で活用するつもりです,
みなさんも前田愛ちゃんの応援をよろしくお願いします.
それでわ,ご感想,改良点などご意見を待っています.

#早く初心者,脱したい.

chirumiru
__________

#!/usr/local/bin/perl
#

$copyright='Copyright © 2003 by chirumriu All Rights Reserved Ver.2.25';

$jcodelib='./jcode.pl';
$charcode='sjis';

$cgiurl='http://hpcgi2.nifty.com/penelotty/anq.cgi';
$backurl='http://homepage2.nifty.com/penelotty/index.html';
$cgimethod='post';

$bg='#ffa500';
$bg_img='';
$text='#ffffff';
$link='#0000ff';
$vlink='#0000ff';

$title='';
$title_img='';
$tile_size='2';
$title_color='';
$t_width='';
$t_height='';

$form_color='#ff8c00';
$wrap='soft';

$title_length='';
$zenkaku_title='';
$com_length=200;
$zenkaku_com=$com_length/2;

$datfile='';
$cntfile='';
$lock=0;

$masterkey='';
$kijimax='';
$pagekiji='';

$ss=<<"_SS_";
input, textarea, select {
	font-family:		MS ゴシック;
	font-size:		10pt;
	color:			#000080;
	background-color:	#ff8c00;
	border:			1 dotted #00ffff;
}

p table {
	color:           #8025da;
	font-size:       10pt;
	background-color:#ff8c00;
}
_SS_

require "$jcodelib";

&init_form($charcode);
if ($myaction eq "wri") { &wri_; }
if ($myaction eq "cnt") { &cnt_; }	#起動時に引数で渡す.
&html_;

sub html_ {
#	&get_;

	&head_;

	$html.=<<"_HTML_";
	<a href="http://homepage2.nifty.com/penelotty/anq.html">□BACK</a>
	<hr color="#ffff00"><center><font size="$title_size">$mytitle</font></center><hr color="#ffff00">
_HTML_

	if ($myaction eq "cnt") { &result_; }
	else { &form_; }
	&foot_;
}

sub init_form {
	my ($charcode)=@_;

	$method=$ENV{'REQUEST_METHOD'};
	$method=~tr/a-z/A-Z/;

	if ($method eq 'POST') { read(STDIN, $query, $ENV{'CONTENT_LENGTH'}); }
	else		       { $query=$ENV{'QUERY_STRING'}; }

	@parts=split(/&/, $query);
	foreach (@parts) {
		($valiable, $value)=split(/=/);
		$value=~tr/+/ /;
		$value=~s/%([a-zA-Z0-9][a-zA-Z0-9])/pack("C", hex($1))/eg;
		&jcode'convert(*value, $charcode);
		$form{$valiable}=$value;
	}

	$myaction =$form{'myaction'};
	$myname   =$form{'myname'};
	$mycard   =$form{'mycard'};
	$mycomment=$form{'mycomment'};
	$myfile   =$form{'myfile'};
	$mytitle  =$form{'mytitle'};

	$mycomment=~s/\r\n/<br>/g;
	$mycomment=~s/\r|\n/<br>/g;
}

sub head_ {
	$html.=<<"_HTML_";
	<html>
	<head>
	<meta HTTP-EQUIV="Content-type" CONTENT="text/html; charset=Shift_JIS">
	<title></title>
	<style>
	<!--
	:link    { color:#0000ff; text-decoration:none; }
	:visited { color:#0000ff; text-decoration:none; }
	:hover   { color:#ff0000; text-decoration:none; }
	$ss
	-->
	</style>
	</head>
_HTML_
	if ($bg_img eq '') { $html.="<body text=\"$text\" bgcolor=\"$bg\" link=\"$link\" vlink=\"vlink\">"; }
	else		   { $html.="<body background=\"$bg_img\" link=\$link\" vlink=\"vlink\" bgproperties=\"fixed\">"; }
}

sub foot_ {
	$html.=<<"_HTML_";
	<br>
	<br>
	<div align="right">$copyright</div>
	</body>
	</html>
_HTML_
	&end_;
}

sub end_ {
	$len=length($html);
	print "Content-type: text/html\n";
	print "Content-length: $len\n";
	print "\n";
	print "$html";
	exit;
}

sub form_ {
	$html.=<<"_HTML_";
	<form action="$cgiurl" method="$cgimethod">
		<table align="center" cellspacing="2" cellpadding="0">
			<tr><td width="50" align="center" bgcolor="$form_color">NAME</td><td width="40" align="center">---&gt</td><td><input type="text" size="32" name="myname"></td></tr>
			<tr><td width="50" align="center" bgcolor="$form_color">投 票</td><td width="40" align="center">---&gt</td><td><input type="text" size="32" name="mycard"></td></tr>
			<tr><td colspan="3" bgcolor="$form_color">COMMENT<br><textarea cols="35" rows="5" wrap="$wrap" name="mycomment"></textarea></td></tr>
			<tr><td colspan="3"><input type="submit" value=送信><input type="reset" value="リセット"><input type="hidden" name="myaction" value="wri"></td></tr>
			<tr><td><input type="hidden" name="myfile" value=$myfile><input type="hidden" name="mytitle" value=$mytitle></td></tr>
		</table>
	</form>
_HTML_
}

sub wri_ {
	if ($mycard eq '') { &error_("未投票!!"); }
	if ($mycomment eq '' || length($mycomment)>$zenkaku_com) { &error_("コメント未入力またはコメントが長すぎ!!"); }

	if (!open(OUTPUT, "+<$myfile")) { &error_("アンケート終了"); }	#ファイルの属性に頼る.
	
	@databank=<OUTPUT>;
	if ($lock) { if (!&lock_(OUTPUT, 1)) { error_("can't lock\n"); } }

	$mycomment=$mycard.'='.$myname.'='.$mycomment;
	$new='1'.'<>'.$mycard.'<>'.$mycomment."\n";
	seek(OUTPUT, 0, 0);
	foreach (@databank) {
		($cnt, $card, @comment)=split(/<>/);
		if ($mycard eq $card) {
			$cnt++;
			$comment=join('<>', @comment);
			chomp($comment);
			$mycomment=$comment.'<>'.$mycomment;
			$message=$cnt.'<>'.$card.'<>'.$mycomment."\n";
			print OUTPUT $message;
			$i=1;
		}
		else { print OUTPUT $_; }
	}
	if (!$i) { print OUTPUT $new; }

	$filesize=tell(OUTPUT);
	truncate(OUTPUT, $filesize);

	if ($lock) { &lock_(OUTPUT, 0); }
	close(OUTPUT);
}

sub cnt_ {
	open(INPUT, "$myfile") || die "can't open $myfile: $!\n";
	@databank=<INPUT>;
	close(INPUT);

	@sorted_databank=sort(@databank);
	foreach (@databank) { ($num, $card, @comment)=split(/<>/); } 
	foreach (@comment) { ($card, $name, $comment)=split(/=/); push (@cardbank, $card); push(@namebank, $name); push(@combank, $comment); } 
}

sub result_ {
	$html.="<br><br>";
	$html.="<p>";
	$html.="<table align=\"center\" border=\"2\" bordercolor=\"#ff0000\" cellpadding=\"10\" cellspacing=\"0\">";

	for ($i=$#sorted_databank, $rank=0, $amend=1; $i>=0; $i--) {
		($cnt, $card)=split(/<>/, $sorted_databank[$i]);
		if ($pcnt==$cnt) { $amend++; $flag=1; }
		else { if ($flag) { $rank+=$amend; $amend=1; }
					 else { $rank++; }
		}
		$html.="<tr><td width=\"50\" align=\"center\">$rank位</td><td width=\"100\" align=\"center\">$card</td><td width=\"50\" align=\"center\">$cnt票</td></tr>";
		$pcnt=$cnt;
	}

	$html.="</table>";
	$html.="<p>";
}		
		
sub lock_ {
	local(*file, $mode)=@_;

	if ($mode) {
		if (flock(OUT, LOCK_EX)) { return 1; }
		else {return 0;}
	}
	else {
		flock(OUT, LOCK_UN);
	}
}
 
sub error_ {
	my ($message)=@_;

	$html.=<<"_HTML_";
	<center>
	$message
	</center>
	<hr color="#ffff00">
_HTML_
	&end_;
}

__________