���������Ŋw��Perl�u�� |
- �������݃{�[�h��������@�́A�傫�������ĂQ�L��܂��B
�P�́A���̓f�[�^��HTML�R�[�h�ɕϊ����āAHTML�h�L�������g�ɒlj�������@�B
�����P�́A���͂��ꂽ�f�[�^���f�[�^�t�@�C���ɕۑ����A�u���E�U����Ăяo���ꂽ�Ƃ��AHTML�h�L�������g��������@�ł��B
���T�C�g�ŏЉ��X�N���v�g�́A���ׂČ�҂̃f�[�^�x�[�X�`�����̗p���Ă��܂��B
�O�҂́A�������܂��HTML�h�L�������g�t�@�C�����K�v�Ȃ��߁A���̓t�H�[���ƁA�\������h�L�������g�t�@�C�����ʁX�ɕK�v�ł��B
�������A��������A���ʂ��u�����Ɂv���f����܂���B�u���E�U����x�ǂݍ��h�L�������g�́A�L���b�V���ɕۑ����A
��x�ڂ���̓L���b�V���̃h�L�������g��W�J���邩��ł��B�i�����[�h����Θb���͕ʁj
�܂��A�u���E�U����̏������擾���A�\������f�[�^��A�`����ύX�ł��Ȃ��̂Ńf�[�^�݊������o�[�W�����A�b�v���s�Ȃ��܂���B
�����ŏЉ��u���������v���Arakugaki.cgi �X�N���v�g�ƁArakugaki.txt �f�[�^�t�@�C���œ��삵�A
�u���E�U����Ăяo�����̂́A�X�N���v�g�����ł��B
rakugaki.cgi
- ���C�����[�`��
��{�I�ȃf�[�^�̎擾��A�����̗�������߂Ă��܂��B
���Ȃ����������Ă���v���o�C�_��perl�����s�ł���p�X���w�肵�܂��B
��ʓI�ɁA#!/usr/bin/per��A#!/usr/local/bin/perl�������悤�ł��B
�������炪�{���B���̏�ɋ�s���P�s�J���܂��傤�B
���{��ϊ����C�u�����̐錾
�o�^�{�^����������A�f�[�^����������u���E�U�����t���b�V�����邽�߂Ɂu���������v��ݒu����URL���w�肵�܂��B
$rakugakiurl = 'http://www.tryhp.net/cgi-bin/rakugaki.cgi';
#�f�[�^��ۑ�����t�@�C���̖��O���w�肵�܂��B
$rakugakifile = 'rakugaki.txt';
#���ݓ��t�Ǝ������V�X�e������擾���A�t�H�[�}�b�g�𐮂��܂��B
#localtime�����Ԃ��l�����ꂼ��ϐ��ɑ�����܂��B
($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year += 1900;
#�擾�������l���Q���ɓ��ꂵ�܂��B�Q���ɓ��ꂷ��̂́A�����ڂ��悭���邾���łȂ��A
#���t�ɂ�鏸���A�~���̕��ёւ����s�Ȃ����߂ł��B
#���ёւ��́A�A�X�L�[�R�[�h�ōs�Ȃ��܂��̂ŁA
#�u�Q�v�Ɓu�P�O�v�ł́u�P�O�v���������Ɣ��f����邩��ł��B
#�u���v�̃f�[�^�́A�O����P�P�Ȃ̂ŁA�P�v���X����B
$mon = sprintf("%02d", $mon + 1);
$day = sprintf("%02d", $day);
$hour = sprintf("%02d", $hour);
$min = sprintf("%02d", $min);
#�t�H�[�}�b�g�𐮂��܂��B
#�_�u���N�H�[�g�u�h�v�ň͂܂ꂽ�萔�̒��̕ϐ��͎����œW�J����܂��B
$date_now = "$year�N$mon��$day�� $hour��$min��";
|
|
�t�H�[������̃f�[�^��ϐ�$formdata�Ɏ擾
���\�b�h�v���p�e�B�[�ɂ���Ď擾���@���قȂ�܂��̂ŁA�ǂ���ł��擾�ł���悤�ɂ��܂��B
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $QUERY_DATA, $ENV{'CONTENT_LENGTH'});
} else { $formdata = $ENV{'QUERY_STRING'}; }
|
|
�t�H�[���瑗���Ă����f�[�^�́Aname=���q&email=kyouko@abc.biglobe.ne.jp&comment=�n�߂܂��ċ��q�ł��B
�̂悤�ɁA�u���v�ŋ���đ����Ă��܂��B���̃f�[�^�����A�y�A�ɂ��܂��B
@pairs = split(/&/,$QUERY_DATA);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
#�s�K�v�ȕ������폜���A�f�R�[�h���܂��B
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
#�^�O�����͂���Ă���A������ɂ��܂��B
$value =~ s/</</g;
$value =~ s/>/>/g;
$value =~ s/\n//g;
$value =~ s/\,//g;
#�ŏ��ɐ錾�������{��ϊ����C�u�������Ăяo���A�V�t�gjis�ɕϊ�
&jcode'convert(*value,'sjis');
#���������f�[�^���L�[�ŌĂяo����悤�A�A�z�z��Ɋi�[���܂��B
$FORM{$name} = $value;
}
|
|
���̃X�N���v�g����������Ăяo���ꂽ���ŏ����܂��B
�t�H�[������Ăяo���ꂽ�̂ł���A$FORM{'action'}���utrue�v�ɁA
���߂ČĂяo���ꂽ�̂Ȃ�$FORM{}�ϐ���'action'�Ƃ������O���瑶�݂��Ȃ��B
$FORM{'action'}���utrue�v�Ȃ�t�H�[������Ȃ̂ŏ������݃��[�`���ցA
if ($FORM{'action'} eq "true") { ®ist; }
#����ȊO�Ȃ�HTML�h�L�������g������
else { &html; }
|
|
- HTML�h�L�������g�������[�`��
sub html {
#�f�[�^�t�@�C����ǂݍ��݃��[�h�I�[�v�����A
#���ׂẴf�[�^��z��ϐ�@DATA�Ɋi�[���܂��B
if (!open(NOTE,"$rakugakifile")) { &error(bad_file); }
@DATA = <NOTE>;
close(NOTE);
#�ǂݍ��܂ꂽ�f�[�^�́A�o�^���i�Â����j�ɕۑ�����Ă���̂ŁA�V�������ɕ��ёւ��܂��B
@DATA = reverse(@DATA);
#HTML�h�L�������g�����܂��B
print "Content-type: text/html\n\n";
print "<!DOCTYPE HTML PUBLIC -//IETF//DTD HTML//EN>\n";
print "<html>\n";
print "<head>\n";
print "<meta http-equiv=Content-Type content= text/html; charset=x-sjis>\n";
print "<title>��������</title></head>\n";
#�o�b�N�O�����h�ƕ����F���w��
print "<body bgcolor=#000000 text=#FFFFFF>\n";
#�h�L�������g�̏㕔�A�R�����g���̓t�H�[����
#[��������]�{�^�����������Ɠ��͂��ꂽ�f�[�^��������rakugaki.cgi���ēx�Ăяo���܂��B
print "<form action=rakugaki.cgi method=POST>\n";
#�P�̃X�N���v�g�ŏ����邽�߁A�����Ȃ��t���O��ݒ�
print "<input type=hidden name=action value=true>\n";
print "<div align=center><center>\n";
print "<table border=1 cellspacing=1>\n";
print "<tr>\n";
print "<td align=center>�j�b�N�l�[��</td>\n";
print "<td><input type=text size=29 name=name></td>\n";
print "</tr>\n";
print "<tr>\n";
print "<td align=center>E-mail</td>\n";
print "<td><input type=text size=29 name=email></td>\n";
print "</tr>\n";
print "<tr>\n";
print "<td align=center>��������</td>\n";
print "<td><textarea name=comment rows=4 cols=68></textarea></td>\n";
print "</tr>\n";
print "<tr>\n";
print "<td align=center colspan=2><input type=submit value=�������Ⴆ></td>\n";
print "</tr>\n";
print "</table></center></div>\n";
print "</form>\n";
#�����܂ł����̓t�H�[��
#�������炪�A�������L�������܂��B
print "<div align=center><center>\n";
#�ۑ�����Ă���f�[�^���Ȃ��Ȃ�܂ŌJ��Ԃ��B
foreach $line (@DATA) {
#�t�@�C������ǂݍ��f�[�^�̍Ō�ɂ͉��s���������Ă���̂ŏ���
chop($line);
#�P�s�̃f�[�^���e���ڂɕ������܂��B
#���t�A���O�A���[���A�R�����g�̏��Ɋi�[����܂��B
#����ȍ~��$d1�`$d4�͏����̃o�[�W�����A�b�v�̂��߃_�~�[�̃f�[�^�ɂ��܂��B
($date,$name,$email,$comment) = split(/\,/,$line);
#�R�����g�ϐ��̒��̉��s�����u\r�v���u<br>�v�ɕϊ����āA
#�K��҂����͂����ʂ�ɕ\�����܂��B
$comment =~ s/\r/<br>/g;
print "<table border=0 width=80% bgcolor=#FFFFFF>\n";
print "<tr>\n";
print "<td><font color=#000000>\n";
#���[���A�h���X�����͂���Ă�������N��t���܂��B
if ($email ne "") {
print "<a href=mailto:$email><strong>$name</strong></a>\n";
} else { print "<strong>$name</strong>\n"; }
print " $date<br>\n";
print "<blockquote>$comment</blockquote>\n";
print "</font>\n";
print "</td>\n";
print "</tr>\n";
print "</table>\n";
print "<p>";
}
print "</center></div>\n";
print "</body></html>\n";
exit;
}
|
|
- �f�[�^�������݃��[�`��
sub regist {
#���O���A�R�����g�����͂���Ă��Ȃ���G���[���o�͂��܂��B
if ($FORM{'name'} eq "") { &error(bad_name); }
if ($FORM{'comment'} eq "") { &error(bad_comment); }
#�f�[�^�t�@�C����lj����[�h�I�[�v�����āA���̓f�[�^���Ō�̍s�ɒlj����܂��B
if (!open(NOTE,">>$rakugakifile")) { &error(bad_file); }
$value = "$date_now\,$FORM{'name'}\,$FORM{'email'}\,$FORM{'comment'}\n";
print NOTE $value;
close(NOTE);
#�lj������f�[�^���u���E�U�ɔ��f�����邽�ߗ��������������[�h���܂��B
print "Location: $rakugakiurl" . '?' . "\n\n";
}
|
|
- �G���[����
sub error {
#�T�u���[�`���ɓn���ꂽ�����Q�Ƃ̂��߂̔z��
$error = $_[0];
#�����ɂ��G���[���b�Z�[�W�̐���
if ($error eq "bad_file") { $msg = '�t�@�C���̃I�[�v���A���o�͂Ɏ��s���܂����B'; }
elsif ($error eq "bad_name") { $msg = '�j�b�N�l�[�����L������Ă��܂���B'; }
elsif ($error eq "bad_comment") { $msg = '�R�����g���L������Ă��܂���B'; }
else { $msg = '�����s���̃G���[�ŏ������p���ł��܂���B'; }
#�G���[���b�Z�[�W�\����HTML�h�L�������g�̐���
print "Content-type: text/html\n\n";
print "<html><head><title>��������</title></head>\n";
print "<body bgcolor=#000000 text=#FFFFFF LINK=#FFAAAA VLINK=#FF8888>\n";
print "<p>\n";
print "<center><h2>error</h2><hr>\n";
print "<i>" . $msg . "</i></hr></center>\n";
print "</body></html>\n";
exit;
}
|
|
|
|