PHPやRubyのソースを見ながら、試行錯誤で作ってみた。
Perlということでplにしたけど、実際にはMENTAディレクトリ内での実行のため、拡張子はcgiに変更した。
久しぶりにモジュールを使わずに一から作ったらなかなか大変だった。
古いソースを引っ張り出して基本的な変換（アンエスケープ）をしたり、ファイルやディレクトリの一覧を得るのに、readdirを使ったり。
調べないと全然覚えてない。
しかし、セキュリティ的に微妙な気がする
。
とりあえず、「.」から始まるファイルやディレクトリは見せないようにはした。
さりげなく使っているけど、最近覚えたData::Dumperの技。
1
|
use Data::Dumper;sub p { print Data::Dumper::Dumper(shift) }
|
こうすることで、デバッグするときは
というふうに簡単に出力することができる。
便利だね。
jqueryFileTree.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
#!/usr/bin/perl
# jQuery File Tree Perl Connector
# Version 0.01
# https://www.nqou.net
# 31 Dec 2008
# Output a list of files for jQuery File Tree
use strict;
use warnings;
use utf8;
# use Data::Dumper;sub p { print Data::Dumper::Dumper(shift) }
print "Content-type: text/html;\n\n";
my @args = <>;
# p(\@args);
my %params = (map { split /=/ } @args);
# p(\%params);
foreach my $value (values %params) {
uri_unescape(\$value);
}
# p(\%params);
my $target = $params{dir} || './';# 省略時は現在のディレクトリ（元々の仕様は最上位ディレクトリ）
die "Error!" if $target =~ /\.\./;# さかのぼり禁止
die "Error!" unless -d $target;# ディレクトリ以外禁止
our @files;
search_dir($target);
# p(\@files);
print qq{<ul class="jqueryFileTree" style="display: none;">};
foreach my $file (@files) {
if (-d $file) {
my ($dir) = $file =~ m!/([^/]*?)$!o;
print qq{<li class="directory collapsed"><a href="#" rel="$file/">$dir</a></li>};
} elsif (-f _) {
my ($ext) = $file =~ /([^\.]+)$/o;
my ($filename) = $file =~ m!/([^/]*?)$!o;
print qq{<li class="file ext_${ext}"><a href="#" rel="$file">$filename</a></li>};
} else {
print "Error!";
}
}
print qq{</ul>};
# ディレクトリを走査
sub search_dir {
my $dir = shift;
my @f;
opendir my $dh, $dir or die "can not open `$dir`: $!";
foreach my $file (sort {$a cmp $b} readdir $dh) {
next if $file =~ /^\./o;
my $path = qq{$dir$file};
if (-f $path) {
push @f, $path
} elsif (-d _) {
push @files, $path;
}
}
closedir $dh;
push @files, @f;# ディレクトリ、ファイルの順にする
}
# アンエスケープ
sub uri_unescape {
my $str = shift;
$$str =~ s/%([0-9a-fA-F]{2})/pack("H2", $1)/eg;
}
|