#!/usr/bin/perl
####################################################################################
# Name :
# Author :
# Version :
# Created :
# Last modified :
####################################################################################
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use strict;
require "functions.pl";
$cgi_nam = '' ;
$start_dir = 'C:/Program Files/Apache Group/Apache2/cgi-bin/forum' ;
$start_url = '/forum/perl/' ;
#############################################
@para = split(/&/ , $ENV{'QUERY_STRING'}) ;
$para[0]="" if !$para[0] ;
$para[1]=0 if !$para[1] ;
read_form();
if ($para[0] eq "next") {
read_dir($FM{'next'});
show_listing();
}
elsif ($para[0] eq "back") {
read_dir($FM{'back'});
show_listing();}
else {
read_dir();
show_listing();}
#############################################
sub read_dir {
my $open_dir = shift;
my @dirlist;
my $item;
opendir (DIR, "$start_dir/$open_dir.") || die "Kann das Verzeichnis -$start_dir/$open_dir- nicht öffnen!" ;
@dirlist=grep(/./,readdir(DIR));
closedir(DIR);
foreach $item (sort(@dirlist)) {
if ($item =~m/\.[a-zA-Z]/) {
# Nach Dateien suchen...
push (@files, $item); }
else {
# Nach Unter-Verzeichnisse suchen...
push (@dirs, $item); }}
# Anzahl aller Verzeichnisse...
$num = @dirs;
# Anzahl aller Dateien...
$row = @files;}
###############################
sub show_listing {
$FM{'next'} =~ /^(.*)[\/\\][^\/\\]+$/;
my $back = $1;
my $end;
# ?????????????????????? #
if ($para[0] eq 'back') {
$title = $back;
}
else {
$title = $FM{'title'};
}
print html_head() ;
print "<h1>Index of / " . $title . "</h1>\n<pre>\n" ;
print "<hr />\n";
print "<img src=\"" . "/folder.gif\" alt=\"[" . $dirs[$i] . "]\"> <a href=\"" . $cgi_nam . "?back&back=" . $back . "&next=" . $back . "\">Parent Directory</a>\n" ;
if ($num ne '0') {
for ($i=0;$i<$num;$i++) {
if ($dirs[$i] =~/\./) {
# $end auf on setzen wenn nur noch drei Punkte vorhanden sind...
if ($num<3) { $end = 'on';} }
else {
# Verzeichnisse ausgeben...
print "<input type=\"checkbox\" name=\"$dirs[i]\" /> <img src=\"" . "/folder.gif\" alt=\"[" . $dirs[$i] . "]\"> <a href=\"" . $cgi_nam . "?next&next=" . $FM{'next'} . "/" . $dirs[$i] . "&title=" . $dirs[$i] . "\">" . $dirs[$i] . "/</a>\n" ;
}
}
}
# Punkt setzen wenn kein Verzeichniss mehr vorhanden...
print ".<br />\n"
if ($end eq 'on');
if ($row ne '0') {
for ($j=0;$j<$row;$j++) {
# Dateien ausgeben...
print "<input type=\"checkbox\" name=\"$dirs[i]\" /> <img src=\"" . "/text.gif\" alt=\"[" . $files[$j] . "]\"> <a href=\"" . $start_url . "" . $FM{'next'} . "/" . $files[$j] . "\">" . $files[$j] . "</a>\n" ;
}
}
print "</pre>\n";
print "<hr />\n";
print "</body>\n</html>\n" ;}
#############################################
sub html_head {
my $tpl = "Content-Type: text/html\n\n<!doctype html public \"-//w3c//dtd html 4.01 transitional//en\">\n\n" ;
$tpl .= "<html>\n<head>\n\t<title>Index of / " . $FM{'title'} . "</title>\n</head>\n\n<body bgcolor=\"white\" link=\"blue\" alink=\"blue\" vlink=\"blue\">\n" ;
return $tpl;
}
#############################################
sub read_form {
my ($buffer, $pair, $name, $value);
my @pairs;
if ($ENV{'REQUEST_METHOD'} eq "GET") {
$buffer = $ENV{'QUERY_STRING'};
}
elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
@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;
$name =~ tr/+/ /; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Mehrere Datenfelder gleichen Namens als Kommagetrennte Liste (z.B. für Checkboxen)
if (defined $FM{$name}) {
$FM{$name} = $FM{$name}.",".$value; }
else { $FM{$name} = $value; }}}
