のぶろぐ

ソースコード

#!/usr/bin/perl
 
# print "Content-type: text/html\n\n";
# open(STDERR, ">&STDOUT");
# $|=1;
 
# 初期設定
# require Jcode;
# $JcodeVer = "Jcode $Jcode::VERSION";
# *Jgetcode = \&Jcode::getcode;
# *Jconvert = \&Jcode::convert;
 
require "../../../cgi-bin/jcode.pl";
$JcodeVer = "jcode.pl $jcode::version";
*Jgetcode = \&jcode::getcode;
*Jconvert = sub { &jcode::to($_[1], $_[0], $_[2]); };
 
@G_styles = ("../../ipp.css","../test.css");
$G_title = "テスト２０";
# $G_myCode = &Jgetcode("漢字");
$G_myCode = &Jgetcode(\"漢字");
$G_code = "jis";
$G_charset = "iso-2022-jp";
%G_form=();
 
$G_scrName = $ENV{'SCRIPT_NAME'};
if($G_scrName =~ /ts[0-9]{4}/){ # _1,_uなどと共通で使用する項目
    $G_scrName = $&;
    $G_dataFile = "dat/$G_scrName.dat";
    $G_lock = "lock/$G_scrName";
    $G_linkFile = "../$G_scrName.htm";
    $G_linkName = $G_title;
}
 
{
    &sigInit;
    if($#ARGV == -1){
        &selectCode;
    }elsif( $ENV{'HTTP_REFERER'} !~ /$ENV{'SCRIPT_NAME'}/ ||
            $ENV{'HTTP_REFERER'} !~ /$ENV{'HTTP_HOST'}/ ){
        exit;
#    }elsif($ARGV[0] eq "utf8"){
#        $G_code = "utf8";
#        $G_charset = "UTF-8";
#        &printForm("post");
    }elsif($ARGV[0] eq "sjis"){
        $G_code = "sjis";
        $G_charset = "shift_jis";
        &printForm("post");
    }elsif($ARGV[0] eq "euc"){
        $G_code = "euc";
        $G_charset = "euc-jp";
        &printForm("post");
    }elsif($ARGV[0] eq "jis"){
        &printForm("post");
    }elsif($ARGV[0] eq "output"){
        &formRead;
        &formWrite;
    }elsif($ARGV[0] eq "read"){
        &dataOpen;
    }else{
        &error("<h2>無効なコマンドが渡されました。</h2>");
    }
    
    exit;
}
 
sub sigInit{
    $SIG{'PIPE'} = "sigExit";
    $SIG{'INT'} = "sigExit";
    $SIG{'HUP'} = "sigExit";
    $SIG{'QUIT'} = "sigExit";
    $SIG{'TERM'} = "sigExit";
}
 
sub sigExit{
    &dataUnlock;
    exit;
}
 
sub error{
    $G_title .= "（エラー）";
    &printHeader;
    &Jprint(@_);
    &printFooter;
    exit;
}
 
sub selectCode{
    $G_title .= "（漢字コード選択）";
    &printHeader;
    print "<div class=test>\n";
    
    &Jprint("<p>入力フォームで使用する漢字コードを選んでください。</p>\n");
    print <<EOM;
<form method=post action="$ENV{'SCRIPT_NAME'}?jis"><input type=submit value="JIS(iso-2022-jp)"></form>
<form method=post action="$ENV{'SCRIPT_NAME'}?sjis"><input type=submit value="Shift_JIS"></form>
<form method=post action="$ENV{'SCRIPT_NAME'}?euc"><input type=submit value="EUC-JP"></form>
EOM
# 以下の一行を削除した
# <form method=post action="$ENV{'SCRIPT_NAME'}?utf8"><input type=submit value="Unicode(UTF-8)"></form>
 
    print qq(<form method=post action="$ENV{'SCRIPT_NAME'}?read">\n);
    &Jprint(qq(<input type=submit value="過去ログ（？）を見る">\n));
    print "</form>\n";
    print "</div>\n";
    &printFooter;
}
 
sub dataLock{
    local($i, $mtime);
    for($i=0;$i<2;$i++){
        if(mkdir($G_lock, 0755)){
            return;
        }else{
            unless($i){
                ($mtime) = (stat($G_lock))[9];
                if ($mtime < time() - 60) { # １分以上前のロックは解除
                    rmdir($G_lock);
                }
            }
        }
    }
    &error("<h2>現在、ロック中です。ごめんなさい。</h2>");
}
 
sub dataUnlock{
    if(-d $G_lock){
        rmdir($G_lock);
    }
}
 
sub dataOpen{
    $G_title .= "（過去ログ）";
    &printHeader;
    print "<div class=test>\n";
    
    &dataLock;
    
    open(IN, "<$ G_dataFile")||die "Can not open $G_dataFile....";
    # データファイルはEUC記録なので時間短縮のつもり。
    # 標準出力は「jis」だけど・・・。
    if($G_code eq "euc"){
        print while (<IN>);
    }else{
        while (<IN>){
            print &Jconvert($_, $G_code, "euc");
        }
    }
    close(IN);
    
    &dataUnlock;
    
    print "</div>\n";
    &printFooter;
}
 
sub formWrite{
    local($name, $value);
    
    &dataLock;
    
    open(OUT, ">> $G_dataFile")||die "Can not open $G_dataFile....";
    print(OUT "<table border=1>\n");
    print(OUT "<tr><th>Name<th>Value</tr>\n");
    while (($name, $value) = each(%G_form)){
        print(OUT "<tr><td>$name<td>$value</tr>\n");
    }
    
    sleep 5;
    
    print(OUT "</table>\n");
    
    close(OUT);
    
    &dataUnlock;
    
    $G_title .= "（送信完了）";
    &printHeader;
    print "<div class=test>\n";
    
    &Jprint("<p>たぶん、無事に送信されました。\n");
    &Jprint(qq(<p><a href="$ENV{'SCRIPT_NAME'}?read">心配だから、過去ログを見る。</a>\n));
    print "</p>\n";
    
    print "</div>\n";
    &printFooter;
}
 
sub formRead{
    local($query_string, @elements, $elm, $name, $value, $code, $method);
    $method = $ENV{'REQUEST_METHOD'};
    if($method eq "POST"){
        read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
    }elsif($method eq "GET"){
        $query_string = $ENV{'QUERY_STRING'};
    }else{
        &error("<h2>「POST」か「GET」のデータしか受け取れません。</h2>");
    }
    @elements = split(/&/, $query_string);  # 中身はpostもgetも同じ
    foreach $elm (@elements){
        ($name, $value) = split(/=/, $elm);
        $value =~ tr/+/ /;
        $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
#        $code = &Jgetcode($value);
        $code = &Jgetcode(\$value);
        if($code ne "euc"){
            $value = &Jconvert($value, "euc", $code); # とりあえずEUCに変換
        }
        $value =~ s/&/&amp;/g;  # メタ文字（？）を無効化
#        $value =~ s/<!--/&lt;!--/g;   # SSI入力を無効化
#        $value =~ s/-->/--&gt;/g;   # SSI入力を無効化
        $value =~ s/</&lt;/g;   # タグを無効化
        $value =~ s/>/&gt;/g;   # タグを無効化
        $value =~ s/\r\n*/\n/g; # 改行を統一
        $value =~ s/\n\n\n+/\n\n/g; # 長い改行（３回以上）を２回（１行空き）に
        $value =~ s/[\n\s]+$//g; # 最後の連続した空白、改行を削除
        $value =~ s/\n/<br>/g;  # 改行を<br>に変換
        $G_form{$name} = $value ."<br>InputCode : $code\n";
    }
}
 
sub printForm{
    $G_title .= "（入力画面）";
    &printHeader;
    print "<div class=test>\n";
    
    print qq(<form method=$_[0] action="$ENV{'SCRIPT_NAME'}?output">\n);
    &Jprint(qq(<input type=hidden name=tx0 value="画面表示：$G_code\nブラウザ：$ENV{'HTTP_USER_AGENT'}\nスクリプト：$G_myCode"><br>\n));
    print qq(<input type=text name=tx1 value="tx1"><br>\n);
    &Jprint("<textarea name=ta1 cols=40 rows=4>ta1\n何か適当にどうぞ。\n</textarea><br>\n");
    &Jprint("<p>送信し、データを書き込んでいる最中に５秒間待ちます。</p>\n");
    &Jprint("<p>この間は、しばらく待つか、他のブラウザなどから「送信」を試してみてください。</p>\n");
    &Jprint(qq(<p><a href="$ENV{'SCRIPT_NAME'}" target="_blank">ブラウザをもう一枚開く</a></p>\n));
    &Jprint(qq(<input type=submit value="送信する">\n));
    print "</form>\n";
    print qq(<form method=$_[0] action="$ENV{'SCRIPT_NAME'}?read">\n);
    &Jprint(qq(<input type=submit value="過去ログ（？）を見る">\n));
    print "</form>\n";
    
    print "</div>\n";
    &printFooter;
}
 
sub printHeader{
    if($G_charset){
        print "Content-type: text/html; charset=$G_charset\n\n";
    }else{
        print "Content-type: text/html\n\n";
    }
    print qq(<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">\n);
    print "<html lang=ja>\n<head>\n";
    if($G_charset){
        print qq(<meta http-equiv="Content-Type" content="text/html; charset=$G_charset">\n);
    }
    print qq(<meta http-equiv="Content-Script-Type" content="text/javascript">\n);
    print qq(<meta http-equiv="Content-Style-Type" content="text/css">\n);
    &Jprint("<title>$G_title</title>\n");
    foreach (@G_styles){
        print qq(<link rel="stylesheet" type="text/css" href="$_">\n);
    }
    print "</head>\n<body>\n";
    print "<div class=head>\n";
    &Jprint("<h1>$G_title</h1><hr>\n");
    &printlinks;
    print "<hr></div>\n";
#    print $ENV{'HTTP_REFERER'}."<br>".$ENV{'SCRIPT_NAME'}."<br>".$ENV{'HTTP_HOST'};
}
 
sub printFooter{
    print "<div class=foot><hr>\n";
    &printlinks;
    print "<hr>\n";
    &Jprint("漢字コード変換 ： $JcodeVer<br>\n");
    open(IN, "../../sig.txt");
    print while (<IN>);
    close(IN);
    print "</div>\n";
    print "</body></html>\n";
}
 
sub printlinks{
    print qq(<a href="../../../index.htm">Home</a>\n);
	print qq(/\n<a href="../../">Perl</a>\n);
	print qq(/\n<a href="../">TestCGI Index</a>\n);
    if($G_linkFile){
        &Jprint(qq(/\n<a href="$G_linkFile">$G_linkNameの解説</a>\n));
    }
}
 
sub Jprint{
    if($G_code eq $G_myCode){
        foreach (@_){ print; }
    }else{
        foreach (@_){ print &Jconvert($_, $G_code, $G_myCode); }
    }
}
 
sub JconvPrint{
    foreach (@_){ print &Jconvert($_, $G_code, &Jgetcode($_)); }
}