| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

CGI-Perl 応用実地編 - 簡易伝言板作成8 (ファイル排他制御)

■伝言投稿ファイル排他制御

  ・この伝言板は、ひとつのファイルに複数ユーザが書き込むので、更新が重な
    ると、ファイルが壊れる可能性があります。
    実のところ、こういう危険な仕様のプログラムは作ったことがありません。
    私が公開しているプログラムでは、排他制御がなくても壊れない仕様になっ
    ています。

  ・ファイルを壊さないためには、更新中は他のユーザの投稿を待たせるか、
    エラーで落とす機能が必要となります。
    次の排他関数 filelock() と unfilelock() を最後に追加します。
    尚、filelock() 中の「#// 強制アンロック」は、# で注釈にした方が良い
    かもしれません。なぜ、ファイルが壊れる危険をおかして、強制アンロック
    しているのかと言うと、サーバ異常などでプログラムがロックしたまま異常
    終了しても、一切の投稿ができなくなるのを防ぐためです。
    この関数では、1 秒待って 5 回のリトライをしても、他ユーザの更新が終
    わらなければ、強制的にアンロックしています。

#//=====================================================================
#//  ファイルロック
#//=====================================================================
sub filelock
{
  my($ct);

#// ファイルロック
  for ($ct = 1; $ct <= 5; $ct++) {
    if (-e "filelock.dat") {
      sleep 1;
    }
    else {
      if (open(FILE, ">filelock.dat")) {
        close(FILE);
        return 1;
      }
    }
  }

#// 強制アンロック
  unfilelock();

#// 戻り値セット
  return 0;
}

#//=====================================================================
#//  ファイルアンロック
#//=====================================================================
sub unfilelock
{
  my($ct);

#// ファイルアンロック
  for ($ct = 1; $ct <= 5; $ct++) {
    if (unlink "filelock.dat") {
      return 1;
    }
    sleep 1;
  }

#// 戻り値セット
  return 0;
}

  ・「#// 伝言ファイル書き込み」の前に、次のように追加します。
    ロックした以降は、プログラムがエラーになっても必ず、unfilelock() が
    呼び出されるようにしなくてはなりません。

  #// 排他開始
    if (!filelock()) {
      DspMsg("他のユーザと投稿が重なりました。<BR>しばらくしてから投稿して下さい。");
      exit(0);
    }

  ・「#// 伝言ファイル書き込み」のファイルオープンでエラーになると、
    exit(0) しているので、このままではロックしたまま終了してしまいます。
    そこで、DspMsg() の前に「unfilelock();」を追加しています。

      unfilelock();
      DspMsg("ファイル書き込みオープンエラー ($msdnm$msfnm)");

  ・「#// 投稿処理終了」の前に、次のように追加します。
    更新が終われば、ファイルをアンロックすると言う意味です。

  #// 排他解除
    unfilelock();

  ・以上を test8.cgi として修正すると、次のようになります。

#!/usr/local/bin/perl
#//=====================================================================
#//  test8.cgi 簡易伝言板
#//=====================================================================

#// 準備
  $title   = '簡易伝言板';
  $callcgi = 'test8.cgi';

#// 伝言ファイル
  $msdnm   = './';
  $msfnm   = 'dengon.txt';
  $msmax   = 10;

#// クッキー
  $cknm    = 'dengon';

#// パラメタ取得
  *data    = GetPara();
  $md      = $data{'md'};
  $hd      = $data{'hd'};
  $ms      = $data{'ms'};

#// セキュリティ情報取得
  $ip      = $ENV{'REMOTE_ADDR'};
  $blws    = $ENV{'HTTP_USER_AGENT'};

#// クッキー取得
  if ($ENV{'HTTP_COOKIE'}) {
    *data = GetCookie($ENV{'HTTP_COOKIE'});
    $data{$cknm} =~ s/%20/ /g;
    @w = split(/\,/, $data{$cknm});
    $hdc = @w[0];
  }

#// 伝言ファイル読み込み
  $err = 0;
  open(FIL, "$msdnm$msfnm") or $err = 1;
  if ($err) {
    DspMsg("ファイル読み込みオープンエラー ($msdnm$msfnm)");
    exit(0);
  }
  @rec = <FIL>;
  close(FIL);

#// 投稿処理開始
  if ($md eq '1') {

  #// データチェック
    $hd =~ s/　/ /g;
    $hd =~ s/</＆ｌｔ；/g;
    $hd =~ s/>/＆ｇｔ；/g;
    $hd =~ s/^\s+//;
    $hd =~ s/\s+$//;
    $ms =~ s/　/ /g;
    $ms =~ s/</＆ｌｔ；/g;
    $ms =~ s/>/＆ｇｔ；/g;
    $ms =~ s/^\s+//;
    $ms =~ s/\s+$//;
    if ($hd eq '') {
      DspMsg("ハンドルが空白です。");
      exit(0);
    }
    if ($ms eq '') {
      DspMsg("メッセージが空白です。");
      exit(0);
    }

  #// クッキーデータセット
    $hdc = $hd;

  #// 伝言編集
    ($ss, $mn, $hh, $dd, $mm, $yy, $yb) = localtime(time);
    $yy += 1900;
    $mm++;
    $dt = sprintf("%04d.%02d.%02d %02d:%02d:%02d", $yy, $mm, $dd, $hh, $mn, $ss);
    $rec = $dt . '_~|~_' . $hd . '_~|~_' . $ms . '_~|~_' . $ip . '_~|~_' . $blws . "\n";

  #// 排他開始
    if (!filelock()) {
      DspMsg("他のユーザと投稿が重なりました。<BR>しばらくしてから投稿して下さい。");
      exit(0);
    }

  #// 伝言ファイル書き込み
    $err = 0;
    open(FIL, ">$msdnm$msfnm") or $err = 1;
    if ($err) {
      unfilelock();
      DspMsg("ファイル書き込みオープンエラー ($msdnm$msfnm)");
      exit(0);
    }
    unshift @rec, $rec;
    for ($i = $#rec; $i >= $msmax; $i--) {
      pop @rec;
    }
    print FIL @rec;
    close(FIL);

  #// 排他解除
    unfilelock();

#// 投稿処理終了
  }

#// クッキーセット
  $hdc =~ s/\,/%2C/g;
  $cooks = "$hdc\,";
  $cooks =~ s/ /%20/g;
  $cooks =~ s/;//g;
  ($secg, $ming, $hourg, $mdayg, $mong, $yearg, $wdayg) = gmtime(time + 5184000);
  @mons = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  @week = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
  $dt= sprintf("%s\, %02d-%s-%04d %02d:%02d:%02d GMT", $week[$wdayg], $mdayg, $mons[$mong], $yearg+1900, $hourg, $ming, $secg);
  print "Content-type: text/html\n";
  print "Set-Cookie: $cknm=$cooks; expires=$dt;\n\n";

#// HTML ヘッド表示
print << "END_OF_HTML";
<HTML>
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
<TITLE>$title</TITLE>
</HEAD>
<BODY>
<CENTER>
<P><B>◆ 簡易伝言板 ◆</B></P>
<FORM action="$callcgi" id=FORM1 method=post name=FORM1>
<INPUT TYPE="hidden" NAME="md" VALUE="1">
<TABLE bgcolor=#b0b0b0 border=0 cellPadding=3 cellSpacing=2>
  <TBODY>
    <TR bgcolor=#f0f0f0>
        <TD nowrap><FONT size=-1>ハンドル</FONT></TD>
        <TD nowrap><INPUT id=hd name=hd size="22" maxlength="40" value="$hdc"></TD>
    </TR>
    <TR bgcolor=#f0f0f0>
        <TD nowrap><FONT size=-1>メッセージ</FONT></TD>
        <TD nowrap><INPUT id=ms name=ms size="62" maxlength="200"></TD>
    </TR>
  </TBODY>
</TABLE>
<BR>
<TABLE bgcolor=#b0b0b0 border=0 cellPadding=3 cellSpacing=2>
  <TBODY>
    <TR bgcolor=#f0f0f0>
        <TD nowrap><INPUT id=submit1 name=submit1 type=submit value="　投稿　"></TD>
        <TD nowrap><INPUT id=reset1 name=reset1 type=reset value="リセット"></TD>
    </TR>
  </TBODY>
</TABLE>
</FORM>
END_OF_HTML

#// 伝言ファイルヘッド表示
print << "END_OF_HTML";
<TABLE bgcolor=#b0b0b0 border=0 cellPadding=3 cellSpacing=2>
  <TBODY>
    <TR bgcolor=#d0d0d0>
        <TD nowrap><FONT size=-1>日付</FONT</TD>
        <TD nowrap><FONT size=-1>ハンドル</FONT</TD>
        <TD><FONT size=-1>メッセージ</FONT</TD>
    </TR>
END_OF_HTML

#// 伝言ファイルボディ表示
  foreach (@rec) {
    @w = split(/\_\~\|\~\_/, $_);
    $dt = substr(@w[0], 0, 16);
    $hd = @w[1];
    $ms = @w[2];
    $ip = @w[3];
    $blws = @w[4];
    print '<TR bgcolor=#f0f0f0>';
    print '<TD nowrap><FONT size=-1>', $dt, '</FONT</TD>';
    print '<TD nowrap><FONT size=-1>', $hd, '</FONT</TD>';
    #print '<TD><FONT size=-1>', $ms, '</FONT</TD>';
    print '<TD><FONT size=-1>', $ms, "<BR>$ip $blws", '</FONT</TD>';
    print '</TR>';
  }

#// 伝言ファイルテイル表示
print << "END_OF_HTML";
  </TBODY>
</TABLE>
END_OF_HTML

#// HTML テイル表示
print << "END_OF_HTML";
</CENTER>
</BODY>
</HTML>
END_OF_HTML

#// 終了
  exit(0);

#//=====================================================================
#//  メッセージ表示
#//=====================================================================
sub DspMsg
{
  my($msg) = @_[0];

#// メッセージ表示
print << "END_OF_HTML";
Content-type: text/html

<HTML>
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
<TITLE>$title</TITLE>
</HEAD>
<BODY>
<P>$msg</P>
</BODY>
</HTML>
END_OF_HTML

#// リターン
  return;
}

#//=====================================================================
#//  パラメタ取得
#//=====================================================================
sub GetPara
{
  my($encode) = @_;
  my($method) = $ENV{'REQUEST_METHOD'};
  local($qu, @in, $key, $val);

#// 日本語コード変換 jcode.pl 読み込み
  require 'jcode.pl' if $encode;

#// パラメタ取得
  if ($method eq 'GET') {
    $qu = $ENV{'QUERY_STRING'};
  }
  elsif ($method eq 'POST') {
    read(STDIN, $qu, $ENV{'CONTENT_LENGTH'});
  }
  local(@qu) = split(/&/, $qu);
  foreach (@qu) {
    tr/+/ /;
    ($key, $val) = split(/=/);
    $key =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack('c', hex($1))/ge;
    $val =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack('c', hex($1))/ge;
    $val =~ s/\r\n/\n/g;
    jcode'convert(*key, $encode) if ($encode);
    jcode'convert(*val, $encode) if ($encode);
    $in{$key} = $val;
  }

#// 戻り値セット
  return *in;
}

#//=====================================================================
#//  クッキー取得
#//=====================================================================
sub GetCookie
{
  local($cookie) = $ENV{'HTTP_COOKIE'};
  local(*data, @cookie, $key, $val);

#// クッキー取得
  @cookie = split(/ /, $cookie);
  foreach (@cookie) {
    ($key, $val) = split(/=/);
    $data{$key} = $val;
  }

#// 戻り値セット
  return *data;
}

#//=====================================================================
#//  ファイルロック
#//=====================================================================
sub filelock
{
  my($ct);

#// ファイルロック
  for ($ct = 1; $ct <= 5; $ct++) {
    if (-e "filelock.dat") {
      sleep 1;
    }
    else {
      if (open(FILE, ">filelock.dat")) {
        close(FILE);
        return 1;
      }
    }
  }

#// 強制アンロック
  unfilelock();

#// 戻り値セット
  return 0;
}

#//=====================================================================
#//  ファイルアンロック
#//=====================================================================
sub unfilelock
{
  my($ct);

#// ファイルアンロック
  for ($ct = 1; $ct <= 5; $ct++) {
    if (unlink "filelock.dat") {
      return 1;
    }
    sleep 1;
  }

#// 戻り値セット
  return 0;
}

■CGI-Perl 応用実地編資料

• 2001.06.26 CGI-Perl 応用実地編 - 簡易伝言板作成1 (投稿フォーム表示)
• 2001.06.26 CGI-Perl 応用実地編 - 簡易伝言板作成2 (投稿パラメタ引き取り)
• 2001.06.26 CGI-Perl 応用実地編 - 簡易伝言板作成3 (投稿内容ファイル書き込み)
• 2001.06.26 CGI-Perl 応用実地編 - 簡易伝言板作成4 (投稿内容チェック整形)
• 2001.06.26 CGI-Perl 応用実地編 - 簡易伝言板作成5 (投稿内容テーブル表示)
• 2001.06.26 CGI-Perl 応用実地編 - 簡易伝言板作成6 (投稿ハンドルクッキー記憶)
• 2001.06.26 CGI-Perl 応用実地編 - 簡易伝言板作成7 (セキュリティ情報取得)
• 2001.06.26 CGI-Perl 応用実地編 - 簡易伝言板作成8 (ファイル排他制御)
• 2001.06.26 CGI-Perl 応用実地編 - 簡易伝言板作成9 (スクロール、その他)

■CGI-Perl 基礎編資料

• 2000.12.23 CGI-Perl 基礎編 (その一) 注釈、変数、配列、連想配列、演算子、特殊文字
• 2000.12.25 CGI-Perl 基礎編 (その二) 制御構造(判定、ループ) if、for、foreach、while
• 2001.01.20 CGI-Perl 基礎編 (その三) 標準ファイル I/O open、unlink、opendir、readdir
• 2001.01.23 CGI-Perl 基礎編 (その四) 基本事項、ユーザ関数 sub、function、return、my
• 2001.01.25 CGI-Perl 基礎編 (その五) 文字列関数 substr、index、split、localtime、crypt
• 2001.01.25 CGI-Perl 基礎編 (その六) 数値関数、その他 srand、rand、int、sleep、$ENV
• 2001.01.25 CGI-Perl 基礎編 (その七) クッキー Cookie $ENV{'HTTP_COOKIE'}
• 2001.09.10 CGI-Perl 基礎編 (その八) 正規表現、マッチパターン、置換演算子、変換演算子
• 2002.05.01 CGI-Perl 基礎編 (その九) 電子メール送信 sendmail (jcode.pl 要)

■CGI-Perl 基礎実地編資料

• 2001.02.04 CGI-Perl 基礎実地編 - 目次
• 2001.02.04 CGI-Perl 基礎実地編 - 用語解説
• 2001.02.04 CGI-Perl 基礎実地編 - 実習1 (HTML 出力)
• 2001.02.04 CGI-Perl 基礎実地編 - 実習2 (変数埋め込み)
• 2001.02.04 CGI-Perl 基礎実地編 - 実習3 (ヒアドキュメント)
• 2001.02.04 CGI-Perl 基礎実地編 - 実習4 (制御構造 - if 判定)
• 2001.02.04 CGI-Perl 基礎実地編 - 実習5 (制御構造 - for ループ)
• 2001.02.04 CGI-Perl 基礎実地編 - 実習6 (制御構造 - while ループ)
• 2001.02.04 CGI-Perl 基礎実地編 - 実習7 (リクエスト)
• 2001.02.04 CGI-Perl 基礎実地編 - 実習8 (フォームリクエスト)
• 2001.02.10 CGI-Perl 基礎実地編 - 実習9 (文字関数、数値関数)
• 2001.02.10 CGI-Perl 基礎実地編 - 実習10 (ユーザ関数)
• 2001.02.10 CGI-Perl 基礎実地編 - 実習11 (ハロー Perl 作成)
• 2001.02.12 CGI-Perl 基礎実地編 - 実習12 (標準ファイル入出力)
• 2001.02.12 CGI-Perl 基礎実地編 - 実習13 (フォルダオープン)
• 2001.02.12 CGI-Perl 基礎実地編 - 実習14 (画像レスポンス、画像出力、画像表示)
• 2001.02.12 CGI-Perl 基礎実地編 - 実習15 (クッキー)
• 2001.02.18 CGI-Perl 基礎実地編 - 実習16 (アクセスカウンタ作成)

■PHP 基礎編資料

• 2002.06.01 PHP 基礎編1 - 開発環境、注釈、変数、配列、連想配列、演算子、特殊文字
• 2002.06.01 PHP 基礎編2 - 制御構造(判定、ループ) if、switch、for、while、foreach、do
• 2002.06.01 PHP 基礎編3 - 標準ファイル I/O fopen、unlink、flock、file、opendir、readdir
• 2002.06.01 PHP 基礎編4 - 基本事項、ユーザ関数、function、return、global、static
• 2002.06.01 PHP 基礎編5 - 文字列関数 substr、strlen、strpos、split、list、time、crypt
• 2002.06.01 PHP 基礎編6 - 数値関数、その他 rand、floor、ceil、round、$REMOTE_ADDR
• 2002.06.03 PHP 基礎編7 - フォームリクエスト、クエリーリクエスト、クッキー setcookie
• 2002.06.03 PHP 基礎編8 - 配列操作、sort、asort、ksort、array_push、array_shift
• 2002.06.03 PHP 基礎編9 - 正規表現、マッチ、置き換え、ereg、eregi、eregi_replace
• 2002.06.03 PHP 基礎編10 - ファイルアップロード、インクルードファイル、require
• 2002.06.03 PHP 基礎編11 - 電子メール送信 mail、i18n_convert、mb_send_mail
• 2002.08.12 PHP 基礎編12 - アクセスカウンタ作成、file_exists、sprintf、filesize、header

■PHP + MySQL 編資料

• 2002.06.01 PHP + MySQL 編1 - 項目型、テーブル作成、項目削除、件数制限問い合わせ
• 2002.06.03 PHP + MySQL 編2 - RDBMS 接続、ログイン、mysql_connect、mysql_select_db
• 2002.06.03 PHP + MySQL 編3 - レコード更新、追加、修正、削除、mysql_affected_rows
• 2002.06.03 PHP + MySQL 編4 - 問い合わせレコード参照 mysql_query,mysql_fetch_array

| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |