• 締切済み

ショッピングカートのカスタマイズ

WEB寺小屋のショッピングカートで当サイトは、現在サポートしていないようで、商品登録する際のサブルーチン処理は 下記です。下記のソースで「id_num」が同じ場合、単純にエラーを返す場合は、どのように返したら分かりません。 わかるかた教えて下さい。ちなみに下記はオリジナルソースで3行目と6行目は同じ処理をしています。 どちらか、削除しても問題ないでしょうか? sub goods_regist { if ( $in{'id'} eq '' ) { &error ('エラー','IDが未選択です'); } if ( $in{'id_num'} eq '' ) { &error ('エラー','商品個別番号が未入力です'); } if ( $in{'goods'} eq '' ) { &error ('エラー','商品名が未入力です'); } if ( $in{'tanka'} eq '' ) { &error ('エラー','商品単価が未入力です'); } if ( $in{'id_num'} eq '' ) { &error ('エラー','商品個別番号が未入力です'); } if ( $in{'ad_amount'} eq 'text' && $in{'ad_amount2'} eq '' ) { &error ('エラー','個数設定が不正です'); } if ( $in{'ad_amount'} eq 'list' && $in{'ad_amount3'} eq '' ) { &error ('エラー','個数設定が不正です'); } $goods_data = "$goods_dir/$in{'id'}.cgi"; open (DATA,"$goods_data") || &error('オープンエラー','商品データファイルが開けません。'); @LINES = <DATA>; close (DATA); $count = @LINES; if ( $count == 0 ) { $num = 1; } else { @lists = $LINES[-1]; $num = $lists[0]; $num = $num + 1; } #if ( $in{'id_num'} != $num ) { &error ('エラー','商品個別番号が間違っています'); } &lock2; open (OUT,">>$goods_data") || &error('オープンエラー','メール設定ファイルが開けません。'); print OUT "$num\t$date_now\t$in{'id'}\t$in{'id_num'}\t$in{'goods'}\t$in{'tanka'}\t"; print OUT "$in{'ad_amount'}\t$in{'ad_amount2'}\t$in{'ad_amount3'}\t$in{'rem'}\t\n"; close (OUT);

  • Perl
  • 回答数4
  • ありがとう数0

みんなの回答

回答No.4

admin.cgi をみてみました。 1) 商品登録フォームに情報を入力し、submit すると、admin.cgi の goods_regist サブルーチンが呼び出される。 2) 管理者は、商品登録のたびに、毎回、登録フォームで商品IDを手入力する 3) 登録された商品情報は、$in{'id'}.cgi というファイルの最後の行に1行追加される。 問題は、 「すでに登録されている商品IDを入力しても、登録されてしまう」 ということでよろしいでしょうか。 これを防ぐには、2つのアプローチが考えられます。 1. 登録者が、毎回最新の商品IDを確認して、すでに登録されている商品IDを入力してしまわないようにする。 「*最新のIDは、こちらで検索して確かめてください。」というところから 2. 登録者が商品IDを入力するのではなく、プログラム内で商品IDを自動に割り当てるようにする。 プログラムで、IDを, 001, 002, 003, ... のようにカウントアップしていく、ということです。

回答No.3

[2] SHOP SYSTEM Final Type1 ​http://www.web-terakoya.net/library/doc/shopv1.html​ のshop.cgi をながめてみましたが、質問での goods_regist というサブルーチンはありませんし、似たような記述も見あたらないようなのです。

semuji
質問者

補足

申し訳ございません。 shop.cgiではなくadmin.cgiです。 ちゃんとした補足でなくて申し訳ございません。 233行目付近のコードなのですが・・・・ お手数おかけしますが、ご回答願えればと思います。 よろしくお願いします。困ってます。

回答No.2

「Web寺子屋」(www.web-terakoya.net) には、ショッピングカートのCGIがいろんなタイプがあるようですが、どのタイプなのでしょうか? プログラム全体をみてみないと、ここのサブルーチンでやりたい処理ができるかどうかは、わかりません。

semuji
質問者

補足

[2] SHOP SYSTEM Final Type1です。 http://www.web-terakoya.net/library/doc/shopv1.html のshop.cgiファイルです。 ご回答お願いします。

  • moon_night
  • ベストアンサー率32% (598/1831)
回答No.1

>「id_num」が同じ場合、 意味が不明です。「id_num」と何が同じになるのでしょうか? >ちなみに下記はオリジナルソースで3行目と6行目は同じ処理をしています。 >どちらか、削除しても問題ないでしょうか? 問題ありません。 エラーを返したい場合は &error ('エラー','XXXが間違っています'); とすればいいです。

semuji
質問者

補足

説明不足ですいません。 「id_num」が同じ場合というのは、商品登録画面上で、商品番号が登録できます。id_numに商品番号が入ります。 現在の仕様では、重複して登録できてしまいますので、防止させるためです。ここのサブルーチン処理ではできないのでしょうか? よろしくお願いします。

関連するQ&A

  • 同名ID、同名画像ファイル名があったらエラー表示

    CGI勉強中です。既に同名の商品id_num及び画像ファイル名gazouが存在する場合、エラー表示する場合、コードの書き方がわかりません。 教えて下さい。 --------------------------------------------------------------- # 商品登録処理 sub goods_regist { if ( $in{'id'} eq '' ) { &error ('エラー','IDが未選択です'); } if ( $in{'id_num'} eq '' ) { &error ('エラー','商品個別番号が未入力です'); } if ( $in{'goods'} eq '' ) { &error ('エラー','商品名が未入力です'); } if ( $in{'tanka'} eq '' ) { &error ('エラー','商品単価が未入力です'); } if ( $in{'id_num'} eq '' ) { &error ('エラー','商品個別番号が未入力です'); } if ( $in{'ad_amount'} eq 'text' && $in{'ad_amount2'} eq '' ) { &error ('エラー','個数設定が不正です'); } if ( $in{'ad_amount'} eq 'list' && $in{'ad_amount3'} eq '' ) { &error ('エラー','個数設定が不正です'); } $goods_data = "$goods_dir/$in{'id'}.cgi"; open (DATA,"$goods_data") || &error('オープンエラー','商品データファイルが開けません。'); @LINES = <DATA>; close (DATA); $count = @LINES; if ( $count == 0 ) { $num = 1; } else { @lists = $LINES[-1]; $num = $lists[0]; $num = $num + 1; } &lock2; open (OUT,">>$goods_data") || &error('オープンエラー','メール設定ファイルが開けません。'); print OUT "$num\t$date_now\t$in{'id'}\t$in{'id_num'}\t$in{'goods'}\t$in{'tanka'}\t"; print OUT "$in{'ad_amount'}\t$in{'ad_amount2'}\t$in{'ad_amount3'}\t$in{'rem'}\t\n"; close (OUT); # 画像アップロード処理 ################ $filename = $in{'gazou'}; $gif = 1; $jpeg = 1; $macbin=0; foreach (@in) { if ($_ =~ /(.*)Content-type:(.*)\/(.*)/i) { $tail=$3; } if ($_ =~ /(.*)gazou=(.*)/i) { $fname=$2; } if ($_ =~ /application\/x-macbinary/i) { $macbin=1; } } $tail =~ s/\r//g; $tail =~ s/\n//g; $filename =~ s/\"//g; $flag=0; if ($image_up eq '0') { $flag=1; } if ($tail =~ /gif/i && $gif) { $tail=".gif"; $flag=1; } if ($tail =~ /jpeg/i && $jpeg) { $tail=".jpg"; $flag=1; } if (!$flag) { if ($fname =~ /.gif/i && $gif) { $tail=".gif"; $flag=1; } if (($fname =~ /.jpg/i && $jpeg) || ($fname =~ /.jpeg/i && $jpeg)) { $tail=".jpg"; $flag=1; } } if (!$flag) { &error("アップロードできないファイル形式です","lock"); } $upfile = $in{'gazou'};

  • データ削除方法について

    現在以下のプログラムでデータを削除しています。 (ここから) print "Content-type: text/html\n\n"; open(IN,"<$memfile") || &error("Can't write $memfile"); flock(IN, 2); @lines = <IN>; foreach $lines (@lines) { ($seq,$name) = split("<>", $lines); if("$del" eq "$seq"){ next; }else{ $data .= $lines; } } close IN; open OUT, "> $memfile"; flock OUT, 2; print OUT $data; close OUT; print "<html>完了しました<br><a href=?mode=menu>戻る</a></body></html>"; exit; (ここまで) このプログラムでも削除出来るのですが、foreachの処理で対応するとパフォーマンスが悪いのかな? と思ってます。(ハッキリとはわかりません) 件数が多くなるとサーバーエラーになるのかな?と思ってます。 もっと効率の良い方法がありましたらと思い質問いたしました。 perlを独学で学んでいるので、見る人が見ると変なつくりだと思ってます。 以上、よろしくお願いいたします。

    • ベストアンサー
    • Perl
  • CGIROOMさんのデータベース機能について、管理者と連絡取りたい

    CGIROOMさんのデータベース機能について、管理者と連絡取りたい。 また、簡易高機能検索専用データベース ソート版(http://cgiroom.nu/list/database/database2s/)と、database.cgi用 データエディタ(http://cgiroom.nu/list/database/dataedit/index.htm)を併用して利用しているのですが、データファイルの容量が300k以上になると、エラーが表示されてしまうのですが、これを解除する方法をどなたか教えていただけませんか? ソースデータ if($FORM{'cmd'} eq "edit" && $FORM{'line'}){ &error('300k以上あるデータは修正できません') if -s $FILE > 01234567; open(IN,$FILE) || &error('データファイルを開けません'); @data = <IN>; close(IN); if($FORM{'write'}){ &error('行指定が不正です') if $FORM{'line'} =~ /\D/; $data[$FORM{'line'} - 1] = join("\t",@line[1..$#line],"\n"); open(OUT,">".$FILE)|| &error('データファイルを更新できません'); print OUT @data; close(OUT); &msg('更新しました'); } @data = split(/\t/,"\t".$data[$FORM{'line'} - 1]); &error('指定されたデータは存在しません') unless @data; open(HTML,$FORM)||&error('フォームファイルを開けません'); read(HTML,$html,-s HTML); close(HTML); $html =~ s/__(cmd|line)__/$FORM{$1}/g; $html =~ s/__data(\d+)([a-zA-Z]*)__/&tag($data[$1],$2)/eg; &html(\$html); }elsif($FORM{'cmd'} eq "new"){ &error('300k以上あるデータは修正できません') if -s $FILE > 01234567; if($FORM{'write'}){ if($unshift){ open(IN,$FILE) || &error('データファイルを開けません'); @data = <IN>; close(IN); open(OUT,">".$FILE)|| &error('データファイルを更新できません'); print OUT join("\t",@line[1..$#line],"\n"),@data; close(OUT); }else{ open(OUT,">>".$FILE)|| &error('データファイルを更新できません'); print OUT join("\t",@line[1..$#line],"\n"); close(OUT); } &msg('データを追加しました'); } open(HTML,$FORM)||&error('フォームファイルを開けません'); read(HTML,$html,-s HTML); close(HTML); $html =~ s/__cmd__/$FORM{'cmd'}/g; $html =~ s/__data\d+[a-zA-Z]*__//g; &html(\$html); }elsif($FORM{'cmd'} eq "delete" && $FORM{'line'}){ &error('300k以上あるデータは修正できません') if -s $FILE > 01234567; &error('行指定が不正です') if $FORM{'line'} =~ /\D/; open(IN,$FILE) || &error('データファイルを開けません'); @data = <IN>; close(IN); &error('指定されたデータは存在しません') unless $data[$FORM{'line'} - 1]; undef $data[$FORM{'line'} - 1]; open(OUT,">".$FILE)|| &error('データファイルを更新できません'); print OUT @data; close(OUT); &msg('指定されたデータを削除しました'); } どこを修正すればいいのでしょうか?

  • 一致する文字としない文字があるのですが

    会員のログイン等で、氏名(漢字)と生年月日でログインするように してあるのですが、「眞」や「はしご高」などの文字が、 フォームで渡ってきた場合に、 データと一致しなくエラーとなってしまいます。 if (!open(IN,"$file")) { &error('データベースエラー','.'); } @BASE = <IN>; $all = @BASE; close(IN); if ($FORM{'FF'} eq '') { $FF = 0; } else { $FF = $FORM{'FF'}; } $TO = $FF + $page - 1; if ($TO > $#BASE) { $TO = $#BASE; } $hit = 0; $next_num = ''; foreach $num ($FF .. $#BASE) { $data = $data2 = $BASE[$num]; &jcode'convert(*data,'euc'); ($d,$NO,$REM,$DATE,$NAME,$EMAIL,$PMAIL,$AGE,$SEX,$PREF) = split(/\,/,$data); # 名前(一致) if ($NAME5 ne 'dadada') { if ($NAME eq $FORM{'NAME'} ) { ; } else { next; } } # 生年月日(一致) if ($AGE5 ne 'kakak') { if ($AGE eq $FORM{'AGE'} ) { ; } else { next; } } # 検索終了処理 if ($hit == $page) { $next_num = $num; last; } else { push(@NEW,$data2); $hit++; } } と検索の部分はなっております。 エラーが出る漢字は少ないのですが、 ログインできないお客様がいて困っています。 なにか対処方法はございますでしょうか? 何卒、宜しくお願い致します。

    • 締切済み
    • CGI
  • ロック処理について

    ロック処理について my$id="abc"; open(IN,"file"); while(<IN>){ my ($cid) = split(/\,/); if($cid eq $id){&error;} } close(IN); open(OUT,">>$file"); print "$id,$pass\n"; close(OUT); いままで上記のような書き方でも普通にロック機構を使っていたのですが、 ふと、追加書込みなら必要ないのではと思い至りました。 上記のようにファイルに追加書込みする場合は、ロックは必要ないのでしょうか?

    • ベストアンサー
    • Perl
  • Socketに関して

    SocketでURLで指定されたバナーを一旦ダウンロードし、 画像サイズを取得するプログラムなのですが、 以下のソースでは、画像が存在するURLを指定しても 「バナ-画像が存在しません。バナ-URLを確認してください。」 となってしまいます。 どこが不具合なのか分かる方がいらっしゃれば教えて頂けないでしょうか? サーバーは「land.to」です。 use Socket; sub GetBannerSize{ #バナ-サイズ取得(sock接続) my ( $url ) = @_; my ( $host, $port, $path, $dir, $file, $base, $ext, $width, $height, $ipaddr, $sockaddr, $tmpimg, $data ); $url =~ /(http:)?(\/\/)?([^:\/]*)?(:([0-9]+))?(\/.*)?/; $host = $3; if ($host eq "" || $host eq $ENV{'SERVER_NAME'}) {$host = 'localhost';} $path = $6; if ($path eq "") {$path = '/';} if ($path =~ /(.*)\/(.*)/) { $dir = $1.'/'; $file = $2; } else { $dir = './'; $file = $path; } if ($file =~ /(.*)\.(.*)/) { $base = $1; $ext = $2; } else { # 拡張子なし $base = $file; $ext = ""; } $port = getservbyname("http", "tcp"); $ipaddr = inet_aton($host) || &error("host($host) not found."); $sockaddr = pack_sockaddr_in($port, $ipaddr); socket(SOCK, PF_INET, SOCK_STREAM, 0) || &error("socket error."); connect(SOCK, $sockaddr) || &error("connect $host $port error."); select(SOCK); $|=1; select(STDOUT); print SOCK << "END_OF_DOC"; GET $path HTTP/1.0 Host:$host Connection:close END_OF_DOC while(<SOCK>){ last if m/^\r\n$/; } $tmpimg = ""; if ($ext eq "gif") { $tmpimg = "./temp/tmp.gif"; }elsif ($ext eq "jpg" || $ext eq "jpeg") { $tmpimg = "./temp/tmp.jpg"; }elsif ($ext eq "png") { $tmpimg = "/temp/tmp.png"; }else{ &error("画像形式が正しくありません。"); } open(OUT,">$tmpimg"); while (<SOCK>) { if ($_ =~ /<HTML>/i) { &error("バナ-画像が存在しません。バナ-URLを確認してください。"); } print OUT $_; } close(OUT); close SOCK; $width = 0; $height = 0; if ($ext eq "gif") { open(IN,"$tmpimg") || return (0,0); binmode(IN); sysread(IN,$data,10); close(IN); if ($data =~ /^GIF/) { $data = substr($data,-4); } $width = unpack("v",substr($data,0,2)); $height = unpack("v",substr($data,2,2)); } elsif ($ext eq "jpg" || $ext eq "jpeg") { local($t, $m, $c, $l); open(IN,"$tmpimg") || return (0,0); binmode(IN); read(IN, $t, 2); while (1) { read(IN, $t, 4); ($m, $c, $l) = unpack("a a n", $t); if ($m ne "\xFF") { $W = $H = 0; last; } elsif ((ord($c) >= 0xC0) && (ord($c) <= 0xC3)) { read(IN, $t, 5); ($height, $width) = unpack("xnn", $t); last; } else { read(IN, $t, ($l - 2)); } } close(IN); } elsif ($ext eq "png") { open(IN,"$tmpimg") || return (0,0); binmode(IN); read(IN, $data, 24); close(IN); $width = unpack("N", substr($data, 16, 20)); $height = unpack("N", substr($data, 20, 24)); } unlink $tmpimg; return( $width, $height ); }

  • アンケートフォームの設定について

    質問が1-1、1-2、1-3とあるのですが、その1-1質問中で「はい」と答えた方のみ1-2へ、更に1-2でも「はい」と答えた方が1-3まで回答いただく設定にし、1-1で「いいえ」と答えれば、次の1-2以降は答えなくても良いようにするにはどのようにすればよいのでしょうか?※csvデータ「いいえ」の回答の際は1-1 いいえ、1-2、1-3はブランクとなるような設定が理想ですが。 省略 # form.htmlよりデータを変数に代入 $d[0]=$in{'name'}; $d[1]=$in{'sex'}; $d[2]=$in{'age'}; $d[3]=$in{'q1-1'}; $d[4]=$in{'q1-2'}; $d[5]=$in{'q1-3'}; $d[6]=$in{'q2-1'}; $d[7]=$in{'q2-2'}; $d[8]=$in{'q2-3'}; # 未入力チェック  if($d[0] eq ""){$error[0]="名前入力";} if($d[1] eq ""){$error[1]="性別を入力";} if($d[2] eq ""){$error[2]="年齢を入力";} if($d[3] eq ""){$error[3]="質問1-1を入力";} if($d[4] eq ""){$error[4]="質問1-2を入力";} if($d[5] eq ""){$error[5]="質問1-3を入力";} if($d[6] eq ""){$error[6]="質問2-1を入力";} if($d[7] eq ""){$error[7]="質問2-2を入力";} if($d[8] eq ""){$error[8]="質問2-3を入力";} # データをカンマ区切りにしてdata.csvに保存 $data=join(",",$d[0],$d[1],$d[2],$d[3],$d[4],$d[5],$d[6],$d[7],$d[8])."\n"; open(FH,">>./data.csv"); print FH $data; close FH; 省略

    • 締切済み
    • CGI
  • レコードの書込み判断

    ファイルを読込み、読込まれたレコードの39桁目が0であれば出力という判断を下記のコーディングに追加したいのですが、どのように記述すればよいでしょうか? if(open(OUT,">$year$mon$mday$csv")){  for my $fname (sort @dirs){   if(open(IN,"$fname")){   my @lines = <IN>;   print OUT @lines;   close(IN);   }  }  close(OUT); }

  • ログファイルの指定行に書込み

    open(IN,"$log") || &error("Open Error"); @data = <IN>; close(IN); while (100 <= @data) { pop(@data); } open(OUT,">$log") || &error("Write Error"); print OUT "$in{'id'}<>$in{'comment'}\n"; print OUT @data; close(OUT); ログにはID、時間、コメントが登録されています。 送信データの中に、ログに登録済みのIDがある場合には、そのIDのある行のみを書き換えたいのですが、方法がどうしてもわかりません。 $logに記録されるIDの順番は以下のようにランダムです。IDに登録される文字列は1からの数値のみです。 52<>コメント 120<>コメント 35<>コメント 8<>コメント 2<>コメント 19<>コメント 85<>コメント よろしくお願いいたします。

    • ベストアンサー
    • Perl
  • perlでファイルのデータの一部を削除したい

    久しぶりにPerlを操作してファイルのデータの一部を削除したいのですが、削除出来ずに困っております。 3年以上触っていないため、過去のファイル等々を見ながらやってましたが、結果は出来ずじまいで停滞して困っております。 ご指導いただけないかと思い、書き込みしました。 ファイル名 $tmpfile データ構成  no,名称 1<>フレーム 2<>レンズ 3<>カメラ 4<>ファインダー 5<>めがね 6<>ズーム これで「めがね」を削除したいのです。 データnoで削除したいと思っておりますが、うまく動作しません。 以下ソース open(DB,"$tmpfile") || &error("Open Error : $tmpfile"); flock(DB, 1); @lines = <DB>; @new=(); foreach $line (@lines) { $flag=0; ($no,$meisyo) = split("<>", $line); foreach $x (@DEL) { if ("$x" eq $tmpnum) { $flag=1; last; } } if ($flag == 0) { push(@new,$line); } } open(OUT,">$tmpfile") || &error("Write Error : $tmpfile"); print OUT @new; close(OUT); ここまで 上のソースですと、エラーこそならずに(そうみえているだけかもしれません)終わりますが、データ削除が正しく出来ませんでした。 説明不足があるかもしれませんので、指摘いただけますと幸いです。 よろしくお願いいたします。

    • ベストアンサー
    • Perl

専門家に質問してみよう