#!/usr/bin/perl -- use vars qw(%config %category %form); use strict; use MIME::Base64; #require 'mimew.pl'; require 'jcode.pl'; #-########################################################################### # # EveryAuction Release Version 1.51 (5/13/00) # Copyright (C) 2000 EverySoft # http://www.everysoft.com/ # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # #-########################################################################### # # Modification Log (please add new entries to bottom): # # * 02/2000 # Matt Hahnfeld (matth@everysoft.com) - Original Concept and Design # Version available from http://www.everysoft.com/ # # * 06/2000 # Yukiyasu Murakami (yukiyasu.murakami@zebec.co.jp) - Japanese(EUC) version. # please refer to a readme file or http://www.zebec.co.jp/ # # * MM/YYYY # Name (email) - Modification # Availability # #-########################################################################### #-############################################# # Configuration Section # Edit these variables! local %config; # The Base Directory. We need an # absolute path for the base directory. # Include the trailing slash. THIS SHOULD # NOT BE WEB-ACCESSIBLE! # 以下のディレクトリはWebで参照付加であること。また、httpサーバが書き込めること。 $config{'basepath'} = '/home/www/auctiondata/'; # # その他のディレクトリはデフォルトのままで十分です。 # # Closed Auction Directory # This is where closed auction items are stored. # Leave this blank if you don't want to store # closed auctions. It can potentially take # up quite a bit of disk space. # オークション終了したものが格納されるディレクトリ # 保存しない場合は空白にする。 $config{'closedir'} = 'closed'; # User Registration Directory # This is where user registrations are stored. # Leave this blank if you don't want to # require registration. It can potentially # take up quite a bit of disk space. # ユーザ情報用のディレクトリ # 保存しない場合は空白にする。 $config{'regdir'} = 'reg'; # List each directory and its associated # category name. These directories should # be subdirectories of the base directory. # カテゴリに関連付けられたディレクトリの一覧 # BASE Directoryに作られます。 %category = ( computer => '木のおもちゃ', # elec => '家電製品', # other => 'その他', ); # This is the password for deleting auction # items. $config{'adminpass'} = 'asobigokoroauc'; # You need to assign either a mail program or # a mail host so confirmation e-mails can # be sent out. # Leave one commented and one uncommented. # # YOU NEED EITHER A MAIL PROGRAM $config{'mailprog'} = '/usr/sbin/sendmail -t'; # # OR YOU NEED A MAIL HOST (SMTP) #$config{'mailhost'} = 'localhost'; # This line should be your e-mail address $config{'admin_address'} = 'asobigokoro@lifestamp.com'; # This line should point to the URL of # your server. It will be used for sending # "you have been outbid" e-mail. The script # name and auction will be appended to the # end automatically, so DO NOT use a trailing # slash. If you do not want to send outbid # e-mail, leave this blank. $config{'scripturl'} = 'www.lifestamp.com'; # This will let you define colors for the # tables that are generated and the # other page colors. The default colors # create a nice "professional" look. Must # be in hex format. $config{'colortablehead'} = '#FFCC00'; $config{'colortablebody'} = '#FFFF99'; # Site Name (will appear at the top of each page) $config{'sitename'} = '「遊び心」店長の気まぐれオークション'; # You can configure your own header which will # be appended to the top of each page. $config{'header'} =<<"EOF"; $config{'sitename'} - Powered By EveryAuction
$config{'sitename'}
珍品・逸品・一点モノをぼちぼち？出品致します

キーワード
ユーザ名

EOF # You can configure your own footer which will # be appended to the bottom of each page. # Although not required, a link back to # everysoft.com will help to support future # development. $config{'footer'} =<<"EOF";

Powered By EveryAuction 1.51
Japanese Translation By 株式会社ジーベック
EOF # Sniper Protection... How many minutes # past last bid to hold auction. If auctions # should close at exactly closing time, set # to zero. $config{'aftermin'} = 5; # File locking enabled? Should be 1 (yes) # for most systems, but set to 0 (no) if you # are getting flock errors or the script # crashes. $config{'flock'} = 1; # User Posting Enabled- 1=yes 0=no $config{'newokay'} = 1; #-############################################# # Main Program # You do not need to edit anything below this # line. #-############################################# # Print The Page Header # print "Content-type: text/html\n\n"; print $config{'header'}; # #-############################################# local %form = &get_form_data; &j_convert; #addition for Japanese translation if ($form{'action'} eq 'new') { &new; } elsif ($form{'action'} eq 'repost') { &new; } elsif ($form{'action'} eq 'procnew') { &procnew; } elsif ($form{'action'} eq 'procbid') { &procbid; } elsif ($form{'action'} eq 'reg') { ® } elsif ($form{'action'} eq 'procreg') { &procreg; } elsif ($form{'action'} eq 'creg') { &creg; } elsif ($form{'action'} eq 'proccreg') { &proccreg; } elsif ($form{'action'} eq 'closed') { &viewclosed1; } elsif ($form{'action'} eq 'closed2') { &viewclosed2; } elsif ($form{'action'} eq 'closed3') { &viewclosed3; } elsif ($form{'action'} eq 'admin') { &admin; } elsif ($form{'action'} eq 'procadmin') { &procadmin; } elsif ($form{'action'} eq 'search') { &procsearch; } elsif ($form{'item'} eq int($form{'item'}) and $category{$form{'category'}}) { &dispitem; } elsif ($category{$form{'category'}}) { &displist; } else { &dispcat; } #-############################################# # Print The Page Footer # print "

[カテゴリ一覧]"; #print " [新規商品登録]" if ($config{'newokay'}); print " [新規ユーザ登録] [ユーザ登録変更]" if ($config{'regdir'}); print " [終了したオークション]" if ($config{'regdir'}) and ($config{'closedir'}); print "

\n"; print $config{'footer'}; # #-############################################# #-############################################# # Sub: Display List Of Categories # This creates a "nice" list of categories. sub dispcat { print "

オークションのカテゴリ

\n"; print ""; my $key; foreach $key (sort keys %category) { umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$key", 0777) unless (-d "$config{'basepath'}$key"); opendir DIR, "$config{'basepath'}$key" or &oops("カテゴリディレクトリ「$key」が開けません。"); my $numfiles = scalar(grep -T, map "$config{'basepath'}$key/$_", readdir DIR); closedir DIR; print ""; } print "
カテゴリ商品
$category{$key}$numfiles
\n"; } #-############################################# # Sub: Display List Of Items # This creates a "nice" list of items in a # category. sub displist { print "

$category{$form{'category'}}

\n"; print "\n"; print "\n"; opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("カテゴリディレクトリ「$form{'category'}」が開けません。"); my @allfiles = grep -T, map "$config{'basepath'}$form{'category'}/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$form{'category'}\///; $file =~ s/\.dat$//; my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($form{'category'},$file); if ($title ne '') { my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); my @closetime = localtime($file); $closetime[4]++; print "\n"; } } print "
商品終了入札数最高入札額
$title"; print " [写真]" if ($image); print "$closetime[4]/$closetime[3]$#bids\\$bid
\n"; } #-############################################# # Sub: Display Item # This displays a particular item, its # description, and its associated bids. sub dispitem { &oops("商品「$form{'item'}」が開けません。") unless (my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($form{'category'},$form{'item'})); my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($form{'category'},$form{'item'}); &oops("商品「$form{'item'}」が開けません。オークションが終了した商品であれば終了したオークションで入札の記録や履歴を確認できます。") if $title eq ''; # my $nowtime = localtime(time); # my $closetime = localtime($form{'item'}); my $nowtime = jptime(time); my $closetime = jptime($form{'item'}); print "

$title

詳細情報
\n"; print ""; print "" if ($image); print "
$title
カテゴリ: $category{$form{'category'}}
"; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[0]); # read first bid print "出品者: $alias
現在時刻: $nowtime
終了: $closetime
または 最後の入札から $config{'aftermin'} 分後...
入札数: $#bids
"; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); # read last bid print "最新入札額: \\$bid "; print "(リザーブ額には到達していません)" if ($bid < $reserve); print "(リザーブ額に到達しています)" if (($bid >= $reserve) and ($reserve > 0)); print "
\n"; print "
商品説明
$desc"; print "
入札の履歴
\n"; my $lowest_new_bid; if ($#bids) { for (my $i=1; $i$alias \($bidtime\) - \\$bid
"; } $lowest_new_bid = &parsebid($bid+$inc); } else { print "入札はまだありません...
"; $lowest_new_bid = (&read_bid($bids[0]))[2]; } # either the item is closed or we will display a bid form my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); # read the last bid if ((time > int($form{'item'})) && (time > (60 * $config{'aftermin'} + $time))) { print "入札は終了しました
"; &closeit($form{'category'},$form{'item'}); } else { print <<"EOF";
入札する
最高入札額: \\$bid
入札できる最低額: \\$lowest_new_bid

入札するということは商品の売り手と契約を結ぶということです。一度入札すると、入札を破棄することはできません。 買いたくないのなら入札してはいけません。 EOF if ($config{'regdir'}) { print <<"EOF";

商品の出品や入札にはユーザ登録 が必要です。

あなたのユーザ名: (入札の記録に使われます)
あなたのパスワード: (有効であること)
あなたの入札額: \\

EOF } else { print <<"EOF";

あなたのユーザ名: (入札の記録に使われます)
あなたのE-Mailアドレス: (有効であること)
あなたの入札額: \\

連絡先: (売り手にのみ通知されます)
氏名:

郵便番号・都道府県・市町村:

町名・番地・マンション等:

EOF } print <<"EOF"; EOF } } #-############################################# # Sub: Add New Item # This allows a new item to be put up for sale sub new { # my $inc = '1.00'; # default increment my $inc = '100'; # 100 YEN my ($title, $reserve, $inc, $desc, $image, @bids); if ($form{'REPOST'}) { $form{'REPOST'} =~ s/\W//g; if (-T "$config{'basepath'}$config{'closedir'}/$form{'REPOST'}.dat") { open THEFILE, "$config{'basepath'}$config{'closedir'}/$form{'REPOST'}.dat"; ($title, $reserve, $inc, $desc, $image, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, @bids); $title =~ s/\"//g; # quotes cause problems for a text input field } } print <<"EOF";

新しい商品の登録

タイトル／商品名:
HTML不可
カテゴリ:
１つ選択してください
写真へのURL:
あれば。200x200より小さいこと。
終了までの日数:
1-14
説明:
HTMLを含んでも良い。 - ここへは商品の状態、説明や支払方法、送付方法および買手が知るべき情報を記します。
オークションへ商品を出品するということは買手と契約を結ぶと言う事です。一度商品を出品すると 破棄することは出来ず、最高額で落札した方に販売しなければなりません。言い換えるなら、売りたくなければ商品を登録しては いけない、ということです。 EOF if ($config{'regdir'}) { print <<"EOF";

商品の出品や入札にはユーザ登録 が必要です。

あなたのユーザ名:
 (商品の記録に使われます)
あなたのパスワード:
正しいものを入力
開始入札額:\\
リザーブ額:
この金額未満の落札には販売する義務がありません。設定しないのであれば空欄にしておくこと。		\\
入札の単位金額:\\
EOF } else { print <<"EOF"; あなたのユーザ名:
(商品の記録に使われます) あなたのE-Mailアドレス:
 (有効であること) 開始入札額:\\ リザーブ額:
この金額未満の落札には販売する義務がありません。設定しないのであれば空欄にしておくこと。\\ 入札の単位金額:\\ 連絡先:
落札した買手にのみ通知されます。 氏名:

郵便番号・都道府県・市町村:

町名・番地・マンション等:
EOF } print <<"EOF";
EOF } #-############################################# # Sub: Process New Item # This processes new item to be put up for # sale from a posted form sub procnew { my ($password, @userbids); if ($config{'regdir'} ne "") { &oops('ユーザ名が見つかりません!') unless ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = &read_reg_file($form{'ALIAS'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('パスワードに誤りがあります。') unless ((lc $password) eq (lc $form{'PASSWORD'})); } &oops('タイトルは全角２５文字までです。') unless ($form{'TITLE'} && (length($form{'TITLE'}) < 51)); $form{'TITLE'} =~ s/\/\>\;/g; &oops('正しいカテゴリを選択してください。') unless (-d "$config{'basepath'}$form{'CATEGORY'}" and $category{$form{'CATEGORY'}}); $form{'IMAGE'} = "" if ($form{'IMAGE'} eq "http://"); &oops('1〜14日の間で入札期間日数を入力しなければなりません。') unless (($form{'DAYS'} > 0) and ($form{'DAYS'} < 15)); &oops('商品の説明を入力してください。') unless ($form{'DESC'}); &oops('ユーザ名を入力してください。') unless ($form{'ALIAS'}); &oops('正しいE-Mailアドレスを入力してください。') unless ($form{'EMAIL'} =~ /^.+\@.+\..+$/); &oops('開始入札金額を入力してください。') unless ($form{'BID'} =~ /^(\d+\.?\d*|\.\d+)$/); &oops('入札の単位金額を入力してください。') unless (($form{'INC'} =~ /^(\d+\.?\d*|\.\d+)$/) and ($form{'INC'} >= .01)); $form{'INC'} = &parsebid($form{'INC'}); $form{'RESERVE'} = &parsebid($form{'RESERVE'}); &oops('氏名を入力してください。') unless ($form{'ADDRESS1'}); &oops('郵便番号・都道府県・市町村を入力して下さい。') unless ($form{'ADDRESS3'}); &oops('町名・番地・マンション等を入力してください。') unless ($form{'ADDRESS2'}); my $item_number = ($form{'DAYS'} * 86400 + time); $item_number = ($form{'DAYS'} * 86400 + time) until (!(-f "$config{'basepath'}$form{'CATEGORY'}/$item_number.dat")); if ($form{'FROMPREVIEW'}) { my $key; foreach $key (keys %form) { $form{$key} =~ s/\[greaterthansign\]/\>/gs; $form{$key} =~ s/\[lessthansign\]/\$config{'basepath'}$form{'CATEGORY'}/$item_number.dat")); print NEW "$form{'TITLE'}\n$form{'RESERVE'}\n$form{'INC'}\n$form{'DESC'}\n$form{'IMAGE'}\n$form{'ALIAS'}\[\]$form{'EMAIL'}\[\]".&parsebid($form{'BID'})."\[\]".time."\[\]$form{'ADDRESS1'}\[\]$form{'ADDRESS2'}\[\]$form{'ADDRESS3'}"; close NEW; if ($config{'regdir'} ne "") { &oops('登録情報が開けませんでした。これはサーバの「書き込み関係」の問題です。') unless (open(REGFILE, ">>$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")); print REGFILE "\n$form{'CATEGORY'}$item_number"; close REGFILE; } print "「$category{$form{'CATEGORY'}}」に「$form{'TITLE'}」を登録しました....
こちらで実際に確認することが出来ます.\n\n"; } else { # my $nowtime = localtime(time); # my $closetime = localtime($item_number); my $nowtime = jptime(time); my $closetime = jptime($item_number); print "

「$form{'TITLE'}」の確認

商品情報
\n"; print ""; print "" if ($form{'IMAGE'}); print "
$form{'TITLE'}
カテゴリ: $category{$form{'CATEGORY'}}
出品者: $form{'ALIAS'}
現在時刻: $nowtime
終了: $closetime
または 最後の入札から $config{'aftermin'} 分後...
入札数: 0
最後の入札: \\$form{'BID'}
\n"; print "
説明
$form{'DESC'}"; print "
内容が良ければ を押して下さい。直す必要があれば、ブラウザの「戻る」ボタンを押して戻り、修正してください。\n"; my $key; foreach $key (keys %form) { $form{$key} =~ s/\>/\[greaterthansign\]/gs; $form{$key} =~ s/\\n"; } print "
\n"; } } #-############################################# # Sub: Process Bid # This processes new bids from a posted form sub procbid { my ($password, @userbids); if ($config{'regdir'} ne "") { &oops('あなたのユーザ名は見つかりませんでした。') unless ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = &read_reg_file($form{'ALIAS'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('パスワードが違います。') unless ((lc $password) eq (lc $form{'PASSWORD'})); } &oops('入札にはユーザ名が必要です。') unless ($form{'ALIAS'}); &oops('有効なE-mailアドレスを入力してください。') unless ($form{'EMAIL'} =~ /^.+\@.+\..+$/); &oops('正しい入札額を入力してください。') unless ($form{'BID'} =~ /^(\d+\.?\d*|\.\d+)$/); $form{'BID'} = &parsebid($form{'BID'}); &oops('氏名を入力してください。') unless ($form{'ADDRESS1'}); &oops('町名・番地・マンション名を入力してください。') unless ($form{'ADDRESS2'}); &oops('郵便番号・都道府県・市町村名を入力してください。') unless ($form{'ADDRESS3'}); my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($form{'CATEGORY'},$form{'ITEM'}); &oops('入札できません。おそらく、商品をご覧になっている間にオークションが終了したものと思われます。') if $title eq ''; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); if ((time <= $form{'ITEM'}) or (time <= (60 * $config{'aftermin'} + $time))) { &oops('現在の入札額より低い入札は登録できません。') if ($form{'BID'} < ($bid+$inc) and ($#bids)) or ($form{'BID'} < $bid); &oops('入札を登録できません。これはサーバの「書き込み関係」の問題です。') unless (open NEW, ">>$config{'basepath'}$form{'CATEGORY'}/$form{'ITEM'}.dat"); if ($config{'flock'}) { flock(NEW, 2); seek(NEW, 0, 2); } print NEW "\n$form{'ALIAS'}\[\]$form{'EMAIL'}\[\]$form{'BID'}\[\]".time."\[\]$form{'ADDRESS1'}\[\]$form{'ADDRESS2'}\[\]$form{'ADDRESS3'}"; close NEW; print "$form{'ALIAS'} さん, あなたの入札が商品番号「$form{'ITEM'}」に \\$form{'BID'} で登録されました。 ".jptime(time).".
この情報を印刷しておけばあなたの入札の確認にもなります。

この商品へ戻る\n"; my $flag=0; my $userbid; foreach $userbid (@userbids) { $flag=1 if ("$form{'CATEGORY'}$form{'ITEM'}" eq $userbid); } if ($flag==0 && $config{'regdir'} ne "") { &oops('登録情報ファイルが開けません。これはサーバの「書き込み関係」の問題です。') unless (open(REGFILE, ">>$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")); print REGFILE "\n$form{'CATEGORY'}$form{'ITEM'}"; close REGFILE; } &sendemail($email, $config{'admin_address'}, 'あなたの入札が高値で更新されました', "$title\! の入札額がより高い金額で更新されました。さらに高い金額を入札されるのであれば以下をご覧ください\:\r\n\r\n\thttp://$config{'scripturl'}$ENV{'SCRIPT_NAME'}\?category=$form{'CATEGORY'}\&item=$form{'ITEM'}\r\n\r\n現在の高値は \\$form{'BID'}です。") if ($config{'scripturl'} and $#bids); } else { print "カテゴリ 「$form{'CATEGORY'}」の 商品番号 「$form{'ITEM'}」の入札は終了しました。
\n"; } } #-############################################# # Sub: Process Search # This displays search results sub procsearch { print "

検索結果 - $form{'searchstring'}

\n"; print "\n"; print "\n"; my $key; foreach $key (sort keys %category) { opendir THEDIR, "$config{'basepath'}$key" or &oops("カテゴリディレクトリ $key が開けません。"); my @allfiles = grep -T, map "$config{'basepath'}$key/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$key\///; $file =~ s/\.dat$//; my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($key,$file); if ($title ne '') { my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); my @closetime = localtime($file); $closetime[4]++; if($form{'searchtype'} eq 'keyword' and ($title =~ /$form{'searchstring'}/i) || ($desc =~ /$form{'searchstring'}/i)) { print "\n"; } elsif($form{'searchtype'} eq 'username' and join(' ',@bids) =~ /$form{'searchstring'}/i) { print "\n"; } } } } print "
商品終了入札数最高入札額
$title"; print " [写真]" if ($image); print "$closetime[4]/$closetime[3]$#bids\\$bid
$title"; print " [写真]" if ($image); print "$closetime[4]/$closetime[3]$#bids\\$bid
\n"; } #-############################################# # Sub: Change Registration # This allows a user to change information sub creg { print <<"EOF";

住所・パスワード変更

この画面で住所またはパスワードの変更ができます。
あなたのユーザ名:
必ず入力
現在のパスワード:
必ず入力
新しいパスワード:
変更しないのであれば空欄
新しいパスワードをもう一度:
変更しないのであれば空欄
連絡先:
変更しないのであれば空欄		 氏名:

郵便番号・都道府県・市町村:

町名・番地・マンション等:
EOF } #-############################################# # Sub: Process Changed Registration # This modifies an account sub proccreg { if ($config{'regdir'}) { &oops('確認のために、ユーザ名を入力してください。') unless ($form{'ALIAS'}); &oops('確認のために、古いパスワードを入力してください。') unless ($form{'OLDPASS'}); if ($form{'ADDRESS1'}) { &oops('連絡先の情報はすべて入力してください。町名・番地・マンション名等を入力してください。') unless ($form{'ADDRESS2'}); &oops('連絡先の情報はすべて入力してください。郵便番号・都道府県・市町村名を入力してください。') unless ($form{'ADDRESS3'}); } if ($form{'NEWPASS1'}) { &oops('あなたの新しいパスワード（2回入力）が合っていません。') unless ($form{'NEWPASS2'} eq $form{'NEWPASS1'}); } if (my ($password,$email,$add1,$add2,$add3,@past_bids) = &read_reg_file($form{'ALIAS'})) { $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('あなたの古いパスワードが合っていません。') unless ((lc $password) eq (lc $form{'OLDPASS'})); $form{'NEWPASS1'} = $password if !($form{'NEWPASS1'}); $form{'ADDRESS1'} = $add1 if !($form{'ADDRESS1'}); $form{'ADDRESS2'} = $add2 if !($form{'ADDRESS2'}); $form{'ADDRESS3'} = $add3 if !($form{'ADDRESS3'}); &oops('あなたの情報を登録できません。これはサーバの「書き込み関係」の問題です。') unless (open NEWREG, ">$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat"); print NEWREG "$form{'NEWPASS1'}\n$email\n$form{'ADDRESS1'}\n$form{'ADDRESS2'}\n$form{'ADDRESS3'}"; my $bid; foreach $bid (@past_bids) { print NEWREG "\n$bid"; } close NEWREG; print "$form{'ALIAS'}さん, あなたの登録情報は変更されました。\n"; } else { print "入力されたユーザ名は正しくありません。ユーザ登録をされていない場合や、忘れてしまった場合は新規ユーザ登録してください。\n"; } } else { print "このサーバではユーザ登録機能が提供されていません! システム管理者が登録用ディレクトリを指定していません...\n"; } } #-############################################# # Sub: New Registration # This creates a form for registration sub reg { print <<"EOF";

新規ユーザ登録

この画面で個人情報を登録することによって売買できるようになります。。 必ず正確な情報を入力してください。パスワードはメールで通知されます。登録に時間がかかる場合がありますので、「登録」ボタンを押した後はしばらくお待ち下さい。
ユーザ名:
あなたの情報が記録されるために使用されます。
あなたのE-Mailアドレス:
有効であること。
連絡先:
入札成立後の売買の相手にのみ通知されます。		 氏名:

郵便番号・都道府県・市町村:

町名・番地・マンション等:
EOF } #-############################################# # Sub: Process Registration # This adds new accounts to the database sub procreg { if ($config{'regdir'}) { umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$config{'regdir'}", 0777) unless (-d "$config{'basepath'}$config{'regdir'}"); &oops('ユーザ名は「半角英数字」で入力してください。') if $form{'ALIAS'} =~ /\W/ or !($form{'ALIAS'}); &oops('有効なメールアドレスを入力してください。') unless ($form{'EMAIL'} =~ /^.+\@.+\..+$/); &oops('売り手や買い手が連絡をとるために、氏名を入力してください。') unless ($form{'ADDRESS1'}); &oops('売り手や買い手が連絡をとるために、正しい町名・番地・マンション名等を入力してください。You must enter a valid street address so buyers or sellers can contact you.') unless ($form{'ADDRESS2'}); &oops('売り手や買い手が連絡をとるために、正しい郵便番号・都道府県・市町村名を入力してください。') unless ($form{'ADDRESS3'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); if (!(-f "$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")) { &oops('ユーザディレクトリに書き込めませんでした。') unless (open NEWREG, ">$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat"); my $newpass = &randompass; print NEWREG "$newpass\n$form{'EMAIL'}\n$form{'ADDRESS1'}\n$form{'ADDRESS2'}\n$form{'ADDRESS3'}"; close NEWREG; print "$form{'ALIAS'}さん, $form{'EMAIL'} にメールを送りましたので数分以内に受信することと思います。 そのメールには商品を出品したり入札するために必要なパスワードが記されています。一旦パスワードを受け取ったなら、それを変更することもできます。メールを受け取らなかった場合は、再度登録してください。\n"; &sendemail($form{'EMAIL'}, $config{'admin_address'}, 'オークションのパスワード', "このメールに応答（返信）しないでください！\r\n\r\n $config{'sitename'} のオンラインオークションをご利用いただきありがとうございます。!\r\n\r\nあなたのパスワード: $newpass\r\n（あなたの入力された）ユーザ名: $form{'ALIAS'}\r\n\r\nご来場ありがとうございました!"); } else { print "既にご希望のユーザ名が登録されていました。ブラウザの「戻る」ボタンを押して再度登録してください。\n"; } } else { print "このサーバではユーザ登録機能が提供されていません! システム管理者が登録用ディレクトリを指定していません...\n"; } } #-############################################# # Sub: Closed items 1 # This displays closed items sub viewclosed1 { print <<"EOF";

終了したオークション

この画面ではあなたが入札または出品した終了オークションの入札状況と連絡先を見ることが出来ます。
あなたのユーザ名:
必ず入力
あなたのパスワード:
必ず入力
EOF } #-############################################# # Sub: Closed items 2 # This displays closed items sub viewclosed2 { &oops('あなたのユーザ名が見つかりませんでした!') unless my ($password,$email,$add1,$add2,$add3,@past_bids) = &read_reg_file($form{'ALIAS'}); &oops('パスワードが間違っています。') unless ((lc $password) eq (lc $form{'PASSWORD'})); &oops('PASSWORD') unless ((lc $password) eq (lc $form{'PASSWORD'})); print "\n"; print "
\n"; } #-############################################# # Sub: Closed items 3 # This displays closed items sub viewclosed3 { $form{'BIDTOVIEW'} =~ s/\W//g; open (THEFILE, "$config{'basepath'}$config{'closedir'}/$form{'BIDTOVIEW'}.dat") or &oops('ご覧になりたい商品情報を開くことができませんでした。これはサーバにおける「ファイル読み取り関係」の問題です。'); my ($title, $reserve, $inc, $desc, $image, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, @bids); print "

$title

\n"; print "
説明
$desc"; print "
入札履歴
\n"; if ($#bids) { for (my $i=1; $i$alias \($bidtime\) - \\$bid
"; } } else { print "入札はありませんでした...
"; } print "

リザーブ額: \\$reserve
\n"; print "

連絡先
\n"; if (ucfirst(lc($form{'ALIAS'})) eq (&read_bid($bids[0]))[0]) { print "あなたは売り手でした...

\n"; if ($#bids) { my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); print "買手の情報:
ユーザ名: $alias
E-Mail: $email
住所: $add1
$add3
$add2

最高入札額: \\$bid\n"; print "

入札者連絡先:
\n"; for (my $i=1; $i$alias - $email
\n"; } } print "

この商品をもう一度出品することができます。:
\n"; } elsif (ucfirst(lc($form{'ALIAS'})) eq (&read_bid($bids[$#bids]))[0]) { print "あなたが落札しました...

\n"; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[0]); print "売り手の情報:
ユーザ名: $alias
E-Mail: $email
住所: $add1
$add3
$add2

"; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); print "最高入札額: \\$bid

\n"; print "入札額がリザーブ額を上回らなければ、販売する必要はありません..."; } else { print "あなたは落札できませんでした... これ以上の情報はありません。\n"; } } #-############################################# # Sub: Admin # Allows the administrator to delete items. sub admin { print <<"EOF";

商品の削除

この画面では商品の削除ができます。処理には管理者のパスワードが必要です。
カテゴリ:
ひとつ選ぶ
商品番号:
管理者パスワード:
確認のため必要
EOF } #-############################################# # Sub: Process Admin # Allows the administrator to delete items. sub procadmin { if (lc($form{'PASSWORD'}) eq lc($config{'adminpass'})) { &oops('カテゴリまたは商品番号が違います!') unless &read_item_file($form{'CATEGORY'},$form{'ITEM'}); if (unlink("$config{'basepath'}$form{'CATEGORY'}/$form{'ITEM'}.dat")) { print "ファイルの削除ができました!\n"; } else { print "ファイルの削除ができません!\n"; } } else { print "管理者のパスワードが違います。削除できません!\n"; } } #-############################################# # Sub: Close Auction # This sets an item's status to closed. sub closeit { my ($cat,$item) = @_; if ($cat ne $config{'closedir'}) { my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($cat,$item); my @lastbid = &read_bid($bids[$#bids]); my @firstbid = &read_bid($bids[0]); if ($#bids) { if ($lastbid[2] >= $reserve) { &sendemail($lastbid[1], $firstbid[1], "オークション終了: $title", "おめでとうございます! あなたが商品番号「$item」の落札者です。\r\n落札額は \\$lastbid[2]でした。\r\n\r\n売り手に連絡を取り、支払と送付方法を相談して下さい:\r\n\r\n$firstbid[4]\r\n$firstbid[5]\r\n$firstbid[6]\r\n$firstbid[1]\r\n\r\n$config{'sitename'} をご利用くださりありがとうございました!"); } else { &sendemail($lastbid[1], $firstbid[1], "オークション終了: $title", "おめでとうございます! あなたが商品番号「$item」の最高額入札者でした。\r\n入札額は \\$lastbid[2]でした。\r\n\r\nしかし残念ながら、あなたの入札額はリザーブ額にとどきませんでした...\r\n\r\n金額について売り手と交渉されてはいかがでしょうか:\r\n\r\n$firstbid[4]\r\n$firstbid[5]\r\n$firstbid[6]\r\n$firstbid[1]\r\n\r\n$config{'sitename'} をご利用くださりありがとうございました!"); } &sendemail($firstbid[1], $lastbid[1], "オークション終了: $title", "商品番号「$item」のオークションは終了しました。\r\n最高入札額は \\$lastbid[2] (リザーブ額: \\$reserve)でした。\r\n\r\n最高額入札者と必要な連絡をおとりください:\r\n\r\n$lastbid[4]\r\n$lastbid[5]\r\n$lastbid[6]\r\n$lastbid[1]\r\n\r\n$config{'sitename'} をご利用くださりありがとうございました!"); } else { &sendemail($firstbid[1], $config{'admin_address'}, "オークション終了: $title", "商品番号 「$item」 のオークションは終了しました。\r\n入札は1件もありませんでした。\r\n次の場所から再度出品されても結構です。\r\n http://$config{'scripturl'}$ENV{'SCRIPT_NAME'} \r\n\r\n$config{'sitename'} をご利用くださりありがとうございました!"); } if ($config{'closedir'}) { umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$config{'closedir'}", 0777) unless (-d "$config{'basepath'}$config{'closedir'}"); print "お手数ですが、終了したオークション情報のコピーが出来なかったことを本サイトの管理者にお知らせ下さい。\n" unless &movefile("$config{'basepath'}$cat/$item.dat", "$config{'basepath'}$config{'closedir'}/$cat$item.dat"); } else { print "お手数ですが、終了したオークション情報を削除できなかったことを本サイトの管理者にお知らせ下さい。\n" unless unlink("$config{'basepath'}$cat/$item.dat"); } } } #-############################################# # SUB: Send E-mail # This is a real quick-and-dirty mailer that # should work on any platform. It is my first # attempt to work with sockets, so if anyone # has any suggestions, let me know! # # Takes: # (To, Subject, From, Message) sub sendemail { my ($to,$from,$subject,$message) = @_; # addition for Japanese translation my $encoded; # &jcode::nocache(); &jcode::euc2jis(\$subject); $encoded = encode_base64($subject,'?='); $subject = '=?iso-2022-jp?B?'.$encoded; &jcode::euc2jis(\$message); $encoded = "MIME-Version: 1.0\nContent-Type: text/plain; charset=\"iso-2022-jp\"\nContent-Transfer-Encoding: 8bit\n\n".$message."\n"; $message = $encoded; # &jcode::cache(); &jcode::flushcache(); # end of addition my $trash; if ($config{'mailhost'}) { eval('use IO::Socket; 1;') or &oops("IO::Socket のロードが出来ませんでした。詳細は添付のドキュメントをご覧ください。このサーバは perl のバージョン $] を使っているようです。IO::Socket は perl バージョン 5.00404 以前には含まれていない場合があります。"); # don't cause errors on machines where IO::Socket is not available my $remote; $remote = IO::Socket::INET->new("$config{'mailhost'}:smtp(25)"); $remote->autoflush(); print $remote "HELO\r\n"; $trash = <$remote>; print $remote "MAIL From:<$config{'admin_address'}>\r\n"; $trash = <$remote>; print $remote "RCPT To:<$to>\r\n"; $trash = <$remote>; print $remote "DATA\r\n"; $trash = <$remote>; print $remote "From: <$from>\r\nSubject: ",$subject,"\r\n"; # print $remote "From: <$from>\r\nSubject: $subject\r\n\r\n"; print $remote $message; print $remote "\r\n.\r\n"; $trash = <$remote>; print $remote "QUIT\r\n"; } else { open MAIL, "|$config{'mailprog'}"; # print MAIL "To: $to\r\nFrom: $from\r\nSubject: $subject\r\n\r\n$message\r\n"; print MAIL "To: $to\r\nFrom: $from\r\nSubject: $subject\r\n$message\r\n"; close MAIL; } } #-############################################# # Sub: Get Form Data # This gets data from a post. sub get_form_data { my $temp; my $buffer; my @data; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); foreach $temp (split(/&|=/,$buffer)) { $temp =~ tr/+/ /; $temp =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; $temp =~ s/[\r\n]/ /g; push @data, $temp; } foreach $temp (split(/&|=/,$ENV{'QUERY_STRING'})) { $temp =~ tr/+/ /; $temp =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; $temp =~ s/[\r\n]/ /g; push @data, $temp; } return @data; } #-############################################# # Sub: Random Password # This generates psudo-random 8-letter # passwords sub randompass { srand(time ^ $$); # my @passset = ('a'..'k', 'm'..'n', 'p'..'z', '2'..'9'); my @passset = ('a'..'k', 'm'..'n', 'p'..'z'); my $randpass = ""; for (my $i=0; $i<10; $i++) { $randpass .= $passset[int(rand($#passset + 1))]; } return $randpass; } #-############################################# # Sub: parse bid # This formats a bid amount to look good... # ie. $###.## sub parsebid { $_[0] =~ s/\,//g; my @bidamt = split(/\./, $_[0]); $bidamt[0] = "0" if (!($bidamt[0])); $bidamt[0] = int($bidamt[0]); # modification for Japanese currency 銭の単位は扱いません # $bidamt[1] = substr($bidamt[1], 0, 2); # $bidamt[1] = "00" if (length($bidamt[1]) == 0); # $bidamt[1] = "$bidamt[1]0" if (length($bidamt[1]) == 1); # return "$bidamt[0].$bidamt[1]"; # return $bidamt[0]; } #-############################################# # Sub: Oops! # This generates an error message and dies. sub oops { print "

エラー:
$_[0]

ブラウザの「戻る」ボタンを押して再度入力されるか、サーバの問題と思われるのであれば次へご連絡下さい。 オークション管理者

\n"; print $config{'footer'}; die "エラー: $_[0]\n"; } #-############################################# # Sub: Movefile(file1, file2) # This moves a file. Quick and dirty! sub movefile { my ($firstfile, $secondfile) = @_; return 0 unless open(FIRSTFILE,$firstfile); my @lines=; close FIRSTFILE; return 0 unless open(SECONDFILE,">$secondfile"); my $line; foreach $line (@lines) { print SECONDFILE $line; } close SECONDFILE; return 0 unless unlink($firstfile); return 1; } #-############################################# # Sub: Read Reg File (alias) # Reads a registration file sub read_reg_file { my $alias = shift; return '' unless $alias; # verify the user exists &oops('ユーザ名には「文字」が含まれていませんでした。') if $alias =~ /\W/; $alias = ucfirst(lc($alias)); return '' unless -r "$config{'basepath'}$config{'regdir'}/$alias.dat" and -T "$config{'basepath'}$config{'regdir'}/$alias.dat"; open FILE, "$config{'basepath'}$config{'regdir'}/$alias.dat"; my ($password,$email,$add1,$add2,$add3,@past_bids) = ; close FILE; chomp ($password,$email,$add1,$add2,$add3,@past_bids); return ($password,$email,$add1,$add2,$add3,@past_bids); } #-############################################# # Sub: Read Item File (cat, item) # Reads an item file sub read_item_file { my ($cat, $item) = @_; # verify the category exists return '' unless ($cat) and ($item); &oops('カテゴリには「文字」がふくまれていませんでした。') if $cat =~ /\W/; return '' unless $category{$cat}; # verify the item exists &oops('商品番号には「数字」が含まれていませんでした。') if $item =~ /\D/; return '' unless (-T "$config{'basepath'}$cat/$item.dat") and (-R "$config{'basepath'}$cat/$item.dat"); open FILE, "$config{'basepath'}$cat/$item.dat"; my ($title, $reserve, $inc, $desc, $image, @bids) = ; close FILE; chomp ($title, $reserve, $inc, $desc, $image, @bids); return ($title, $reserve, $inc, $desc, $image, @bids); } #-############################################# # Sub: Read Bid Information (bid_string) # Reads an item file sub read_bid { my $bid_string = shift; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = split(/\[\]/,$bid_string); return ($alias, $email, $bid, $time, $add1, $add2, $add3); } #-############################################# # Sub: 日本語入力箇所を変換 sub j_convert { my $work; if ($form{'TITLE'} ne ""){ $work = $form{'TITLE'}; &jcode::convert(*work, 'euc'); $form{'TITLE'} = $work; } if ($form{'DESC'} ne ""){ $work = $form{'DESC'}; &jcode::convert(*work, 'euc'); $form{'DESC'} = $work; } if ($form{'ADDRESS1'} ne ""){ $work = $form{'ADDRESS1'}; &jcode::convert(*work, 'euc'); $form{'ADDRESS1'} = $work; } if ($form{'ADDRESS2'} ne ""){ $work = $form{'ADDRESS2'}; &jcode::convert(*work, 'euc'); $form{'ADDRESS2'} = $work; } if ($form{'ADDRESS3'} ne ""){ $work = $form{'ADDRESS3'}; &jcode::convert(*work, 'euc'); $form{'ADDRESS3'} = $work; } } #-############################################# # Sub: 日時の日本書式表示 sub jptime { my ($vtime) = shift; my @youbi = ("日","月","火","水","木","金","土"); my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($vtime); my $retstr; my $ctime = sprintf("%02d時%02d分%02d秒",$hour,$min,$sec); $retstr = scalar($year+1900) . "年" . scalar($mon + 1) . "月" . $mday . "日($youbi[$wday])" . $ctime; return $retstr; }