#!/usr/bin/perl
#-----------------------------------------
# dir.cgi
#-----------------------------------------
#
# カレントディレクトリの一覧を表示する.
#
# 主要関数
# @filelist = read_dir( $dir ) 指定ディレクトリのファイル名リストを返す.
# 再帰下降無し
# '.' '..' は取り除かれる.
# ファイル名(パス名付属しない)のリストが返る.
#
use strict;
my %input;
my $buffer;
###########################################################################
# @filelist = read_dir( $dir ) 指定ディレクトリのファイル名リストを返す.
# 再帰下降無し、ディレクトリ含む.
###########################################################################
sub read_dir() {
my ($dir)=@_;
opendir(FILE,$dir);
my @filelist = readdir(FILE);
closedir(FILE);
if($filelist[0] eq '.') {
shift @filelist;
}
if($filelist[0] eq '..') {
shift @filelist;
}
return @filelist;
}
#-----------------------------------------
# CGIパラメータを受け取って連想配列に入れる.
#-----------------------------------------
sub read_input()
{
my (@pairs, $pair, $name, $value, %FORM);
$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}else{
$buffer = $ENV{'QUERY_STRING'};
}
@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# &jcode'convert(*value, 'euc'); #'
$value =~ s/\&/\&\;/ig;
$value =~ s/\"/\"\;/ig; #"
$value =~ s/\/\>\;/ig;
$FORM{$name} = $value;
}
%FORM;
}
#-----------------------------------------
#
#-----------------------------------------
sub html_header()
{
print "Content-type: text/html; charset=Shift_JIS\n\n";
# print "charset=Shift_JIS\n\n";
print "\n";
print "\n";
}
#-----------------------------------------
#
#-----------------------------------------
sub html_footer()
{
print "\n";
print "\n";
}
#-----------------------------------------
#
#-----------------------------------------
sub print_input()
{
my ($key,$val);
print "\n";
foreach $key (keys %input) {
$val = $input{$key};
print "$key = $val\n";
}
print "\n";
}
#-----------------------------------------
#
#-----------------------------------------
sub cap2sjis()
{
my ($file) = @_;
my $sjis='';
my ($i,$c,$h);
for($i=0;$i[dir]";
$adir = "[dir]";
$dir = '/';
$color = ' bgcolor=#e0e080';
}
print "";
printf( '%s%s %s ' . " | \n"
,$adir , $curdir . $file , $sjis . $dir);
print "$size_k" . "k | ";
print " | ";
# print "$t | ";
my @times=split(/[ ]+/,$t);
my $t1;
foreach $t1(@times) {
print "$t1 | ";
}
print "";
}
sub sanitize()
{
my ($s) = @_;
$s =~ s/[ \t\.]+//g;
return $s;
}
#-----------------------------------------
#
#-----------------------------------------
sub dirlist()
{
my ($currentdir) = @_;
my $file;
my @list;
my $subtree = '/' . $currentdir;
$currentdir = &sanitize($currentdir);
my $subdir = $currentdir;
if($subdir eq '') {
$subdir = '/';
}else{
$currentdir .= '/';
}
my $pwd =`pwd`;
$pwd =~ s/\n//;
# printf "Index of $pwd$subtree
\n";
printf "Index of $pwd/$subdir
\n";
my @filelist = &read_dir($pwd . '/' . $subdir);
@list = sort(@filelist);
print "";
foreach $file (@list) {
&printfile($currentdir , $file);
}
print "
";
print "
";
print "Created by filelist.cgi"
# print "この一覧はindex.cgiが作成しました。";
# print " [dir] をクリックするとhttpd::Indexesのかわりにindex.cgiが表\示します。"
}
#-----------------------------------------
#
#-----------------------------------------
sub main()
{
my $cmd;
%input = &read_input();
&html_header();
&dirlist($input{'dir'});
&html_footer();
}
#-----------------------------------------
#
#-----------------------------------------
#
&main();
1;
#