本を買ってから「効率的なソース」について考えるようになった。とはいっても、数回の実行では目に見えて変わる事はないけど。
で、「サブディレクトリ内も一覧（その２）」を見てしまって「これはちょっと・・・」と思った（コスト表示した「その２」）。
で、ほぼ同じ物を新しく作ってみたら、時間が約半分になった（当社比）。結果的に「readdir」を一回で済むようにしたのが効いたのかもしれない。少なくとも、その発想が出ただけでも良しとしよう。
ただ、以前は使っていなかった「リファレンス」を使うようにしたので、ファイル数やディレクトリが多くなると、もっと短くなるかもしれない。
・・・と思ってやってみた。条件と結果は、以下のようになりました。
| タイプ１ | タイプ２ | |||||||
|---|---|---|---|---|---|---|---|---|
| ts0014p | ts0025 | ts0014p | ts0025 | |||||
| 総フォルダ数 | 70 | 10.44 | 5.82 | 36 | 2.80 | 2.25 | ||
| 総ファイル数 | 4,631 | 424 | ||||||
| 総ファイルサイズ（バイト） | 12,843,625 | 1,746,391 | ||||||
| HTMLファイル数 | 419 | 252 | ||||||
| HTMLファイルサイズ（バイト） | 2,314,124 | 882,760 | ||||||
これだけで決めてしまうのはよくないけど、ファイル数が多いと「readdir」の回数が効いてくるようだ。でも、HTMLファイルの比率が高い場合は、それほど差がつかないのがちょっと残念。
ところで、「dumpvar.pl」と「dumpValueサブルーチン」は、（「リファレンス」を含む）配列、ハッシュを把握するのにとても役に立つパッケージで、「ActivePerl522」にはついている。これも前述の「実用 Perlプログラミング」に載っていたんだけど、実は非公開（非公式？）のパッケージらしい。
このサブルーチンを使うと、深い階層の配列やハッシュの値が、整形されて表示される。複雑な形式の変数を扱うときは、これで確認しながら作っていくと、デバッグもしやすいのでお奨めです。
使用する方法は、まず「dumpvar.pl」を「require」します。これは標準の「@INC」に入っていると思うので、探す必要はないと思います。そして、そのパッケージ内に存在する「dumpValue」サブルーチンに、表示したい配列、またはハッシュを「リファレンス」で渡します。すると、あら不思議。デバッグに有効な情報が手に入る。というわけです。是非試してみてください。
・・・ちょっと欠陥（ディレクトリ名が正しく取れない事があったみたいです）を見つけてしまったので、訂正しました。すると、悲しいかな、差が縮んでしまいました (T_T)
ただ、「ts0014p」にも新しい欠陥（ディレクトリの字下げが正しく行なわれていないみたいです）を見つけてしまったのですが・・・。
多少条件が変わりましたが、とりあえず、新しい結果を・・・。
| タイプ１ | タイプ２ | |
|---|---|---|
| ts0014p | 11.15 | 2.80 |
| ts0025 | 9.88 | 2.31 |
「タイプ１」が、かなり遅くなってしまいました。ディレクトリ情報を収集するだけで「６秒」ほどかかってしまいます。訂正方法が良くなかったのかもしれません。ディレクトリとファイルの区別を、もっと簡潔にできないものでしょうか・・・。
・・・
今回、ローカル環境から完全に移行するために「jcode.pl」に変更しました。
ついでに、リンク先も付け加えたのですが・・・。ハッシュは順不同で呼び出されるので、見事にリンクの順番が変わってしまいました・・・。いくつか先に、配列を２つ使ってリンクを作成するスクリプトがあるはずなので、これは愛嬌ということに・・・ (^^;;;
ここから追記（2000/12/14）
ハッシュは、順不同で呼び出される、じゃなくて、取り出しやすいように順不同で格納される、が正解。呼び出した結果だけ見れば同じようなものだけど・・・。
ソースコード
#!/usr/bin/perl
#BEGIN{
# print "Content-type: text/plain\n\n";
# open(STDERR, ">&STDOUT");
# $|=1;
#}
$timeBegin = times;
# use Jcode;
require '../../../cgi-bin/jcode.pl';
$info_mailName = 'Nobu3';
$info_mailAddr = 'nobu3@x.age.ne.jp';
$info_uriName = 'Incomprehensible Perl Project';
$info_uriAddr = 'http://www.age.ne.jp/x/nobu3/perl/';
$info_uri = qq(<a href="$info_uriAddr">$info_uriName</a>.);
$info_mail = qq((C)1999 <a href="mailto:$info_mailAddr">$info_mailName</a>. All rights reserved.);
$info_copyright = "<address>\n<font face=times>$info_uri<br>\n$info_mail</font><br>\n</address>\n";
# @usr_stylesheet = ('/Nobu3/ipp.css','../test.css');# できあがりからのURIパス
@usr_stylesheet = ('../../ipp.css', '../test.css');
$usr_outcode = 'jis';
$usr_outCharset = 'iso-2022-jp';
$usr_title = 'テスト２５';
$explain = $ENV{SCRIPT_NAME};
$explain =~ s|cgi/(ts[0-9]{4})(_[12u])?\.cgi$|$1\.htm|;
$explain_title = $usr_title . 'の解説';
%usr_links = ( 'Home' => '../../../index.htm'
, 'Perl' => '../../'
, 'TestCGI Index' => '../'
, $explain_title => $explain
);
$searchDir = '..';
$searchReg = '\.(html?|[sp]ht(ml)?)$';
$indexReg = "index$searchReg";
{
$ra_dir = dirSearch($searchDir);
printHeader($usr_title);
printBodyHeader($usr_title);
print "<div class=test>\n";
Jprint('<p>親ディレクトリ以下にあるファイルの一覧（HTMLファイルのみ）</p>'."\n");
print "<ul>\n";
# require "dumpvar.pl"; dumpValue($ra_dir);
printRefArray($ra_dir);
print "</ul>\n</div>\n";
printFooter();
exit(0);
}
sub searchTitle{
my($file)= @_;
my $title = 'タイトル無し';
open(IN, $file);
while(<IN>){
if(m|<title>(.*?)</title>|i){
$title = ($1 !~ /^\s*$/) ? $1:'不正なタイトル';
last;
}
last if m|</head>|i;
}
close(IN);
return $title;
}
sub printRefArray{
my($ra_dir) = @_;
my $indexfile = (grep(/$indexReg/, @$ra_dir))[0] || '';
my $dir = shift(@$ra_dir);
my($dirname) = $dir =~ m|([^/]+)/$|;
my $title = 'ＨＴＭＬインデックス無し';
$title = searchTitle($indexfile) if($indexfile);
Jprint(qq(<li><strong><a href="$dir">$dirname（$title）</a></strong>\n));
return if($#$ra_dir < 0);
print "<ul>\n";
foreach $file(@$ra_dir){
next if($file eq $indexfile);
if(ref($file)){
printRefArray($file);
next;
}elsif(-r $file){
my $title = searchTitle($file);
my($filename) = $file =~ m|([^/]+)$|;
Jprint(qq(<li><a href="$file">$filename（$title）</a>\n));
}
}
print "</ul>\n";
}
sub dirSearch{
my($dir) = @_;
my @dirs = ();
my @filenames = ("$dir/");
opendir(DIR, $dir);
my @files = sort grep(/^[^\.]/, readdir(DIR));
closedir(DIR);
foreach(@files){
$_ = "$dir/$_";
if(-d $_){
push(@dirs, dirSearch($_));
}elsif(/$searchReg/){
push(@filenames, $_);
}
}
push(@filenames, @dirs);
return \@filenames;
}
sub printHeader{
# 「<title>タグ」の文字列
my($title) = @_;
print "Content-type: text/html; charset=$usr_outCharset\n\n";
print qq(<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">\n);
print "<html lang=ja>\n<head>\n";
print qq(<meta http-equiv="Content-type" content="text/html; charset=$usr_outCharset">\n);
print qq(<meta http-equiv="Content-style-type" content="text/css">\n);
Jprint("<title>$title</title>\n");
print qq(<link rev="made" href="$info_mailAddr">\n);
foreach(@usr_stylesheet){ print qq(<link rel="stylesheet" type="text/css" href="$_">\n); }
print qq(<meta name="ROBOTS" content="NOINDEX">\n);
print "</head>\n\n";
print "<body>\n\n";
}
sub printBodyHeader{
# 英字なら「printBodyHeader("<font face=times>Title String</font>");」がいい
my($title) = @_;
print "<div align=center>\n";
Jprint(qq(<h1><a name="top">$title</a></h1>\n<hr>\n));
printLinks();
print "</div>\n";
}
sub printFooter{
print "<div align=center>\n";
print qq(<a href="#top">Top</a>\n<hr>\n);
printLinks();
print "</div>\n";
print "\n<div align=right>\n";
$timeEnd = sprintf("%.3f", times - $timeBegin);
print "Cost : $timeEnd<br>\n";
print $info_copyright;
print "\n</body>\n</html>\n\n";
}
sub printLinks{
my $cnt = 0;
foreach(keys %usr_links){
print "/ " if($cnt++);
Jprint(qq(<a href="$usr_links{$_}">$_</a>\n));
}
print "<hr>\n";
}
sub Jprint{
foreach(@_){
# print Jcode::convert($_, $usr_outcode);
print jcode::to($usr_outcode, $_);
}
}