| 記事No | ： 16814 |
| 投稿日 | ： 2022/04/21(Thu) 22:32:39 |
| タイトル | ： 注文入力ページでの改良について |
| ID情報 | ： tmhk0722 |
| 投稿者 | ： tomo |
| URL | ： http://bodyvine.sakura.ne.jp |
いつもお世話になっています。
現在、当ショップにWEB MARTを導入するべくトライ中です。
各ファイルの修正や設置、パーミッション設定、商品登録など完了し、今は注文入力フォームを当店用にカスタマイズしているところです。
注文入力ページ(addr.html)と、その内容確認ページ(conf.html)内の注文者入力情報を追加・削除等をし、当ショップ用にカスタマイズが完了したのですが、２点問題が。
��"ローマ字名前"と"ローマ字住所"の入力欄を追加し、必須項目にもできた様なのですが、この2箇所のみ、未入力があった場合の”名前が未入力です”等のアラートが出ません。
order.cgiの入力チェック部分の、名前や電話番号などと同じ様に、if ($in{roman} eq '') { $er{roman} = 'ローマ字名前が未入力です'; }と追加したのですが、それでもアラートは出ません。もっと他のところに何か追加が必要なのでしょうか？どこに何をしたら改善されますでしょうか？
��仮に全ての情報を入力して、確定注文するボタンを押すと、注文完了ページに行かず、以下のメッセージがブラウザに出ます。
Can't locate lib/jacode.pl in @INC (@INC contains: ./lib /usr/local/perl/5.32/lib/perl5/site_perl/5.32/mach /usr/local/perl/5.32/lib/perl5/site_perl/5.32 /usr/local/perl/5.32/lib/perl5/5.32/mach /usr/local/perl/5.32/lib/perl5/5.32) at order.cgi line 525.
For help, please send mail to the webmaster ([no address given]), giving this error message and the time and date of the error.
何か…初めてみるエラーなので驚いてます。
どうしたら改善されますでしょうか？
ご教示頂けると嬉しいです。
| 記事No | ： 16815 |
| 投稿日 | ： 2022/04/22(Fri) 04:24:22 |
| タイトル | ： Re: 注文入力ページでの改良について |
| ID情報 | ： tmhk0722 |
| 投稿者 | ： tomo |
| URL | ： http://bodyvine.sakura.ne.jp |
ちなみに、order.cgiのタグは下記になります。
#!/usr/local/bin/perl
#┌─────────────────────────────────
#│ WEB MART : order.cgi - 2021/04/25
#│ copyright (c) kentweb, 1997-2021
#│ https://www.kent-web.com/
#└─────────────────────────────────
# モジュール宣言
use strict;
use CGI::Carp qw(fatalsToBrowser);
use lib "./lib";
use CGI::Minimal;
use Crypt::RC4;
# 設定ファイル取り込み
require './init.cgi';
my %cf = set_init();
# データ受理
CGI::Minimal::max_read_size($cf{maxdata});
my $cgi = CGI::Minimal->new;
cgi_err('容量オーバー') if ($cgi->truncated);
my %in = parse_form($cgi);
# 処理分岐
if ($in{mode} eq "law") { law_data(); }
if ($in{mode} eq "addr") { addr_form(); }
if ($in{mode} eq "conf") { conf_form(); }
if ($in{mode} eq "send") { send_form(); }
error("不明な処理です");
#-----------------------------------------------------------
# 住所入力画面 (Step1)
#-----------------------------------------------------------
sub addr_form {
my %er = @_;
# back属性チェック
chk_back($in{back});
# 買物データ受理
my ($cart,$cust) = get_cookie();
if (@{$cart} == 0) { error("買物カゴの中身が空です"); }
# 商品データ認識
my %cart = get_data();
# 軽減税率
my %red = read_redtax() if ($cf{tax_per} > 0);
# 前画面からの戻りの場合
my %c;
if ($in{job} eq "back" or %er != 0) {
%c = %in;
# 戻りでない場合は顧客情報のクッキー取り出し
} else {
# 復号
($c{name},$c{roman},$c{email},$c{zip},$c{pref},$c{addr},$c{addr2},$c{tel}) = decrypt_cust(@{$cust});
}
# 改行復元
$c{addr} =~ s/\t/\n/g;
$c{addr2} =~ s/\t/\n/g;
$c{memo} =~ s/\t/\n/g;
# 送料で有償の地区があるかをチェック
my ($flg,$remark);
foreach (0 .. $#{$cf{pref}}) {
my ($prf,$pri) = split(/,/,${$cf{pref}}[$_]);
if ($pri > 0) {
$flg++;
last;
}
}
if ($flg) { $remark = "(送料等は次画面で計算されます)"; }
# 支払方法
my $payment;
foreach (0 .. $#{$cf{payment}}) {
my ($pay,$cost) = split(/,/,${$cf{payment}}[$_]);
if (($in{payment} eq $_) || ($in{payment} eq "" && $_ == 0)) {
$payment .= qq|<input type="radio" name="payment" value="$_" checked>$pay<br>\n|;
} else {
$payment .= qq|<input type="radio" name="payment" value="$_">$pay<br>\n|;
}
}
# 配達時間
my $opt_deli;
foreach (0 .. $#{$cf{deli}}) {
if ($in{deli} eq $_) {
$opt_deli .= qq|<option value="$_" selected>${$cf{deli}}[$_]</option>\n|;
} else {
$opt_deli .= qq|<option value="$_">${$cf{deli}}[$_]</option>\n|;
}
}
# 都道府県
my ($opt_pref,$opt_pref2);
foreach (0 .. $#{$cf{pref}}) {
my ($pref,$postage) = split(/,/,${$cf{pref}}[$_]);
if ($c{pref} eq $_) {
$opt_pref .= qq|<option value="$_" selected>$pref</option>\n|;
} else {
$opt_pref .= qq|<option value="$_">$pref</option>\n|;
}
if ($c{pref2} eq $_) {
$opt_pref2 .= qq|<option value="$_" selected>$pref</option>\n|;
} else {
$opt_pref2 .= qq|<option value="$_">$pref</option>\n|;
}
}
# テンプレート読み込み
open(IN,"$cf{tmpldir}/addr.html") or error("open err: addr.html");
my $tmpl = join('',<IN>);
close(IN);
# 置き換え
$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;
$tmpl =~ s/!cmnurl!/$cf{cmnurl}/g;
$tmpl =~ s/!home!/$cf{home}/g;
$tmpl =~ s/!back!/$in{back}/g;
$tmpl =~ s/!payment!/$payment/g;
$tmpl =~ s/!remark!/$remark/g;
$tmpl =~ s/!date!/$in{date}/g;
$tmpl =~ s/!c_(\w+)!/$c{$1}/g;
$tmpl =~ s/<!-- option_deli -->/$opt_deli/g;
$tmpl =~ s/<!-- option_pref -->/$opt_pref/g;
$tmpl =~ s/<!-- option_pref2 -->/$opt_pref2/g;
$tmpl =~ s/!renraku!/$c{memo} eq '' ? ' ' : $c{memo}/eg;
$tmpl =~ s|!icon:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;
# 税対応
if (!$cf{tax_per}) { $tmpl =~ s|<!-- tax -->.+?<!-- /tax -->||s; }
# 入力エラー
if (%er != 0) {
for (qw(date name roman email zip addr addr2 tel)) {
if (defined $er{$_}) { $tmpl =~ s|<!-- err:$_ -->|<div class="err-addr">$er{$_}</div>|g; }
}
}
# 配送先
if (!$in{deliv}) { $in{deliv} = 1; }
$tmpl =~ s|<input type="radio" name="deliv" value="$in{deliv}" ([^>]+)>|<input type="radio" name="deliv" value="$in{deliv}" $1 checked>|g;
# 配送先フォーム
if ($in{deliv} == 2) {
$tmpl =~ s/!disp!/block/g;
} else {
$tmpl =~ s/!disp!/none/g;
}
# テンプレート分割
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- item -->(.+?)<!-- /item -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
# 買物カゴ展開
my $all = 0;
my $red = 0;
my $body;
for (@{$cart}) {
my ($id,$code,$num,@op) = split(/,/);
my (undef,$name,$price,$memo,$back,@ops) = split(/<>/,$cart{$code});
# チェック
$id =~ s/\D//g;
$code =~ s/\W//g;
$num =~ s/\D//g;
# オプション処理
my ($memo,@op2);
for my $i (0 .. $#{$cf{options}}) {
my ($key,$nam) = split(/,/,$cf{options}[$i]);
$op2[$i] = [split(/\s+/,$ops[$i])];
if ($op[$i] ne '') { $memo .= "[$nam]$op[$i] "; }
}
# 引数
my $hid = "$id;$code;$num";
for my $i (0 .. $#{$cf{options}}) {
# 正当性チェック
if ($cf{chk_ops} == 1) {
my $flg;
foreach my $opt (@{$op2[$i]}) {
if ($op[$i] eq $opt) {
$flg++;
last;
}
}
if ($op[$i] ne '' && !$flg) { error("属性の値が不正です"); }
}
$hid .= ";$op[$i]";
}
# 小計/累計
my $kei = $price * $num;
$all += $kei;
# 軽減税率
if ($cf{tax_per} > 0 && defined $red{$code}) {
$red += $kei;
$memo .= "<br>" if ($memo ne '');
$memo .= "【軽減税率対象】";
}
if ($memo eq '') { $memo = '<br>'; }
# 書き出し
my $tmp = $loop;
$tmp =~ s/!code!/$code/g;
$tmp =~ s/!item!/$name/g;
$tmp =~ s/!num!/$num/g;
$tmp =~ s/!tanka!/comma($price)/ge;
$tmp =~ s/!gouka!/comma($kei)/ge;
$tmp =~ s/!memo!/$memo/g;
$body .= $tmp;
}
# 消費税
my ($kei,$tax1,$tax2,$all,$tar) = calc_tax($all,$red);
for ($head, $foot) {
s/!kei!/comma($kei)/ge;
s/!tax!/comma($tax1)/ge;
s/!tax_red!/comma($tax2)/ge;
s/!all!/comma($all)/ge;
s/!tax_per!/$cf{tax_per}/e;
s/!red_per!/$cf{red_per}/e;
s/!tar_tax1!/comma($tar)/ge;
s/!tar_tax2!/comma($red)/ge;
}
# 画面展開
print "Content-type: text/html; charset=utf-8\n\n";
print $head, $body;
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# 確認画面 (Step2)
#-----------------------------------------------------------
sub conf_form {
# back属性チェック
chk_back($in{back});
# 買物情報取得
my ($cart,undef) = get_cookie();
if (@{$cart} == 0) { error("買物情報がありません"); }
# 入力確認
check_input();
# 注文者情報をクッキー格納
my $cookie;
if ($in{cook} == 1) {
# 顧客情報暗号化
my @cust = encrypt_cust($in{name},$in{roman},$in{email},$in{zip},$in{pref},$in{addr},$in{addr2},$in{tel});
# クッキー保存
set_cookie(@cust);
}
# 在庫認識
my %zan = get_zan() if ($cf{stock});
# 商品データ認識
my %cart = get_data();
# 軽減税率
my %red = read_redtax() if ($cf{tax_per} > 0);
# 都道府県/送料
my ($pref2,%pref);
my $postage = 0;
my ($pref,$postage) = split(/,/,${$cf{pref}}[$in{pref}]);
$pref{pref} = $pref;
if ($in{pref2} ne "") {
($pref2,$postage) = split(/,/,${$cf{pref}}[$in{pref2}]);
$pref{pref2} = $pref2;
}
# 支払方法の手数料
my ($pay,$cost) = split(/,/,${$cf{payment}}[$in{payment}]);
# 送料サービスフラグ
my $serv_flag = 0;
# 配達時間
my $deliv;
if ($in{date} ne '') { $deliv = "$in{date} "; }
if ($in{deli} ne '') { $deliv .= ${$cf{deli}}[$in{deli}]; }
if ($deliv eq '') { $deliv = '<br>'; }
# 郵便番号
$in{zip} =~ s/(\d{3})(\d{4})/$1-$2/;
$in{zip2} =~ s/(\d{3})(\d{4})/$1-$2/;
# 改行復元
$in{addr} =~ s/\t/<br>/g;
$in{addr2} =~ s/\t/<br>/g;
$in{memo} =~ s/\t/<br>/g;
# テンプレート読み込み
open(IN,"$cf{tmpldir}/conf.html") or error("open err: conf.html");
my $tmpl = join('',<IN>);
close(IN);
# 置き換え
$tmpl =~ s/!ses!/make_session()/e;
$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;
$tmpl =~ s/!cmnurl!/$cf{cmnurl}/g;
$tmpl =~ s/!home!/$cf{home}/g;
$tmpl =~ s/!back!/$in{back}/g;
$tmpl =~ s/!c_(\w+)!/$in{$1}/g;
$tmpl =~ s/!renraku!/$in{memo}/g;
$tmpl =~ s/!deliv!/$deliv/g;
$tmpl =~ s/!payment!/$pay/g;
$tmpl =~ s/!ses!/$in{ses}/g;
# 税対応
if (!$cf{tax_per}) { $tmpl =~ s|<!-- tax -->.+?<!-- /tax -->||s; }
# テンプレート分割
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- item -->(.+?)<!-- /item -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
# 買物カゴ展開
my $all = 0;
my $red = 0;
my $gkei = 0;
my ($flg,$scode,$body);
for (@{$cart}) {
my ($id,$code,$num,@op) = split(/,/);
my (undef,$name,$price,$memo,$back,@ops) = split(/<>/,$cart{$code});
# チェック
$id =~ s/\D//g;
$code =~ s/\W//g;
$num =~ s/\D//g;
# オプション処理
my ($memo,@op2);
for my $i (0 .. $#{$cf{options}}) {
my ($key,$nam) = split(/,/,$cf{options}[$i]);
$op2[$i] = [split(/\s+/,$ops[$i])];
if ($op[$i] ne '') { $memo .= "[$nam]$op[$i] "; }
}
# 引数
my $hid = "$id;$code;$num";
for my $i (0 .. $#{$cf{options}}) {
# 正当性チェック
if ($cf{chk_ops} == 1) {
my $flg;
for my $opt (@{$op2[$i]}) {
if ($op[$i] eq $opt) {
$flg++;
last;
}
}
if ($op[$i] ne '' && !$flg) { error("属性の値が不正です"); }
}
$hid .= ";$op[$i]";
}
# 小計/累計
my $kei = $price * $num;
$all += $kei;
# 軽減税率
if ($cf{tax_per} > 0 && defined $red{$code}) {
$red += $kei;
$memo .= "<br>" if ($memo ne '');
$memo .= "【軽減税率対象】";
}
if ($memo eq '') { $memo = '<br>'; }
# 書き出し
my $tmp = $loop;
$tmp =~ s/!code!/$code/g;
$tmp =~ s/!item!/$name/g;
$tmp =~ s/!num!/$num/g;
$tmp =~ s/!tanka!/comma($price)/ge;
$tmp =~ s/!gouka!/comma($kei)/ge;
$tmp =~ s/!memo!/$memo/g;
$body .= $tmp;
# 在庫数チェック
if ($cf{stock}) {
if ($zan{$code} - $num < 0) {
$scode = $code;
$flg++;
last;
}
}
}
# 在庫切れ
if ($flg) {
my ($name) = (split(/<>/,$cart{$scode}))[1];
my $msg = "大変申し訳ありません。「$name」は在庫切れです(在庫数:$zan{$scode})<br>\n";
$msg .= "たった今、他の方からの購入があったようです\n";
error($msg);
}
# 送料
if ($postage > 0) {
# 送料サービス有り
if ($cf{cari_serv} && $cf{cari_serv} <= $all) {
$postage = 0;
$serv_flag++;
}
}
# 送料が設定されている場合
if (!$serv_flag) { $all += $postage; }
# 支払手数料が設定されている場合
if ($cost > 0) { $all += $cost; }
# 次画面用パラメータ
my $hidden;
for (qw(payment date deli name roman email zip pref addr addr2 tel memo)) {
my $val = $in{$_};
if ($_ eq 'addr' or $_ eq 'addr2' or $_ eq 'memo') {
$val =~ s|<br>|\t|g;
}
$hidden .= qq|<input type="hidden" name="$_" value="$val">\n|;
}
# 消費税
my ($kei,$tax1,$tax2,$all,$tar) = calc_tax($all,$red);
for ($head, $foot) {
s/!kei!/comma($kei)/ge;
s/!tax!/comma($tax1)/ge;
s/!tax_red!/comma($tax2)/ge;
s/!all!/comma($all)/ge;
s/!postage!/comma($postage)/ge;
s/!cost!/comma($cost)/ge;
s/!(pref2?)!/$pref{$1}/g;
s/<!-- hidden -->/$hidden/g;
s/!tax_per!/$cf{tax_per}/e;
s/!red_per!/$cf{red_per}/e;
s/!tar_tax1!/comma($tar)/ge;
s/!tar_tax2!/comma($red)/ge;
if ($in{deliv} == 1) {
s|<!-- deliv -->.+?<!-- /deliv -->||s;
}
}
# 画面展開
print "Content-type: text/html; charset=utf-8\n\n";
print $head, $body;
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# 注文送信 (Step3)
#-----------------------------------------------------------
sub send_form {
# 買物情報取得
my ($cart,undef) = get_cookie();
if (@{$cart} == 0) { error("買物情報がありません"); }
# 入力確認
check_input();
# 改行変換
for ( keys %in ) {
if ($_ eq 'addr' or $_ eq 'addr2' or $_ eq 'memo') {
$in{$_} =~ s/\t+$//;
$in{$_} =~ s/\t/\n /g;
} else {
$in{$_} =~ s/\t//g;
}
}
# 在庫認識
my %zan = get_zan() if ($cf{stock});
# 軽減税率
my %red = read_redtax() if ($cf{tax_per} > 0);
# ホスト名/時間を取得
my $host = get_host();
my ($time,$mdate) = get_time();
$in{time} = $time;
$in{host} = $host;
# ブラウザ情報
$in{agent} = $ENV{HTTP_USER_AGENT};
$in{agent} =~ s/[<>&"']//g;
# 注文番号採番
open(DAT,"+< $cf{datadir}/num.dat") or error("open err: num.dat");
eval "flock(DAT,2);";
my $num = <DAT>;
seek(DAT,0,0);
print DAT ++$num;
truncate(DAT,tell(DAT));
close(DAT);
# 桁数調整
$in{number} = sprintf("%06d",$num);
# メール件名をMIMEエンコード
require "lib/jacode.pl";
my $msub = mime_unstructured_header("ご注文メール ($in{name}様)");
# メールヘッダー定義
my $mhead = <<EOM;
Subject: $msub
Date: $mdate
MIME-Version: 1.0
Content-type: text/plain; charset=ISO-2022-JP
Content-Transfer-Encoding: 7bit
X-Mailer: $cf{version}
EOM
# データ読み取り
my %cart = get_data();
# 買物カゴ展開
my $all = 0;
my $red = 0;
my $i = 0;
$in{order} = '';
foreach (@{$cart}) {
my ($id,$code,$num,@op) = split(/,/);
my (undef,$name,$price,undef,undef,@ops) = split(/<>/,$cart{$code});
# チェック
$id =~ s/\D//g;
$code =~ s/\W//g;
$num =~ s/\D//g;
# 小計
my $kei = $price * $num;
$all += $kei;
if ($cf{tax_per} > 0 && defined $red{$code}) { $red += $kei; }
# 在庫チェック
if ($cf{stock}) {
if ($zan{$code} - $num < 0) {
my $msg = "大変申し訳ありません。「$name」は在庫切れです(現在の在庫数:$zan{$code})<br>\n";
$msg .= "たった今、他の方からの購入があったようです\n";
error($msg);
}
$zan{$code} -= $num;
}
# 単価計算
$price = comma($price);
$kei = comma($kei);
$i++;
$in{order} .= "●ご注文内容$i\n";
$in{order} .= "コード : $code\n";
$in{order} .= "商品名 : $name\n";
# オプション処理
my @op2;
foreach my $i (0 .. $#{$cf{options}}) {
my ($key,$nam) = split(/,/,$cf{options}[$i]);
$op2[$i] = [split(/\s+/,$ops[$i])];
if ($op[$i] ne '') { $in{order} .= "[$nam] $op[$i]\n"; }
}
if ($cf{tax_per} > 0 && defined $red{$code}) { $in{order} .= "[軽減税率対象]\n"; }
$in{order} .= "金 額 : $price × $num = ￥$kei\n\n";
# オプション正当チェック
if ($cf{chk_ops} == 1) {
foreach my $i (0 .. $#{$cf{options}}) {
my $flg;
foreach my $opt (@{$op2[$i]}) {
if ($op[$i] eq $opt) {
$flg++;
last;
}
}
if ($op[$i] ne '' && !$flg) { error("属性の値が不正です"); }
}
}
}
$in{order} =~ s/\n+$//;
# セッションチェック
check_session();
# 配達時間
$in{deliv} = '';
if ($in{date} ne '') {
$in{deliv} = "$in{date} ";
if ($in{deli} ne "") {
$in{deliv} .= " ${$cf{deli}}[$in{deli}]";
}
}
# 都道府県/送料
my ($pref,$pref2);
my $postage = 0;
my ($pref,$postage) = split(/,/,${$cf{pref}}[$in{pref}]);
$in{pref} = $pref;
if ($in{pref2} ne "") {
($pref2,$postage) = split(/,/,${$cf{pref}}[$in{pref2}]);
$in{pref2} = $pref2;
}
# 支払方法の手数料
my ($pay,$cost) = split(/,/,${cf{payment}}[$in{payment}]);
my $q_pay = $in{payment};
$in{payment} = $pay;
# 県別送料
my $memo;
if ($postage > 0) {
# 送料サービス有り
$in{postage} = 0;
if ($cf{cari_serv} && $cf{cari_serv } <= $all) {
$in{postage} = $postage = 0;
$in{postage} .= ' (送料サービス)';
# 送料サービス無し
} else {
$all += $postage;
$in{postage} = comma($postage);
}
}
if ($in{postage} eq '') { $in{postage} = 0; }
# 支払手数料
$in{cost} = 0;
if ($cost > 0) {
$all += $cost;
$in{cost} = comma($cost);
}
# 消費税
my ($kei,$tax1,$tax2,$all,$tar) = calc_tax($all,$red);
# メール本文用
$in{kei} = comma($kei);
$in{all} = comma($all);
if ($cf{tax_per} == 0) {
$in{tax1} = $in{tax2} = "[内税]";
} else {
$in{tax1} = comma($tax1) . "（$cf{tax_per}%対象 ￥" . comma($tar) . "）";
$in{tax2} = comma($tax2) . "（$cf{red_per}%対象 ￥" . comma($red) . "）";
}
# メール本文テンプレート読出（管理者宛）
open(IN,"$cf{tmpldir}/order.txt") or error("open err: order.txt");
my $body_ord = join('',<IN>);
close(IN);
# オーダー本文テンプレート読出（注文者宛）
open(IN,"$cf{tmpldir}/reply.txt") or error("open err: reply.txt");
my $body_rep = join('',<IN>);
close(IN);
# 文字置き換え
$body_ord =~ s/!(\w+)!/$in{$1}/g;
$body_rep =~ s/!(\w+)!/$in{$1}/g;
# ログ用
my $log = $body_ord;
# コード変換
my $tmp_body;
for my $tmp ( split(/\n/,$body_ord) ) {
jcode::convert(\$tmp,'jis','utf8');
$tmp_body .= "$tmp\n";
}
$body_ord = $tmp_body;
my $tmp_body;
for my $tmp ( split(/\n/,$body_rep) ) {
jcode::convert(\$tmp,'jis','utf8');
$tmp_body .= "$tmp\n";
}
$body_rep = $tmp_body;
# タグ復元
$body_ord = tag_chg($body_ord);
$body_rep = tag_chg($body_rep);
# sendmailコマンド定義
my $scmd1 = "$cf{sendmail} -t -i";
my $scmd2 = "$cf{sendmail} -t -i";
if ($cf{sendm_f} == 1) {
$scmd1 .= " -f $in{email}";
$scmd2 .= " -f $cf{master}";
}
# 管理者へ送信
open(MAIL,"| $scmd1") or error("メール送信失敗");
print MAIL "To: $cf{master}\n";
print MAIL "From: $in{email}\n";
print MAIL "$mhead\n";
print MAIL "$body_ord\n";
close(MAIL);
# 注文者へ送信
open(MAIL,"| $scmd2") or error("メール送信失敗");
print MAIL "To: $in{email}\n";
print MAIL "From: $cf{master}\n";
print MAIL "$mhead\n";
print MAIL "$body_rep\n";
close(MAIL);
# 買物情報のクッキー消去
del_cookie();
# 在庫数更新
if ($cf{stock}) {
my @data;
while ( my ($id,$zan) = each %zan ) {
push(@data,"$id<>$zan<>\n");
}
open(OUT,"> $cf{datadir}/stock.dat") or error("write err: stock.dat");
eval "flock(OUT,2);";
print OUT @data;
close(OUT);
}
# ログ保存
save_log($time,$in{number},$log);
# テンプレート判別
my $zeus_num;
my $tmplfile = "send.html";
# クレジット
if (($cf{zeus_serv} == 1 && $q_pay == $#{$cf{payment}})
or ($cf{zeus_serv} == 2 && $q_pay == $#{$cf{payment}}-1)
or ($cf{zeus_serv} == 3 && $q_pay == $#{$cf{payment}}-1)
or ($cf{zeus_serv} == 4 && $q_pay == $#{$cf{payment}}-2)) {
$tmplfile = "send-credit.html";
$zeus_num = $cf{zeus_num};
# 銀行
} elsif (($cf{zeus_serv} == 2 && $q_pay == $#{$cf{payment}})
or ($cf{zeus_serv} == 4 && $q_pay == $#{$cf{payment}}-1)) {
$tmplfile = "send-bank.html";
$zeus_num = $cf{zeus_bip};
# コンビニ
} elsif (($cf{zeus_serv} == 3 && $q_pay == $#{$cf{payment}})
or ($cf{zeus_serv} == 4 && $q_pay == $#{$cf{payment}})) {
$tmplfile = "send-conv.html";
$zeus_num = $cf{zeus_cip};
}
# 完了画面
open(IN,"$cf{tmpldir}/$tmplfile") or error("open err: $tmplfile");
my $tmpl = join('',<IN>);
close(IN);
# 文字置換
$tmpl =~ s/!home!/$cf{home}/g;
$tmpl =~ s/!cmnurl!/$cf{cmnurl}/g;
# ゼウス用
my $money = $all;
if ($cf{zeus_serv} > 0) {
$in{tel} =~ s/\D//g;
$tmpl =~ s/!zeus_num!/$zeus_num/g;
$tmpl =~ s/!money!/$money/g;
$tmpl =~ s/!tel!/$in{tel}/g;
$tmpl =~ s/!email!/$in{email}/g;
$tmpl =~ s/!sendid!/$in{number}/g;
}
$tmpl =~ s/!order_cgi!/$cf{order_cgi}/g;
# 表示
print "Content-type: text/html; charset=utf-8\n\n";
footer($tmpl);
}
#-----------------------------------------------------------
# 時間取得
#-----------------------------------------------------------
sub get_time {
my ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0..6];
my @week = qw|Sun Mon Tue Wed Thu Fri Sat|;
my @mon = qw|Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec|;
# 日時フォーマット
my $date = sprintf("%04d/%02d/%02d(%s) %02d:%02d:%02d",
$year+1900,$mon+1,$mday,$week[$wday],$hour,$min,$sec);
# メール用フォーマット
my $mdate = sprintf("%s, %02d %s %04d %02d:%02d:%02d",
$week[$wday],$mday,$mon[$mon],$year+1900,$hour,$min,$sec) . " +0900";
return ($date,$mdate);
}
#-----------------------------------------------------------
# ホスト名取得
#-----------------------------------------------------------
sub get_host {
my $host = $ENV{REMOTE_HOST};
my $addr = $ENV{REMOTE_ADDR};
if ($cf{gethostbyaddr} && ($host eq "" || $host eq $addr)) {
$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
}
$host ||= $addr;
return $host;
}
#-----------------------------------------------------------
# ログ保存
#-----------------------------------------------------------
sub save_log {
my ($date,$num,$log) = @_;
# 改行置き換え
$log =~ s/\n/\t/g;
$log =~ s/ +/ /g;
# ログファイル名を定義
my $file = ($date =~ /^(\d{4})\/(\d{2})/) && "$1$2.cgi";
# 存在チェック
my $flg;
if (-e "$cf{datadir}/log/$file") { $flg++; }
# ログ追加書き込み
open(DAT,">> $cf{datadir}/log/$file") or error("write err: $file");
eval "flock(DAT, 2);";
print DAT "$date<>$num<>$log\n";
close(DAT);
# 新規生成の場合はパーミッション付与
chmod(0666, "$cf{datadir}/log/$file") if (!$flg);
}
#-----------------------------------------------------------
# 入力チェック
#-----------------------------------------------------------
sub check_input {
# 改行末尾をカット
$in{addr} =~ s/\t+$//g;
$in{addr2} =~ s/\t+$//g;
$in{memo} =~ s/\t+$//g;
# 入力確認
my %er;
if ($in{payment} eq '') { $er{payment} = '支払方法が未選択です'; }
if ($in{date} ne '') {
if ($in{date} =~ m|^(\d+)/(\d+)/(\d+)|) {
my ($yr,$mon,$day) = ($1,$2,$3);
my ($d,$m,$y) = (localtime())[3..5];
my $date = sprintf("%04d%02d%02d",$y+1900,$m+1,$d);
if ("$yr$mon$day" < $date) { $er{date} = '配達日は今日以降を指定してください'; }
} else {
$er{date} = '配達日は「年/月/日」で入力してください';
}
}
if ($in{name} eq '') { $er{name} = '名前が未入力です'; }
if ($in{roman} eq '') { $er{roman} = 'ローマ字名前が未入力です'; }
if ($in{email} !~ /^[\w\.\-]+\@[\w\.\-]+\.[a-zA-Z]{2,6}$/) { $er{email} = '電子メールの入力が不正です'; }
if ($in{zip} !~ /^\d{3}-?\d{4}$/) { $er{zip} = '郵便番号は「数字7桁」か「数字3桁-4桁」です'; }
if ($in{pref} eq '' or $in{addr} eq '') { $er{addr} = '住所が未入力です'; }
if ($in{pref} eq '' or $in{addr2} eq '') { $er{addr2} = 'ローマ字住所が未入力です'; }
if ($in{tel} eq '') { $er{tel} = '電話番号が未入力です'; }
if ($in{deliv} == 2) {
if ($in{name2} eq '') { $er{name2} = '配送先の名前が未入力です'; }
if ($in{zip2} !~ /^\d{3}-?\d{4}$/) { $er{zip2} = '配送先の郵便番号は「数字7桁」か「数字3桁-4桁」です'; }
if ($in{pref2} eq '' or $in{addr2} eq '') { $er{addr2} = '配送先の住所が未入力です'; }
if ($in{tel2} eq '') { $er{tel2} = '配送先の電話番号が未入力です'; }
} else {
$in{name2} = $in{kana2} = $in{zip2} = $in{addr2} = $in{pref2} = $in{tel2} = $in{fax2} = '';
}
if (%er != 0) { addr_form(%er); }
}
#-----------------------------------------------------------
# タグ復元
#-----------------------------------------------------------
sub tag_chg {
local($_) = @_;
s/</</g;
s/>/>/g;
s/"/"/g;
s/&/&/g;
$_;
}
#-----------------------------------------------------------
# 顧客情報暗号化
#-----------------------------------------------------------
sub encrypt_cust {
my @cust = @_;
my @ret;
foreach (@cust) {
my $encrypt = RC4($cf{passphrase}, $_);
$encrypt =~ s/(.)/unpack('H2', $1)/eg;
push(@ret,$encrypt);
}
return @ret;
}
#-----------------------------------------------------------
# 顧客情報復号化
#-----------------------------------------------------------
sub decrypt_cust {
my @cust = @_;
my @ret;
foreach (@cust) {
s/([0-9A-Fa-f]{2})/pack('H2', $1)/eg;
my $decrypt = RC4($cf{passphrase}, $_);
$decrypt =~ s/[&"'<>]//g;
push(@ret,$decrypt);
}
return @ret;
}
#-----------------------------------------------------------
# クッキー消去
#-----------------------------------------------------------
sub del_cookie {
print "Set-Cookie: $cf{cookie_cart}=; expires=Thu, 01-Jan-1970 00:00:00 GMT;\n";
}
#-----------------------------------------------------------
# クッキー発行
#-----------------------------------------------------------
sub set_cookie {
my @data = @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,undef,undef) = gmtime(time + 60*24*60*60);
my @mon = qw|Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec|;
my @week = qw|Sun Mon Tue Wed Thu Fri Sat|;
# 時刻フォーマット
my $gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
$week[$wday],$mday,$mon[$mon],$year+1900,$hour,$min,$sec);
# URLエンコード
my $cook;
foreach (@data) {
s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
$cook .= "$_<>";
}
print "Set-Cookie: $cf{cookie_cust}=$cook; expires=$gmt;";
print " secure" if ($cf{ssl_cookie});
print "\n";
}
#-----------------------------------------------------------
# クッキー取得
#-----------------------------------------------------------
sub get_cookie {
# クッキー取得
my $cook = $ENV{HTTP_COOKIE};
# 該当IDを取り出す
my %cook;
for ( split(/;/,$cook) ) {
my ($key,$val) = split(/=/);
$key =~ s/\s//g;
$cook{$key} = $val;
}
# URLデコード
my (@cart,@cook);
for ( split(/<>/,$cook{$cf{cookie_cart}}) ) {
s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("H2",$1)/eg;
s/[&"'<>]//g;
push(@cart,$_);
}
for ( split(/<>/,$cook{$cf{cookie_cust}}) ) {
s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("H2",$1)/eg;
s/[&"'<>]//g;
push(@cook,$_);
}
return (\@cart,\@cook);
}
#-----------------------------------------------------------
# 在庫数認識
#-----------------------------------------------------------
sub get_zan {
my %zan;
open(IN,"$cf{datadir}/stock.dat") or error("open err: stock.dat");
while (<IN>) {
my ($id,$zan) = split(/<>/);
$zan{$id} = $zan;
}
close(IN);
return %zan;
}
#-----------------------------------------------------------
# セッション作成
#-----------------------------------------------------------
sub make_session {
# 生成
my @wd = (0 .. 9, 'a' .. 'z', 'A' .. 'Z', '_');
my $ses;
for (1 .. 25) { $ses .= $wd[int(rand(@wd))]; }
# 更新
my $now = time;
open(DAT,">> $cf{datadir}/ses.dat") or error("write err: ses.dat");
eval "flock(DAT,2);";
print DAT "$now\t$ses\n";
close(DAT);
return $ses;
}
#-----------------------------------------------------------
# セッション確認
#-----------------------------------------------------------
sub check_session {
my $now = time;
my ($flg,@log);
open(DAT,"+< $cf{datadir}/ses.dat") or error("open err: ses.dat");
eval "flock(DAT,2);";
while(<DAT>) {
chomp;
my ($time,$id) = split(/\t/);
next if ($now - $time > 3600); # 60分以上はスキップ
if ($in{ses} eq $id) {
$flg++;
next;
}
push(@log,"$_\n");
}
seek(DAT,0,0);
print DAT @log;
truncate(DAT,tell(DAT));
close(DAT);
if (!$flg) {
my $msg = "画面表示後一定時間が経過したため、下記のリンクから再度やり直してください\n";
$msg .= qq|<p><a href="$cf{order_cgi}?mode=addr&back=$in{back}">注文者情報入力</a></p>\n|;
error($msg);
}
}
#-----------------------------------------------------------
# mimeエンコード
# [quote] http://www.din.or.jp/~ohzaki/perl.htm#JP_Base64
#-----------------------------------------------------------
sub mime_unstructured_header {
my $oldheader = shift;
jcode::convert(\$oldheader,'euc','utf8');
my ($header,@words,@wordstmp,$i);
my $crlf = $oldheader =~ /\n$/;
$oldheader =~ s/\s+$//;
@wordstmp = split /\s+/, $oldheader;
for ($i = 0; $i < $#wordstmp; $i++) {
if ($wordstmp[$i] !~ /^[\x21-\x7E]+$/ and
$wordstmp[$i + 1] !~ /^[\x21-\x7E]+$/) {
$wordstmp[$i + 1] = "$wordstmp[$i] $wordstmp[$i + 1]";
} else {
push(@words, $wordstmp[$i]);
}
}
push(@words, $wordstmp[-1]);
foreach my $word (@words) {
if ($word =~ /^[\x21-\x7E]+$/) {
$header =~ /(?:.*\n)*(.*)/;
if (length($1) + length($word) > 76) {
$header .= "\n $word";
} else {
$header .= $word;
}
} else {
$header = add_encoded_word($word, $header);
}
$header =~ /(?:.*\n)*(.*)/;
if (length($1) == 76) {
$header .= "\n ";
} else {
$header .= ' ';
}
}
$header =~ s/\n? $//mg;
$crlf ? "$header\n" : $header;
}
sub add_encoded_word {
my ($str, $line) = @_;
my $result;
my $ascii = '[\x00-\x7F]';
my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
while (length($str)) {
my $target = $str;
$str = '';
if (length($line) + 22 +
($target =~ /^(?:$twoBytes|$threeBytes)/o) * 8 > 76) {
$line =~ s/[ \t\n\r]*$/\n/;
$result .= $line;
$line = ' ';
}
while (1) {
my $encoded = '=?ISO-2022-JP?B?' .
b64encode(jcode::jis($target,'euc','z')) . '?=';
if (length($encoded) + length($line) > 76) {
$target =~ s/($threeBytes|$twoBytes|$ascii)$//o;
$str = $1 . $str;
} else {
$line .= $encoded;
last;
}
}
}
$result . $line;
}
# [quote] http://www.tohoho-web.com/perl/encode.htm
sub b64encode {
my $buf = shift;
my ($mode,$tmp,$ret);
my $b64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
. "abcdefghijklmnopqrstuvwxyz"
. "0123456789+/";
$mode = length($buf) % 3;
if ($mode == 1) { $buf .= "\0\0"; }
if ($mode == 2) { $buf .= "\0"; }
$buf =~ s/(...)/{
$tmp = unpack("B*", $1);
$tmp =~ s|(......)|substr($b64, ord(pack("B*", "00$1")), 1)|eg;
$ret .= $tmp;
}/eg;
if ($mode == 1) { $ret =~ s/..$/==/; }
if ($mode == 2) { $ret =~ s/.$/=/; }
return $ret;
}
| 記事No | ： 16816 |
| 投稿日 | ： 2022/04/22(Fri) 04:30:48 |
| タイトル | ： Re: 注文入力ページでの改良について |
| ID情報 | ： tmhk0722 |
| 投稿者 | ： tomo |
| URL | ： http://bodyvine.sakura.ne.jp |
念の為、mart.cgiのタグも載せておきます。
#!/usr/local/bin/perl
#┌─────────────────────────────────
#│ WEB MART : mart.cgi - 2021/04/25
#│ copyright (c) kentweb, 1997-2021
#│ https://www.kent-web.com/
#└─────────────────────────────────
# モジュール宣言
use strict;
use CGI::Carp qw(fatalsToBrowser);
use lib "./lib";
use CGI::Minimal;
# 外部ファイル取り込み
require './init.cgi';
my %cf = set_init();
# データ受理
CGI::Minimal::max_read_size($cf{maxdata});
my $cgi = CGI::Minimal->new;
cgi_err('容量オーバー') if ($cgi->truncated);
my %in = parse_form($cgi);
# 処理分岐
if ($in{mode} eq "law") { law_data(); }
if ($in{mode} eq "chg") { chg_cart(); }
pick_cart();
#-----------------------------------------------------------
# カゴ入れ
#-----------------------------------------------------------
sub pick_cart {
# コード/数量の正当性
$in{code} =~ s/\W//g;
$in{num} =~ s/\D//g;
# BACK属性がなければ、HTTP_REFERERで取得
$in{back} ||= $ENV{HTTP_REFERER};
if ($in{back}) {
chk_back($in{back});
} else {
error("BACK属性がありません");
}
# 登録データ認識
my %cart = get_data();
# 個数がない場合は1とする
if ($in{num} eq '') { $in{num} = 1; }
# コードがない場合は「中身確認」
if ($in{code} eq '') {
my @cook = get_cookie();
basket(\@cook,\%cart);
}
# 商品コードの整合性チェック
error("商品コード「$in{code}」は未登録です") if (!defined $cart{$in{code}});
# 在庫管理の場合
chk_stock($in{code},$in{num}) if ($cf{stock});
# クッキー取得
my @cook = get_cookie();
# 重複チェック
my ($flg,@new);
for (@cook) {
my ($id,$code,$num,@op) = split(/,/);
if ($in{code} eq $code) {
my $chk;
for my $i (0 .. $#{$cf{options}}) {
my ($key,$nam) = split(/,/,$cf{options}[$i]);
if ($op[$i] ne $in{$key}) {
$chk++;
last;
}
}
# 要素が同じ場合は数量を足しこむ（重複する場合）
if (!$chk) {
$flg++;
$num += $in{num};
$_ = "$id,$code,$num";
foreach my $op (@op) {
$_ .= ",$op";
}
}
}
push(@new,$_);
}
@cook = @new;
# 重複がなければ買物カゴへ追加
if (!$flg) {
# 商品情報
my (undef,undef,undef,undef,undef,@ops) = split(/<>/,$cart{$in{code}});
# オプションを二次元配列化
my $i = 0;
my @op;
for (0 .. $#{$cf{options}}) {
$op[$i] = [split(/\s+/,$ops[$_])];
$i++;
}
# ID番号発行
my ($id) = (split(/,/,$cook[0]))[0];
$id++;
# 追加分
my $add = "$id,$in{code},$in{num}";
# オプション
for my $i (0 .. $#{$cf{options}}) {
my ($key,$nam) = split(/,/,$cf{options}[$i]);
# 正当性をチェック
if ($in{$key} ne '' && $cf{chk_ops} == 1) {
my $flg;
for (@{$op[$_]}) {
if ($_ eq $in{$key}) {
$flg++;
last;
}
}
if (!$flg) {
my $msg = qq|$in{$key}は不正な値です|;
error($msg);
}
}
$add .= qq|,$in{$key}|;
}
unshift(@cook,$add);
}
# クッキー格納
set_cookie(@cook);
# カゴ確認画面
basket(\@cook,\%cart);
}
#-----------------------------------------------------------
# 買物カゴ画面表示
#-----------------------------------------------------------
sub basket {
my ($cook,$mart) = @_;
# 軽減税率
my %red = read_redtax() if ($cf{tax_per} > 0);
# テンプレート読み込み
open(IN,"$cf{tmpldir}/mart.html") or error("open err: mart.html");
my $tmpl = join('',<IN>);
close(IN);
# 変換
$tmpl =~ s/!back!/$in{back}/g;
$tmpl =~ s/!home!/$cf{home}/g;
$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;
$tmpl =~ s/!cmnurl!/$cf{cmnurl}/g;
# 中身なしのとき
if (@{$cook} == 0) { $tmpl =~ s|<!-- next_btn -->.+?<!-- /next_btn -->||s; }
# 税対応
if (!$cf{tax_per}) { $tmpl =~ s|<!-- tax -->.+?<!-- /tax -->||s; }
# テンプレート分解
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- item -->(.+?)<!-- /item -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
# 商品内容を展開
my $all = 0;
my $red = 0;
my $body;
for my $ck (@{$cook}) {
my ($id,$code,$num,@op) = split(/,/,$ck);
my (undef,$name,$price,$memo,$back,@ops) = split(/<>/,$mart->{$code});
# チェック
$id =~ s/\D//g;
$code =~ s/\W//g;
$num =~ s/\D//g;
# オプション処理
my ($memo,@op2);
for my $i (0 .. $#{$cf{options}}) {
my ($key,$nam) = split(/,/,$cf{options}[$i]);
$op2[$i] = [split(/\s+/,$ops[$i])];
if ($op[$i] ne '') { $memo .= "[$nam]$op[$i] "; }
}
# 引数
my $hid = "$id;$code;$num";
for my $i (0 .. $#{$cf{options}}) {
# 正当性チェック
if ($cf{chk_ops} == 1) {
my $flg;
for my $opt (@{$op2[$i]}) {
if ($op[$i] eq $opt) {
$flg++;
last;
}
}
if ($op[$i] ne '' && !$flg) { error("属性の値が不正です"); }
}
$hid .= ";$op[$i]";
}
# 小計/累計
my $kei = $price * $num;
$all += $kei;
# 軽減税率
if ($cf{tax_per} > 0 && defined $red{$code}) {
$red += $kei;
$memo .= "<br>" if ($memo ne '');
$memo .= "【軽減税率対象】";
}
if ($memo eq '') { $memo = '<br>'; }
# プルダウン生成
my ($sel_num,$flg);
for my $i (1 .. $cf{max_select}) {
if ($num == $i) {
$flg++;
$sel_num .= qq|<option value="$i" selected>$i</option>\n|;
} else {
$sel_num .= qq|<option value="$i">$i</option>\n|;
}
}
if (!$flg) { $sel_num .= qq|<option value="$num" selected>$num</option>\n|; }
my $tmp = $loop;
$tmp =~ s/!code!/$code/g;
$tmp =~ s/!item!/$name/g;
$tmp =~ s/!num!/num:$id/g;
$tmp =~ s/<!-- sel_num -->/$sel_num/g;
$tmp =~ s/!chg!/chg:$id/g;
$tmp =~ s/!tanka!/comma($price)/ge;
$tmp =~ s/!gouka!/comma($kei)/ge;
$tmp =~ s/!del!/del:$id/g;
$tmp =~ s/!memo!/$memo/g;
$body .= $tmp;
}
# 消費税計算
my ($kei,$tax1,$tax2,$all,$tar) = calc_tax($all,$red);
# 文字置換
for ($head,$foot) {
s/!kei!/comma($kei)/ge;
s/!tax!/comma($tax1)/ge;
s/!tax_red!/comma($tax2)/ge;
s/!tax_per!/$cf{tax_per}/e;
s/!red_per!/$cf{red_per}/e;
s/!all!/comma($all)/ge;
s/!tar_tax1!/comma($tar)/ge;
s/!tar_tax2!/comma($red)/ge;
}
# 画面表示
print "Content-type: text/html; charset=utf-8\n\n";
print $head, $body;
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# カート内容変更
#-----------------------------------------------------------
sub chg_cart {
# 商品コード
$in{code} =~ s/\W//g;
# 変更/削除ボタン認識
my ($chg_num,$del_num);
for ( keys %in ) {
if (/^chg:(\d+)/) {
$chg_num = $1;
last;
} elsif (/^del:(\d+)/) {
$del_num = $1;
last;
}
}
# クッキー取得
my @get = get_cookie();
my ($mycode,$mynum,@cook);
for (@get) {
my ($id,$code,$num,@op) = split(/,/);
# 変更
if ($chg_num eq $id) {
$mycode = $code;
$mynum = $in{"num:$id"};
$_ = qq|$id,$code,$in{"num:$id"}|;
foreach my $op (@op) {
$_ .= ",$op";
}
# 削除
} elsif ($del_num eq $id) {
next;
}
push(@cook,$_);
}
# 数量変更の場合、在庫チェック
if ($cf{stock} && $chg_num) { chk_stock($mycode,$mynum); }
# クッキー格納
set_cookie(@cook);
# 買物カゴ
my %cart = get_data();
basket(\@cook,\%cart);
}
#-----------------------------------------------------------
# 数字半角変換
#-----------------------------------------------------------
sub num_z2h {
local($_) = @_;
s/０/0/g;
s/１/1/g;
s/２/2/g;
s/３/3/g;
s/４/4/g;
s/５/5/g;
s/６/6/g;
s/７/7/g;
s/８/8/g;
s/９/9/g;
$_;
}
#-----------------------------------------------------------
# 在庫数チェック
#-----------------------------------------------------------
sub chk_stock {
my ($qcode,$qnum) = @_;
my ($flg,$zaiko);
open(IN,"$cf{datadir}/stock.dat") or error("open err: stock.dat");
while (<IN>) {
my ($code,$zan) = split(/<>/);
if ($qcode eq $code) {
if ($zan - $qnum < 0) {
$zaiko = $zan;
$flg++;
last;
}
}
}
close(IN);
# 在庫なし
error("誠に申し訳ありません。<br>この商品は在庫切れです(在庫数:<b>$zaiko</b>)") if ($flg);
}
#-----------------------------------------------------------
# クッキー取得
#-----------------------------------------------------------
sub get_cookie {
# クッキー取得
$ENV{HTTP_COOKIE} =~ /$cf{cookie_cart}=([^=;]+);?/;
my $cook = $1;
$cook =~ s/\s//g;
# URLデコード
my @cook;
foreach ( split(/<>/,$cook) ) {
s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("H2",$1)/eg;
s/[&"'<>]//g;
push(@cook,$_);
}
return @cook;
}
#-----------------------------------------------------------
# クッキー発行
#-----------------------------------------------------------
sub set_cookie {
my @data = @_;
# URLエンコード
my $cook;
foreach (@data) {
s/(\W)/sprintf("%%%02X",unpack("C",$1))/eg;
$cook .= "$_<>";
}
print "Set-Cookie: $cf{cookie_cart}=$cook\n";
}
| 記事No | ： 16817 |
| 投稿日 | ： 2022/04/22(Fri) 04:57:41 |
| タイトル | ： Re: 注文入力ページでの改良について |
| ID情報 | ： tmhk0722 |
| 投稿者 | ： tomo |
| URL | ： http://bodyvine.sakura.ne.jp |
念の為、order.cgiのタグを貼り付けておきます。
#!/usr/local/bin/perl
#┌─────────────────────────────────
#│ WEB MART : order.cgi - 2021/04/25
#│ copyright (c) kentweb, 1997-2021
#│ https://www.kent-web.com/
#└─────────────────────────────────
# モジュール宣言
use strict;
use CGI::Carp qw(fatalsToBrowser);
use lib "./lib";
use CGI::Minimal;
use Crypt::RC4;
# 設定ファイル取り込み
require './init.cgi';
my %cf = set_init();
# データ受理
CGI::Minimal::max_read_size($cf{maxdata});
my $cgi = CGI::Minimal->new;
cgi_err('容量オーバー') if ($cgi->truncated);
my %in = parse_form($cgi);
# 処理分岐
if ($in{mode} eq "law") { law_data(); }
if ($in{mode} eq "addr") { addr_form(); }
if ($in{mode} eq "conf") { conf_form(); }
if ($in{mode} eq "send") { send_form(); }
error("不明な処理です");
#-----------------------------------------------------------
# 住所入力画面 (Step1)
#-----------------------------------------------------------
sub addr_form {
my %er = @_;
# back属性チェック
chk_back($in{back});
# 買物データ受理
my ($cart,$cust) = get_cookie();
if (@{$cart} == 0) { error("買物カゴの中身が空です"); }
# 商品データ認識
my %cart = get_data();
# 軽減税率
my %red = read_redtax() if ($cf{tax_per} > 0);
# 前画面からの戻りの場合
my %c;
if ($in{job} eq "back" or %er != 0) {
%c = %in;
# 戻りでない場合は顧客情報のクッキー取り出し
} else {
# 復号
($c{name},$c{roman},$c{email},$c{zip},$c{pref},$c{addr},$c{romanaddr},$c{tel}) = decrypt_cust(@{$cust});
}
# 改行復元
$c{addr} =~ s/\t/\n/g;
$c{romanaddr} =~ s/\t/\n/g;
$c{memo} =~ s/\t/\n/g;
# 送料で有償の地区があるかをチェック
my ($flg,$remark);
foreach (0 .. $#{$cf{pref}}) {
my ($prf,$pri) = split(/,/,${$cf{pref}}[$_]);
if ($pri > 0) {
$flg++;
last;
}
}
if ($flg) { $remark = "(送料等は次画面で計算されます)"; }
# 支払方法
my $payment;
foreach (0 .. $#{$cf{payment}}) {
my ($pay,$cost) = split(/,/,${$cf{payment}}[$_]);
if (($in{payment} eq $_) || ($in{payment} eq "" && $_ == 0)) {
$payment .= qq|<input type="radio" name="payment" value="$_" checked>$pay<br>\n|;
} else {
$payment .= qq|<input type="radio" name="payment" value="$_">$pay<br>\n|;
}
}
# 配達時間
my $opt_deli;
foreach (0 .. $#{$cf{deli}}) {
if ($in{deli} eq $_) {
$opt_deli .= qq|<option value="$_" selected>${$cf{deli}}[$_]</option>\n|;
} else {
$opt_deli .= qq|<option value="$_">${$cf{deli}}[$_]</option>\n|;
}
}
# 都道府県
my ($opt_pref,$opt_pref2);
foreach (0 .. $#{$cf{pref}}) {
my ($pref,$postage) = split(/,/,${$cf{pref}}[$_]);
if ($c{pref} eq $_) {
$opt_pref .= qq|<option value="$_" selected>$pref</option>\n|;
} else {
$opt_pref .= qq|<option value="$_">$pref</option>\n|;
}
if ($c{pref2} eq $_) {
$opt_pref2 .= qq|<option value="$_" selected>$pref</option>\n|;
} else {
$opt_pref2 .= qq|<option value="$_">$pref</option>\n|;
}
}
# テンプレート読み込み
open(IN,"$cf{tmpldir}/addr.html") or error("open err: addr.html");
my $tmpl = join('',<IN>);
close(IN);
# 置き換え
$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;
$tmpl =~ s/!cmnurl!/$cf{cmnurl}/g;
$tmpl =~ s/!home!/$cf{home}/g;
$tmpl =~ s/!back!/$in{back}/g;
$tmpl =~ s/!payment!/$payment/g;
$tmpl =~ s/!remark!/$remark/g;
$tmpl =~ s/!date!/$in{date}/g;
$tmpl =~ s/!c_(\w+)!/$c{$1}/g;
$tmpl =~ s/<!-- option_deli -->/$opt_deli/g;
$tmpl =~ s/<!-- option_pref -->/$opt_pref/g;
$tmpl =~ s/<!-- option_pref2 -->/$opt_pref2/g;
$tmpl =~ s/!renraku!/$c{memo} eq '' ? ' ' : $c{memo}/eg;
$tmpl =~ s|!icon:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;
# 税対応
if (!$cf{tax_per}) { $tmpl =~ s|<!-- tax -->.+?<!-- /tax -->||s; }
# 入力エラー
if (%er != 0) {
for (qw(date name roman email zip addr romanaddr tel)) {
if (defined $er{$_}) { $tmpl =~ s|<!-- err:$_ -->|<div class="err-addr">$er{$_}</div>|g; }
}
}
# 配送先
if (!$in{deliv}) { $in{deliv} = 1; }
$tmpl =~ s|<input type="radio" name="deliv" value="$in{deliv}" ([^>]+)>|<input type="radio" name="deliv" value="$in{deliv}" $1 checked>|g;
# 配送先フォーム
if ($in{deliv} == 2) {
$tmpl =~ s/!disp!/block/g;
} else {
$tmpl =~ s/!disp!/none/g;
}
# テンプレート分割
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- item -->(.+?)<!-- /item -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
# 買物カゴ展開
my $all = 0;
my $red = 0;
my $body;
for (@{$cart}) {
my ($id,$code,$num,@op) = split(/,/);
my (undef,$name,$price,$memo,$back,@ops) = split(/<>/,$cart{$code});
# チェック
$id =~ s/\D//g;
$code =~ s/\W//g;
$num =~ s/\D//g;
# オプション処理
my ($memo,@op2);
for my $i (0 .. $#{$cf{options}}) {
my ($key,$nam) = split(/,/,$cf{options}[$i]);
$op2[$i] = [split(/\s+/,$ops[$i])];
if ($op[$i] ne '') { $memo .= "[$nam]$op[$i] "; }
}
# 引数
my $hid = "$id;$code;$num";
for my $i (0 .. $#{$cf{options}}) {
# 正当性チェック
if ($cf{chk_ops} == 1) {
my $flg;
foreach my $opt (@{$op2[$i]}) {
if ($op[$i] eq $opt) {
$flg++;
last;
}
}
if ($op[$i] ne '' && !$flg) { error("属性の値が不正です"); }
}
$hid .= ";$op[$i]";
}
# 小計/累計
my $kei = $price * $num;
$all += $kei;
# 軽減税率
if ($cf{tax_per} > 0 && defined $red{$code}) {
$red += $kei;
$memo .= "<br>" if ($memo ne '');
$memo .= "【軽減税率対象】";
}
if ($memo eq '') { $memo = '<br>'; }
# 書き出し
my $tmp = $loop;
$tmp =~ s/!code!/$code/g;
$tmp =~ s/!item!/$name/g;
$tmp =~ s/!num!/$num/g;
$tmp =~ s/!tanka!/comma($price)/ge;
$tmp =~ s/!gouka!/comma($kei)/ge;
$tmp =~ s/!memo!/$memo/g;
$body .= $tmp;
}
# 消費税
my ($kei,$tax1,$tax2,$all,$tar) = calc_tax($all,$red);
for ($head, $foot) {
s/!kei!/comma($kei)/ge;
s/!tax!/comma($tax1)/ge;
s/!tax_red!/comma($tax2)/ge;
s/!all!/comma($all)/ge;
s/!tax_per!/$cf{tax_per}/e;
s/!red_per!/$cf{red_per}/e;
s/!tar_tax1!/comma($tar)/ge;
s/!tar_tax2!/comma($red)/ge;
}
# 画面展開
print "Content-type: text/html; charset=utf-8\n\n";
print $head, $body;
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# 確認画面 (Step2)
#-----------------------------------------------------------
sub conf_form {
# back属性チェック
chk_back($in{back});
# 買物情報取得
my ($cart,undef) = get_cookie();
if (@{$cart} == 0) { error("買物情報がありません"); }
# 入力確認
check_input();
# 注文者情報をクッキー格納
my $cookie;
if ($in{cook} == 1) {
# 顧客情報暗号化
my @cust = encrypt_cust($in{name},$in{roman},$in{email},$in{zip},$in{pref},$in{addr},$in{romanaddr},$in{tel});
# クッキー保存
set_cookie(@cust);
}
# 在庫認識
my %zan = get_zan() if ($cf{stock});
# 商品データ認識
my %cart = get_data();
# 軽減税率
my %red = read_redtax() if ($cf{tax_per} > 0);
# 都道府県/送料
my ($pref2,%pref);
my $postage = 0;
my ($pref,$postage) = split(/,/,${$cf{pref}}[$in{pref}]);
$pref{pref} = $pref;
if ($in{pref2} ne "") {
($pref2,$postage) = split(/,/,${$cf{pref}}[$in{pref2}]);
$pref{pref2} = $pref2;
}
# 支払方法の手数料
my ($pay,$cost) = split(/,/,${$cf{payment}}[$in{payment}]);
# 送料サービスフラグ
my $serv_flag = 0;
# 配達時間
my $deliv;
if ($in{date} ne '') { $deliv = "$in{date} "; }
if ($in{deli} ne '') { $deliv .= ${$cf{deli}}[$in{deli}]; }
if ($deliv eq '') { $deliv = '<br>'; }
# 郵便番号
$in{zip} =~ s/(\d{3})(\d{4})/$1-$2/;
$in{zip2} =~ s/(\d{3})(\d{4})/$1-$2/;
# 改行復元
$in{addr} =~ s/\t/<br>/g;
$in{romanaddr} =~ s/\t/<br>/g;
$in{memo} =~ s/\t/<br>/g;
# テンプレート読み込み
open(IN,"$cf{tmpldir}/conf.html") or error("open err: conf.html");
my $tmpl = join('',<IN>);
close(IN);
# 置き換え
$tmpl =~ s/!ses!/make_session()/e;
$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;
$tmpl =~ s/!cmnurl!/$cf{cmnurl}/g;
$tmpl =~ s/!home!/$cf{home}/g;
$tmpl =~ s/!back!/$in{back}/g;
$tmpl =~ s/!c_(\w+)!/$in{$1}/g;
$tmpl =~ s/!renraku!/$in{memo}/g;
$tmpl =~ s/!deliv!/$deliv/g;
$tmpl =~ s/!payment!/$pay/g;
$tmpl =~ s/!ses!/$in{ses}/g;
# 税対応
if (!$cf{tax_per}) { $tmpl =~ s|<!-- tax -->.+?<!-- /tax -->||s; }
# テンプレート分割
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- item -->(.+?)<!-- /item -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
# 買物カゴ展開
my $all = 0;
my $red = 0;
my $gkei = 0;
my ($flg,$scode,$body);
for (@{$cart}) {
my ($id,$code,$num,@op) = split(/,/);
my (undef,$name,$price,$memo,$back,@ops) = split(/<>/,$cart{$code});
# チェック
$id =~ s/\D//g;
$code =~ s/\W//g;
$num =~ s/\D//g;
# オプション処理
my ($memo,@op2);
for my $i (0 .. $#{$cf{options}}) {
my ($key,$nam) = split(/,/,$cf{options}[$i]);
$op2[$i] = [split(/\s+/,$ops[$i])];
if ($op[$i] ne '') { $memo .= "[$nam]$op[$i] "; }
}
# 引数
my $hid = "$id;$code;$num";
for my $i (0 .. $#{$cf{options}}) {
# 正当性チェック
if ($cf{chk_ops} == 1) {
my $flg;
for my $opt (@{$op2[$i]}) {
if ($op[$i] eq $opt) {
$flg++;
last;
}
}
if ($op[$i] ne '' && !$flg) { error("属性の値が不正です"); }
}
$hid .= ";$op[$i]";
}
# 小計/累計
my $kei = $price * $num;
$all += $kei;
# 軽減税率
if ($cf{tax_per} > 0 && defined $red{$code}) {
$red += $kei;
$memo .= "<br>" if ($memo ne '');
$memo .= "【軽減税率対象】";
}
if ($memo eq '') { $memo = '<br>'; }
# 書き出し
my $tmp = $loop;
$tmp =~ s/!code!/$code/g;
$tmp =~ s/!item!/$name/g;
$tmp =~ s/!num!/$num/g;
$tmp =~ s/!tanka!/comma($price)/ge;
$tmp =~ s/!gouka!/comma($kei)/ge;
$tmp =~ s/!memo!/$memo/g;
$body .= $tmp;
# 在庫数チェック
if ($cf{stock}) {
if ($zan{$code} - $num < 0) {
$scode = $code;
$flg++;
last;
}
}
}
# 在庫切れ
if ($flg) {
my ($name) = (split(/<>/,$cart{$scode}))[1];
my $msg = "大変申し訳ありません。「$name」は在庫切れです(在庫数:$zan{$scode})<br>\n";
$msg .= "たった今、他の方からの購入があったようです\n";
error($msg);
}
# 送料
if ($postage > 0) {
# 送料サービス有り
if ($cf{cari_serv} && $cf{cari_serv} <= $all) {
$postage = 0;
$serv_flag++;
}
}
# 送料が設定されている場合
if (!$serv_flag) { $all += $postage; }
# 支払手数料が設定されている場合
if ($cost > 0) { $all += $cost; }
# 次画面用パラメータ
my $hidden;
for (qw(payment date deli name roman email zip pref addr romanaddr tel memo)) {
my $val = $in{$_};
if ($_ eq 'addr' or $_ eq 'romanaddr' or $_ eq 'memo') {
$val =~ s|<br>|\t|g;
}
$hidden .= qq|<input type="hidden" name="$_" value="$val">\n|;
}
# 消費税
my ($kei,$tax1,$tax2,$all,$tar) = calc_tax($all,$red);
for ($head, $foot) {
s/!kei!/comma($kei)/ge;
s/!tax!/comma($tax1)/ge;
s/!tax_red!/comma($tax2)/ge;
s/!all!/comma($all)/ge;
s/!postage!/comma($postage)/ge;
s/!cost!/comma($cost)/ge;
s/!(pref2?)!/$pref{$1}/g;
s/<!-- hidden -->/$hidden/g;
s/!tax_per!/$cf{tax_per}/e;
s/!red_per!/$cf{red_per}/e;
s/!tar_tax1!/comma($tar)/ge;
s/!tar_tax2!/comma($red)/ge;
if ($in{deliv} == 1) {
s|<!-- deliv -->.+?<!-- /deliv -->||s;
}
}
# 画面展開
print "Content-type: text/html; charset=utf-8\n\n";
print $head, $body;
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# 注文送信 (Step3)
#-----------------------------------------------------------
sub send_form {
# 買物情報取得
my ($cart,undef) = get_cookie();
if (@{$cart} == 0) { error("買物情報がありません"); }
# 入力確認
check_input();
# 改行変換
for ( keys %in ) {
if ($_ eq 'addr' or $_ eq 'romanaddr' or $_ eq 'memo') {
$in{$_} =~ s/\t+$//;
$in{$_} =~ s/\t/\n /g;
} else {
$in{$_} =~ s/\t//g;
}
}
# 在庫認識
my %zan = get_zan() if ($cf{stock});
# 軽減税率
my %red = read_redtax() if ($cf{tax_per} > 0);
# ホスト名/時間を取得
my $host = get_host();
my ($time,$mdate) = get_time();
$in{time} = $time;
$in{host} = $host;
# ブラウザ情報
$in{agent} = $ENV{HTTP_USER_AGENT};
$in{agent} =~ s/[<>&"']//g;
# 注文番号採番
open(DAT,"+< $cf{datadir}/num.dat") or error("open err: num.dat");
eval "flock(DAT,2);";
my $num = <DAT>;
seek(DAT,0,0);
print DAT ++$num;
truncate(DAT,tell(DAT));
close(DAT);
# 桁数調整
$in{number} = sprintf("%06d",$num);
# メール件名をMIMEエンコード
require "lib/jacode.pl";
my $msub = mime_unstructured_header("ご注文メール ($in{name}様)");
# メールヘッダー定義
my $mhead = <<EOM;
Subject: $msub
Date: $mdate
MIME-Version: 1.0
Content-type: text/plain; charset=ISO-2022-JP
Content-Transfer-Encoding: 7bit
X-Mailer: $cf{version}
EOM
# データ読み取り
my %cart = get_data();
# 買物カゴ展開
my $all = 0;
my $red = 0;
my $i = 0;
$in{order} = '';
foreach (@{$cart}) {
my ($id,$code,$num,@op) = split(/,/);
my (undef,$name,$price,undef,undef,@ops) = split(/<>/,$cart{$code});
# チェック
$id =~ s/\D//g;
$code =~ s/\W//g;
$num =~ s/\D//g;
# 小計
my $kei = $price * $num;
$all += $kei;
if ($cf{tax_per} > 0 && defined $red{$code}) { $red += $kei; }
# 在庫チェック
if ($cf{stock}) {
if ($zan{$code} - $num < 0) {
my $msg = "大変申し訳ありません。「$name」は在庫切れです(現在の在庫数:$zan{$code})<br>\n";
$msg .= "たった今、他の方からの購入があったようです\n";
error($msg);
}
$zan{$code} -= $num;
}
# 単価計算
$price = comma($price);
$kei = comma($kei);
$i++;
$in{order} .= "●ご注文内容$i\n";
$in{order} .= "コード : $code\n";
$in{order} .= "商品名 : $name\n";
# オプション処理
my @op2;
foreach my $i (0 .. $#{$cf{options}}) {
my ($key,$nam) = split(/,/,$cf{options}[$i]);
$op2[$i] = [split(/\s+/,$ops[$i])];
if ($op[$i] ne '') { $in{order} .= "[$nam] $op[$i]\n"; }
}
if ($cf{tax_per} > 0 && defined $red{$code}) { $in{order} .= "[軽減税率対象]\n"; }
$in{order} .= "金 額 : $price × $num = ￥$kei\n\n";
# オプション正当チェック
if ($cf{chk_ops} == 1) {
foreach my $i (0 .. $#{$cf{options}}) {
my $flg;
foreach my $opt (@{$op2[$i]}) {
if ($op[$i] eq $opt) {
$flg++;
last;
}
}
if ($op[$i] ne '' && !$flg) { error("属性の値が不正です"); }
}
}
}
$in{order} =~ s/\n+$//;
# セッションチェック
check_session();
# 配達時間
$in{deliv} = '';
if ($in{date} ne '') {
$in{deliv} = "$in{date} ";
if ($in{deli} ne "") {
$in{deliv} .= " ${$cf{deli}}[$in{deli}]";
}
}
# 都道府県/送料
my ($pref,$pref2);
my $postage = 0;
my ($pref,$postage) = split(/,/,${$cf{pref}}[$in{pref}]);
$in{pref} = $pref;
if ($in{pref2} ne "") {
($pref2,$postage) = split(/,/,${$cf{pref}}[$in{pref2}]);
$in{pref2} = $pref2;
}
# 支払方法の手数料
my ($pay,$cost) = split(/,/,${cf{payment}}[$in{payment}]);
my $q_pay = $in{payment};
$in{payment} = $pay;
# 県別送料
my $memo;
if ($postage > 0) {
# 送料サービス有り
$in{postage} = 0;
if ($cf{cari_serv} && $cf{cari_serv } <= $all) {
$in{postage} = $postage = 0;
$in{postage} .= ' (送料サービス)';
# 送料サービス無し
} else {
$all += $postage;
$in{postage} = comma($postage);
}
}
if ($in{postage} eq '') { $in{postage} = 0; }
# 支払手数料
$in{cost} = 0;
if ($cost > 0) {
$all += $cost;
$in{cost} = comma($cost);
}
# 消費税
my ($kei,$tax1,$tax2,$all,$tar) = calc_tax($all,$red);
# メール本文用
$in{kei} = comma($kei);
$in{all} = comma($all);
if ($cf{tax_per} == 0) {
$in{tax1} = $in{tax2} = "[内税]";
} else {
$in{tax1} = comma($tax1) . "（$cf{tax_per}%対象 ￥" . comma($tar) . "）";
$in{tax2} = comma($tax2) . "（$cf{red_per}%対象 ￥" . comma($red) . "）";
}
# メール本文テンプレート読出（管理者宛）
open(IN,"$cf{tmpldir}/order.txt") or error("open err: order.txt");
my $body_ord = join('',<IN>);
close(IN);
# オーダー本文テンプレート読出（注文者宛）
open(IN,"$cf{tmpldir}/reply.txt") or error("open err: reply.txt");
my $body_rep = join('',<IN>);
close(IN);
# 文字置き換え
$body_ord =~ s/!(\w+)!/$in{$1}/g;
$body_rep =~ s/!(\w+)!/$in{$1}/g;
# ログ用
my $log = $body_ord;
# コード変換
my $tmp_body;
for my $tmp ( split(/\n/,$body_ord) ) {
jcode::convert(\$tmp,'jis','utf8');
$tmp_body .= "$tmp\n";
}
$body_ord = $tmp_body;
my $tmp_body;
for my $tmp ( split(/\n/,$body_rep) ) {
jcode::convert(\$tmp,'jis','utf8');
$tmp_body .= "$tmp\n";
}
$body_rep = $tmp_body;
# タグ復元
$body_ord = tag_chg($body_ord);
$body_rep = tag_chg($body_rep);
# sendmailコマンド定義
my $scmd1 = "$cf{sendmail} -t -i";
my $scmd2 = "$cf{sendmail} -t -i";
if ($cf{sendm_f} == 1) {
$scmd1 .= " -f $in{email}";
$scmd2 .= " -f $cf{master}";
}
# 管理者へ送信
open(MAIL,"| $scmd1") or error("メール送信失敗");
print MAIL "To: $cf{master}\n";
print MAIL "From: $in{email}\n";
print MAIL "$mhead\n";
print MAIL "$body_ord\n";
close(MAIL);
# 注文者へ送信
open(MAIL,"| $scmd2") or error("メール送信失敗");
print MAIL "To: $in{email}\n";
print MAIL "From: $cf{master}\n";
print MAIL "$mhead\n";
print MAIL "$body_rep\n";
close(MAIL);
# 買物情報のクッキー消去
del_cookie();
# 在庫数更新
if ($cf{stock}) {
my @data;
while ( my ($id,$zan) = each %zan ) {
push(@data,"$id<>$zan<>\n");
}
open(OUT,"> $cf{datadir}/stock.dat") or error("write err: stock.dat");
eval "flock(OUT,2);";
print OUT @data;
close(OUT);
}
# ログ保存
save_log($time,$in{number},$log);
# テンプレート判別
my $zeus_num;
my $tmplfile = "send.html";
# クレジット
if (($cf{zeus_serv} == 1 && $q_pay == $#{$cf{payment}})
or ($cf{zeus_serv} == 2 && $q_pay == $#{$cf{payment}}-1)
or ($cf{zeus_serv} == 3 && $q_pay == $#{$cf{payment}}-1)
or ($cf{zeus_serv} == 4 && $q_pay == $#{$cf{payment}}-2)) {
$tmplfile = "send-credit.html";
$zeus_num = $cf{zeus_num};
# 銀行
} elsif (($cf{zeus_serv} == 2 && $q_pay == $#{$cf{payment}})
or ($cf{zeus_serv} == 4 && $q_pay == $#{$cf{payment}}-1)) {
$tmplfile = "send-bank.html";
$zeus_num = $cf{zeus_bip};
# コンビニ
} elsif (($cf{zeus_serv} == 3 && $q_pay == $#{$cf{payment}})
or ($cf{zeus_serv} == 4 && $q_pay == $#{$cf{payment}})) {
$tmplfile = "send-conv.html";
$zeus_num = $cf{zeus_cip};
}
# 完了画面
open(IN,"$cf{tmpldir}/$tmplfile") or error("open err: $tmplfile");
my $tmpl = join('',<IN>);
close(IN);
# 文字置換
$tmpl =~ s/!home!/$cf{home}/g;
$tmpl =~ s/!cmnurl!/$cf{cmnurl}/g;
# ゼウス用
my $money = $all;
if ($cf{zeus_serv} > 0) {
$in{tel} =~ s/\D//g;
$tmpl =~ s/!zeus_num!/$zeus_num/g;
$tmpl =~ s/!money!/$money/g;
$tmpl =~ s/!tel!/$in{tel}/g;
$tmpl =~ s/!email!/$in{email}/g;
$tmpl =~ s/!sendid!/$in{number}/g;
}
$tmpl =~ s/!order_cgi!/$cf{order_cgi}/g;
# 表示
print "Content-type: text/html; charset=utf-8\n\n";
footer($tmpl);
}
#-----------------------------------------------------------
# 時間取得
#-----------------------------------------------------------
sub get_time {
my ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0..6];
my @week = qw|Sun Mon Tue Wed Thu Fri Sat|;
my @mon = qw|Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec|;
# 日時フォーマット
my $date = sprintf("%04d/%02d/%02d(%s) %02d:%02d:%02d",
$year+1900,$mon+1,$mday,$week[$wday],$hour,$min,$sec);
# メール用フォーマット
my $mdate = sprintf("%s, %02d %s %04d %02d:%02d:%02d",
$week[$wday],$mday,$mon[$mon],$year+1900,$hour,$min,$sec) . " +0900";
return ($date,$mdate);
}
#-----------------------------------------------------------
# ホスト名取得
#-----------------------------------------------------------
sub get_host {
my $host = $ENV{REMOTE_HOST};
my $addr = $ENV{REMOTE_ADDR};
if ($cf{gethostbyaddr} && ($host eq "" || $host eq $addr)) {
$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
}
$host ||= $addr;
return $host;
}
#-----------------------------------------------------------
# ログ保存
#-----------------------------------------------------------
sub save_log {
my ($date,$num,$log) = @_;
# 改行置き換え
$log =~ s/\n/\t/g;
$log =~ s/ +/ /g;
# ログファイル名を定義
my $file = ($date =~ /^(\d{4})\/(\d{2})/) && "$1$2.cgi";
# 存在チェック
my $flg;
if (-e "$cf{datadir}/log/$file") { $flg++; }
# ログ追加書き込み
open(DAT,">> $cf{datadir}/log/$file") or error("write err: $file");
eval "flock(DAT, 2);";
print DAT "$date<>$num<>$log\n";
close(DAT);
# 新規生成の場合はパーミッション付与
chmod(0666, "$cf{datadir}/log/$file") if (!$flg);
}
#-----------------------------------------------------------
# 入力チェック
#-----------------------------------------------------------
sub check_input {
# 改行末尾をカット
$in{addr} =~ s/\t+$//g;
$in{romanaddr} =~ s/\t+$//g;
$in{memo} =~ s/\t+$//g;
# 入力確認
my %er;
if ($in{payment} eq '') { $er{payment} = '支払方法が未選択です'; }
if ($in{date} ne '') {
if ($in{date} =~ m|^(\d+)/(\d+)/(\d+)|) {
my ($yr,$mon,$day) = ($1,$2,$3);
my ($d,$m,$y) = (localtime())[3..5];
my $date = sprintf("%04d%02d%02d",$y+1900,$m+1,$d);
if ("$yr$mon$day" < $date) { $er{date} = '配達日は今日以降を指定してください'; }
} else {
$er{date} = '配達日は「年/月/日」で入力してください';
}
}
if ($in{name} eq '') { $er{name} = '名前が未入力です'; }
if ($in{roman} eq '') { $er{roman} = 'ローマ字名前が未入力です'; }
if ($in{email} !~ /^[\w\.\-]+\@[\w\.\-]+\.[a-zA-Z]{2,6}$/) { $er{email} = '電子メールの入力が不正です'; }
if ($in{zip} !~ /^\d{3}-?\d{4}$/) { $er{zip} = '郵便番号は「数字7桁」か「数字3桁-4桁」です'; }
if ($in{pref} eq '' or $in{addr} eq '') { $er{addr} = '住所が未入力です'; }
if ($in{pref} eq '' or $in{romanaddr} eq '') { $er{romanaddr} = 'ローマ字住所が未入力です'; }
if ($in{tel} eq '') { $er{tel} = '電話番号が未入力です'; }
if ($in{deliv} == 2) {
if ($in{name2} eq '') { $er{name2} = '配送先の名前が未入力です'; }
if ($in{zip2} !~ /^\d{3}-?\d{4}$/) { $er{zip2} = '配送先の郵便番号は「数字7桁」か「数字3桁-4桁」です'; }
if ($in{pref2} eq '' or $in{addr2} eq '') { $er{addr2} = '配送先の住所が未入力です'; }
if ($in{tel2} eq '') { $er{tel2} = '配送先の電話番号が未入力です'; }
} else {
$in{name2} = $in{kana2} = $in{zip2} = $in{addr2} = $in{pref2} = $in{tel2} = $in{fax2} = '';
}
if (%er != 0) { addr_form(%er); }
}
#-----------------------------------------------------------
# タグ復元
#-----------------------------------------------------------
sub tag_chg {
local($_) = @_;
s/</</g;
s/>/>/g;
s/"/"/g;
s/&/&/g;
$_;
}
#-----------------------------------------------------------
# 顧客情報暗号化
#-----------------------------------------------------------
sub encrypt_cust {
my @cust = @_;
my @ret;
foreach (@cust) {
my $encrypt = RC4($cf{passphrase}, $_);
$encrypt =~ s/(.)/unpack('H2', $1)/eg;
push(@ret,$encrypt);
}
return @ret;
}
#-----------------------------------------------------------
# 顧客情報復号化
#-----------------------------------------------------------
sub decrypt_cust {
my @cust = @_;
my @ret;
foreach (@cust) {
s/([0-9A-Fa-f]{2})/pack('H2', $1)/eg;
my $decrypt = RC4($cf{passphrase}, $_);
$decrypt =~ s/[&"'<>]//g;
push(@ret,$decrypt);
}
return @ret;
}
#-----------------------------------------------------------
# クッキー消去
#-----------------------------------------------------------
sub del_cookie {
print "Set-Cookie: $cf{cookie_cart}=; expires=Thu, 01-Jan-1970 00:00:00 GMT;\n";
}
#-----------------------------------------------------------
# クッキー発行
#-----------------------------------------------------------
sub set_cookie {
my @data = @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,undef,undef) = gmtime(time + 60*24*60*60);
my @mon = qw|Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec|;
my @week = qw|Sun Mon Tue Wed Thu Fri Sat|;
# 時刻フォーマット
my $gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
$week[$wday],$mday,$mon[$mon],$year+1900,$hour,$min,$sec);
# URLエンコード
my $cook;
foreach (@data) {
s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
$cook .= "$_<>";
}
print "Set-Cookie: $cf{cookie_cust}=$cook; expires=$gmt;";
print " secure" if ($cf{ssl_cookie});
print "\n";
}
#-----------------------------------------------------------
# クッキー取得
#-----------------------------------------------------------
sub get_cookie {
# クッキー取得
my $cook = $ENV{HTTP_COOKIE};
# 該当IDを取り出す
my %cook;
for ( split(/;/,$cook) ) {
my ($key,$val) = split(/=/);
$key =~ s/\s//g;
$cook{$key} = $val;
}
# URLデコード
my (@cart,@cook);
for ( split(/<>/,$cook{$cf{cookie_cart}}) ) {
s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("H2",$1)/eg;
s/[&"'<>]//g;
push(@cart,$_);
}
for ( split(/<>/,$cook{$cf{cookie_cust}}) ) {
s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("H2",$1)/eg;
s/[&"'<>]//g;
push(@cook,$_);
}
return (\@cart,\@cook);
}
#-----------------------------------------------------------
# 在庫数認識
#-----------------------------------------------------------
sub get_zan {
my %zan;
open(IN,"$cf{datadir}/stock.dat") or error("open err: stock.dat");
while (<IN>) {
my ($id,$zan) = split(/<>/);
$zan{$id} = $zan;
}
close(IN);
return %zan;
}
#-----------------------------------------------------------
# セッション作成
#-----------------------------------------------------------
sub make_session {
# 生成
my @wd = (0 .. 9, 'a' .. 'z', 'A' .. 'Z', '_');
my $ses;
for (1 .. 25) { $ses .= $wd[int(rand(@wd))]; }
# 更新
my $now = time;
open(DAT,">> $cf{datadir}/ses.dat") or error("write err: ses.dat");
eval "flock(DAT,2);";
print DAT "$now\t$ses\n";
close(DAT);
return $ses;
}
#-----------------------------------------------------------
# セッション確認
#-----------------------------------------------------------
sub check_session {
my $now = time;
my ($flg,@log);
open(DAT,"+< $cf{datadir}/ses.dat") or error("open err: ses.dat");
eval "flock(DAT,2);";
while(<DAT>) {
chomp;
my ($time,$id) = split(/\t/);
next if ($now - $time > 3600); # 60分以上はスキップ
if ($in{ses} eq $id) {
$flg++;
next;
}
push(@log,"$_\n");
}
seek(DAT,0,0);
print DAT @log;
truncate(DAT,tell(DAT));
close(DAT);
if (!$flg) {
my $msg = "画面表示後一定時間が経過したため、下記のリンクから再度やり直してください\n";
$msg .= qq|<p><a href="$cf{order_cgi}?mode=addr&back=$in{back}">注文者情報入力</a></p>\n|;
error($msg);
}
}
#-----------------------------------------------------------
# mimeエンコード
# [quote] http://www.din.or.jp/~ohzaki/perl.htm#JP_Base64
#-----------------------------------------------------------
sub mime_unstructured_header {
my $oldheader = shift;
jcode::convert(\$oldheader,'euc','utf8');
my ($header,@words,@wordstmp,$i);
my $crlf = $oldheader =~ /\n$/;
$oldheader =~ s/\s+$//;
@wordstmp = split /\s+/, $oldheader;
for ($i = 0; $i < $#wordstmp; $i++) {
if ($wordstmp[$i] !~ /^[\x21-\x7E]+$/ and
$wordstmp[$i + 1] !~ /^[\x21-\x7E]+$/) {
$wordstmp[$i + 1] = "$wordstmp[$i] $wordstmp[$i + 1]";
} else {
push(@words, $wordstmp[$i]);
}
}
push(@words, $wordstmp[-1]);
foreach my $word (@words) {
if ($word =~ /^[\x21-\x7E]+$/) {
$header =~ /(?:.*\n)*(.*)/;
if (length($1) + length($word) > 76) {
$header .= "\n $word";
} else {
$header .= $word;
}
} else {
$header = add_encoded_word($word, $header);
}
$header =~ /(?:.*\n)*(.*)/;
if (length($1) == 76) {
$header .= "\n ";
} else {
$header .= ' ';
}
}
$header =~ s/\n? $//mg;
$crlf ? "$header\n" : $header;
}
sub add_encoded_word {
my ($str, $line) = @_;
my $result;
my $ascii = '[\x00-\x7F]';
my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
while (length($str)) {
my $target = $str;
$str = '';
if (length($line) + 22 +
($target =~ /^(?:$twoBytes|$threeBytes)/o) * 8 > 76) {
$line =~ s/[ \t\n\r]*$/\n/;
$result .= $line;
$line = ' ';
}
while (1) {
my $encoded = '=?ISO-2022-JP?B?' .
b64encode(jcode::jis($target,'euc','z')) . '?=';
if (length($encoded) + length($line) > 76) {
$target =~ s/($threeBytes|$twoBytes|$ascii)$//o;
$str = $1 . $str;
} else {
$line .= $encoded;
last;
}
}
}
$result . $line;
}
# [quote] http://www.tohoho-web.com/perl/encode.htm
sub b64encode {
my $buf = shift;
my ($mode,$tmp,$ret);
my $b64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
. "abcdefghijklmnopqrstuvwxyz"
. "0123456789+/";
$mode = length($buf) % 3;
if ($mode == 1) { $buf .= "\0\0"; }
if ($mode == 2) { $buf .= "\0"; }
$buf =~ s/(...)/{
$tmp = unpack("B*", $1);
$tmp =~ s|(......)|substr($b64, ord(pack("B*", "00$1")), 1)|eg;
$ret .= $tmp;
}/eg;
if ($mode == 1) { $ret =~ s/..$/==/; }
if ($mode == 2) { $ret =~ s/.$/=/; }
return $ret;
}
| 記事No | ： 16818 |
| 投稿日 | ： 2022/04/22(Fri) 08:53:12 |
| タイトル | ： 禁止されている行為です! |
| ID情報 | ： passerby |
| 投稿者 | ： 通りすがり |
CGIプログラムの丸ごと貼り付けは禁止されている行為です。
「.txt」ファイルに変換してサーバーにupし、そのアドレスを記載して下さい。
| 記事No | ： 16819 |
| 投稿日 | ： 2022/04/22(Fri) 12:13:18 |
| タイトル | ： htmlに載せると文字化けしちゃいます |
| ID情報 | ： tmhk0722 |
| 投稿者 | ： tomo |
| URL | ： http://bodyvine.sakura.ne.jp/cgi.html |
どうやって公開すれば良いでしょうか…
すみません…
| 記事No | ： 16820 |
| 投稿日 | ： 2022/04/22(Fri) 12:20:55 |
| タイトル | ： Re: htmlに載せると文字化けしちゃいます |
| ID情報 | ： passerby |
| 投稿者 | ： 通りすがり |
> どうやって公開すれば良いでしょうか…
> すみません…
No.16818の記事を読み返して下さい。
回答はそこに記載しました。
もう一度言うと、
拡張子「.cgi」ファイルを拡張子「.txt」に変換して
サーバーにupして、そのアドレス(URL)を記載して下さい。
※エディターでcgiファイルを開き、「名前をつけて保存」にある
ファイルの種類をテキストを選択して保存します。
| 記事No | ： 16821 |
| 投稿日 | ： 2022/04/22(Fri) 12:32:46 |
| タイトル | ： Re^2: htmlに載せると文字化けしちゃいます |
| ID情報 | ： tmhk0722 |
| 投稿者 | ： tomo |
| URL | ： http://bodyvine.sakura.ne.jp/cgi.html |
ご忠告＆ご説明、ありがとうございます。
無事、修正できました。
ここでDLしたデータなので、貼り付けが禁止されているとは思いませんでした。
大変失礼しました。以後、気を付けます。
今後の方達のためにも記載させて頂くと、
2022/04/05(Tue) 13:59:37にhirayama様が他の方にアドバイスされていた
order.cgi 525行目の
require "lib/jacode.pl";
を
require "./lib/jacode.pl";
と変更してみてください。
という部分が私も同じでした。