#!/usr/local/bin/perl
my $base = '.';
my $sort_anchor = 0;
my $max_upload = 0;
my $edit_length = 500000;
my $post_max = 2000000;
my $date_func = sub { sprintf '%04d年%02d月%02d日 %02d時%02d分', 1900 + $_[5], 1 + $_[4], @_[3, 2, 1] };
# 設定終わり。
# folder.gif と file.gif は別途用意してください。
# $sort_anchor = 1; $max_upload = 3; くらいで全ての機能が使えます。
# アップロード機能の実装に伴い CGI.pm のテンポラリファイルである
# /^CGItemp\d+$/ のファイル名は例外的に非表示にしました。
# アップロード可能なファイル名は半角英数程度と思ってください。
# JavaScript は無効でも全ての機能が使えますが有効にするとタブエディタになりますよ♪
# このスクリプトは性質上、利用者が安全性を管理しなければなりません。
$base =~ s/[\\\/]+$//;
use CGI qw/:param/;
$CGI::POST_MAX = $post_max;
$CGI::DISABLE_UPLOADS = 1 <= $max_upload ? 0 : 1;
#param('path' => '.');
#param('edit:aabb.dat' => 1);
#param('mode', 'Edit');
my $obj = new Explorer substr param('mode') || '', 0, 256;
$obj->set_path($base);
$obj->set_sort_anchor($sort_anchor);
$obj->set_max_upload($max_upload);
$obj->set_date_func($date_func);
$obj->set_language('JP');
$obj->set_edit_length($edit_length);
$obj->set_post_max($post_max);
$obj->set_version('3.2');
my $charset = $obj->dict('charset');
my $javascript = $max_upload ? $obj->get_javascript() : '';
my $body = join "\n", $obj->execute();
binmode STDOUT;
#print "Cache-Control: no-cache\x0d\x0a";
print "Content-Type: text/html\x0d\x0a\x0d\x0a";
print param('mode')
? '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">'
: '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN">',
"\n",
<<HTML;
<html lang="ja">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=$charset">
<meta http-equiv="Content-Script-Type" content="text/javascript">
<meta http-equiv="Content-Style-Type" content="text/css">
$javascript
<style type="text/css">
<!--
.alert { color:red; margin:0px; padding:0px; }
.chmod { text-align:right }
.copyright { color:teal; text-align:right; }
.IE { background-color:#eeeeee; border:1px solid silver; font-size:11px; position:absolute; top:24px; width:180px; }
.IE dd, .IE dd ul, .NN dd, .NN dd ul { margin:0px; padding:2px; }
.IE dt { color:blue; font-size:120%; font-weight:bold; }
.NN { background-color:#eeeeee; border:1px solid silver; font-size:11px; position:fixed; right:0px; top:0px; width:180px; }
.NN dt { color:blue; cursor:hand; font-weight:bold; text-decoration:underline; }
.reload { display:inline; font-weight:bold; }
.status { background-color:#eeeeee; border:1px solid silver; font-size:11px; width:300px; }
.status dd, .status dd ul { margin:0px; padding:2px; }
.status dt { color:blue; font-size:120%; }
.submit { margin:0px 0px 20px 20px; padding:0px 32px; }
body { font-family:Tahoma, sans-serif; font-size:90%; }
h1 { font-size:120% }
img { border:0px }
li { margin:0px; padding:0px; white-space:nowrap; }
ol, ul { list-style:none; margin:0px; padding:0px 16px; }
var { font-style:normal; position:absolute; left:50px; }
-->
</style>
<title>WebExplorer</title>
</head>
$body
</html>
HTML
exit;
package Language::JP;
sub get {
scalar {
'charset' => 'Shift_JIS',
'reload' => '更新',
'save_all' => '全て保存',
'delete' => '削除',
'edit' => '編集',
'back' => '戻る',
'property' => 'のプロパティ',
'exit_confirm' => '保存していない場合は変更が破棄されます。',
'update' => '更新しました。',
'submit' => '送 信',
'error_open' => 'ファイルが開けませんでした。',
'error_size' => 'ファイルが大きすぎます。',
'error_length' => 'データが大きすぎます。',
'sort_name' => '名前▲',
'sort_r_name' => '名前▼',
'sort_size' => 'サイズ▲',
'sort_r_size' => 'サイズ▼',
'sort_mtime' => '日付▲',
'sort_r_mtime' => '日付▼',
'stat_dev' => 'デバイス番号:',
'stat_ino' => 'iノード番号:',
'stat_mode' => 'パーミッション:',
'stat_nlink' => 'リンク数:',
'stat_uid' => 'ユーザID:',
'stat_gid' => 'グループID:',
'stat_rdev' => '識別子:',
'stat_size' => 'サイズ:',
'stat_atime' => 'アクセス時刻:',
'stat_mtime' => '更新時刻:',
'stat_ctime' => '作成時刻:',
'stat_blksize' => 'ブロックサイズ:',
'stat_blocks' => 'ブロック数:',
'help001' => 'チェックボックスは<strong>削除用</strong>と<strong>編集用</strong>です。',
'help002' => '<strong>削除</strong>は確認無しで削除するので注意が必要です。',
'help003' => 'リネームはファイルが存在していると<strong>上書き</strong>されます。',
'help004' => 'データが大きくなりすぎると<strong>破損する恐れ</strong>があります。',
};
}
package Language::EN;
sub get {
scalar {
'charset' => 'ISO-8859-1',
'reload' => 'Reload',
'save_all' => 'Save all',
'delete' => 'Delete',
'edit' => 'Edit',
'back' => 'Back',
'property' => '',
'exit_confirm' => 'Quit?',
'update' => 'Update',
'submit' => 'Submit',
'error_open' => 'No such file or directory',
'error_size' => 'too large',
'error_length' => 'too large',
'sort_name' => 'Name U',
'sort_r_name' => 'Name D',
'sort_size' => 'Size U',
'sort_r_size' => 'Size D',
'sort_mtime' => 'Date U',
'sort_r_mtime' => 'Date D',
'stat_dev' => 'dev = ',
'stat_ino' => 'ino = ',
'stat_mode' => 'mode = ',
'stat_nlink' => 'nlink = ',
'stat_uid' => 'uid = ',
'stat_gid' => 'gid = ',
'stat_rdev' => 'rdev = ',
'stat_size' => 'size = ',
'stat_atime' => 'atime = ',
'stat_mtime' => 'mtime = ',
'stat_ctime' => 'ctime = ',
'stat_blksize' => 'blksize = ',
'stat_blocks' => 'blocks = ',
'help001' => '',
'help002' => '',
'help003' => '',
'help004' => '',
};
}
package Language;
sub new {
my ($class, $country) = @_;
my $dict = 'Language::JP';
if ($class && $country) {
no strict 'refs';
if (exists ${$class . '::'}{$country . '::'}) {
$dict = $class . '::' . $country;
}
}
bless $dict->get(), ref $class || $class;
}
sub get {
my ($self, $key) = @_;
$self->{$key};
}
package File::Tree;
sub new {
my ($class, $path) = @_;
my $self = bless {
'path' => '',
'filename' => undef,
'status' => [],
# 'child' => [],
}, ref $class || $class;
$self->set_path($path)->set_status();
}
sub set_filename {
my $self = shift;
$self->{'filename'} = $self->get_path() =~ /([^\\\/]+)$/ ? $1 : undef;
$self;
}
sub set_path {
my ($self, $path) = @_;
if (defined $path) {
$self->{'path'} = $path;
$self->set_filename();
if (-d $self->get_path()) {
$self->{'child'} = [];
}
}
$self;
}
sub get_status {
wantarray ? @{shift->{'status'}} : shift->{'status'};
}
sub set_status {
my $self = shift;
if (length $self->get_path()) {
$self->{'status'} = [stat $self->get_path()];
}
$self;
}
sub dev { shift->{'status'}[0] }
sub ino { shift->{'status'}[1] }
sub mode { shift->{'status'}[2] }
sub nlink { shift->{'status'}[3] }
sub uid { shift->{'status'}[4] }
sub gid { shift->{'status'}[5] }
sub rdev { shift->{'status'}[6] }
sub size { shift->{'status'}[7] }
sub atime { shift->{'status'}[8] }
sub mtime { shift->{'status'}[9] }
sub ctime { shift->{'status'}[10] }
sub blksize { shift->{'status'}[11] }
sub blocks { shift->{'status'}[12] }
sub set_child {
my ($self, $type, $recursive, $sort_method) = @_;
my @type = (
sub { 1 },
sub { -d $_[0] },
sub { -f $_[0] },
sub { -l $_[0] },
);
$sort_method ||= 'sort_name';
$type = defined $type ? $type % @type : 0;
if (defined $self->{'child'}) {
if (opendir my $dh, $self->get_path()) {
while (my $name = readdir $dh) {
my $path = $self->get_path() . "/$name";
if ($name ne '.' && $name ne '..' && $name !~ /^CGItemp\d+$/ && $type[$type]->($path)) {
push @{$self->{'child'}}, File::Tree->new($path);
if ($recursive) {
$self->{'child'}[-1]->set_child($type, $recursive, $sort_method);
}
}
}
closedir $dh;
no strict 'refs'; # 最近のバージョンでは不要
$self->$sort_method();
} else {
warn $!;
}
}
$self;
}
sub path_exists {
my ($self, $path, $base) = @_;
my $result = '';
if (defined $path && length $path) {
unless (defined $base) {
$base = $self->get_path();
}
if ($path eq $base) {
$result = $base;
} elsif (opendir my $dh, $base) {
while (my $name = readdir $dh) {
if ($name ne '.' && $name ne '..') {
$result = $self->path_exists($path, "$base/$name");
if (length $result) {
last;
}
}
}
closedir $dh;
}
}
$result;
}
sub mkdir_recursive {
my ($self, $dirname, $mode, $pattern) = @_;
$mode = defined $mode && $mode =~ /^([0-7]{1,4})$/ ? $1 : '0700';
my $path = '';
my $result;
if (defined $dirname) {
foreach (split /[\\\/]+/, $dirname) {
s/^\s+//;
s/\s+$//;
s/\.+/./g;
if (/^($pattern)$/) {
$path .= $1;
if (length $path) {
if ($self->get_path() =~ /^(.+)$/) { # -T を回避
$result = mkdir $1 . '/' . $path, 0777 & oct $mode;
}
}
$path .= '/';
} else {
last;
}
}
}
$result;
}
sub remove_recursive {
my ($self, $path) = @_;
my $result = 0;
if ($path =~ /^(.+)$/) { # -T を回避
$path = $1;
if (opendir my $dh, $path) {
while (my $name = readdir $dh) {
if ($name ne '.' && $name ne '..') {
$result += $self->remove_recursive("$path/$name");
}
}
closedir $dh;
$result += rmdir $path;
} else {
$result += unlink $path;
}
}
$result;
}
sub remove {
my ($self, @path) = @_;
my $result;
foreach (@path) {
$result = $self->remove_recursive($_);
}
$result;
}
sub upload {
my ($self, $pattern, @files) = @_;
my $buffer = 65536;
my $num = 0;
if ($self->get_path() =~ /^(.+)$/) { # -T を回避
my $path = $1;
foreach my $filename (@files) {
if ($filename =~ /($pattern)$/) {
my $name = $1;
$name =~ s/^\s+//;
$name =~ s/\s+$//;
$name =~ s/\.+/./g;
if (length $name && open my $fh, "> $path/$name") {
binmode $fh;
binmode $filename;
while (read $filename, my $data, $buffer) {
print $fh $data;
}
close $fh;
$num++;
}
}
close $filename;
}
}
$num;
}
sub multi_chmod {
my ($self, %dict) = @_;
my $num = 0;
while (my ($path, $mode) = each %dict) {
if ($mode =~ /^([0-7]{1,4})$/ && chmod 0777 & oct $1, $path) {
$num++;
}
}
$num;
}
sub multi_rename {
my ($self, %dict) = @_;
my $num = 0;
if ($self->get_path() =~ /^(.+)$/) { # -T を回避
my $path = $1;
while (my ($old_name, $new_name) = each %dict) {
if (length $old_name && length $new_name && $old_name ne $new_name) {
$num += rename "$path/$old_name", "$path/$new_name";
}
}
}
$num;
}
sub sort_method_exists {
my ($self, $method) = @_;
no strict 'refs';
(grep /^sort_[a-z_]+?$/ && $method eq $_, keys %{__PACKAGE__ . '::'})[0];
}
sub sort_name {
my $self = shift;
@{$self->{'child'}} = sort {
defined $b->{'child'} <=> defined $a->{'child'}
|| lc $a->get_path() cmp lc $b->get_path()
} @{$self->{'child'}};
$self;
}
sub sort_r_name {
my $self = shift;
@{$self->{'child'}} = sort {
defined $b->{'child'} <=> defined $a->{'child'}
|| lc $b->get_path() cmp lc $a->get_path()
} @{$self->{'child'}};
$self;
}
sub sort_size {
my $self = shift;
@{$self->{'child'}} = sort {
defined $b->{'child'} <=> defined $a->{'child'}
|| $a->size() <=> $b->size()
|| lc $a->get_path() cmp lc $b->get_path()
} @{$self->{'child'}};
$self;
}
sub sort_r_size {
my $self = shift;
@{$self->{'child'}} = sort {
defined $b->{'child'} <=> defined $a->{'child'}
|| $b->size() <=> $a->size()
|| lc $a->get_path() cmp lc $b->get_path()
} @{$self->{'child'}};
$self;
}
sub sort_mtime {
my $self = shift;
@{$self->{'child'}} = sort {
defined $b->{'child'} <=> defined $a->{'child'}
|| $a->mtime() <=> $b->mtime()
|| lc $a->get_path() cmp lc $b->get_path()
} @{$self->{'child'}};
$self;
}
sub sort_r_mtime {
my $self = shift;
@{$self->{'child'}} = sort {
defined $b->{'child'} <=> defined $a->{'child'}
|| $b->mtime() <=> $a->mtime()
|| lc $a->get_path() cmp lc $b->get_path()
} @{$self->{'child'}};
$self;
}
sub AUTOLOAD {
my $self = shift;
$File::Tree::AUTOLOAD =~ /::get_([0-9A-Za-z_]{1,256})$/ && exists $self->{$1}
? $self->{$1}
: undef;
}
package Explorer::Index;
sub execute {
my $self = shift;
'<frameset cols="30%,*" title="Index">',
'<frame src="' . $self->get_myself() . '?mode=Tree" name="Tree" title="Tree">',
'<frame src="' . $self->get_myself() . '?mode=Edit" name="Edit" title="Edit">',
'<noframes>',
'<body>',
'<ul>',
'<li><a href="' . $self->get_myself() . '?mode=Tree">Tree</a>',
'<li><a href="' . $self->get_myself() . '?mode=Edit">Edit</a>',
'</ul>',
'</body>',
'</noframes>',
'</frameset>';
}
package Explorer::List;
use CGI qw/:param/;
sub create_sort_anchor {
my ($self, $path) = @_;
map(
'<a href="' . $self->get_myself() . '?mode=Edit&path=' . $path . '&sort=' . $_->[0] . '">' . $_->[1] . '</a>',
map(
[$_, $self->dict("sort_$_")],
qw/name r_name size r_size mtime r_mtime/
)
);
}
sub execute {
my $self = shift;
my $obj = new File::Tree $self->get_path();
my $path = $obj->path_exists(substr param('path') || '', 0, 256);
my $sort_method = $obj->sort_method_exists('sort_' . substr param('sort') || '', 0, 64);
unless (length $path && -d $path) {
$path = $self->get_path();
}
my $parent = $path;
$parent =~ s/\/[^\\\/]+$//;
undef $obj;
my $current_obj = new File::Tree $path;
$current_obj->set_child(0, 0, $sort_method);
'<body>',
'<p class="reload">',
'<a href="' . $self->get_myself() . '?mode=Edit&path=' . $path . '" target="Edit">' . $self->dict('reload') . '</a>',
$self->get_sort_anchor() ? $self->create_sort_anchor($current_obj->get_path()) : (),
'</p>',
'<h1>' . $current_obj->get_path() . '/</h1>',
1 <= $self->get_max_upload()
? do {
'<form action="' . $self->get_myself() . '" method="post" enctype="multipart/form-data">',
'<ul>',
'<li>'
. '<img src="folder.gif" alt="[folder]"> '
. '<input type="text" name="chmod_0" value="705" size="4" class="chmod"><input type="text" name="mkdir">',
map(
'<li><img src="file.gif" alt="[ file ]"> '
. qq{<input type="text" name="chmod_$_" value="604" size="4" class="chmod"><input type="file" name="file$_">},
1..$self->get_max_upload()
),
'<li><input type="submit" value="' . $self->dict('submit') . '" class="submit" accesskey="x">',
'</ul>',
'<ol>',
'<li>'
. '<img src="folder.gif" alt="[folder]"> '
. '<input type="checkbox" name="disable1" value="" disabled> '
. '<input type="checkbox" name="disable2" value="" disabled> '
. '<input type="text" name="disable3" value="" size="4" disabled> '
. '<input type="text" name="disable4" value="" size="8" disabled> '
. ' <- '
. '<a href="' . $self->get_myself() . '?mode=Edit&path=' . $parent . '">..</a>',
$self->obj2html($current_obj, $self->get_max_upload()),
'<input type="hidden" name="sort" value="' . ($sort_method && $sort_method =~ /^sort_(.+)$/ ? $1 : '') . '">',
'<input type="hidden" name="path" value="' . $path . '">',
'<input type="hidden" name="mode" value="Edit">',
'</ol>',
'</form>',
'<ul>',
'<li>' . $self->dict('help001'),
'<li>' . $self->dict('help002'),
'<li>' . $self->dict('help003'),
'</ul>';
}
: do {
'<ol>',
'<li>'
. '<img src="folder.gif" alt="[folder]"> '
. '<a href="' . $self->get_myself() . '?mode=Edit&path=' . $parent . '">..</a>',
$self->obj2html($current_obj, $self->get_max_upload()),
'</ol>';
},
'<p class="copyright">WebExplorer ' . $self->get_version() . '</p>',
'<div id="p0"></div>',
'</body>';
}
package Explorer::Tree;
sub execute {
my $self = shift;
my $obj = new File::Tree $self->get_path();
$obj->set_child(1, 1);
'<body>',
'<p class="reload"><a href="' . $self->get_myself() . '?mode=Tree" target="Tree">' . $self->dict('reload') . '</a></p>',
'<ol>',
'<li><img src="folder.gif" alt="[folder]"> <a href="' . $self->get_myself() . '?mode=Edit&path=' . $self->get_path() . '" target="Edit">.</a>',
$self->obj2html($obj),
'</ol>',
'</body>';
}
package Explorer::Edit;
use CGI qw/:param/;
our @ISA;
sub update {
my ($self, $path) = @_;
my $current_obj = new File::Tree $path;
my $sort_method = $current_obj->sort_method_exists('sort_' . substr param('sort') || '', 0, 64);
$current_obj->set_child(0, 0, $sort_method);
my @obj = ref $current_obj->get_child() eq 'ARRAY' ? @{$current_obj->get_child()} : ();
$current_obj->multi_chmod(
map
length $_->get_filename() && defined param('chmod:' . $_->get_filename())
? ($_->get_path() => substr param('chmod:' . $_->get_filename()), 0, 4)
: (),
@obj
);
$current_obj->mkdir_recursive(
substr(defined param('mkdir') ? param('mkdir') : '', 0, 256),
substr(defined param('chmod_0') ? param('chmod_0') : '0700', 0, 4),
$self->get_dir_pattern()
);
my @num = grep ref param("file$_") eq 'Fh', 1..$self->get_max_upload();
my $file_pattern = $self->get_file_pattern();
$current_obj->upload($file_pattern, map param("file$_"), @num);
$current_obj->multi_chmod(
map
param("file$_") =~ /($file_pattern)$/
? ($current_obj->get_path() . "/$1" => substr defined param("chmod_$_") ? param("chmod_$_") : '0600', 0, 4)
: (),
@num
);
$current_obj->remove(
map
length $_->get_filename() && param('remove:' . $_->get_filename())
? $_->get_path()
: (),
@obj
);
$current_obj->multi_rename(
map {
my $new_name;
if (length $_->get_filename()) {
if (defined param('rename:' . $_->get_filename()) && param('rename:' . $_->get_filename()) =~ /^($file_pattern)$/) {
$new_name = $1;
}
}
defined $new_name ? ($_->get_filename() => $new_name) : ();
} @obj
);
}
sub file {
my ($self, $path, $data) = @_;
if ($path =~ /^(.+)$/) { # -T を回避
$path = $1;
if (open my $fh, "+< $path") {
binmode $fh;
eval { flock $fh, 2 };
if (defined $data and print $fh $data) {
truncate $fh, tell $fh;
}
seek $fh, 0, 0;
read $fh, $data, -s $fh;
close $fh;
}
}
$data;
}
sub execute {
my $self = shift;
my @html;
@ISA = qw/Explorer::List/;
if (1 <= $self->get_max_upload()) {
my $obj = new File::Tree $self->get_path();
my $path = $obj->path_exists(substr param('path') || '', 0, 256);
undef $obj;
if ($path =~ /^\./) {
$self->update($path);
unless (-d $path) {
$path = $self->get_path();
}
my $current_obj = new File::Tree $path;
$current_obj->set_child(2);
my @filename;
@html = sub {
@_
? (
'<body onload="reset_zindex(' . @filename . ')">',
'<p class="reload">',
'<a href="' . $self->get_myself() . '?mode=Edit&path=' . $current_obj->get_path() . '" target="Edit" onclick="return exit_confirm()">' . $self->dict('back') . '</a>',
map(
qq{<a href="javascript:add_zindex($_)" id="tab$_">$filename[$_ - 1]</a>},
1..@filename
),
'</p>',
'<h1>' . $current_obj->get_path() . '/</h1>',
'<form action="' . $self->get_myself() . '" method="post">',
'<div>',
@_,
'<input type="hidden" name="mode" value="Edit">',
'<input type="hidden" name="path" value="' . $current_obj->get_path() . '">',
'</div>',
'</form>',
'</body>'
)
: ();
}->(
map {
my $message = '';
my $data = '';
if ($_->size() <= $self->get_edit_length()) {
if (defined($data = $self->file($_->get_path()))) {
if (defined param('data:' . $_->get_filename())) {
$data = substr param('data:' . $_->get_filename()), 0, 1.5 * $self->get_edit_length();
$data =~ s/\x0d\x0a|\x0d|\x0a/\n/g;
if (length $data <= $self->get_edit_length()) {
$self->file($_->get_path(), $data);
$_->set_status();
$message = $self->dict('update');
} else {
$message = $self->dict('error_length');
}
}
} else {
$data = '';
$message = $self->dict('error_open');
}
} else {
$message = $self->dict('error_size');
}
push @filename, $_->get_filename();
'<div id="zindex' . @filename . '">',
'<textarea name="data:' . $_->get_filename() . '" cols="64" rows="14" wrap="off">'
. $self->htmlspacialchars($data)
. '</textarea><br>',
'<input type="submit" value="' . $self->dict('save_all') . '" accesskey="x">',
'<input type="hidden" name="edit:' . $_->get_filename() . '" value="">',
'<dl class="status">',
'<dt><strong>' . $_->get_filename() . '</strong> <strong class="alert">' . $message . '</strong>',
'<dd>',
'<ul>',
'<li>' . $self->dict('stat_dev') . $_->dev(),
'<li>' . $self->dict('stat_ino') . $_->ino(),
'<li>' . $self->dict('stat_mode') . sprintf("%03o", 07777 & $_->mode()),
'<li>' . $self->dict('stat_nlink') . $_->nlink(),
'<li>' . $self->dict('stat_uid') . $_->uid(),
'<li>' . $self->dict('stat_gid') . $_->gid(),
'<li>' . $self->dict('stat_rdev') . $_->rdev(),
'<li>' . $self->dict('stat_size') . $_->size(),
'<li>' . $self->dict('stat_atime') . $self->get_date_func()->(localtime $_->atime()),
'<li>' . $self->dict('stat_mtime') . $self->get_date_func()->(localtime $_->mtime()),
'<li>' . $self->dict('stat_ctime') . $self->get_date_func()->(localtime $_->ctime()),
'<li>' . $self->dict('stat_blksize') . $_->blksize(),
'<li>' . $self->dict('stat_blocks') . $_->blocks(),
'</ul>',
'</dl>',
'<p>' . $self->dict('help004') . '</p>',
'</div>';
} grep
length $_->get_filename()
&& defined param('edit:' . $_->get_filename()),
@{$current_obj->get_child()}
);
}
}
@html ? @html : $self->SUPER::execute();
}
package Explorer;
our @ISA;
sub new {
my ($class, $mode) = @_;
if ($mode) {
$mode =~ tr/A-Za-z//cd;
}
@ISA = 'Explorer::Index';
if ($class && $mode) {
no strict 'refs';
if (exists ${$class . '::'}{$mode . '::'}) {
@ISA = $class . '::' . $mode;
}
}
bless {
'path' => '',
'myself' => (__FILE__ =~ /([^\\\/]+)$/)[0],
'sort_anchor' => 0,
'max_upload' => 0,
'edit_length' => 500000,
'post_max' => 2000000,
'date_func' => sub { sprintf '%04d/%02d/%02d %02d:%02d:%02d', 1900 + $_[5], 1 + $_[4], @_[3, 2, 1, 0] },
'language' => Language->new('EN'),
'dir_pattern' => '[ 0-9A-Za-z_.-]{0,256}',
'file_pattern' => '[0-9A-Za-z_.-]{1,256}',
'version' => '',
}, ref $class || $class;
}
sub set_path {
my ($self, $path) = @_;
if (defined $path) {
$self->{'path'} = $path;
}
$self;
}
sub set_myself {
my ($self, $myself) = @_;
if (defined $myself) {
$self->{'myself'} = $myself;
}
$self;
}
sub set_sort_anchor {
my ($self, $sort_anchor) = @_;
$self->{'sort_anchor'} = $sort_anchor ? 1 : 0;
$self;
}
sub set_max_upload {
my ($self, $max_upload) = @_;
$self->{'max_upload'} = abs int $max_upload;
$self;
}
sub set_edit_length {
my ($self, $edit_length) = @_;
if (defined $edit_length) {
$self->{'edit_length'} = $edit_length;
}
$self;
}
sub set_post_max {
my ($self, $post_max) = @_;
if (defined $post_max) {
$self->{'post_max'} = $post_max;
}
$self;
}
sub set_date_func {
my ($self, $date_func) = @_;
if (ref $date_func eq 'CODE') {
$self->{'date_func'} = $date_func;
}
$self;
}
sub set_language {
my ($self, $language) = @_;
if (defined $language) {
$self->{'language'} = new Language $language;
}
$self;
}
sub set_version {
my ($self, $version) = @_;
if (defined $version) {
$self->{'version'} = $version;
}
$self;
}
sub dict {
my ($self, $key) = @_;
$self->get_language->get($key);
}
sub add_comma {
my ($self, $str) = @_;
$str =~ s{(\d+)}{
my $integer = reverse $1;
$integer =~ s/(\d\d\d)(?=\d)/$1,/g;
reverse $integer;
}eg;
$str;
}
sub htmlspacialchars {
my $self = shift;
if (my $str = shift) {
$str =~ s/&/&/g;
$str =~ s/</</g;
$str =~ s/>/>/g;
$str =~ s/"/"/g;
$str;
}
}
sub delete_indent {
my ($self, $str) = @_;
if ($str =~ /^(\s+)/) {
my $indent = $1;
$str =~ s/^$indent//gm;
}
$str;
}
sub obj2html {
my ($self, $obj, $form) = @_;
$form = $form ? 1 : 0;
my @data;
my $id = 0;
my @javascript = (
sub { '' },
sub {
my ($obj, $id) = @_;
sprintf q{ onmouseover="s('%s',%s)" onmouseout="e(%s)"},
$obj->get_filename(),
join(',', map $_ || 0, $id, $obj->get_status()),
$id;
}
);
my @input = (
sub { ' ' },
sub {
my ($obj, $id) = @_;
sprintf qq{<var id="p$id"></var>}
. ' <input type="checkbox" name="remove:%s" value="1" title="' . $self->dict('delete') . '">'
. ' <input type="checkbox" name="edit:%s" value="1" title="' . $self->dict('edit') . '"%s>'
. ' <input type="text" name="chmod:%s" value="%03o" size="4" class="chmod">'
. ' <input type="text" name="rename:%s" value="" size="8">'
. ' <- ',
$obj->get_filename(),
$obj->get_filename(),
ref $obj->get_child() eq 'ARRAY' ? ' disabled' : '',
$obj->get_filename(),
07777 & $obj->mode(),
$obj->get_filename();
}
);
foreach (@{$obj->get_child()}) {
$id++;
if (defined $_->get_child()) {
push @data,
'<li>'
. '<img src="folder.gif" alt="[folder]"' . $javascript[$form]->($_, $id) . '>'
. $input[$form]->($_, $id)
. '<a href="' . $self->get_myself() . '?mode=Edit&path=' . $_->get_path() . '" target="Edit">' . $_->get_filename() . '</a>';
# . $self->get_date_func()->(localtime $_->mtime());
if (my @child = $self->obj2html($_, $form)) {
push @data, '<ol>', @child, '</ol>';
}
} else {
my $path = $_->get_path() =~ m{^(.+)/[^/]+$} ? $1 : $self->get_path();
push @data, '<li><img src="file.gif" alt="[ file ]"' . $javascript[$form]->($_, $id) . '>' . $input[$form]->($_, $id)
. '<a href="' . $_->get_path() . '">' . $_->get_filename() . '</a> '
. $self->get_date_func()->(localtime $_->mtime());
}
}
@data;
}
sub get_javascript {
my $self = shift;
my $javascript = <<'JAVASCRIPT';
<script type="text/javascript">
<!--
var html = Array('', '');
var status = 1;
var zindex = 1;
var max_zindex = 1;
function exit_confirm() {
return window.confirm('$exit_confirm');
}
function print_html(id) {
eval('document.all.p' + id + '.innerHTML = html[status]');
}
function invert() {
status ^= 1;
print_html(0);
}
function e(id) {
if (window.navigator.appName == 'Microsoft Internet Explorer') {
print_html(id);
status ^= 1;
}
}
function s(filename, id, dev, ino, mode, nlink, uid, gid, rdev, size, atime, mtime, ctime, blksize, blocks) {
mode = (07777 & mode).toString(8);
while (mode.length < 3) {
mode = '0' + mode;
}
var list = '<ul>'
+ '<li>$stat_dev' + dev
+ '<li>$stat_ino' + ino
+ '<li>$stat_mode' + mode
+ '<li>$stat_nlink' + nlink
+ '<li>$stat_uid' + uid
+ '<li>$stat_gid' + gid
+ '<li>$stat_rdev' + rdev
+ '<li>$stat_size' + size
+ '<li>$stat_atime' + utime2date(atime)
+ '<li>$stat_mtime' + utime2date(mtime)
+ '<li>$stat_ctime' + utime2date(ctime)
+ '<li>$stat_blksize' + blksize
+ '<li>$stat_blocks' + blocks
+ '<\/ul>';
if (window.navigator.appName == 'Microsoft Internet Explorer') {
status = 1;
html = Array(
'',
'<dl class="IE">'
+ '<dt>' + filename + ' $property'
+ '<dd>' + list
+ '<\/dl>'
);
e(id);
} else {
html = Array(
'<dl class="NN">'
+ '<dt onclick="invert()">' + filename + ' $property'
+ '<dd>'
+ '<\/dl>',
'<dl class="NN">'
+ '<dt onclick="invert()">' + filename + ' $property'
+ '<dd>' + list
+ '<\/dl>'
);
print_html(0);
}
}
function change_color(id) {
var color = Array('silver', 'white');
var bgcolor = Array('white', '#000080');
var border_color = Array('gray', 'black');
var i;
for (i = 1; i <= max_zindex; i++) {
var obj = document.getElementById('tab' + i);
obj.style.textDecoration = 'none';
obj.style.borderWidth = '1px';
obj.style.borderStyle = 'solid';
obj.style.margin = '0px';
obj.style.padding = '0px 2px';
obj.style.color = color[id == i ? 1 : 0];
obj.style.backgroundColor = bgcolor[id == i ? 1 : 0];
obj.style.borderColor = border_color[id == i ? 1 : 0];
}
}
function add_zindex(id) {
var x_pos = 0;
var y_pos = 80;
var obj = document.getElementById('zindex' + id);
obj.style.position = "absolute";
obj.style.top = y_pos;
document.getElementById('zindex' + id).style.zIndex = zindex;
change_color(id);
zindex++;
}
function reset_zindex(max_id) {
zindex = 1;
max_zindex = max_id;
var i;
for (i = max_id; 0 < i; i--) {
add_zindex(i);
}
}
function utime2date(utime) {
var d = new Date();
d.setTime(1000 * utime);
var date = Array(
d.getSeconds(),
d.getMinutes(),
d.getHours(),
d.getDay(),
1 + d.getMonth(),
d.getYear() % 100
);
for (i = 0; i < date.length; i++) {
date[i] = String(date[i]);
while (date[i].length < 2) {
date[i] = '0' + date[i];
}
}
return date[5] + '/' + date[4] + '/' + date[3] + ' ' + date[2] + ':' + date[1] + ':' + date[0];
}
// -->
</script>
JAVASCRIPT
$javascript =~ s{\$(\w+)}{$self->dict($1)}eg;
$self->delete_indent($javascript);
}
sub AUTOLOAD {
my $self = shift;
$Explorer::AUTOLOAD =~ /::get_([0-9A-Za-z_]{1,256})$/ && exists $self->{$1}
? $self->{$1}
: undef;
}