第10章のサンプルコード
---------------------
目次（ページ番号）
■P217
■P222
■P225-1
■P225-2
■P226
■P230
■P231
■P233
---------------------

■P217
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
<!--
 簡単なアンケートのHTML

 questionnaire.html
-->
<html>
  <head>
    <title>アンケートの例</title>
  </head>

  <body>
    <h1>アンケートの例</h1>

    <p>次の質問にお答えください。</p>

    <form action="/cgi-bin/questionnaire.cgi" method="post">
      <dl>
        <dt>お名前</dt>
        <dd><input type="text" name="name" value=""></dd>
        <dt>最もよくお使いになっているOS</dt>
        <dd>
          <ul>
            <li><input type="radio" name="os" 
                value="Windows" 
                checked>Windows</li>
            <li><input type="radio" name="os" 
                value="Linux">Linux</li>
            <li><input type="radio" name="os" 
                value="FreeBSD">FreeBSD</li>
            <li><input type="radio" name="os" 
                value="Solaris">Solaris</li>
            <li><input type="radio" name="os" 
                value="MacOS">MacOS</li>
            <li><input type="radio" name="os" 
                value="Other">その他</li>
          </ul>
        </dd>
      </dl>
      <p>
        <input type="submit" name="send" value="送信"><br>
        <input type="reset" value="リセット">
      </p>
    </form>

  </body>
</html>

■P222
#!/usr/bin/perl
# ↑この行は、UNIXで動作させるときには必須。
# /usr/bin/perlは環境によっては/usr/local/binなどになる。
# このCGIプログラムスクリプトは、UNIXでは実行権限を与えておく必要がある
# (chmod a+x questionnaire.cgi)。

# アンケート処理CGIプログラムスクリプト
# ユーザーが使っているOSの合計を調べる
#  questionnaire.cgi

# モジュール読み込み
use CGI;
$query = new CGI;

# 統計ファイルの存在のチェック
if (-f "data/statistic.log") {
  # 存在するならファイルをオープンする。失敗したらエラーページを表示
  open(F, "data/statistic.log") ||
    &error("ファイル data/statistic.log をオープンできません ($!)。\n");
  while (<F>) {
    # 改行文字を除く
    chomp( );
    # 名前とOSを取得
    ($name, $os) = split(/\t/);
    # 配列@nametotalに名前を蓄積
    push(@nametotal, $name);
    # ハッシュ$ostotalに合計値を蓄積
    $ostotal{$os}++;
  }
  close(F);
}

# アンケートを解析
# 名前からタブ文字を取り除く(タブ文字をファイルのデータの区切りとして使っているため)
$name = $query->param('name');
$name =~ s/\t//g;
# 名前に重複がないか解析
foreach (@nametotal) {
  if ($_ eq $name) {
    # 等しいものがあったときにはエラーページを表示
    &error("お名前 $name はすでに登録されています。\n");
  }
}

# 変数osに入っているOS名をキーとする値をインクリメント
$ostotal{$query->param('os')}++;

# 記録に追加。失敗したらエラーページを表示
open(F, ">>data/statistic.log") ||
  &error("ファイル data/statistic.log に書き込めません ($!)。\n");
print F $name, "\t", $query->param('os'), "\n";
close(F);

# 表示 (UNIXではEUC-JPとする)
print $query->header(-charset=>'Shift_JIS'), 
  $query->start_html(-title=>"現在のアンケート結果");
print "<h2>使用OS</h2>\n";
print "<ul>\n";
# 合計数を表示
print "<li><strong>$os</strong>: $count</li>\n"
  while (($os, $count) = each (%ostotal));
print "</ul>\n";
print $query->end_html( );

sub error {
  # エラーページ表示のサブルーチン
  my($message) = @_;

  print $query->header(-charset=>'Shift_JIS'), 
    $query->start_html(-title=>"エラー");
  print "<h1>エラーが発生しました。</h1>\n";
  print $message;
  print $query->end_html( );
  # 異常終了
  exit(1);
}

■P225-1
<dt>用途(いくつでも)</dt>
<dd><ul>
<li><input type="checkbox" name="use" 
    value="インターネット">インターネット</li>
<li><input type="checkbox" name="use" 
    value="ワープロ">ワープロ</li>
<li><input type="checkbox" name="use" 
    value="表計算">表計算</li>
<li><input type="checkbox" name="use" 
    value="ゲーム">ゲーム</li>
<li><input type="checkbox" name="use" 
    value="プログラミング">プログラミング</li>
<li><input type="checkbox" name="use" 
    value="CG">CG</li>
<li><input type="checkbox" name="use" 
    value="音楽">音楽</li>
<li><input type="checkbox" name="use" 
    value="その他">その他</li>
</ul>
</dd>

■P225-2
<form action="/cgi-bin/questionnaire2.cgi" method="post">

■P226
#!/usr/bin/perl
# アンケート処理CGIプログラムスクリプト(複数値対応)
# ユーザーが使っているOSの合計を調べる
#  questionnaire2.cgi

# モジュール読み込み
use CGI;
$query = new CGI;

# 統計ファイルの存在のチェック
if (-f "data/statistic2.log") {
  # 存在するならファイルをオープンする。失敗したらエラーページを表示
  open(F, "data/statistic2.log") ||
    &error("ファイル data/statistic2.log をオープンできません ($!)。\n");
  while (<F>) {
    # 改行文字を除く
    chomp( );
    # 名前とOS、用途を取得
    ($name, $os, $use) = split(/\t/);
    # 配列@nametotalに名前を蓄積
    push(@nametotal, $name);
    # ハッシュ$ostotalに合計値を蓄積
    $ostotal{$os}++;
    # ハッシュ$usetotalに合計値を蓄積
    # ,で区切られているので分割
    foreach (split(/,/, $use)) {
      $usetotal{$_}++;
    }
  }
  close(F);
}

# アンケートを解析
# 名前からタブ文字を取り除く(ファイルのデータの区切りにしているため)
$name = $query->param('name');
$name =~ s/\t//g;
# 名前に重複がないか解析
foreach (@nametotal) {
  if ($_ eq $name) {
    # 等しいものがあったときはエラーページを表示
    &error("お名前 $name はすでに登録されています。\n");
  }
}

# 変数osに入っているOS名をキーとする値をインクリメント
$ostotal{$query->param('os')}++;

# リストuseに入っている用途をキーとする値をインクリメント
foreach ($query->param('use')) {
  $usetotal{$_}++;
}

# 記録に追加。失敗したらエラーページを表示
open(F, ">>data/statistic2.log") ||
  &error("ファイル data/statistic2.log に書き込めません ($!) 。\n");
# リストuseは,で区切った文字列にして書き込み
print F $name, "\t", $query->param('os'), "\t",
  join(",", $query->param('use')), "\n";
close(F);

# 表示 (UNIXではEUC-JPとする)
print $query->header(-charset=>'Shift_JIS'), 
  $query->start_html(-title=>"現在のアンケート結果");
print "<h2>使用OS</h2>\n";
print "<ul>\n";
# 合計数を表示
print "<li><strong>$os</strong>: $count</li>\n"
  while (($os, $count) = each (%ostotal));
print "</ul>\n";

print "<h2>用途</h2>\n";
# 合計数を表示
print "<li><strong>$use</strong>: $count</li>\n"
  while (($use, $count) = each (%usetotal));
print "</ul>\n";

print $query->end_html( );

sub error {
  # エラーページ表示のサブルーチン
  my($message) = @_;

  print $query->header(-charset=>'Shift_JIS'), 
    $query->start_html(-title=>"エラー");
  print "<h1>エラーが発生しました。</h1>\n";
  print $message;
  print $query->end_html( );
  # 異常終了
  exit(1);
}

■P230
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
<!--
 ファイル情報表示のHTML

 fileinfo.html
-->
<html>
  <head>
    <title>ファイル情報表示</title>
  </head>

  <body>
    <h1>ファイル情報表示</h1>

    <p>ファイルを指定して［送信］を押してください。</p>

    <form action="/cgi-bin/fileinfo.cgi" method="post" 
        enctype="multipart/form-data">
      <p><input type="file" name="filename"></p>
      <p>
        <input type="submit" name="send" value="送信"><br>
        <input type="reset" value="リセット">
      </p>
    </form>

  </body>
</html>

■P231
#!/usr/bin/perl
# ファイル情報表示CGIプログラムスクリプト
#  fileinfo.cgi

# モジュール読み込み
use CGI;
$query = new CGI;
$filename = $query->param('filename');

# 表示
print $query->header(-charset=>'Shift_JIS'), 
  $query->start_html(-title=>"ファイル情報");

print "<h2>ファイル情報</h2>\n";
print "<ul>\n";
# スカラー変数として扱うとファイル名を返す
print "<li>ファイル名:", $filename, "</li>\n";
print "<li>ファイルのMIMEタイプ:",
  $query->uploadInfo($filename)->{'Content-Type'} , 
  "</li>\n";
print "</ul>\n";

print "<h2>ファイル内容</h2>\n";
print "<PRE>\n";
while (<$filename>) {
  # ファイルの内容を表示
  print;
}
print "</PRE>\n";
print $query->end_html( );

■P233
#!/usr/bin/perl
# ブラウザ情報表示CGIプログラムスクリプト
#  browserinfo.cgi

# モジュール読み込み
use CGI;
$query = new CGI;

# 表示
print $query->header(-charset=>'Shift_JIS'), 
  $query->start_html(-title=>"ブラウザ情報");
print "<dl>\n";
print "<dt><strong>使用ブラウザ</strong></dt>\n";
print "<dd>", $query->user_agent( ), "</dd>\n";
print "<dt><strong>ホスト</strong></dt>\n";
print "<dd>", $query->remote_host( ), "</dd>\n";
print "<dt><strong>前のページ</strong></dt>\n";
print "<dd>", $query->referer( ), "</dd>\n";
print "</dl>\n";
print $query->end_html( );
