人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

http://box.elsia.net/~diamond/cgi.html
このソースを分かりやすく(ヴィジュアル重視)解説してくれるかた、大変な作業だと
思うので300ポイント一名さまに

●質問者: yujihirose
●カテゴリ:コンピュータ 学習・教育
✍キーワード:ソース ポイント ヴィジュアル
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● doctormusic
●50ポイント

http://www.yahoo.co.jp/

Yahoo! JAPAN

↑URLはダミーです。

######################################################

# これははじめてのCGI設置?として説明します。まず、一番に

# この「#!/usr/local/bin/perl」ですがこれはパスといい、これが

# 正しくないと動作しない場合があります。(サーバーによって異なる)

# 調べたところこのサーバーでは「#!/usr/bin/perl」が正しいパスです。

# ですので必ず↓のパスを変えてください。

######################################################

#!/usr/local/bin/perl

##################################################

# 初期設定ブロック

##################################################

#最大記録記事数(変更しなくてもいいです。)

$savemax = 100;

#最大表示記事数(変更しなくてもいいです。)

$pagemax = 10;

#CGIプログラムのパス(755←はパーミッションといいアップなどしたあと

#パーミッションを変えます。この場合だとbbs.cgiというファイルを

#755にするという意味です。パーミッションの変え方はソフトや提供されている

#FTPシステムによって異なるので詳細がないためわかりません。)

$pageurl = ’./bbs.cgi’;

#データファイルのパス(666←も上記と同じでbbs.datというファイルを666にします。)

$datafile = ’./bbs.dat’;

#ロックディレクトリのパス(777←同じくlockファイルの中にあるbbs.lockを777に。)

$lockdir = ’./lock/bbs.lock’;

#タイトル画像のHTML(これは掲示板の上に表示されるタイトル画像のことです。とりあえず設置には関係ないので

#いじらなくてもよいでしょう。)

#$titleimg = ’<IMG SRC=”./bbs.gif” WIDTH=”408” HEIGHT=”31” ALT=”BULLETIN BOARD SYSTEM”>’;

#jcode.pl(644←同じくjcode.plを644にします。)

require ’./jcode.pl’;

#BBSのタイトル(そのままです。)

$pagetitle = ’BBS’;

#新着マークのHTML(新しく投稿された記事をNEWと表示するときの画像)

$newimg = ’<img src=”./new.gif” alt=”NEW!” width=”27” height=”11”>’;

#新着マーク表示期間の秒数(NEWの表示期間。変えなくてもいいです。)

$newtime = 60 * 60 * 24;

#HTMLタグを有効にする(1)しない(0)(これも変える必要はありません。)

$taguse = 1;

#書き込みを拒否する禁句(掲示板で使って欲しくない言葉を入力します。

#増やす場合はこのようになります。(’バカ’,’アホ’,’クソ’,’エロ’,’お前);となります。

@words = (’バカ’,’アホ’,’クソ’);

#アイコン画像のURL(これは使用するアイコンの設定)

@icons = (’./icon_1.gif’,’./icon_2.gif’,’./icon_3.gif’);

#アイコン画像の横幅(使用するアイコンの幅)

$wicon = 15;

#アイコン画像の高さ(使用するアイコンの高さ)

$hicon = 15;

#アクセスを拒否するドメイン名(これは変える必要ありません。)

@domains = (’d-force¥.org’,’d-force¥.net’,’d-force¥.com’);

#管理用パスワード(ウェブ上で編集などをするときのパスワードです。)

#絶対変えるようにしてください。

$adpass = ’panda’;

######################################################

#以上がわかっていただければ大丈夫です。残りの↓のものたちですが

#何もする必要のない項目なのでいじらないでください。(簡単に言えば

#デザインやプログラムにこだわる時のみにいじります。)上級者のみは

#いじることができます。最後に気になっていたと思いますが「#」は

#最初に入れておくと「ここからコメントだよー」になります。

######################################################

##################################################

# データの受け取りブロック

##################################################

#データを受け取るサブルーチン

&get_data;

#使いやすい変数に入れ換える

$xdo = ”$form{’do’}”;

$xstart = ”$form{’start’}”;

$xname = ”$form{’name’}”;

$xmail = ”$form{’mail’}”;

$xurl = ”$form{’url’}”;

$xtitle = ”$form{’title’}”;

$xmes = ”$form{’mes’}”;

$xicon = ”$form{’icon’}”;

$xno = ”$form{’no’}”;

$xpass = ”$form{’pass’}”;

#エポック秒を取得する

$xtime = time;

#環境変数を取得するサブルーチン

&get_env;

##################################################

# 処理の分岐ブロック

##################################################

#ホスト名にアクセスを拒否するドメイン名が含まれていたらエラー表示する

foreach $domain (@domains) {

if ($xhost =~ m/$domain/) { &error(’アクセスエラー’); }

}

#ホスト名にアクセスを拒否するドメイン名が含まれていたら特定のURLにジャンプさせる

#foreach $domain (@domains) {

# if ($xhost =~ m/$domain/) {

# print ”Location:

http://www.d-force.org/se/

BBS RE-DESIGN BOOK

¥n¥n”;

# exit;

# }

#}

if ($xdo eq ’write’) {

#記事の書き込みブロック

&write_bbs;

} elsif ($xdo eq ’delete’) {

#記事の削除ブロック

&delete_bbs;

} else {

#記事の読み込みブロック

&read_bbs;

}

#記事の表示ブロック

&view_bbs;

#全処理の終了を宣言する

exit;

##################################################

# 記事の読み込みブロック

##################################################

sub read_bbs {

#ロックするサブルーチン

&lock;

#データを読み込むサブルーチン

&read_data;

#アンロックするサブルーチン

&unlock;

}

##################################################

# 記事の表示ブロック

##################################################

sub view_bbs {

#表示を開始するための添え字を決定する

if ($xstart eq ’’) { $xstart = 0; }

#表示を終了するための添え字を決定する

$end = $xstart + $pagemax;

if ($end > @data) { $end = @data; }

#次の何件ボタンの表示を設定する

if ($end < @data) {

$nextbutton = ”<a href=¥”$pageurl?start=$end¥”>[Next >]</a>”;

} else {

$nextbutton = ”[Next >]”;

}

#前の何件ボタンの表示を設定する

if ($xstart == 0) {

$prebutton = ”[< Previous]”;

} else {

$pre = $xstart - $pagemax;

$prebutton = ”<a href=¥”$pageurl?start=$pre¥”>[< Previous]</a>”;

}

#ダイレクトボタンの表示を設定する

$block = int((@data - 1) / $pagemax) + 1 ;

for ($a = 0; $a < $block; $a++) {

$dnb = $a * $pagemax;

$vnb = $a + 1;

if ($xstart == $dnb) {

$list = ” <b>$vnb</b>”;

} else {

$list = ” <a href=¥”$pageurl?start=$dnb¥”>$vnb</a>”;

}

$directbutton = ”$directbutton”.”$list”;

}

$directbutton = ”$directbutton ”;

#HTML出力開始を宣言する

print ”Content-type: text/html¥n¥n”;

#TOPパートのヒアドキュメント

print <<BBS_TOP;

<!DOCTYPE HTML PUBLIC ”-//W3C//DTD HTML 4.01 Transitional//EN”>

<html lang=”ja”>

<head>

<meta http-equiv=”content-type” content=”text/html; charset=euc-jp”>

<title>$pagetitle</title>

<style type=”text/css”>

<!--

body {

background-color:white;

color:black;

margin:0px;

background-image:url(background.gif);

}

#l {

position:absolute;

left:5px;

width:150px;

}

#r {

position:absolute;

top:5px;

left:180px;

width:400px;

height:100%;

margin-bottom:10px;

}

h1 {

font-family:arial;

font-size:60px;

color:#393;

margin:0px;

letter-spacing:-2px

}

h2 {

font-size:12px;

margin:0px;

}

p {

font-size:12px;

line-height:18px;

}

small {

font-size:10px;

font-weight:normal;

line-height:14px;

}

form {

margin:0px;

}

td {

padding:0px;

font-size:10px;

color:#393;

vertical-align:top;

}

textarea {

width:320px;

height:100px;

border-width:1px;

border-color:#393;

border-style:solid;

margin:0px 0px 15px 15px;

}

select {

border-style:solid;

border-color:#393;

border-width:1px;

height:14px;

font-size:10px;

margin:0px 0px 6px 15px;

}

input.check {

margin:0px 0px 5px 15px;

}

input.fo {

border-color:#393;

border-style:solid;

border-top-width:0px;

border-right-width:0px;

border-bottom-width:1px;

border-left-width:0px;

width:100%;

font-size:10px;

margin:0px 0px 5px 15px

}

input.f1 {

width:320px;

}

input.f2 {

width:80px;

margin:0px 20px 0px 5px

}

.hr1 {

background-color:#393;

color:#393;

height:8px;

border-style:solid;

border-width:0

}

.hr2 {

background-color:#030;

height:1px;

border-style:solid;

border-width:0

}

#iconsample {

margin:0px 0px 6px 10px

}

.pages {

font-size:10px;

}

.button1 {

border-width:2px;

border-color:#393;

border-style:solid;

background-color:#fff;

width:60px;

padding:1px;

color:#393;

font-size:10px;

font-weight:bold;

margin:0px 10px 5px 0px

}

a:link,a:visited { color:black; text-decoration:underline }

a:active,a:hover { color:blue; text-decoration:underline }

-->

</style>

</head>

<body>

<h1 id=”l” lang=”en”>BBS</h1>

<div id=”r”>

BBS_TOP

#FORMパートのヒアドキュメント

print <<BBS_FORM;

<hr class=”hr1”>

<form action=”$pageurl” method=”post”>

<table>

<tr>

<td>Name:</td>

<td><input class=”fo f1” NAME=”name” type=”text” size=”20”></td>

</tr>

<tr>

<td>Icon:</td>

<td><select name=”icon”><option value=”0” selected>1</option> <option value=”1”>2</option><option value=”2”>3</option></select><img id=”iconsample” src=”iconsample.gif” alt=”Icon” width=”72” height=”15” align=”absbottom”></td>

</tr>

<tr>

<td>Mail:</td>

<td><input class=”fo f1” NAME=”mail” type=”text” size=”20”></td>

</tr>

<tr>

<td>URL:</td>

<td><input class=”fo f1” NAME=”url” type=”text” size=”20”></td>

</tr>

<tr>

<td>Password:</td>

<td><input class=”fo f1” NAME=”pass” type=”password” size=”20”></td>

</tr>

<tr>

<td>Title:</td>

<td><input class=”fo f1” NAME=”title” type=”text” size=”20”></td>

</tr>

<tr>

<td>Message:</td>

<td><TEXTAREA COLS=”55” ROWS=”5” NAME=”mes”></TEXTAREA><INPUT TYPE=”hidden” NAME=”do” VALUE=”write”></td>

</tr>

</table>

<INPUT class=”button1” TYPE=”submit” VALUE=”Submit”><INPUT class=”button1” TYPE=”reset” VALUE=”Clear All”>

</form>

<hr class=”hr1”>

BBS_FORM

#記事データを1件ずつ読み込み表示するループ

for ($i = $xstart; $i < $end; $i++) {

#行末の改行記号「¥n」を取り除く

chomp $data[$i];

#記事データを「,」で切り分けて各々変数に代入する

($no,$time,$title,$mes,$name,$mail,$url,$icon,$host,$addr,$agent) = split(/,/,$data[$i]);

#タイトルが未記入のときの表示を変更する

if ($title eq ’’) { $title = ’no title’ }

#新着マークを設定する

if ($newtime >= ($xtime - $time)) { $vnewimg = $newimg }

else { $vnewimg = ’’ }

if ($taguse) {

#メッセージ中の<を<に置換する

$mes=~ s/</</g;

#メッセージ中の>を>に置換する

$mes =~ s/>/>/g;

#メッセージ中の”を”に置換する

$mes =~ s/”/”/g;

}

#エポック秒から時刻文字列を取得する

$time_string = &make_time($time);

#名前が未記入のときの表示を変更する

if ($name eq ’’) { $name = ’no name’ }

#アイコン画像を選択する

$vicon = ”<img src=¥”$icons[$icon]¥” alt=¥”Icon¥” width=¥”$wicon¥” height=¥”$hicon¥” align=¥”absbottom¥”>”;

#メールアドレスが未記入のときの表示を変更する

if ($mail ne ’’) { $vmail = ”Mail: <a href=¥”mailto:$mail¥” target=¥”_blank¥”>$mail</a>

” }

else { $vmail = ’’ }

#ホームページURLが未記入のときの表示を変更する

if ($url ne ’’) { $vurl = ”URL: <a href=¥”$url¥” target=¥”_blank¥”>$url</a>

” }

else { $vurl = ’’ }

#DATAパートのヒアドキュメント

print <<BBS_DATA;

<h2>

No.$no

$title$vnewimg

<small>$name$vicon

$time_string</small>

</h2>

<p>

$mes

</p>

<div>

<small>

$vmail

$vurl

Agent: $agent

Host: $host

Addr: $addr

</small>

</div>

<hr class=”hr2”>

BBS_DATA

}

#CONTROLパートのヒアドキュメント

print <<BBS_CONTROL;

<div class=”pages”>

<b>Pages:</b> $prebutton$directbutton$nextbutton

</div>

<hr class=”hr1”>

<form action=”$pageurl” method=”post”>

<table>

<tr>

<td><input class=”button1” type=”submit” value=”Delete”></td>

<td>No.:<input class=”fo f2” type=”text” name=”no” size=”10”></td>

<td><input type=”hidden” name=”do” value=”delete”>Password: <input class=”fo f2” type=”password” name=”pass” size=”10” value=””></td>

</tr>

</table>

</form>

BBS_CONTROL

#BOTTOMパートのヒアドキュメント

print <<BBS_BOTTOM;

</div>

</body>

</html>

BBS_BOTTOM

}

##################################################

# 記事の書き込みブロック

##################################################

sub write_bbs {

#名前が未記入のときはエラー表示する

#if ($xname eq ’’) { push(@error_mes,”名前を入力して下さい。

”); }

#メールアドレスが不正のときはエラー表示する

if (($xmail ne ’’) && ($xmail !~ m/.+¥@.+¥..+/)) { push(@error_mes,”メールアドレスが不正です。

”); }

#ホームページURLが不正のときはエラー表示する

if (($xurl ne ’’) && ($xurl !~ m/http:¥/¥/.+¥..+/)) { push(@error_mes,”ホームページURLが不正です。

”); }

#タイトルが50バイト以上のときはエラー表示する

#if (length($xtitle) >= 50) { push(@error_mes,”タイトルを短くして下さい。

”); }

#メッセージが未記入のときはエラー表示する

if ($xmes eq ’’) { push(@error_mes,”メッセージを入力して下さい。

”); }

#メッセージが1000バイト以上のときはエラー表示する

if (length($xmes) >= 1000) { push(@error_mes,”メッセージを短くして下さい。

”); }

#メッセージに禁句が含まれていたらエラー表示する

foreach $word (@words) {

if ($xmes =~ m/$word/) { push(@error_mes,”不正な文字「$word」が含まれています。

”); }

}

#エラーメッセージがあれば入力エラー表示する

if (@error_mes) { &error(’入力エラー’); }

#データをチェンジする

$xname = &change_data(”$xname”);

$xmail = &change_data(”$xmail”);

$xurl = &change_data(”$xurl”);

$xtitle = &change_data(”$xtitle”);

$xmes = &change_data(”$xmes”);

$xicon = &change_data(”$xicon”);

$xhost = &change_data(”$xhost”);

$xaddr = &change_data(”$xaddr”);

$xagent = &change_data(”$xagent”);

$xpass = &change_data(”$xpass”);

#ロックするサブルーチン

&lock;

#データを読み込むサブルーチン

&read_data;

#最新記事データを取得する

($no,$time,$title,$mes,$name,$mail,$url) = split(/,/,$data[0]);

#二重投稿でなければ

unless (($xname eq $name) && ($xmes eq $mes)) {

#最新記事No.+1を取得する

$xno = $no + 1;

#新しい記事データを作成する

$newdata = join(”,”,($xno,$xtime,$xtitle,$xmes,$xname,$xmail,$xurl,$xicon,$xhost,$xaddr,$xagent,$xpass));

#新しい記事データを@dataの先頭に追加する

unshift(@data,”$newdata¥n”);

#最大記録記事数で@dataを切りつめる

splice(@data,$savemax);

#データを書き込むサブルーチン

&write_data;

}

#アンロックするサブルーチン

&unlock;

}

########################################

# 記事の削除ブロック

########################################

sub delete_bbs {

#ロックするサブルーチン

&lock;

#データを読み込むサブルーチン

&read_data;

#記事データを1件ずつ読み込み調査するループ

for ($i = 0; $i < @data; $i++) {

#記事データを「,」で切り分けて各々変数に代入する

($no,$time,$title,$mes,$name,$mail,$url,$icon,$host,$addr,$agent,$pass) = split(/,/,$data[$i]);

#記事No.が同じなら

if ($no eq $xno) {

#投稿者パスワード末尾の改行記号「¥n」を取り除く

chomp $pass;

#投稿者パスワードが空なら管理用パスワードを代入する

if ($pass eq ’’) { $pass = $adpass; }

#投稿者パスワードまたは管理用パスワードが一致すれば

if (($xpass eq $pass) || ($xpass eq $adpass)) {

#その記事を削除する

splice(@data,$i,1);

#データを書き込むサブルーチン

&write_data;

}

#ループを抜ける

last;

}

}

#アンロックするサブルーチン

&unlock;

}

########################################

# 時刻文字列を作るサブルーチン

########################################

sub make_time {

#引数(エポック秒)をローカル変数に代入する

local($time) = $_[0];

#ローカルタイム関数で取得したリストをローカル変数に代入する

local($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($time);

#曜日の配列を定義してローカル変数を宣言する

local(@week) = (’Sun’,’Mon’,’Tue’,’Wed’,’Thu’,’Fri’,’Sat’);

#local(@week) = (’日’,’月’,’火’,’水’,’木’,’金’,’土’);

#曜日を取得する

$wday = $week[$wday];

#月数に1を加算する

$mon++;

#年数に1900を加算する

$year += 1900;

#時刻文字列を作成してローカル変数を宣言する

local($time_string) = sprintf(”%04d/%02d/%02d (%s) %02d:%02d:%02d”,”$year”,”$mon”,”$mday”,”$wday”,”$hour”,”$min”,”$sec”);

# local($time_string) = sprintf(”%04d年%02d月%02d日(%s)%02d時%02d分%02d秒”,”$year”,”$mon”,”$mday”,”$wday”,”$hour”,”$min”,”$sec”);

#時刻文字列を戻り値として返す

return $time_string;

}

########################################

# データをチェンジするサブルーチン

########################################

sub change_data {

#引数(データ)をローカル変数に代入する

local($string) = $_[0];

#<を<に置換する

$string =~ s/</</g;

#>を>に置換する

$string =~ s/>/>/g;

#”を”に置換する

$string =~ s/”/”/g;

#,を,に置換する

$string =~ s/,/,/g;

#Windowsの改行コードを

に置換する

$string =~ s/¥r¥n/

/g;

#Macintoshの改行コードを

に置換する

$string =~ s/¥r/

/g;

#Unixの改行コードをを

に置換する

$string =~ s/¥n/

/g;

#チェンジ後のデータを戻り値として返す

return $string;

}

########################################

# データを受け取るサブルーチン

########################################

sub get_data {

#ローカル変数を宣言する

local($method,@pairs,$pair,$key,$value);

#環境変数からリクエストメソッドを取得する

$method = $ENV{’REQUEST_METHOD’};

if ($method eq ’POST’) {

#リクエストメソッドがPOSTの時のデータを取得する

read (STDIN,$buffer,$ENV{’CONTENT_LENGTH’});

} else {

#リクエストメソッドがPOST以外の時のデータを取得する

$buffer = $ENV{’QUERY_STRING’};

}

#データを「&」で切り分けて配列に代入する

@pairs = split (/&/,$buffer);

foreach $pair (@pairs) {

#データを「=」で切り分けて各々変数に代入する

($key,$value) = split(/=/,$pair);

#+を半角スペースに変換する

$value =~ tr/+/ /;

#%16進数の文字コードを読める文字に置換する

$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack(”C”,hex($1))/ge;

#文字コードをEUCに統一する

&jcode’convert(*value,’euc’);

#ハッシュを作成する

$form{$key} = $value;

}

}

########################################

# 環境変数を取得するサブルーチン

########################################

sub get_env {

#ユーザーのホスト名

$xhost = $ENV{’REMOTE_HOST’};

#ユーザーのIPアドレス

$xaddr = $ENV{’REMOTE_ADDR’};

#ユーザーのブラウザ情報

$xagent = $ENV{’HTTP_USER_AGENT’};

#直前に参照していたURL

#$xref = $ENV{’HTTP_REFERER’};

$xhost = $xaddr unless $xhost;

if ($xhost eq $xaddr) {

$ipad = pack(’C4’,split(/¥./,$xaddr));

$xhost = gethostbyaddr ($ipad,2) || $xaddr;

}

}

########################################

# データを読み込むサブルーチン

########################################

sub read_data {

#READというファイルハンドルでファイルを開く

open(READ,”$datafile”) || &error (’ファイルオープンエラー’);

#ファイルからデータを@dataに読み込む

@data = <READ>;

#ファイルを閉じる

close(READ);

}

########################################

# データを書き込むサブルーチン

########################################

sub write_data {

#WRITEというファイルハンドルでファイルを開く

open(WRITE,”>$datafile”) || &error(’ファイルオープンエラー’);

#ファイルに@dataを書き込む

print WRITE @data;

#ファイルを閉じる

close(WRITE);

}

########################################

# ロックするサブルーチン

########################################

sub lock {

#ロックディレクトリがすでに存在すれば

if (-e $lockdir) {

#作成された時間を調べて

local($checktime) = (stat($lockdir))[9];

#180秒経過していたら

if (($xtime - $checktime) > 180) {

#ロックディレクトリを削除する

rmdir($lockdir);

}

}

#ロックディレクトリを作成する

unless (mkdir($lockdir,0755)) {

#作成できなければエラー表示する

&error (’ロックエラー’);

}

}

########################################

# アンロックするサブルーチン

########################################

sub unlock {

#ロックディレクトリを削除する

rmdir($lockdir);

}

########################################

# エラーを表示するサブルーチン

########################################

sub error {

#引数(エラー名)をローカル変数に代入する

local($warning) = $_[0];

#HTML出力開始を宣言する

print ”Content-type: text/html¥n¥n”;

#ERRORパートのヒアドキュメント

print <<BBS_ERROR;

<html>

<head>

<meta http-equiv=”content-type” content=”text/html; charset=euc-jp”>

<title>$pagetitle</title>

<style type=”text/css”>

<!--

body {

background-color:white;

font-size:12px;

background-image:url(background.gif);

}

td {

font-size:12px;

}

-->

</style>

</head>

<body>

<table border=”0” cellspacing=”0” cellpadding=”0”>

<tr>

<td width=”40” valign=”top”><img src=”alert_icon.gif” alt=”Error” width=”32” height=”32”></td>

<td>$warning

@error_mes</td>

</tr>

</table>

</body>

</html>

BBS_ERROR

#全処理の終了を宣言する

exit;

}

##################################################

# Copyright (C) 2001 Tetsuro Mawatari & Yuji Adachi.

# Supported by

http://www.d-force.org/se/

BBS RE-DESIGN BOOK

##################################################


2 ● TomCat
●300ポイント

http://www.hatena.ne.jp/1

人力検索はてな

1000行超えてるよ〜(^-^;

うまく表示できなかったらサーバにUPして

再回答します。

▼部分が解説です。

分かりにくかったらあとで日記にでも書いてください。

コメントで説明します。

---------------------------------------

▼perlの位置。サーバの指定に合わせます

#!/usr/local/bin/perl

▼ここからメインルーチンが始まります。

▼初期設定ブロックはそれぞれのコメントの通りに実際の環境に合わせて設定すればOK。

##################################################

# 初期設定ブロック

##################################################

#最大記録記事数

$savemax = 100;

#最大表示記事数

$pagemax = 10;

#CGIプログラムのパス(755)

$pageurl = ’./bbs.cgi’;

#データファイルのパス(666)

$datafile = ’./bbs.dat’;

#ロックディレクトリのパス(777)

$lockdir = ’./lock/bbs.lock’;

#タイトル画像のHTML

#$titleimg = ’<IMG SRC=”./bbs.gif” WIDTH=”408” HEIGHT=”31” ALT=”BULLETIN BOARD SYSTEM”>’;

#jcode.pl(644)

require ’./jcode.pl’;

#BBSのタイトル

$pagetitle = ’BBS’;

#新着マークのHTML

$newimg = ’<img src=”./new.gif” alt=”NEW!” width=”27” height=”11”>’;

#新着マーク表示期間の秒数

$newtime = 60 * 60 * 24;

#HTMLタグを有効にする(1)しない(0)

$taguse = 1;

#書き込みを拒否する禁句

@words = (’バカ’,’アホ’,’クソ’);

#アイコン画像のURL

@icons = (’./icon_1.gif’,’./icon_2.gif’,’./icon_3.gif’);

#アイコン画像の横幅

$wicon = 15;

#アイコン画像の高さ

$hicon = 15;

#アクセスを拒否するドメイン名

@domains = (’d-force¥.org’,’d-force¥.net’,’d-force¥.com’);

#管理用パスワード

$adpass = ’panda’;

▼sub get_dataで、送られてきたデータを取り込んで、

連想配列になっているものを普通の変数に代入します。

##################################################

# データの受け取りブロック

##################################################

#データを受け取るサブルーチン

&get_data;

#使いやすい変数に入れ換える

$xdo = ”$form{’do’}”;

$xstart = ”$form{’start’}”;

$xname = ”$form{’name’}”;

$xmail = ”$form{’mail’}”;

$xurl = ”$form{’url’}”;

$xtitle = ”$form{’title’}”;

$xmes = ”$form{’mes’}”;

$xicon = ”$form{’icon’}”;

$xno = ”$form{’no’}”;

$xpass = ”$form{’pass’}”;

#エポック秒を取得する

$xtime = time;

▼sub get_envで、ホスト名、IPアドレス、ブラウザ情報、直前に参照していたURLを取得します

#環境変数を取得するサブルーチン

&get_env;

▼送られてきたパラメータに従って、読み出し、書き込み、記事削除といった動作に分岐します。

##################################################

# 処理の分岐ブロック

##################################################

▼配列 @domains に拒否ドメインが入っていたら、

その全てについてアクセス情報と突き合わせ、

拒否したいドメインと合致していたらエラー表示を出してアクセスさせないようにします。

#ホスト名にアクセスを拒否するドメイン名が含まれていたらエラー表示する

foreach $domain (@domains) {

if ($xhost =~ m/$domain/) { &error(’アクセスエラー’); }

}

▼ここは使っていません。プログラムとしては全く動作しない部分です。

#ホスト名にアクセスを拒否するドメイン名が含まれていたら特定のURLにジャンプさせる

#foreach $domain (@domains) {

# if ($xhost =~ m/$domain/) {

# print ”Location:

http://www.d-force.org/se/

BBS RE-DESIGN BOOK

¥n¥n”;

# exit;

# }

#}

▼もしCGIが呼び出された時に’write’が指定されていたら書き込み動作に分岐します。

if ($xdo eq ’write’) {

#記事の書き込みブロック

&write_bbs;

▼もしCGIが呼び出された時に’delete’が指定されていたら書き込み動作に分岐します。

} elsif ($xdo eq ’delete’) {

#記事の削除ブロック

&delete_bbs;

▼それ以外なら記事の表示動作に分岐します。

} else {

#記事の読み込みブロック

&read_bbs;

}

#記事の表示ブロック

&view_bbs;

▼プログラムのおおまかな流れはここで終了です。

#全処理の終了を宣言する

exit;

▲メインルーチン終了----------------------

▼ここから下は全てサブルーチンです---------------

▼書き込みデータファイルの読み込みブロックです。

「&何々」は全て「sub 何々」で書かれたサブルーチンをコールしています。

ですから、実際の処理の内容はそれぞれのサブルーチンの方を見ます。

##################################################

# 記事の読み込みブロック

##################################################

▼&read_bbsで参照されるサブルーチンです

sub read_bbs {

▼サブルーチンの中にもサブルーチンのコールがあります。

サブルーチンはこうして入れ子(マトリョーシカみたいに。わかります?)にすることができます。

#ロックするサブルーチン

&lock;

#データを読み込むサブルーチン

&read_data;

#アンロックするサブルーチン

&unlock;

}

▼読み込まれたファイルの内容を、体裁を付けて表示していくブロックです。

##################################################

# 記事の表示ブロック

##################################################

▼&view_bbsで参照されるサブルーチンです

sub view_bbs {

▼このへんはif文のかたまりなので

もし「何々の変数の内容が何々だったら」

と読み解いていけば動作が分かると思います。

#表示を開始するための添え字を決定する

if ($xstart eq ’’) { $xstart = 0; }

#表示を終了するための添え字を決定する

$end = $xstart + $pagemax;

if ($end > @data) { $end = @data; }

#次の何件ボタンの表示を設定する

if ($end < @data) {

$nextbutton = ”<a href=¥”$pageurl?start=$end¥”>[Next >]</a>”;

} else {

$nextbutton = ”[Next >]”;

}

#前の何件ボタンの表示を設定する

if ($xstart == 0) {

$prebutton = ”[< Previous]”;

} else {

$pre = $xstart - $pagemax;

$prebutton = ”<a href=¥”$pageurl?start=$pre¥”>[< Previous]</a>”;

}

#ダイレクトボタンの表示を設定する

▼1ページの表示書き込み数と書き込みの全数から、全部で何ページになるのかを計算します。

$block = int((@data - 1) / $pagemax) + 1 ;

▼ダイレクトボタンを作ります。

for ($a = 0; $a < $block; $a++) {

$dnb = $a * $pagemax;

$vnb = $a + 1;

if ($xstart == $dnb) {

$list = ” <b>$vnb</b>”;

} else {

$list = ” <a href=¥”$pageurl?start=$dnb¥”>$vnb</a>”;

}

$directbutton = ”$directbutton”.”$list”;

}

$directbutton = ”$directbutton ”;

▼ここからが表示の本番です。

#HTML出力開始を宣言する

print ”Content-type: text/html¥n¥n”;

▼ページのHTMLの上半分というか、書き込みフォームの所までのHTMLそのものです。

#TOPパートのヒアドキュメント

▼「<<BBS_TOP」から「BBS_TOP」に至るまでが、改行も含めてそのまま出力されます。

print <<BBS_TOP;

▼HTMLのお決まりのおまじない

<!DOCTYPE HTML PUBLIC ”-//W3C//DTD HTML 4.01 Transitional//EN”>

<html lang=”ja”>

▼head部分。<meta ・・・・>などは自由に増やせます。

ここに検索エンジン向けの様々な指定などを付加してやることもできます。

<head>

<meta http-equiv=”content-type” content=”text/html; charset=euc-jp”>

▼形式はHTMLそのものですが、$pagetitleは初期設定ブロックで設定した内容が表示されます。

<title>$pagetitle</title>

▼CSSです。

<style type=”text/css”>

<!--

▼背景色は白、文字色は黒、表示に余白を取らない、壁紙には background.gif を使う、

ということが指定されています。

body {

background-color:white;

color:black;

margin:0px;

background-image:url(background.gif);

}

▼「id=”l”」が指定された時に適用される表示の指定です。

表示の位置関係と横幅が指定されています。

#l {

position:absolute;

left:5px;

width:150px;

}

▼「id=”r”」が指定された時に適用される表示の指定です。

表示の位置関係と横幅のほか、高さと、margin-bottomで下の余白が指定されています。

#r {

position:absolute;

top:5px;

left:180px;

width:400px;

height:100%;

margin-bottom:10px;

}

▼タグ h1 に適用される指定です。

フォントファミリー、フォントのサイズ、表示色、周囲の余白、字間が指定されています。

h1 {

font-family:arial;

font-size:60px;

color:#393;

margin:0px;

letter-spacing:-2px

}

▼タグ h2 に適用される指定です。

フォントのサイズ、周囲の余白が指定されています。

h2 {

font-size:12px;

margin:0px;

}

▼タグ p に適用される指定です。

フォントのサイズ、行間が指定されています。

p {

font-size:12px;

line-height:18px;

}

▼タグ small に適用される指定です。

フォントのサイズ、フォントの太さ、行間が指定されています。

small {

font-size:10px;

font-weight:normal;

line-height:14px;

}

▼タグ form に適用される指定です。

余白が指定されています。

form {

margin:0px;

}

▼タグ td、つまりテーブルのセルに適用される指定です。

セル内の余白、フォントのサイズ、表示色、表示位置の上揃えが指定されています。

td {

padding:0px;

font-size:10px;

color:#393;

vertical-align:top;

}

▼フォーム部品textareaに適用される指定です。

縦横の幅のほか、枠の表示の様子も様々に設定されています。

border-styleにsolidを指定すると陰がつきません。

textarea {

width:320px;

height:100px;

border-width:1px;

border-color:#393;

border-style:solid;

margin:0px 0px 15px 15px;

}

▼フォーム部品selectに適用される指定です。

textareaの指定とほぼ同様です。

これで見栄えの統一感が出ます。

select {

border-style:solid;

border-color:#393;

border-width:1px;

height:14px;

font-size:10px;

margin:0px 0px 6px 15px;

}

▼フォーム部品inputに class=”check” と指定された時に適用される指定です。

余白だけ指定しています。

input.check {

margin:0px 0px 5px 15px;

}

▼フォーム部品inputに class=”fo” と指定された時に適用される指定です。

textareaの指定とほぼ同様にして統一感を出しています。

input.fo {

border-color:#393;

border-style:solid;

border-top-width:0px;

border-right-width:0px;

border-bottom-width:1px;

border-left-width:0px;

width:100%;

font-size:10px;

margin:0px 0px 5px 15px

}

▼フォーム部品inputに class=”f1” と指定された時に適用される指定です。

横幅だけ指定しています。

input.f1 {

width:320px;

}

▼フォーム部品inputに class=”f1” と指定された時に適用される指定です。

横幅と余白を指定しています。

input.f2 {

width:80px;

margin:0px 20px 0px 5px

}

▼何らかのタグに class=”hr1” と指定された時に適用される指定です。

背景色、表示色、高さ、ボーダーのスタイル、ボーダーの高さを指定しています。

.hr1 {

background-color:#393;

color:#393;

height:8px;

border-style:solid;

border-width:0

}

▼何らかのタグに class=”hr2” と指定された時に適用される指定です。

背景色、高さ、ボーダーのスタイル、ボーダーの横幅を指定しています。

.hr2 {

background-color:#030;

height:1px;

border-style:solid;

border-width:0

}

▼何らかのタグに id=”iconsample” と指定された時に適用される指定です。

余白だけ指定しています。

#iconsample {

margin:0px 0px 6px 10px

}

▼何らかのタグに class=”pages” と指定された時に適用される指定です。

フォントのサイズだけ指定しています。

.pages {

font-size:10px;

}

▼何らかのタグに class=”button1” と指定された時に適用される指定です。

これはボタン用の指定ですね。

border何々で枠の様子を、

あとは背景色、横幅、枠の中の余白、表示色、フォントのサイズ、フォントの太さ、余白を指定しています。

.button1 {

border-width:2px;

border-color:#393;

border-style:solid;

background-color:#fff;

width:60px;

padding:1px;

color:#393;

font-size:10px;

font-weight:bold;

margin:0px 10px 5px 0px

}

▼リンクの表示指定です。通常のリンクと、訪問済みリンクについて、

表示色は黒、下線付きということを指定しています。

a:link,a:visited { color:black; text-decoration:underline }

▼同じくリンクの表示指定です。アクティブ中のリンクと、マウスカーソルが乗っているリンクについて、

表示色は青、下線付きということを指定しています。

a:active,a:hover { color:blue; text-decoration:underline }

-->

</style>

▲ここまででCSSの指定は終了です。

</head>

▲ここまででhead部分は終了です。

▼ここからが実際に画面に表示される部分です。

<body>

<h1 id=”l” lang=”en”>BBS</h1>

<div id=”r”>

BBS_TOP

▲ヒアドキュメントの終わり。「<<BBS_TOP」からここまでが出力されます。

▼ここからは書き込みフォームのヒアドキュメントです。

「<<BBS_FORM」から「BBS_FORM」までがそのまま出力されます。

#FORMパートのヒアドキュメント

print <<BBS_FORM;

▼横線

<hr class=”hr1”>

▼書き込みフォームのはじまり

<form action=”$pageurl” method=”post”>

▼テーブルを組んでそれぞれの表示の位置関係を揃えます

テーブルのセルの中に、Name: などの項目名とフォーム部品が入っていきます。

class=”何々”、id=”何々” で、上のCSSで指定した表示の指定が

各フォーム部品に適用されている様子に注目してください。

<table>

<tr>

<td>Name:</td>

<td><input class=”fo f1” NAME=”name” type=”text” size=”20”></td>

</tr>

<tr>

<td>Icon:</td>

<td><select name=”icon”><option value=”0” selected>1</option> <option value=”1”>2</option><option value=”2”>3</option></select><img id=”iconsample” src=”iconsample.gif” alt=”Icon” width=”72” height=”15” align=”absbottom”></td>

</tr>

<tr>

<td>Mail:</td>

<td><input class=”fo f1” NAME=”mail” type=”text” size=”20”></td>

</tr>

<tr>

<td>URL:</td>

<td><input class=”fo f1” NAME=”url” type=”text” size=”20”></td>

</tr>

<tr>

<td>Password:</td>

<td><input class=”fo f1” NAME=”pass” type=”password” size=”20”></td>

</tr>

<tr>

<td>Title:</td>

<td><input class=”fo f1” NAME=”title” type=”text” size=”20”></td>

</tr>

<tr>

<td>Message:</td>

<td><TEXTAREA COLS=”55” ROWS=”5” NAME=”mes”></TEXTAREA><INPUT TYPE=”hidden” NAME=”do” VALUE=”write”></td>

</tr>

</table>

<INPUT class=”button1” TYPE=”submit” VALUE=”Submit”><INPUT class=”button1” TYPE=”reset” VALUE=”Clear All”>

</form>

<hr class=”hr1”>

BBS_FORM

▲ヒアドキュメントの終わり。「<<BBS_FORM」からここまでが出力されます。

▼ここからは記事データをプログラム的に整形して表示していきます。

#記事データを1件ずつ読み込み表示するループ

for ($i = $xstart; $i < $end; $i++) {

#行末の改行記号「¥n」を取り除く

chomp $data[$i];

#記事データを「,」で切り分けて各々変数に代入する

($no,$time,$title,$mes,$name,$mail,$url,$icon,$host,$addr,$agent) = split(/,/,$data[$i]);

#タイトルが未記入のときの表示を変更する

if ($title eq ’’) { $title = ’no title’ }

#新着マークを設定する

if ($newtime >= ($xtime - $time)) { $vnewimg = $newimg }

else { $vnewimg = ’’ }

if ($taguse) {

#メッセージ中の<を<に置換する

$mes=~ s/</</g;

#メッセージ中の>を>に置換する

$mes =~ s/>/>/g;

#メッセージ中の"を”に置換する

$mes =~ s/"/”/g;

}

#エポック秒から時刻文字列を取得する

$time_string = &make_time($time);

#名前が未記入のときの表示を変更する

if ($name eq ’’) { $name = ’no name’ }

#アイコン画像を選択する

$vicon = ”<img src=¥”$icons[$icon]¥” alt=¥”Icon¥” width=¥”$wicon¥” height=¥”$hicon¥” align=¥”absbottom¥”>”;

#メールアドレスが未記入のときの表示を変更する

if ($mail ne ’’) { $vmail = ”Mail: <a href=¥”mailto:$mail¥” target=¥”_blank¥”>$mail</a><br>” }

else { $vmail = ’’ }

#ホームページURLが未記入のときの表示を変更する

if ($url ne ’’) { $vurl = ”URL: <a href=¥”$url¥” target=¥”_blank¥”>$url</a><br>” }

else { $vurl = ’’ }

▼またまたヒアドキュメントです。

ヒアドキュメント部分は、とにかくそのままHTMLになると思ってください。

ただ変数部分は変数の内容が表示されます。

#DATAパートのヒアドキュメント

print <<BBS_DATA;

<h2>

No.$no<br>

$title$vnewimg<br>

<small>$name$vicon<br>$time_string</small>

</h2>

<p>

$mes

</p>

<div>

<small>

$vmail

$vurl

Agent: $agent<br>

Host: $host<br>

Addr: $addr<br>

</small>

</div>

<hr class=”hr2”>

BBS_DATA

▲ヒアドキュメントの終わり。「<<BBS_DATA」からここまでが出力されます。

}

▲記事データを1件ずつ読み込み表示するループの終わり

▼またまたヒアドキュメント。HTMLそのまんまです。

ただ変数部分は変数の内容が表示されます。

#CONTROLパートのヒアドキュメント

print <<BBS_CONTROL;

<div class=”pages”>

<b>Pages:</b> $prebutton$directbutton$nextbutton

</div>

<hr class=”hr1”>

<form action=”$pageurl” method=”post”>

<table>

<tr>

<td><input class=”button1” type=”submit” value=”Delete”></td>

<td>No.:<input class=”fo f2” type=”text” name=”no” size=”10”></td>

<td><input type=”hidden” name=”do” value=”delete”>Password: <input class=”fo f2” type=”password” name=”pass” size=”10” value=””></td>

</tr>

</table>

</form>

BBS_CONTROL

▲ヒアドキュメントの終わり。「<<BBS_CONTROL」からここまでが出力されます。

▼またまたヒアドキュメント。HTMLそのまんまです。

ただ変数部分は変数の内容が表示されます。

#BOTTOMパートのヒアドキュメント

print <<BBS_BOTTOM;

</div>

</body>

</html>

BBS_BOTTOM

▲ヒアドキュメントの終わり。「<<BBS_BOTTOM」からここまでが出力されます。

}

▲sub view_bbs の終わり。

##################################################

# 記事の書き込みブロック

##################################################

▼サブルーチン write_bbsのはじまり。

&write_bbs で参照される部分です。

sub write_bbs {

#名前が未記入のときはエラー表示する

#if ($xname eq ’’) { push(@error_mes,”名前を入力して下さい。<BR>”); }

#メールアドレスが不正のときはエラー表示する

if (($xmail ne ’’) && ($xmail !~ m/.+¥@.+¥..+/)) { push(@error_mes,”メールアドレスが不正です。<br>”); }

#ホームページURLが不正のときはエラー表示する

if (($xurl ne ’’) && ($xurl !~ m/http:¥/¥/.+¥..+/)) { push(@error_mes,”ホームページURLが不正です。<br>”); }

#タイトルが50バイト以上のときはエラー表示する

#if (length($xtitle) >= 50) { push(@error_mes,”タイトルを短くして下さい。<br>”); }

#メッセージが未記入のときはエラー表示する

if ($xmes eq ’’) { push(@error_mes,”メッセージを入力して下さい。<br>”); }

#メッセージが1000バイト以上のときはエラー表示する

if (length($xmes) >= 1000) { push(@error_mes,”メッセージを短くして下さい。<br>”); }

#メッセージに禁句が含まれていたらエラー表示する

foreach $word (@words) {

if ($xmes =~ m/$word/) { push(@error_mes,”不正な文字「$word」が含まれています。<br>”); }

}

#エラーメッセージがあれば入力エラー表示する

if (@error_mes) { &error(’入力エラー’); }

#データをチェンジする

$xname = &change_data(”$xname”);

$xmail = &change_data(”$xmail”);

$xurl = &change_data(”$xurl”);

$xtitle = &change_data(”$xtitle”);

$xmes = &change_data(”$xmes”);

$xicon = &change_data(”$xicon”);

$xhost = &change_data(”$xhost”);

$xaddr = &change_data(”$xaddr”);

$xagent = &change_data(”$xagent”);

$xpass = &change_data(”$xpass”);

#ロックするサブルーチン

&lock;

#データを読み込むサブルーチン

&read_data;

#最新記事データを取得する

($no,$time,$title,$mes,$name,$mail,$url) = split(/,/,$data[0]);

#二重投稿でなければ

unless (($xname eq $name) && ($xmes eq $mes)) {

#最新記事No.+1を取得する

$xno = $no + 1;

#新しい記事データを作成する

$newdata = join(”,”,($xno,$xtime,$xtitle,$xmes,$xname,$xmail,$xurl,$xicon,$xhost,$xaddr,$xagent,$xpass));

#新しい記事データを@dataの先頭に追加する

unshift(@data,”$newdata¥n”);

#最大記録記事数で@dataを切りつめる

splice(@data,$savemax);

#データを書き込むサブルーチン

&write_data;

}

#アンロックするサブルーチン

&unlock;

}

▲sub write_bbs の終わり。

########################################

# 記事の削除ブロック

########################################

▼サブルーチン delete_bbsのはじまり。

&delete_bbs で参照される部分です。

sub delete_bbs {

#ロックするサブルーチン

&lock;

#データを読み込むサブルーチン

&read_data;

#記事データを1件ずつ読み込み調査するループ

for ($i = 0; $i < @data; $i++) {

#記事データを「,」で切り分けて各々変数に代入する

($no,$time,$title,$mes,$name,$mail,$url,$icon,$host,$addr,$agent,$pass) = split(/,/,$data[$i]);

#記事No.が同じなら

if ($no eq $xno) {

#投稿者パスワード末尾の改行記号「¥n」を取り除く

chomp $pass;

#投稿者パスワードが空なら管理用パスワードを代入する

if ($pass eq ’’) { $pass = $adpass; }

#投稿者パスワードまたは管理用パスワードが一致すれば

if (($xpass eq $pass) || ($xpass eq $adpass)) {

#その記事を削除する

splice(@data,$i,1);

#データを書き込むサブルーチン

&write_data;

}

#ループを抜ける

last;

}

}

#アンロックするサブルーチン

&unlock;

}

▲sub delete_bbs の終わり。

########################################

# 時刻文字列を作るサブルーチン

########################################

▼サブルーチン make_timeのはじまり。

&make_time で参照される部分です。

sub make_time {

#引数(エポック秒)をローカル変数に代入する

local($time) = $_[0];

#ローカルタイム関数で取得したリストをローカル変数に代入する

local($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($time);

#曜日の配列を定義してローカル変数を宣言する

local(@week) = (’Sun’,’Mon’,’Tue’,’Wed’,’Thu’,’Fri’,’Sat’);

#local(@week) = (’日’,’月’,’火’,’水’,’木’,’金’,’土’);

#曜日を取得する

$wday = $week[$wday];

#月数に1を加算する

$mon++;

#年数に1900を加算する

$year += 1900;

#時刻文字列を作成してローカル変数を宣言する

local($time_string) = sprintf(”%04d/%02d/%02d (%s) %02d:%02d:%02d”,”$year”,”$mon”,”$mday”,”$wday”,”$hour”,”$min”,”$sec”);

# local($time_string) = sprintf(”%04d年%02d月%02d日(%s)%02d時%02d分%02d秒”,”$year”,”$mon”,”$mday”,”$wday”,”$hour”,”$min”,”$sec”);

#時刻文字列を戻り値として返す

return $time_string;

}

▲sub make_time の終わり。

########################################

# データをチェンジするサブルーチン

########################################

▼サブルーチン change_dataのはじまり。

&change_data で参照される部分です。

ここでは、書き込みの文字コードのうち、HTMLとしてそのまま表示できないものを

HTML用に変換しています。

sub change_data {

#引数(データ)をローカル変数に代入する

local($string) = $_[0];

#<を<に置換する

$string =~ s/</</g;

#>を>に置換する

$string =~ s/>/>/g;

#”を"に置換する

$string =~ s/”/"/g;

#,を,に置換する

$string =~ s/,/,/g;

#Windowsの改行コードを<BR>に置換する

$string =~ s/¥r¥n/<BR>/g;

#Macintoshの改行コードを<BR>に置換する

$string =~ s/¥r/<BR>/g;

#Unixの改行コードをを<BR>に置換する

$string =~ s/¥n/<BR>/g;

#チェンジ後のデータを戻り値として返す

return $string;

}

▲sub change_data の終わり。

########################################

# データを受け取るサブルーチン

########################################

▼サブルーチン get_dataのはじまり。

&get_data で参照される部分です。

ここでは、CGIが呼び出された時に付された様々なデータ、

たとえば書き込み、削除といった動作のモードとか、

書き込みの内容などを、

それぞれの変数の中に格納していきます。

sub get_data {

#ローカル変数を宣言する

local($method,@pairs,$pair,$key,$value);

#環境変数からリクエストメソッドを取得する

$method = $ENV{’REQUEST_METHOD’};

if ($method eq ’POST’) {

#リクエストメソッドがPOSTの時のデータを取得する

read (STDIN,$buffer,$ENV{’CONTENT_LENGTH’});

} else {

#リクエストメソッドがPOST以外の時のデータを取得する

$buffer = $ENV{’QUERY_STRING’};

}

#データを「&」で切り分けて配列に代入する

@pairs = split (/&/,$buffer);

foreach $pair (@pairs) {

#データを「=」で切り分けて各々変数に代入する

($key,$value) = split(/=/,$pair);

#+を半角スペースに変換する

$value =~ tr/+/ /;

#%16進数の文字コードを読める文字に置換する

$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack(”C”,hex($1))/ge;

#文字コードをEUCに統一する

&jcode’convert(*value,’euc’);

#ハッシュを作成する

$form{$key} = $value;

}

}

▲sub get_data の終わり。

########################################

# 環境変数を取得するサブルーチン

########################################

▼サブルーチン get_envのはじまり。

&get_env で参照される部分です。

ここではアクセス者のホスト情報など、

要するにアクセス解析的情報をサーバから受け取ります。

sub get_env {

#ユーザーのホスト名

$xhost = $ENV{’REMOTE_HOST’};

#ユーザーのIPアドレス

$xaddr = $ENV{’REMOTE_ADDR’};

#ユーザーのブラウザ情報

$xagent = $ENV{’HTTP_USER_AGENT’};

#直前に参照していたURL

#$xref = $ENV{’HTTP_REFERER’};

$xhost = $xaddr unless $xhost;

if ($xhost eq $xaddr) {

$ipad = pack(’C4’,split(/¥./,$xaddr));

$xhost = gethostbyaddr ($ipad,2) || $xaddr;

}

}

▲sub get_env の終わり。

########################################

# データを読み込むサブルーチン

########################################

▼サブルーチン read_dataのはじまり。

&read_data で参照される部分です。

ここではサーバのHDDから書き込みデータのファイルを読み込んでいます。

sub read_data {

#READというファイルハンドルでファイルを開く

open(READ,”$datafile”) || &error (’ファイルオープンエラー’);

#ファイルからデータを@dataに読み込む

@data = <READ>;

#ファイルを閉じる

close(READ);

}

▲sub read_data の終わり。

########################################

# データを書き込むサブルーチン

########################################

▼サブルーチン write_dataのはじまり。

&write_data で参照される部分です。

ここではサーバのHDDの書き込みデータのファイルに、

書き込み内容を保存しています。

sub write_data {

#WRITEというファイルハンドルでファイルを開く

open(WRITE,”>$datafile”) || &error(’ファイルオープンエラー’);

#ファイルに@dataを書き込む

print WRITE @data;

#ファイルを閉じる

close(WRITE);

}

▲sub write_data の終わり。

########################################

# ロックするサブルーチン

########################################

▼サブルーチン lockのはじまり。

&lock で参照される部分です。

ここでは同時に二人以上が書き込みや削除などの

ファイルを改変してしまう操作をしようとした時、

先着を優先して、一人だけに操作を許可する仕組みを実現しています。

sub lock {

#ロックディレクトリがすでに存在すれば

if (-e $lockdir) {

#作成された時間を調べて

local($checktime) = (stat($lockdir))[9];

#180秒経過していたら

if (($xtime - $checktime) > 180) {

#ロックディレクトリを削除する

rmdir($lockdir);

}

}

#ロックディレクトリを作成する

unless (mkdir($lockdir,0755)) {

#作成できなければエラー表示する

&error (’ロックエラー’);

}

}

▲sub lock の終わり。

########################################

# アンロックするサブルーチン

########################################

▼サブルーチン unlockのはじまり。

&unlock で参照される部分です。

ここでは sub lock による排他制御を解除します。

sub unlock {

#ロックディレクトリを削除する

rmdir($lockdir);

}

▲sub unlock の終わり。

########################################

# エラーを表示するサブルーチン

########################################

▼サブルーチン errorのはじまり。

&error で参照される部分です。

エラーメッセージの表示部分です。

sub error {

#引数(エラー名)をローカル変数に代入する

local($warning) = $_[0];

#HTML出力開始を宣言する

print ”Content-type: text/html¥n¥n”;

▼エラーメッセージのHTMLの本体です。

変数$warningと、配列@error_mesの内容を表示します。

#ERRORパートのヒアドキュメント

print <<BBS_ERROR;

<html>

<head>

<meta http-equiv=”content-type” content=”text/html; charset=euc-jp”>

<title>$pagetitle</title>

<style type=”text/css”>

<!--

body {

background-color:white;

font-size:12px;

background-image:url(background.gif);

}

td {

font-size:12px;

}

-->

</style>

</head>

<body>

<table border=”0” cellspacing=”0” cellpadding=”0”>

<tr>

<td width=”40” valign=”top”><img src=”alert_icon.gif” alt=”Error” width=”32” height=”32”></td>

<td>$warning<br>@error_mes</td>

</tr>

</table>

</body>

</html>

BBS_ERROR

#全処理の終了を宣言する

exit;

}

▲sub error の終わり。

---------------------------------------

以上です。

◎質問者からの返答

お疲れ様でした!!そして感謝!!

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ