Code.013 2003年01月13日発行
■━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━■
【 Webプログラミング 】
〜 猫的プログラマーとその軌跡 〜
■━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━■
▼毎週月曜日に配信しています。
▼等幅フォントでご覧いただくとキレイに見えます。
▼登録・解除はこちらから可能です。
< http://www.ichikoro.com/webp/ >
※ぜひお友達にもご紹介ください(^^)/
こんにちは、編集者の勝部です。
遅ればせながら、あけましておめでとうざいます。
今年もよろしくお願いします( ^.^)( -.-)( _ _)
＃Amazonギフト券の当選者発表は、編集後記の後に
＃あります。
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
CGI(Perl)ファイル処理 その6：「ディレクトリ操作」
──────────────────────────────────────
今回はCGI特有の話題ではなくPerlに特化したお話です。
まぁ年明け一発目ですし、今回はウォーミングアップもかねて、以下のようなCGIを
作ってみたいと思います。
Mission : 簡易エクスプローラーを作成せよ
‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
○問題
指定ディレクトリ内にあるファイルを一覧表示し、ディレクトリの
作成・削除、名称変更が出来るCGI「mini_explorer.cgi」を作成せよ。
今回の目的は「ディレクトリの操作」です。
まずはソースの下にある「実行方法」を読んで、
実際に動かしてみてください。
あくまで学習用ですので、排他制御やセキュリティ面他、細かい
処理などはあまり考慮していません。また使い勝手も微妙に悪い
です。てなわけで本番運用で使うにはもう一工夫必要です。
───────
ソース
───────
#!/usr/bin/perl
;#
;#簡易エクスプローラー(mini_explorer.cgi)
;#
#----------------------------------------------------------------------#
# モジュール #
#----------------------------------------------------------------------#
use strict; #コーディングを厳格化
use CGI qw(:cgi); #フォームデータ取得
use CGI::Carp qw(fatalsToBrowser); #エラー時にブラウザへ表示
#======================================================================#
# メインルーチン #
#======================================================================#
package main;
{
my $document_root = $ENV{'DOCUMENT_ROOT'} || "."; #ドキュメントルート取得
my $q = new CGI();
#-----------------------------------#
# 引数取得 #
#-----------------------------------#
my $dir = $q->param("dir") || $document_root; #ディレクトリ取得
my $mode = $q->param("mode"); #実行モード
my $target = $q->param("target"); #修正時：修正対象ディレクトリ
#削除時：削除対象ディレクトリ
my $newname = $q->param("newname"); #新規作成時：ディレクトリ名
# 修正時：新しいディレクトリ名
#-----------------------------------#
# ヘッダ表示 #
#-----------------------------------#
$| = 1;
print $q->header( -type => "text/html",
-charset => "Shift_JIS" );
Explorer::print_header( $dir );
#-----------------------------------#
# 新規作成 #
#-----------------------------------#
if( $mode eq "new" ){
#-- 入力チェック --#
if( ! Explorer::chkFileName($newname) ){
util::error("入力エラー", "入力されたファイル名が不正か空白です");
}
#-- ディレクトリ作成 --#
mkdir("$dir/$newname", 0755)
or util::error("システムエラー", "ディレクトリが作成できませんでした。$dir/$newname ($!)");
}
#-----------------------------------#
# 修 正 #
#-----------------------------------#
elsif( $mode eq "update" ){
#-- 入力チェック --#
if( ! Explorer::chkFileName($newname) ){
util::error("入力エラー", "入力されたファイル名が不正か空白です");
}
#-- ディレクトリ名変更 --#
rename($target, "$dir/$newname")
or util::error("システムエラー","ディレクトリ名の変更ができませんでした。$target --> $dir/$newname ($!)");
}
#-----------------------------------#
# 削 除 #
#-----------------------------------#
elsif( $mode eq "del" ){
#-- 指定ディレクトリ配下のファイルを全て削除する --#
Explorer::rmAll($target);
}
#-----------------------------------#
# ファイル一覧表示 #
#-----------------------------------#
my $file;
#-- カレントディレクトリ移動 --#
chdir($dir) or die("Can not change directory:$dir ($!)");
#-- ディレクトリ内をなめる --#
opendir(DIR, ".") or die("Can not open directory: . ($!)");
while( $file = readdir(DIR) ){
next if( $file =~ /^\./); #最初が '.' で始まるファイルはパス
#-- ディレクトリなら --#
if( -d $file ){
Explorer::print_directory( $dir, $file );
}
#-- ファイルなら --#
elsif( -f $file ){
Explorer::print_file( $dir, $file );
}
}
closedir(DIR);
#-----------------------------------#
# フッタ表示 #
#-----------------------------------#
Explorer::print_footer();
#-----------------------------------#
# 正常終了 #
#-----------------------------------#
exit(0);
}
;#
;#Explorerパッケージ
;#
package Explorer;
use strict; #コーディングを厳格化
#--------------------------------------------------------------#
#■ディレクトリ名表示
# 内容：ディレクトリ名を表示する
#
# 引数：(1)カレントディレクトリのパス：スカラー
# (2)ディレクトリ名：スカラー
# 戻り値：なし
#--------------------------------------------------------------#
sub print_directory{
my $dir = shift;
my $file = shift;
my $q = util::uri_encode("$dir/$file");
print <<"END_OF_HTML";
<TABLE border="1">
<TR>
<TD width="300" align="left" valign="middle"><A href="$ENV{SCRIPT_NAME}?dir=$q">$file</A></TD>
<TD>
<FORM onSubmit="return( confirm('本当に変更しますか？(実行後の取り消し・復帰はできません)') )">
<INPUT type="hidden" name="mode" value="update">
<INPUT type="hidden" name="target" value="$dir/$file">
<INPUT type="hidden" name="dir" value="$dir">
<INPUT type="text" name="newname" size="10">
<INPUT type="submit" value="修正">
</FORM>
</TD>
<TD>
<FORM onSubmit="return( confirm('ディレクトリ配下の全てのファイルを削除します。OKですか？') )">
<INPUT type="hidden" name="mode" value="del">
<INPUT type="hidden" name="target" value="$dir/$file">
<INPUT type="hidden" name="dir" value="$dir">
<INPUT type="submit" value="削除">
</FORM>
</TD>
</TR>
</TABLE>
END_OF_HTML
}
#--------------------------------------------------------------#
#■ファイル名表示
# 内容：ファイル名を表示する
#
# 引数：(1)ディレクトリのパス：スカラー
# (2)ファイル名：スカラー
# 戻り値：なし
#--------------------------------------------------------------#
sub print_file{
my $dir = shift;
my $file = shift;
print <<"END_OF_HTML";
<TABLE border="1">
<TR>
<TD width="300" align="left" valign="middle">$file</TD>
</TR>
</TABLE>
END_OF_HTML
}
#--------------------------------------------------------------#
#■ディレクトリ配下を全て削除
# 内容：指定のディレクトリを含む、その配下のファイル・ディレ
# クトリを再帰的に全て削除する。
#
# 引数：(1)ディレクトリのパス：スカラー
# 戻り値：なし
#--------------------------------------------------------------#
sub rmAll{
my $dir = shift;
my $file;
opendir(DIR, $dir) or die("Can not open directory:$dir ($!)");
while( $file = readdir(DIR) ){
next if( $file =~ /^\.{1,2}$/ ); # '.' と '..' はパス
#-- ディレクトリの場合は自分自身を呼び出す --#
if( -d "$dir/$file" ){
rmAll("$dir/$file");
}
#-- それ以外は unlink --#
else{
unlink("$dir/$file") or die("Can not unlink file:$dir/$file ($!)");
}
}
closedir(DIR);
#-- 最後に指定ディレクトリを削除 --#
rmdir($dir) or die("Can not open directory:$dir ($!)");
}
#--------------------------------------------------------------#
#■ファイル名をチェックする
# 内容：指定の文字列が、ファイル名として使用するのに
# 問題ないかチェックする
#
# 引数：(1)文字列：スカラー
# 戻り値：問題なし -> 真
# 問題あり -> 偽
#--------------------------------------------------------------#
sub chkFileName{
my $name = shift;
if( $name =~ /^[a-zA-Z0-9\.\-\_]{1,32}$/ ){
return(1);
}
else{
return(0);
}
}
#--------------------------------------------------------------#
#■ヘッダ表示
# 内容：ヘッダ部分のHTMLを表示する
# 引数：(1)ディレクトリ：スカラー
# 戻り値：なし
#--------------------------------------------------------------#
sub print_header{
my $dir = shift;
print <<"END_OF_HTML";
<HTML>
<HEAD>
<META http-equiv="Content-type" content="text/html; charset=Shift_JIS">
<TITLE>エクスプローラー</TITLE>
<STYLE type="text/css"><!--
FORM {
margin: 0px;
}
-->
</STYLE>
</HEAD>
<BODY bgcolor="#FFFFFF">
<FORM>
<INPUT type="hidden" name="mode" value="new">
<INPUT type="hidden" name="dir" value="$dir">
ディレクトリ名：<INPUT type="text" name="newname" size="30">
<INPUT type="submit" value="新規作成">
</FORM>
<BR>
<H2>$dir</H2>
END_OF_HTML
}
#--------------------------------------------------------------#
#■フッタ表示
# 内容：フッタ部分のHTMLを表示する
# 引数：なし
# 戻り値：なし
#--------------------------------------------------------------#
sub print_footer{
print <<"END_OF_HTML";
<BR>
<HR>
<DIV align="right">All Right Reserved, CopyRight (C) 2003
<A href="http://www.ichikoro.com/webp/" target="_blank">Webプログラミング</A>
</DIV>
</BODY>
</HTML>
END_OF_HTML
}
;#
;#ユーティリティーパッケージ
;#
package util;
use strict; #コーディングを厳格化
#--------------------------------------------------------------#
#■URLエンコード
# 内容：指定文字列をURLエンコードする
# 引数：(1)対象文字列：スカラー
# 戻り値：URLエンコード後の文字列：スカラー
#--------------------------------------------------------------#
sub uri_encode{
my $str = shift;
$str =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
return($str);
}
#--------------------------------------------------------------#
#■エラー終了
# 内容：エラーメッセージを表示しプログラムを終了する
# 引数：(1)タイトル：スカラー
# (2)詳細なメッセージ：スカラー
# 戻り値：なし
#--------------------------------------------------------------#
sub error{
my $title = shift;
my $msg = shift;
print "<H2>$title</H2>$msg";
exit(0);
}
__END__
───────
実行方法
───────
テキストエディタ(メモ帳やSimpleText)などで上記のソース(プログラム)を
保存してください。適当な名前(xxxx.cgi)でOKです。
その他、CGIの詳しい実行方法については Code.001 をご参照ください。
http://www.ichikoro.com/webp/bk/00046/
★注意！(必読)
全ての人に公開されたサーバ上で実行するのは非常に危険です。
アクセス制限を設けるか、ローカル上で実行してください。
またこのCGIを使用したことによって被害などが出ても責任は
取れません。あくまで自己責任の範疇でご使用ください。
───────
解 説
───────
○ディレクトリ操作用の関数
今回使用した関数の中で、ディレクトリの操作にかかわる物は
以下になります。
opendir ........ ディレクトリを開く
readdir ........ ディレクトリ内のファイル、ディレクトリ名を取り出す
closedir ....... ディレクトリを閉じる
mkdir .......... ディレクトリを作成
rmdir .......... ディレクトリを削除
rename ......... ファイル(ディレクトリ)名変更
unlink ......... ファイル削除
※ディレクトリの削除は行えない
ではでは簡単に説明していきましょう。
○ファイル名を取り出す
基本的にはファイルを操作するのとあまり変わりません。
・ディレクトリの場合
#-- ディレクトリ内のファイル名を表示 --#
opendir(DIR, "./mydocument");
while( $buff = readdir(DIR) ){ #一行ずつ取り出し
print $buff . "\n"; #表示する
}
closedir(DIR);
ディレクトリを開いて、一行ずつ読み出し、最後は閉じる。
ファイルと変わらないですよね？
これを実行するとディレクトリ内のファイルを一つずつ表示
してくれるのですが、その中に '.' と '..' も含まれます。
これは、
'.' ..... 今いるディレクトリ
'..' ..... 一階層上のディレクトリ
を示しています。
表示したくない場合は、
while( $buff = readdir(DIR) ){ #一行ずつ取り出し
next if( $buff =~ /^\.{1,2}$/ );
print $buff . "\n"; #表示する
}
とするか、'.'で始まるファイルを全て表示しないのであれば
while( $buff = readdir(DIR) ){ #一行ずつ取り出し
next if( $buff =~ /^\./ );
print $buff . "\n"; #表示する
}
何て方法をよくみかけます。
○ディレクトリの作成
作成するには関数を一つ呼び出すだけです。
> #-- ディレクトリ作成 --#
> mkdir("$dir/$newname", 0755);
第2引数はパーミションです。
○ディレクトリの削除
削除するのもやはり関数を一つ呼び出すだけです。
> #-- 最後に指定ディレクトリを削除 --#
> rmdir($dir) or die("Can not open directory:$dir ($!)");
ただし、ディレクトリの中にファイルやディレクトリが残っている
場合は削除することができません。そこで、全てを消去するには
以下のサブルーチンにあるように、再帰的に消してやる方法を
取ります。
> sub rmAll{
> my $dir = shift;
> my $file;
>
> opendir(DIR, $dir) or die("Can not open directory:$dir ($!)");
> while( $file = readdir(DIR) ){
> next if( $file =~ /^\.{1,2}$/ ); # '.' と '..' はパス
>
> #-- ディレクトリの場合は自分自身を呼び出す --#
> if( -d "$dir/$file" ){
> rmAll("$dir/$file");
> }
> #-- それ以外は unlink --#
> else{
> unlink("$dir/$file") or die("Can not unlink file:$dir/$file ($!)");
> }
> }
> closedir(DIR);
>
> #-- 最後に指定ディレクトリを削除 --#
> rmdir($dir) or die("Can not open directory:$dir ($!)");
> }
OSに依存しますが、UNIX系の場合は
system("rm -r [ディレクトリ名]");
と、コマンドに頼る方法もあります。
探せばCPANにモジュールも落っこちてると思います。
http://search.cpan.org/
○ディレクトリ名変更
ファイルの名前を変更するのと全く一緒です。
関数も同じなのです。
> #-- ディレクトリ名変更 --#
> rename($target, "$dir/$newname");
私もよく忘れそうになるのですが、
rename(古い名前, 新しい名前);
の順番です。
間違えるとややこしくなりますので、ご注意を。
いやー、よく勘違いするんですよね(^^;)
───────
次回予告
───────
次回はDBMについて解説したいと思います。
おおっと、またもやCGIとは直接関係ない話ですな(^^;)
ただ、使いこなせればこんなに便利な機構はありません。
小規模データベースが簡単に作成できますよ。
───────
配信予定
───────
ファイル処理編の配信予定一覧です。
・CGI(Perl)ファイル処理 その1：「ファイルを読む」
http://www.ichikoro.com/webp/bk/00053/
・CGI(Perl)ファイル処理 その2：「ファイルへの書き込み」
http://www.ichikoro.com/webp/bk/00054/
・CGI(Perl)ファイル処理 その3：「ファイルロック:flock 前編」
http://www.ichikoro.com/webp/bk/00055/
・CGI(Perl)ファイル処理 その4：「ファイルロック:flock 後編」
http://www.ichikoro.com/webp/bk/00056/
・CGI(Perl)ファイル処理 その5：「ファイルロック:mkdir編」
http://www.ichikoro.com/webp/bk/00057/
・CGI(Perl)ファイル処理 その6：「ディレクトリ操作」＜＜今回
・CGI(Perl)ファイル処理 その7：「DBMを使おう！」
これらの配信予定は都合により追加・変更・中止になる可能性が
あります。取り上げて欲しいテーマやご意見・ご要望はぜひ以下
までおよせください。
・BBS
http://www.ichikoro.com/webp/bbs/
・メール
mm-webp@ichikoro.com
───────
分からない
───────
いまいちよく分からない場合は、以下へれっつらごー。
・サポートBBS
このメルマガ専用のサポート掲示板です。
勝部が(分かる範囲内で)ギモンにスパッとお答えします。
メールで聞くより高速です。お気軽にお書き込みください(^^)/
http://www.ichikoro.com/webp/bbs/
・CGIプログラミングML
CGIなどWebに関する話題を繰り広げるメーリングリスト。
このメルマガとは関係ありませんので発言時は注意を。
http://www.ichikoro.com/cgi/ml/
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
編 集 後 記
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
年男＆厄年だけあって、年始から色んな目にあってます。
実家から東京に戻る予定の朝、一本の電話がかかってきました。
小・中学校時代の同級生で一時期惚れていた子でした(^^ゞ
ドキドキしながら話を聞いていると、小学校の頃の担任の先生が昨日亡くなられ
たらしく、葬儀に参列したいが皆忙しくてつかまらない、といった内容でした。
何を期待しとんねんと思いつつ、戻る日を1日ずらし友人とともに参列してきた
のでした。
亡くなられたのは非常に残念だったのですが、旧友と連絡がとれたのをきっかけ
に、向こうでは同窓会でもしようという話になっているとか。
そして翌日、実家から帰省する際に 松江(島根県)〜東京間の切符をなくし、
再発行する羽目になりました。何十回と帰省＆旅行に行ってますが、こんな
ことは初めて。
途中乗り換える予定の岡山駅で気がつき泣く泣く緑の窓口で事情を相談し、
再発行をしていただきました。区間分(乗車券と特急券など)の料金を支払うこと
になりまが、もしもその切符がどこからか出てきた場合には払い戻しをしてもら
えるとか。
戻ってから数日後、見つからないだろうなぁと思っていた矢先に、JCBから
電話が！岡山駅で切符が発見されたとの事。昨年、カードで切符を購入した
ためカード番号から私の連絡先を割り当てたそうです。
○教訓
長距離切符を買う時はカードで。
ってか無くすな(^^;)
そのことを会社で話したとたん、今度は成り行き上お昼をおごる羽目に(^-^;
ついてんだかついてないんだか(笑)
今年は生まれてはじめて(?)年明け前から高校の頃の先輩に誘われ初詣に行き
帰りにガストで朝の5時くらいまで昔話をしたりと、こうしてみると良い事の
方が多いのかな？と思います。
ま、とりあえず楽しいからよし（笑）
--------------------------
Amazonギフト券当選者発表
--------------------------
Amazonギフト券1000円分がご応募いただいた方の中から抽選で5名の方に
当たるアンケート。厳正な抽選の結果、以下の方が当選されました！
・当選番号
00001
00003
00006
00008
00009
昨年末にあらかじめお送りしている抽選番号が書かれた
メールをご確認ください。
※応募したにも関わらず届いていない場合は
ご連絡ください。
1月16日以降に、ご応募いただきましたメールアドレスへギフト券を送付
いたします。もしメールアドレスをご変更されている場合は至急ご連絡
ください。
また、ご当選されているのにもかかわらず2月になっても何の連絡もない
場合は大変お手数ですが、以下のメールアドレスまでご連絡ください。
mm-webp@ichikoro.com
それでは今年もWebプログラミングをよろしくお願いいたします。
また来週お会いしましょう！ (^-^)/~~~
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
【 Webプログラミング Code Sample 】
発 行 ： ichikoro.com
発行責任者 ： 勝部 麻季人
< katsube@ichikoro.com >
Webサイト ： < http://www.ichikoro.com/webp/ >
お問い合わせ先 ： < mm-webp@ichikoro.com >
Powerd by まぐまぐ
All Right Reserved, CopyRight(C) 2001-2003 Webプログラミング Code Sample
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
