#!/usr/bin/perl
# ---------------------------------------------------------------
#  - システム名    フォームデコード+メール送信 (FORM MAILER)
#  - バージョン    0.58
#  - 公開年月日    2002/12/27
#  - スクリプト名  f_mailer.cgi
#  - 著作権表示    (c)1997-2002 Perl Script Laboratory
#  - 連  絡  先    info@psl.ne.jp (http://www.psl.ne.jp/)
# ---------------------------------------------------------------
# ご利用にあたっての注意
#   ※このシステムはフリーウエアです。
#   ※このシステムは、「利用規約」をお読みの上ご利用ください。
#     http://www.psl.ne.jp/lab/copyright.html
# ---------------------------------------------------------------
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Pg;
require 'jcode.pl';
require "v2_conf.pl";
require "lib.pl";
$q = new CGI;
umask 0;
setver();
conf();
$ENV{PGCLIENTENCODING} = "SJIS";

error("フォームデコードサービスV2はサービスを終了いたしました。長い間にわたりご利用いただき誠にありがとうございました。");

@name_list = decoding()
  or error_v2("このプログラムを直接起動しても動作しません。".
           "フォームの送信先に指定してご利用ください。");
$GETCODE = jcode::getcode(\$FORM{GETCODE}) if $FORM{GETCODE};
if ($GETCODE eq "euc" or $GETCODE eq "jis") {
    my %FORM2;
    while (my($key,$value) = each %FORM) {
        jcode::convert(\$key, 'sjis', $GETCODE);
        jcode::convert(\$value, 'sjis', $GETCODE);
        $FORM2{$key} = $value;
    }
    foreach (@name_list) { jcode::convert(\$_, 'sjis', $GETCODE); }
    %FORM = %FORM2;
}

if ($FORM{FID} eq '') {
    error_v2("フォームIDが指定されていないため、ご利用になれません。");
}

$FORM{REMOTE_HOST} = remote_host();
$FORM{REMOTE_ADDR} = $ENV{REMOTE_ADDR};
$FORM{USER_AGENT} = $ENV{HTTP_USER_AGENT};
$FORM{ENCODING} ||= ($ENCODING or 'uuencode');

#map { eval "\$$_ = \$FORM{$_} if defined \$FORM{$_} and \$$_ eq \"\"" }
# reserved_words2();
#$SUBJECT or error_v2("メールの件名が設定されていません。");
#$SENDTO or error_v2("送付先アドレスが設定されていません。");
#$SENDFROM or error_v2("送付元アドレスが設定されていません。");
#if (!$THANKS and $THANKS_FLAG) {
#    error_v2("送信後に表示するページのURLが設定されていません。");
#}

$db = Pg::connectdb("dbname=form_decode user=postgres")
 or error($db->errorMessage);

sql("select fkey,id,stat,location,cond,sendto,usepgp,pgpkey,sendfrom,
 subject,format,reply,reply_sendfrom,reply_subject,reply_message,
 reply_format,finished from fkey where fkey='$FORM{FID}'");
my %d;
if (my @data = $dataset->fetchrow()) {
    @d{qw(fkey id stat location cond sendto usepgp pgpkey sendfrom
     subject format reply reply_sendfrom reply_subject reply_message
     reply_format finished)} = @data;
#    foreach (qw(cond subject format reply_subject reply_message
#     reply_format)) {
#        jcode::convert(\$d{$_}, 'sjis', 'euc');
#    }
    if ($d{stat} == 0) {
        error_v2("指定されたフォームIDが不明のため処理ができません。")
    } elsif ($d{stat} == 9) {
        error_v2("このフォームは現在ご利用できなくなっております。。")
    }
} else {
    error_v2("指定されたフォームIDが不明のため処理ができません。");
}

if ($FORM{FID} eq "ik7ap3y4674udmyee63hcxjp" and $ENV{"REMOTE_ADDR"} eq "110.4.189.181") {
#   use Data::Dumper;
#   die Dumper(\%d);
}

#########################
### confdata override ###
#########################
eval "\@COND = ($d{cond});";
error_v2("入力条件データの読み込みに失敗しました。: $@") if $@;
$SENDTO         = $d{sendto};
$SENDFROM       = $d{sendfrom};
$SUBJECT        = $d{subject};
if ($d{format} == 1 or $d{format} == 2 or $d{format} == 3) {
    $MAIL_FORMAT_TYPE = $d{format};
} else {
    $MAIL_FORMAT_TYPE = 0;
    $FORMAT = $d{format}
}
$AUTO_REPLY     = $d{reply};
$REPLY_SENDFROM = $d{reply_sendfrom};
$REPLY_SUBJECT  = $d{reply_subject};
$REPLY_MESSAGE  = $d{reply_message};
if ($d{reply_format} == 1 or $d{reply_format} == 2 or $d{reply_format} == 3) {
    $REPLY_MAIL_FORMAT_TYPE = $d{reply_format};
} else {
    $REPLY_MAIL_FORMAT_TYPE = 0;
    $REPLY_FORMAT = $d{reply_format}
}
$REPLY_FORMAT   = $d{reply_format};
$THANKS         = $d{finished};
########################
#$SENDTO or error_v2("送付先アドレスが設定されていません。");
#$SENDFROM or error_v2("送付元アドレスが設定されていません。");


setalt();
checkvalues();
checkuploads() unless $FORM{TEMP};
#error_v2($GETCODE,(map{"$_ => $FORM{$_}"} keys %FORM));
if ($FORM{SEND_FORCED} or !$CONFIRM_FLAG and !$FORM{CONFIRM_FORCED}
 and !$FORM{FORM_MAILER_FLAG}) {
    $FORM{REFERER} = $ENV{HTTP_REFERER} || $ENV{HTTP_REFERRER}
     if !$FORM{SEND_FORCED} and !$FORM{REFERER};
    sendmail_v2()
}
$FORM{REFERER} = $ENV{HTTP_REFERER} || $ENV{HTTP_REFERRER};
confirm();

sub confirm {

    if ($CONFIRM_FLAG == 2) {
        open(R, $CONFIRM_TMPL)
         || error_v2("CONFIRM_TMPL = $CONFIRM_TMPL が開けませんでした。: $!");
        $confirmstr = join('', <R>);
        close(R);
        $confirmstr =~ s/##CREDIT##/$CREDIT/g;
    } else {
        $confirmstr = set_default_confirm_format();
    }
#error_v2($confirmstr) if $FORM{FID} eq 'qu7c286bsy2u3k4k4nu6zaph';
    $confirmstr =~ s/##([^#]+)##/replace($1,'html')/eg;
    print "Content-type: text/html; charset=Shift_JIS\n\n$confirmstr";

}

sub checkuploads {

    if (@ATTACH_EXT) {
        foreach (@ATTACH_EXT) { $ext{$_} = 1 }
    }
    foreach $fname(@ATTACH_FIELDNAME) {
        ($temp, $FORM{$fname},$fsize{$fname}) = imgsave($fname);
        $FORM{TEMP} ||= $temp;
        if ($ATTACH_SIZE_MAX and $fsize{$fname} > $ATTACH_SIZE_MAX * 1024) {
            push(@msg, "$FORM{$fname} のファイルサイズが ".
             $ATTACH_SIZE_MAX . "キロバイトを超えています。");
        }
        $fsize += $fsize{$fname};
    }
    if ($ATTACH_TSIZE_MAX and $fsize > $ATTACH_TSIZE_MAX * 1024) {
        push(@msg, "添付ファイルのファイルサイズ合計が ".
         $ATTACH_TSIZE_MAX . "キロバイトを超えています。");
    }
    if (@msg) {
        opendir(DIR, $TEMP_DIR)
         or error_v2($TEMP_DIR."ディレクトリが開けませんでした。: $!");
        unlink( map { "$TEMP_DIR/$_" } grep(/^$FORM{TEMP}-/, readdir(DIR)));
        error_v2(@msg);
    }

}

sub checkvalues {

    my @check_keys = load_condcheck();

    foreach (@COND) {
        my($f_name, $cond_hash) = @$_;
#        push(@msg, $f_name);
        foreach my $key (@check_keys) {
            next if $key eq 'alt';
            next unless defined $cond_hash->{$key};
            &{$condcheck{$key}}($f_name, $alt{$f_name}, $cond_hash->{$key});
        }
    }
    eval $EVAL_COMMAND;
    error_v2($@) if $@;

    $FORM{EMAIL} = email_chk_v2($FORM{EMAIL}) if defined $FORM{EMAIL};
    $FORM{"E-mail"} = email_chk_v2($FORM{"E-mail"}) if defined $FORM{"E-mail"};

    error_v2(@msg) if @msg;

}

sub sendmail_v2 {

    if ($DENY_DUPL_SEND) {
        if (get_cookies($FORM{CONF})) {
            error_v2("同一フォームの連続送信はできません。いったんブラウザを".
             "終了\させてから再度アクセスしてください。");
        }
    }

    if (@ATTACH_FIELDNAME) {
        opendir(DIR, $TEMP_DIR)
         or error_v2("$TEMP_DIR が開けませんでした。: $!");
        foreach $f_(grep(/^$FORM{TEMP}-/, readdir(DIR))) {
            ($file = $f_) =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
            $file =~ s/^$FORM{TEMP}-//;
            open(R, "$TEMP_DIR/$f_")
             or error_v2("添付ファイルの読み出しに失敗しました。: $!");
            $attachdata{$file} = join("", <R>);
            close(R);
        push(@del_list, "$TEMP_DIR/$f_");
        }
        close(DIR);
    }
    $FORM{EMAIL} ||= $FORM{"E-mail"} || $SENDFROM || 'xxx@xxx.xx.xx';

    my($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
    $FORM{NOW_DATE} = sprintf("%04d-%02d-%02d %02d:%02d:%02d",
                              $year+1900,++$mon,$mday,$hour,$min,$sec);

    eval $EVAL_COMMAND2;
    error_v2($@) if $@;

    if ($MAIL_FORMAT_TYPE) {
        $FORMAT = set_default_mail_format($MAIL_FORMAT_TYPE);
    } else {
        $FORMAT ||= set_default_mail_format($MAIL_FORMAT_TYPE);
    }
    $FORMAT =~ s/##reply_message##\r?\n//;
    $FORMAT =~ s/##([^#]+)##/replace($1)/eg;
    my $FORMAT_enc = $FORMAT;
    my $SUBJECT_enc = $SUBJECT;
    $prod_name_enc = $prod_name;
    jcode::convert(\$prod_name_enc,'jis');
    jcode::convert(\$FORMAT,'jis');
    jcode::convert(\$SUBJECT_enc,'jis');
    $SUBJECT_enc = base64_subj($SUBJECT_enc);

### 2020-04-26 終了告知
chomp(my $information = <<'STR');
◆お知らせ◆
本サービスは2020/8/31(月) 0:00をもって終了させていただきます。
長い間ご利用いただきありがとうございました。
https://www.psl.ne.jp/topics/topics.cgi?shousai=71
---------------------------------------------------------------------
STR
    jcode::convert(\$information,'jis');

    if (!scalar(keys %attachdata)) {
#error(__LINE__);
        $str = <<STR;
From: $FORM{EMAIL}
Subject: $SUBJECT_enc
Content-type: text/plain; charset=ISO-2022-JP
Content-Transfer-Encording: 7bit

$FORMAT
$information
$prod_name_enc
$a_url
STR

    } else {
        $boundary = '';
        foreach (1..12) { $boundary .= ('0'..'9','a'..'f')[rand(16)]; }
        $str = <<STR;
From: $FORM{EMAIL}
Subject: $SUBJECT_enc
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="$boundary"


--$boundary
Content-type: text/plain; charset=ISO-2022-JP

$FORMAT
$information
$prod_name_enc
$a_url
STR

        foreach $filename(keys %attachdata) {
            if ($FORM{ENCODING} eq 'uuencode') {
                $attachdata = uuencode($attachdata{$filename},$filename);
                $encoding_type = "X-uuencode";
            } else {
                $attachdata = base64($attachdata{$filename});
                $encoding_type = "base64";
            }
            $str .= <<STR;
--$boundary
Content-Type: application/octet-stream; name="$filename"
Content-Disposition: attachment;
 filename="$filename"
Content-Transfer-Encoding: $encoding_type

$attachdata
STR
        }

        $str .= "--$boundary--\n";

    }

    sql("begin");

    foreach $mailto(split(/\s*,\s*/,$SENDTO)) {
        open(MAIL, "| $SENDMAIL -t") || error_v2("Can\'t sendmail: $!");
        print MAIL "To: $mailto\n";
        print MAIL "X-Mailer: $prod_name_e $a_url\n";
        print MAIL "X-FID: $FORM{FID}\n";
        print MAIL $str;
        close(MAIL);

        $FORMAT_enc =~ s/'/''/g;
        sql("insert into sentlog values ('$FORM{FID}','$FORM{NOW_DATE}',
         '$mailto','$FORM{EMAIL}',null,
         '$FORM{REMOTE_HOST}','$FORM{USER_AGENT}','$FORM{REFERER}')");

    }

    if ($AUTO_REPLY and $REPLY_SENDTO ne 'xxx@xxx.xx.xx') {
        if ($REPLY_MAIL_FORMAT_TYPE) {
            $REPLY_FORMAT = set_default_mail_format($REPLY_MAIL_FORMAT_TYPE);
        } else {
            $REPLY_FORMAT ||= set_default_mail_format($REPLY_MAIL_FORMAT_TYPE);
        }
        $REPLY_FORMAT =~ s/##reply_message##/$REPLY_MESSAGE/;
        $REPLY_FORMAT =~ s/##([^#]+)##/replace($1)/eg;
        my $REPLY_FORMAT_enc = $REPLY_FORMAT;
        jcode::convert(\$REPLY_FORMAT,'jis');
        jcode::convert(\$REPLY_SUBJECT,'jis');
        $REPLY_SUBJECT = base64_subj($REPLY_SUBJECT);
        $REPLY_SENDFROM ||= $SENDFROM;
        $REPLY_SENDTO ||= $FORM{EMAIL};
        foreach $mailto(split(/\s*,\s*/,$REPLY_SENDTO)) {
            next if $mailto eq 'xxx@xxx.xx.xx';
            next if $mailto eq '';
            open(MAIL, "| $SENDMAIL -t") || error_v2("Can\'t sendmail: $!");
            print MAIL <<STR;
X-Mailer: $prod_name_e $a_url
X-FID: $FORM{FID}
To: $mailto
From: $REPLY_SENDFROM
Subject: $REPLY_SUBJECT
Mime-Version: 1.0
Content-Transfer-Encording: 7bit
Content-Type: text/plain; charset=ISO-2022-JP

$REPLY_FORMAT
$prod_name_enc
$a_url
STR
            close(MAIL);
            $REPLY_FORMAT_enc =~ s/'/''/g;
            sql("insert into sentlog values ('$FORM{FID}','$FORM{NOW_DATE}',
             '$mailto','$REPLY_SENDFROM',null,
             '$FORM{REMOTE_HOST}','$FORM{USER_AGENT}','$FORM{REFERER}')");
        }
    }

    if ($FILE_OUTPUT) {
        $OUTPUT_FILENAME =~ s/##([^#]+)##/$FORM{$1}/g;
        $OUTPUT_FILENAME =~ s#([^\da-zA-Z_.,-/])#'%' . unpack('H2', $1)#eg;
        open(W, ">> $OUTPUT_FILENAME")
         or error_v2("$OUTPUT_FILENAME へデータの書き込みができませんでした。: $!");
        if ($OUTPUT_SEPARATOR) {
            foreach $field(@OUTPUT_FIELDS) {
                $FORM{$field} =~ s/\r\n/\n/g;
                $FORM{$field} =~ s/\r/\n/g;
                $FORM{$field} =~ s/"/""/g;
                $FORM2{$field} = qq|"$FORM{$field}"|;
                $FORM2{$field} =~ s/\!\!\!/ /;
            }
        } else {
            foreach $field(@OUTPUT_FIELDS) {
                $FORM{$field} =~ s/\r\n/\n/g;
                $FORM{$field} =~ s/\r/\n/g;
                $FORM{$field} =~ s/\t+/ /g;
                $FORM2{$field} = $FORM{$field};
            }
        }
        print W join(($OUTPUT_SEPARATOR ? "," : "\t"),
                     @FORM2{@OUTPUT_FIELDS}
                ),"\n";
        close(W);
    }

    unlink(@del_list);
    set_cookies($FORM{CONF},1) if $DENY_DUPL_SEND;

    sql("update fkey set sent_total=sent_total+1 where fkey='$FORM{FID}'");
    sql("commit");

    if (!$THANKS_FLAG) {
        print "Location: $THANKS\n\n";
    } else {
        print <<HTML;
Content-type: text/html; charset=Shift_JIS

<html><head><title>$SUBJECT</title></head>
<body text="$TEXT" bgcolor="$BGCOLOR" link="$LINK" vlink="$VLINK"
alink="$ALINK" background="$BACKGROUND">
<h2>$SUBJECT</h2>

送信しました。<br>
ありがとうございました。<p>

<hr noshade>
<div align=right><b><small>$prod_name v$version
<a href=$a_url>$signature</a></b></div></body></html>
HTML

    }
    exit;

}

sub replace {

    my($fieldname,$indent,$option) = split(/:/, $_[0]);
    my $V;
    my $value = $FORM{$fieldname};
    if ($option eq 'h') {
        $value =~ s/\!\!\!/ /g;
    } else {
        $value =~ s/\!\!\!/\n/g;
    }
    $value =~ s/\n/"\n" . ' ' x $indent/eg if $indent;

    if ($_[1] eq 'html') {
        if ($fieldname eq 'VALUES') {
            foreach (reserved_words(), qw(FID GETCODE SUBJECT VALUE_REQUIRED
             FINISHED ID FORM_MAILER_FLAG)) { $replace{$_}++ }
            foreach $name(@name_list) {
                next if $replace{$name};
                $FORM{$name} =~ s/"/&quot;/g;
                $FORM{$name} =~ s/<BR>\n/\n/ig;
                $V .= qq|<input type=hidden NAME="$name" value="$FORM{$name}">\n|;
            }
            foreach $name(qw(FID REFERER)) {
                $V .= qq|<input type=hidden name=$name value="$FORM{$name}">\n|;
            }
            $V .= qq|<input type=hidden name=SEND_FORCED value=1>\n|;
            return $V;
        }
        $value = html_output_escape($value);
        $value =~ s/\n/<br>\n/g;
    }

    $value eq '' ? $BLANK_STR : $value;

}

sub comma {

    local($_) = @_;
    1 while s/(.*\d)(\d\d\d)/$1,$2/;
    $_ or 0;

}

sub set_default_confirm_format {

    my $default_confirm_format = <<STR;
<html><head>
<meta http-equiv="content-type" content="text/html;charset=Shift_JIS">
<title>フォームデコードサービスV2</title>
<style type="text/css">
<!--
a:link {color:#3333ff; text-decoration:none; }
a:visited {color:#000099; text-decoration:none; }
a:hover {color:red; text-decoration:underline; }
-->
</style>
</head>
<body bgcolor=#ffffff>
<div align=center>
<form action=v2.cgi method=post>

<table border=0 cellpadding=1 cellspacing=0 width=650>
<tr><td align=right bgcolor=gold><font color=black><b>Perl Script Laboratory</b></font></td></tr>
</table><p>

<table width=650>
<tr><td>
<h3>送信内容を確認します。</h3>

内容が正しい場合は送信ボタンを押してください。<br>
訂正する場合は戻るボタンで前のページへ戻って訂正してください。<p>

<table border cellpadding=3 cellspacing=0>
<tr><th bgcolor=#eeeebb>項　目</th><th bgcolor=#eeeebb>内　容</th></tr>
STR

    foreach (reserved_words(), qw(FID GETCODE SUBJECT VALUE_REQUIRED
     FINISHED ID FORM_MAILER_FLAG)) { $reserved_words{$_}++ }
    foreach $name(@name_list) {
        next if $reserved_words{$name};
        my $name_dsp = $alt{$name} || $name;
        $default_confirm_format .= <<STR;
<tr><th align=left>$name_dsp</th><td>##$name##</td></tr>
STR
    }

    $default_confirm_format .= <<STR;
</table><p>
##VALUES##


<input type=submit value=送　信>
<input type=button value=戻　る onclick=history.back()>

<div align=right>
<hr size=1 color=orange><small><b><a href=$a_url>$prod_name</a></b>
</small></div></td></tr></table>
<div style="border:2px red dotted;padding:5px;margin:10px auto;background:#ffe;color:red;width:650px;text-align:left;font-size:0.8rem">
■お知らせ■<br>
フォームデコードサービスV2は<a href="https://www.psl.ne.jp/topics/topics.cgi?shousai=71" target="_blank">2020/8/31(月) 0:00をもってサービス終了させていただきます。</a>
</div>
</div></form></body></html>
STR

    $default_confirm_format;

}

sub set_default_mail_format {

    my $format_type = shift;

    my $default_mail_format = <<STR;
---------------------------------------------------------------------
$SUBJECT
---------------------------------------------------------------------
##reply_message##
STR

    foreach (reserved_words(), qw(FID GETCODE SUBJECT VALUE_REQUIRED
     FINISHED ID FORM_MAILER_FLAG)) { $reserved_words{$_}++ }
    my $indent = (" " x length($MARK));
    foreach $name(@name_list) {
        next if $reserved_words{$name};

        my $name_dsp = $alt{$name} || $name;
        my $value_dsp = $FORM{$name};

        if ($format_type == 1) {
            $value_dsp =~ s/\!\!\!|\n/\n$indent/g;
            $default_mail_format .= "$MARK$name_dsp$SEPR\n$indent$value_dsp\n\n";
        } elsif ($format_type == 2) {
            $value_dsp =~ s/\!\!\!/ /g;
            $value_dsp =~ s/\n/\n$indent/g;
            $default_mail_format .= "$MARK$name_dsp$SEPR$value_dsp\n";
        } else {
            $value_dsp =~ s/\!\!\!/ /g;
            $value_dsp =~ s/\n/"\n".(" " x ($OFT+length($SEPR)))/eg;
            $default_mail_format .= sprintf("%-${OFT}s","$MARK$name_dsp").
                                    "$SEPR$value_dsp\n";
        }
    }

    chomp($default_mail_format .= <<STR);
---------------------------------------------------------------------
送信日時    ：$FORM{NOW_DATE}
接続元ホスト：$FORM{REMOTE_HOST}
使用ブラウザ：$FORM{USER_AGENT}
---------------------------------------------------------------------
STR

    $default_mail_format;

}

sub error_v2 {

    my $errmsg = join("", map { "<li>$_\n" } map { html_output_escape($_) } @_);

    if ($ERROR_FLAG) {
        unless(open(R, $ERROR_TMPL)) {
            my $error = $ERROR_TMPL;
            $ERROR_TMPL = "";
            error_v2("エラーページテンプレートファイル ( $error ) ".
                  "が開けませんでした。: $!");
        }
        $htmlstr = join("", <R>);

        unless( $htmlstr =~ s/##errmsg##/$errmsg/ ) {
            $ERROR_TMPL = "";
            error_v2("エラーメッセージを埋め込むための文字列".
                  " ( ##errmsg## ) がテンプレートに指定されていません。");
        }
        $htmlstr =~ s/##CREDIT##/$CREDIT/;
        print "Content-type: text/html; charset=Shift_JIS\n\n$htmlstr";

    } else {
        my $back = is_mobile()
         ? qq{<form><input type=button value=戻　る onclick=history.back()></form>}
         : qq{};
        print <<HTML;
Content-type: text/html; charset=Shift_JIS

<html><head><title>$prod_name v$version</title></head>
<body text="$TEXT" bgcolor="$BGCOLOR" link="$LINK" vlink="$VLINK"
alink="$ALINK" background="$BACKGROUND">
<h2>$prod_name v$version</h2>
<p><ul>$errmsg</ul></p>
$back
<hr noshade><div align=right><b><small>$prod_name v$version
<a href=$a_url>$signature</a></b></div></body></html>
HTML

    }

     exit;

}

sub remote_host {

    if ($ENV{REMOTE_HOST} eq $ENV{REMOTE_ADDR} or $ENV{REMOTE_HOST} eq '') {
        gethostbyaddr(pack('C4',split(/\./,$ENV{REMOTE_ADDR})),2)
         or $ENV{REMOTE_ADDR};
    } else {
        $ENV{REMOTE_HOST};
    }
}

sub email_chk_v2 {

    my $email = shift;

#    $email || push(@msg,'メールアドレスが入力されていません。');
    if ($email =~ /[\0-,\:\;<-?\[-\^\`\{-\~]/) {
        push(@msg, ($alt{EMAIL} or "EMAIL").'に使用できない文字が含まれています。');
    }
    if ($email =~ /[^ -\~]/) {
        push(@msg, ($alt{EMAIL} or "EMAIL").'に全角文字は使用できません。');
    }
    if ($email && $email !~ /[^@]+\@[^@.]+\.[^@.]+/) {
        push(@msg, ($alt{EMAIL} or "EMAIL").'が正しくありません。');
    }

    $email = lc($email);

}

sub uuencode {

    my($str, $filename) = @_;
    $str = pack('u', $str);
    $str = "begin 644 $filename\n$str\`\nend";
    $str;

}

sub base64 {

    my($subject, $nofold) = @_;
    my($str, $padding);
    while ($subject =~ /(.{1,45})/gs) {
        $str .= substr(pack('u', $1), 1);
        chop($str);
    }
    $str =~ tr|` -_|AA-Za-z0-9+/|;
    $padding = (3 - length($subject) % 3) % 3;
    $str =~ s/.{$padding}$/'=' x $padding/e if $padding;
    $str =~ s/(.{76})/$1\n/g unless $nofold;
    $str;

}

sub base64_subj {

    my($subject) = @_;
    $subject = base64($subject, 'nofold');
    "=?ISO-2022-JP?B?$subject?=";

}

sub get_cookies {

    my($cookie_name) = @_;
    error_v2('クッキー名を指定してください。') if !$cookie_name;
    foreach (split(/; /, $ENV{HTTP_COOKIE})) {
        ($name, $value) = split(/=/);
        if ($name eq $cookie_name) {
            $cookie_data = $value;
            last;
        }
    }

    split(/\!\!\!/, $cookie_data);

}

sub set_cookies {

    my($cookie_name, @cookie_data) = @_;
    my($cookie_data) = join('!!!', @cookie_data);
    print "Set-Cookie: $cookie_name=$cookie_data; \n";
}

sub imgsave {

    umask 0;

    my($param) = @_;
    my $filename = $q->param($param);
    my $stream;
    $temp ||= time . $$;

    if (ref $q->uploadInfo($q->param($param))) {
        my $ctype = $q->uploadInfo($q->param($param))->{'Content-Type'};
        if ($ctype =~ /macbinary/) {
            my $len;
            seek ($q->param($param), 83, SEEK_SET);
            read ($q->param($param), $len, 4);
            $len = unpack "%N", $len;
            seek ($q->param($param), 128, SEEK_SET);
            read ($q->param($param), $stream, $len);
        } else {
            my $buf;
            $stream .= $buf while read($q->param($param),$buf,1024);
        }
    }

    if ($stream) {
        jcode::convert(\$filename, 'euc','sjis');
        my @path = split(/\\/, $filename);
        $filename = $path[-1];
        jcode::convert(\$filename, 'sjis','euc');
        if (@ATTACH_EXT) {
            my $ext_limit = 1;
            foreach $ext(@ATTACH_EXT) {
                if ($filename =~ /\.$ext$/i) { $ext_limit = 0; }
            }
            error_v2("アップロードファイル ( $filename ) の拡張子は、許可されて".
             "いないため、送信できません。") if $ext_limit;
        }
        (my $filename_enc = $filename) =~ s/([^\da-zA-Z_.,-])/'%'.unpack('H2',$1)/eg;
        open(W, "> $TEMP_DIR/$temp-$filename_enc")
         or error_v2("$TEMP_DIR/$temp-$filename_enc への書き込みに失敗しました。: $!");
        print W $stream;
        close(W);
        ($temp, $filename, length($stream));
    } else {
        undef;
    }

}

sub load_condcheck {

    $condcheck{trim} = sub {
        my($f_name) = @_;
        $FORM{$f_name} =~ s/\s+//g;
    };
    $condcheck{trim2} = sub {
        my($f_name) = @_;
        $FORM{$f_name} =~ s/\s+//g;
        $FORM{$f_name} =~ s/\Q　\E//g;
    };
    $condcheck{required} = sub {
        my($f_name, $alt) = @_;
        if ($FORM{$f_name} eq '') {
            push(@msg, ($alt or $f_name) . "が入力されていません。");
        }
    };
    $condcheck{z2h} = sub {
        my($f_name, $alt) = @_;
        $FORM{$f_name} = z2h($FORM{$f_name});
    };
    $condcheck{d_only} = sub {
        my($f_name, $alt) = @_;
        if ($FORM{$f_name} =~ /\D/) {
            push(@msg, ($alt or $f_name) . "は半角数字のみ使用できます。");
        }
    };
    $condcheck{h2z} = sub {
        my($f_name, $alt) = @_;
        $FORM{$f_name} = h2z($FORM{$f_name});
    };
    $condcheck{h2z_kana} = sub {
        my($f_name, $alt) = @_;
        $FORM{$f_name} = h2z_kana($FORM{$f_name});
    };
    $condcheck{deny_rel} = sub {
        my($f_name, $alt) = @_;
        my $ret = mojichk($FORM{$f_name}, ($alt or $f_name));
        push(@msg, $ret) if $ret;
    };
    $condcheck{len_min} = sub {
        my($f_name, $alt, $cond) = @_;
        if (length($FORM{$f_name}) < $cond) {
            push(@msg, ($alt or $f_name) . "は ".
            $cond . " 文字(半角)以上で指定してください。");
        }
    };
    $condcheck{num_min} = sub {
        my($f_name, $alt, $cond) = @_;
        if (scalar(split(/\!\!\!/, $FORM{$f_name})) < $cond) {
            push(@msg, ($alt or $f_name) . "は ".
             $cond . " 個以上指定してください。");
        }
    };
    $condcheck{min} = sub {
        my($f_name, $alt, $cond) = @_;
        if ($FORM{$f_name} ne '' and $FORM{$f_name} < $cond) {
            push(@msg, ($alt or $f_name) . "は ".
             $cond . " 以上の数値を指定してください。");
        }
    };
    $condcheck{len_max} = sub {
        my($f_name, $alt, $cond) = @_;
        if (length($FORM{$f_name}) > $cond) {
            push(@msg, ($alt or $f_name) . "は ".
            $cond . " 文字(半角)以下で指定してください。");
        }
    };
    $condcheck{num_max} = sub {
        my($f_name, $alt, $cond) = @_;
        if (scalar(split(/\!\!\!/, $FORM{$f_name})) > $cond) {
            push(@msg, ($alt or $f_name) . "は ".
             $cond . " 個を超えて指定できません。");
        }
    };
    $condcheck{max} = sub {
        my($f_name, $alt, $cond) = @_;
        if ($FORM{$f_name} ne '' and $FORM{$f_name} > $cond) {
            push(@msg, ($alt or $f_name) . "は ".
             $cond . " 以下の数値を指定してください。");
        }
    };
    $condcheck{regex} = sub {
        my($f_name, $alt, $cond) = @_;
        eval {
            if ($FORM{$f_name} =~ /$cond/) {
                push(@msg, ($alt or $f_name) . "は不正な値です。");
            }
        };
        error_v2($FORM{$f_name}.'の正規表現が不正です: '. $@) if $@;
    };
    qw(trim trim2 required z2h d_only h2z h2z_kana deny_rel len_min num_min
    min len_max num_max max regex);

}

sub mojichk {

    my($str, $fname) = @_;
    my @error_char;

    my @chars = $str =~ /[\x20-\x7e\xa1-\xdd][\xde\xdf]*|[\x81-\x9f\xe0-\xfc][\x40-\xfc]/og;

    foreach my $char(@chars) {
        my $code = lc(unpack("H*",$char));
        if (length($char) == 2 and ($code lt '8140' or $code gt '84be' and $code lt '889f' or $code gt '9872' and $code lt '989f' or $code gt 'eaa4')) {
            push(@error_char, $char);
        }
    }

    @error_char
     ? ("$fname の欄の、「" . join("」「", @error_char) .
       "」の文字は、機種依存であるため使用できません。")
     : "";

}

sub setalt {
    foreach (@COND) { $alt{$_->[0]} = $_->[1]->{alt}; }
}

### 2004.6.20 タグを構成するキャラクタのエスケープ
sub html_output_escape {

    my $str = shift;
    $str =~ s/&/&amp;/g;
    $str =~ s/>/&gt;/g;
    $str =~ s/</&lt;/g;
    $str =~ s/"/&quot;/g;
    $str =~ s/'/&#39;/g;
    $str;

}