#!/usr/bin/perl -Tw
# ---------------------------------------------------------------
#  - システム名    トップページバナー設置権争奪くじ(^^;
#  - バージョン    0.2
#  - 公開年月日    2004/9/20
#  - スクリプト名  auto_kuji.cgi
#  - 著作権表示    (c)1998-2004 Perl Script Laboratory
#  - 連  絡  先    info@psl.ne.jp (http://www.psl.ne.jp/)
# ---------------------------------------------------------------
# ご利用にあたっての注意
#   ※このシステムはフリーウエアです。
#   ※このシステムは、「利用規約」をお読みの上ご利用ください。
#     http://www.psl.ne.jp/lab/copyright.html
# ---------------------------------------------------------------
use strict;
use lib qw(.);
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Fcntl qw(:flock);
use POSIX qw(SEEK_SET); 
use vars qw($q %CONF %PROD %FORM $date $pid);
require 'jcode.pl';
require 'auto_kuji_conf.pl';
%CONF = (conf(), setver());
$ENV{PATH} = "/usr/bin:/bin:/usr/sbin:/usr/local/bin";
umask 0;

$q = new CGI;
%FORM = decoding($q);

$date = time;
$pid = $$;
file_lock();

login() if $FORM{login};

admin() if $FORM{admin};
admin_del() if $FORM{admin_del};
admin_list() if $FORM{admin_list};
admin_mod() if $FORM{admin_mod};
admin_void() if $FORM{admin_void};
kuji() if $FORM{kuji};
logout() if $FORM{logout};
send_key() if $FORM{send_key};
reg_form() if $FORM{reg_form};
reg_confirm() if $FORM{reg_confirm};
reg_done() if $FORM{reg_done};
cancel() if $FORM{cancel};
indexpage();
exit;

sub admin {

    get_cookie("AUTO_KUJI") or login_form();

}

sub admin_list {

    get_cookie("AUTO_KUJI") or login_form();

    %CONF = (%CONF, get_list_data($FORM{p}, 5));

    printhtml("_admin_list.html", map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub admin_del {



}

sub admin_mod {

}

sub cancel {

    key_check($FORM{cancel});
    unlink("temp/key");

    printhtml("_cancel.html", map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub comma {

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

}

sub crypt_passwd {

    my $passwd = shift;
    my $salt;
    my @salt = ('0'..'9','A'..'Z','a'..'z','.','/');
    foreach (1..8) { $salt .= $salt[rand(@salt)] };
#    crypt($passwd, $salt);
    crypt($passwd,
     index(crypt('a', '$1$a$'), '$1$a$') == 0 ? '$1$'.$salt.'$' : $salt);

}

sub crypt_passwd_is_valid {

    my($plain_passwd, $crypt_passwd) = @_;
    return 0 if $plain_passwd eq '' or $crypt_passwd eq '';
    return crypt($plain_passwd, $crypt_passwd) eq $crypt_passwd ? 1 : 0;

}

sub date_f {

    my $time = shift;
    my($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($time);
    sprintf("%4d-%02d-%02d %02d:%02d:%02d", $year+1900,++$mon,$mday,
     $hour,$min,$sec);

}

sub date_f2 {

    my $time = shift;
    my($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($time);
    ($year+1900,sprintf("%02d",++$mon),sprintf("%02d", $mday),
     (qw(Sun Mon Tue Wed Thu Fri Sat))[$wday],sprintf("%02d", $hour),
     sprintf("%02d", $min),sprintf("%02d", $sec));

}

sub decoding {

    my($q) = @_;
    my %FORM;
    foreach my $name($q->param()) {
        foreach my $each($q->param($name)) {
            if (defined($FORM{$name})) {
                $FORM{$name} = join('|||', $FORM{$name}, $each);
            } else {
                $FORM{$name} = $each;
            }
        }
    }
    if (keys %FORM == 1 and $FORM{keywords}) {
        $FORM{$FORM{keywords}} = 1;
        delete $FORM{keywords};
    } else {
        foreach my $key(qw(admin admin_del admin_list admin_mod admin_void
         kuji cancel logout reg_form reg_confirm reg_done)) {
            $FORM{$key} = 1 if exists $FORM{$key} and $FORM{$key} eq '';
        }
    }
    %FORM;
}

sub email_chk {

    my($email, $str) = @_;
    $str ||= "メールアドレス";
    my @msg;

    $email || push(@msg, "$strが入力されていません。");
    if ($email =~ /[\0-,\/\:\;<-?\[-\^\`\{-\~]/) {
        push(@msg, "$strに特殊文字は使用できません。");
    }
    if ($email =~ /[^ -\~]/) {
        push(@msg, "$strに全角文字は使用できません。");
    }
    if ($email && $email !~ /^[-_.!*a-zA-Z0-9\/&+%\#]+\@[-_.a-zA-Z0-9]+\.(?:[a-zA-Z]{2,3})$/) {
        push(@msg, "$strが正しくありません。");
    }

    return(lc($email), @msg);

}

sub enc_b64 {

    my($subject) = @_;
    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;
    "=?ISO-2022-JP?B?$str?=";

}

sub error {

    my $errmsg = join("", map { "<li>$_\n" } map { html_output_escape($_) } @_);
    open(R, "tmpl/_error.html")
     or die "tmpl/_error.htmlが開けませんでした。: $!";
    my $htmlstr = join("", <R>);
    close(R);
    $htmlstr =~ s/##errmsg##/$errmsg/;
    $htmlstr =~ s/##([^#]+)##/$CONF{$1}/g;
    print "Content-type: text/html; charset=Shift_JIS\n\n$htmlstr";
    exit;

}

sub file_lock {

    open(LOCK, "lockfile")
     or error("ロックファイルが開けませんでした。: $!");
    flock(LOCK, LOCK_EX);

}

sub file_save {

    my %extlist = map { $_ => 1 } qw(jpg gif jpeg html shtml htm pdf);
    my($stream, $filepath, $filename, @extra_extlist) = @_;
    %extlist = map { $_ => 1 } @extra_extlist if @extra_extlist;
    $stream or return;

    ($filename) = $filename =~ m#.*?[\\/]?([^\\/]+)$#;
    my($ext) = $filename =~ /\.([^\.]+)$/;
    unless ($extlist{lc($ext)}) {
        return "$filename:$ext:アップロードできるファイルは、" .
         join(" ", sort keys %extlist) .
         " の拡張子を持つものに限られています。";
    }
    open(W, "> $filepath/$filename")
     or error("$filepath/$filename の書き込みに失敗しました。: $!");
    print W $stream;
    close(W);
    undef;

}

sub get_cookie {

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

}

sub get_datetime_for_cookie {

    my($time) = @_;
    ($time, my $unit) = split(/\s+/, $time, 2);
    $unit = $unit =~ /days?/i ? 86400 : 1;
    my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time + $time * $unit);
    sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
     (qw(Sun Mon Tue Wed Thu Fri Sat))[$wday],
     $mday, (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[++$mon],
     $year+1900, $hour, $min, $sec);

}

sub get_file_stream {

    my($q,$param) = @_;
    my $stream;

    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);
        }
    }
    $stream;

}

sub get_image_size {

    require "GetPicSize.pl";
    return GetImageSize(shift);

}

sub get_list_data {

    my($offset, $limit) = @_;
    my %rv;

    open(R, "data/list.dat")
     or error("当選データファイルが開けませんでした。: $!");
    my @data = reverse <R>;
    $rv{cnt_all} = @data;
    close(R);

    if ($offset > 0) {
        my $prev_p = $offset - $offset;
        $rv{prev} = "<a href=auto_kuji.cgi?admin_list&p=$prev_p>&lt;&lt; 戻る</a>";
    } else {
        $rv{prev} = "<font color=#999999>&lt;&lt; 戻る</font>";
    }
    if ($offset + $limit < $rv{cnt_all}) {
        my $next_p = $offset + $offset;
        $rv{next} = "<a href=auto_kuji.cgi?admin_list&p=$next_p>進む &gt;&gt;</a>";
    } else {
        $rv{next} = "<font color=#999999>進む &gt;&gt;</font>";
    }

    ### 現在のページと総ページ数の算出
    $rv{page_c} = $offset / $limit + 1;
    $rv{page_all} = int($rv{cnt_all} / $limit)
     + (($rv{cnt_all} % $limit) ? 1 : 0);

    my $cnt;
    my $offset_ = $offset;
    foreach my $data(@data) {
        next if $offset_-- > 0;
        last if ++$cnt > $limit;
        my %d;
        @d{qw(date name email url char key)} = split(/\t/, $data);
        next unless $d{key};
        my $filename = ($offset == 0 and $cnt == 1) ? "_" : $d{key};
        open(R2, "banner/$filename.html");
        my $htmlstr = join("", <R2>);
        close(R2);
        $rv{list} .= <<STR;
<tr>
<td>$d{key}<br><a href="mailto:$d{email}">$d{name}</a></td>
<td valign=top>
<table border=0 cellpadding=0 cellspacing=0 width=$CONF{link_img_width} height=$CONF{link_img_height} bgcolor=#ffffff align=center style="border-width:1px;border-style:dotted;border-color:#cccccc;">
<tr><td align=center>$htmlstr</td></tr></table>
</td>
<td><a href=auto_kuji.cgi?admin_mod=$d{key}>修正</a>
<a href=auto_kuji.cgi?admin_del=$d{key}>削除</a></td></tr>
STR

    }

    %rv;

}

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;

}

sub indexpage {

    open(R, "data/won.dat") or error("あたり数ファイルが開けません。: $!");
    chomp(my $won = <R>);
    close(R);
    open(R, "data/lost.dat") or error("はずれ数ファイルが開けません。: $!");
    chomp(my $lost = <R>);
    close(R);

    my $times = $won + $lost;
    my $times_dsp = comma($times);
    my $won_dsp = comma($won);

    # 確率の計算
    my $now_rate = sprintf("%.2f", $times ? $won / $times * 100 : 0);
    #$now_rate =~ s/^(\d)(.*)/$1\.$2/;

    # 当選者リストの読み出し
    open(R, "data/list.dat")
     or error("当選者リストファイルが開けません。: $!");
    my $list;
    while (<R>) {
        my ($date,$name,$email,$url) = split(/\t/);
        my $link;
        if ($date =~ /^\d+$/) {
            $date = date_f($date);
            $link = $url;
        } else {
            $date =~ s/^(\d{4})(\d{2})(\d{2})/$1-$2-$3/;
            $link = qq{<a href=$url target=_top>$url</a>};
        }
        $list = <<STR . $list;
<tr><td>$date</td><td>$name</td><td>$link</td></tr>
STR
    }
    close(R);

    my $limit_dsp = $CONF{limit} ? qq{一度くじを引くと、$CONF{limit_duration}時間くじを引くことができません。} : q{このくじは何度でも引くことができます。};

    printhtml("_index.html", list=>$list, times_dsp=>$times_dsp,
     won_dsp=>$won_dsp, now_rate=>$now_rate, limit_dsp=>$limit_dsp,
     map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub key_check {

    my $form_key = shift;
    $form_key or error("キーが指定されていません。");
    my($key, $email) = key_exists();
    unless ($key) {
        error("あたりが出ていないか、または登録期限($CONF{reg_expire}分)が経過したため、登録できません。");
    }
    error("キーが一致しません。") if $key ne $form_key;
    return $key, $email;

}

sub key_exists {

    if ($date >= (stat("temp/key"))[9] + $CONF{reg_expire} * 60) {
        unlink("temp/key");
    }
    if (-e "temp/key") {
        open(R, "temp/key") or error("キーファイルが開けませんでした。: $!");
        chomp(my $data = <R>);
        close(R);
        my @data = split(/\t/, $data);
        return wantarray ? @data : $data[0];
    } else {
        return undef;
    }

}

sub kuji {

    unless ($ENV{HTTP_REFERER} eq "$CONF{kuji_url}/auto_kuji.cgi") {
#        error("このくじはくじのトップページのリンクをクリックして引いてください。URLを直接指定して引くことはできません。");
    }
    under_reg() if key_exists();
    renzoku_check($date) if $CONF{limit};

    srand($date|$pid);
    my $number1 = int(rand($CONF{rate}));
    my $number2 = int(rand($CONF{rate}));

    open(W, ">> data/log.dat") or error("ログファイルが開けません。: $!");
    print W join("\t", $date,$pid,$number1,$number2,
     $ENV{REMOTE_ADDR}), "\n";
    close(W);

    $number1 == $number2 ? won() : lost();

}

sub login {

    $FORM{passwd} or error("パスワードを入力してください。");

    if ((stat("data/passwd.dat"))[7]) {
        open(R, "data/passwd.dat")
         or error("パスワードファイルが開けません。: $!");
        my $passwd = <R>;
        close(R);
        unless (crypt_passwd_is_valid($FORM{passwd}, $passwd)) {
            error("パスワードが違います。");
        }
    } else {
        ### 入力したパスワードをそのまま登録する
        open(W, "> data/passwd.dat")
         or error("パスワードファイルの生成ができませんでした。: $!");
        print W crypt_passwd($FORM{passwd});
        close(W);
    }

    set_cookie("AUTO_KUJI", "", "login");
    $FORM{do_cache} ? set_cookie("AUTO_KUJI_CACHE", 30, $FORM{passwd})
     : set_cookie("AUTO_KUJI_CACHE");
    print "Location: $CONF{kuji_url}/auto_kuji.cgi?admin\n\n";
    exit;

}

sub login_form {

    my $init_guide = (stat("data/passwd.dat"))[7] ? ""
     : "<br><b>パスワードが登録されていません。入力したパスワードがそのまま登録されます。</b>";

    my $passwd_cache = get_cookie("AUTO_KUJI_CACHE");
    printhtml("_login_form.html", passwd=>$passwd_cache,
     init_guide=>$init_guide, map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub logout {

    set_cookie("AUTO_KUJI");
    printhtml("_logout.html", map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub lost {

    open(R, "data/lost.dat")
     or error("はずれ数ファイルが開けません。: $!");
    chomp(my $lost = <R>);
    close(R);
    open(W, "> data/lost.dat")
     or error("はずれ数ファイルが開けません。: $!");
    print W ++$lost;
    close(W);

    printhtml("_lost.html", map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub mk_banner_html {

    my %d = @_;
    my $htmlstr;
    my $jsstr;
    my $dir = $d{__temp__} ? "temp/_" : "$CONF{kuji_url}/banner/";
    if ($d{ext}) {
        chomp($htmlstr = <<HTML);
<a href="$d{url}" target="_blank"><img src="$dir$d{key}.$d{ext}?$date" border="0" alt="$d{char}" /></a>
HTML
        $jsstr = qq|document.write('<a href="$d{url}" target="_blank"><img src="$dir$d{key}.$d{ext}?$date" border="0" alt="$d{char}" /></a>')|;

    } else {
        chomp($htmlstr = <<HTML);
<a href="$d{url}" target="_blank"><span style="font-size:$CONF{link_char_size}pt;font-weight:bold">$d{char}</span></a>
HTML
        $jsstr = qq|document.write('<a href="$d{url}" target="_blank"><span style="font-size:$CONF{link_char_size}pt;font-weight:bold">$d{char}</span></a>')|;
    }
    return $htmlstr, $jsstr;

}

sub printhtml {

    my($filename, %tr) = @_;
    $filename or error("printhtml: 使用するhtmlファイルを指定してください。");
    open(R, "tmpl/$filename")
     or error("printhtml: $filename が開けませんでした。 $!");
    my $htmlstr = join("", <R>);
    foreach my $key(keys %tr) {
        $htmlstr =~ s/##$key##/$tr{$key}/g;
    }
    print "Content-type: text/html; charset=Shift_JIS\n\n$htmlstr";

}

sub reg_confirm {

    my($key, $email) = key_check($FORM{key});

    my @msg;
    my @msg_;
    unlink("temp/_$FORM{key}.$FORM{ext}") if $FORM{img_del};
    if (my $stream = get_file_stream($q, "img")) {
        ($FORM{ext}) = $FORM{img} =~ /\.(\w+)$/;
        if ($stream > $CONF{link_img_kbyte} * 1024) {
            push(@msg, "イメージのファイルサイズが$CONF{link_img_kbyte}kbを超えています。制限以下のファイルをアップロードしてください。");
        } else {
            my $errmsg = file_save($stream, "temp", "_$FORM{key}.$FORM{ext}", qw(jpg gif png));
            push(@msg, $errmsg) if $errmsg;
        }
    }
    if (-e "temp/_$FORM{key}.$FORM{ext}") {
        my($format, $width, $height)
         = get_image_size("temp/_$FORM{key}.$FORM{ext}");
        if ($width > $CONF{link_img_width}
         or $height > $CONF{link_img_height}) {
            push(@msg,"イメージのサイズ($width x $height)が制限枠($CONF{link_img_width} x $CONF{link_img_height})を超えています。枠内に収まるようにサイズを調整してからアップロードしてください。");
        }
    }

    $FORM{name} || push(@msg, 'お名前を入力してください。');
    ($FORM{email}, @msg_) = email_chk($FORM{email});
    push(@msg, @msg_) if @msg_;
    $FORM{url} || push(@msg, 'リンク先のURLを入力してください。');
    unless ($FORM{url} =~ /^(?:s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%\#]+)$/) {
        push(@msg, "URLを正しく指定してください。");
    }
    $FORM{char} || push(@msg, 'リンクを貼る文字を入力してください。');
    if (length($FORM{char}) > $CONF{link_char_byte}) {
        push(@msg, 'リンクを貼る文字バイト数が制限を超えています。');
    }

    reg_form(@msg) if @msg;

    %FORM = map { $_=>html_output_escape($FORM{$_}) } keys %FORM;
    (my $banner_dsp) = mk_banner_html(%FORM, __temp__=>1);

    printhtml("_reg_confirm.html", banner_dsp=>$banner_dsp,
     (map { $_=>$FORM{$_} } keys %FORM), map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub reg_done {

    eval { use File::Copy };

    my($key, $email) = key_check($FORM{key});

    my $date = time;
    ($FORM{key}) = $FORM{key} =~ /^(\d+)$/;
    ($FORM{ext}) = $FORM{ext} =~ /^(\w+)$/;
    if (-e "temp/_$FORM{key}.$FORM{ext}") {
        move("temp/_$FORM{key}.$FORM{ext}", "banner/$FORM{key}.$FORM{ext}")
         or error("画像ファイルの移動ができませんでした。: $!");
    }

    my($htmlstr, $jsstr) = mk_banner_html(%FORM);
    open(W, "> banner/$FORM{key}.html")
     or error("バナーhtmlを書き込めません");
    print W $htmlstr;
    close(W);
    open(W, "> banner/$FORM{key}.js")
     or error("バナーjsを書き込めません");
    print W $jsstr;
    close(W);

    copy("banner/$FORM{key}.html", "banner/_.html")
     or error("バナーhtmlのコピーができませんでした。: $!");
    copy("banner/$FORM{key}.js", "banner/_.js")
     or error("バナーhtmlのコピーができませんでした。: $!");

    opendir(DIR, "temp") or error("tempディレクトリが開けませんでした。: $!");
    foreach my $file(grep(!/^\.\.?/, readdir(DIR))) {
        ($file) = $file =~ /^([.\w]+)$/;
        unlink("temp/$file");
    }

    open(W, ">> data/list.dat")
     or error("当選者記録ファイルが開けません。: $!");
    print W join("\t", date_f($date), @FORM{qw(name email url char key ext)});
    print W "\n";
    close(W);

    open(R, "tmpl/_notification.txt")
     or error("tmpl/_notification.txtが開けませんでした。: $!");
    chomp(my $mail_subject = <R>);
    my $mail_body = join("", <R>);
    $mail_subject =~ s/##([^#]+)##/$CONF{$1}/g;
    $mail_body =~ s/##key##/$key/g;
    foreach (qw(name email url char)) { $mail_body =~ s/##$_##/$FORM{$_}/g }
    $mail_body =~ s/##html_dsp##/$htmlstr/g;
    $mail_body =~ s/##([^#]+)##/$CONF{$1}/g;

    sendmail($CONF{k_email},$FORM{email},$mail_subject,$mail_body);

    printhtml("_reg_done.html", map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub reg_form {

    my @errmsg = @_;
    my $errmsg;

    if (@errmsg) {
        $errmsg = join("", map { "　　 $_<br>\n" } @errmsg);
        $errmsg = <<STR;
<table border=0 cellspacing=0 cellpadding=1 class=main>
<tr><td bgcolor=#ffddaa height=20><font color=#cc0000><b>+++ 以下の通り入力の不備がありましたのでご確認の上再送信してください。 +++</b></font></td></tr>
<tr><td bgcolor=#ffffdd><font color=#ff3333>
$errmsg</font></td></tr></table><br>
STR
    }

    @FORM{qw(key email)} = key_check($FORM{key});

    my $banner_dsp;
    if ($FORM{ext} and -e "temp/_$FORM{key}.$FORM{ext}") {
        $banner_dsp = <<STR;
<a href=temp/_$FORM{key}.$FORM{ext} target=_blank>バナーアップ済</a>
<input type=checkbox name=img_del value=1>削除
STR
    }

    printhtml("_reg_form.html", errmsg=>$errmsg, banner_dsp=>$banner_dsp,
     (map { $_=>$FORM{$_} } qw(key ext email name url char)),
     map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub renzoku_check {

    my $date = shift;
    my $flag;
    ($ENV{REMOTE_ADDR}) = $ENV{REMOTE_ADDR} =~ /^([0-9\.]+)$/;
    if (-e "ip/$ENV{REMOTE_ADDR}") {
        my $rest = (stat("ip/$ENV{REMOTE_ADDR}"))[9]
         + $CONF{limit_duration} * 3600 - $date;
        $flag = $rest if $rest > 0;
    }
    unless ($flag) {
        open(W, "> ip/$ENV{REMOTE_ADDR}")
         or error("IPファイルが生成できませんでした。: $!");
        close(W);
    }
    if ($flag) {
        printhtml("_renzoku.html",
         rest=>sprintf("%d時間%d分%d秒", int($flag/3600), int(($flag%3600)/60),
          $flag % 60), map { $_=>$CONF{$_} } keys %CONF);
        exit;
    }

}

sub send_key {

    my @msg;
    ($FORM{email}, @msg) = email_chk($FORM{email});
    error(@msg,__LINE__) if @msg;

    my($key, $email) = key_check($FORM{key});

    open(W, "> temp/key")
     or error("キーファイルへ書き込みできませんでした。: $!");
    print W "$key\t$FORM{email}";
    close(W);

    open(R, "tmpl/_send_key.txt")
     or error("tmpl/_send_key.txtが開けませんでした。: $!");
    chomp(my $mail_subject = <R>);
    my $mail_body = join("", <R>);
    $mail_body =~ s/##key##/$key/g;
    $mail_body =~ s/##([^#]+)##/$CONF{$1}/g;

    sendmail($FORM{email},$CONF{k_email},$mail_subject,$mail_body);

    printhtml("_send_key.html", email=>$FORM{email},
     map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub sendmail {

    my($mailto, $from, $subject, $mailstr, $date) = @_;

    jcode::convert(\$subject,'jis');
    jcode::convert(\$mailstr,'jis');
    $subject = enc_b64($subject) if $subject =~ /[^\t\n\x20-\x7e]/;

    open(SEND, "|$CONF{sendmail} -t 1>/dev/null 2>/dev/null")
     || error("$mailto への送信に失敗しました。: $!");

    print SEND "Date: $date\n" if $date;
    print SEND <<STR;
To: $mailto
From: $from
Subject: $subject
Content-Transfer-Encoding: 7bit
Mime-Version: 1.0
Content-Type: text/plain; charset=ISO-2022-JP

$mailstr
STR
    close(SEND);

}

sub set_cookie {

    my($cookie_name, $expire, @cookie_data) = @_;
    my($cookie_data) = join('!!!', @cookie_data);
    $expire = "expires=". get_datetime_for_cookie("$expire days") . "; "
     if $expire;
    print "Set-Cookie: $cookie_name=$cookie_data; path=/; $expire\n";

}

sub setver {

    # このサブルーチン内の設定は変更しないでください。
    my %prod = (
	prod_name => q{Auto Kuji},
	version   => q{0.2},
	signature => q{Author's page},
	a_email   => q{info@psl.ne.jp},
	a_url     => q{http://www.psl.ne.jp/},
    );
    $prod{COPYRIGHT} = <<STR;
<div align=right><hr noshade><b>
<a href=$prod{a_url}>$prod{prod_name} v$prod{version}</a></b></div>
</form></body></html>
STR
    $prod{COPYRIGHT2} = qq{$prod{prod_name} v$prod{version}\n$prod{a_url}};

    %prod;

}

sub under_reg {

    printhtml("_under_reg.html", map { $_=>$CONF{$_} } keys %CONF);
    exit;

}

sub won {

    open(R, "data/won.dat")
     or error("あたり数ファイルが開けません。: $!");
    chomp(my $won = <R>);
    close(R);
    open(W, "> data/won.dat")
     or error("あたり数ファイルが開けません。: $!");
    print W ++$won;
    close(W);

    open(W, "> temp/key") or error("キーファイルが作成できませんでした。: $!");
    print W $date . $pid;
    close(W);

    printhtml("_won.html", key => $date . $pid,
     map { $_=>$CONF{$_} } keys %CONF);
    exit;

}