=rem
version 0.4
This script was made for web directory listing.
Install it by copying this file into /perl/lib or some other directory
in @INC. You have to set your webserver to use also default.plx
(or some other name of a perl script).
Make a file default.plx in all directories you want to show.
The file will contain only some options and
require 'weblist.pl';
Options :
$heading = The
of the page, default is "Index of "
$message = the HTML code to include on top of the page.
$footer = the HTML code to include on bottom of the page.
$showicons = 0/1, whether to show the icons
$showdate = 0/1, whether to show the last modification date
$showsize = 0/1, whether to show the file size
$showdescription = 0/1, whether to show the description
$showname = 0/1, whether to show the icons
all these options default to 1
$noupdir = 0/1, should we show '..'? Default is 1.
$style = 'SIMPLE'/'EXTENDED', the SIMPLE style doesn't show the form with options and
file masks.
$head_name = the heading for file name column
$head_date = the heading for date column
$head_size = the heading for file size column
all these options defalut to English.
$q{dir} = the default for the select list on the page
0 - Directories shown with files
1 - Directories shown before files
-1 - Directories shown after files
2 - Only files
3 - Only directories
$q{file} = the default filename mask, eg. "*.ppd"
$q{grep} = the default perl regexp, eg. "\.ppd$"
A description for a $file is to be written into file "$file.dsc".
Example:
Authent-0.2.1.tar.gz
Authent-0.2.1.tar.gz.dsc
where Authent-0.2.1.tar.gz.dsc contains
Request HTTP authentification if a condition fails
=cut
#use Deurl qw(as q);
#print "Content-type: text/html\n\n";
#$scriptname = $0; $scriptname =~ s#^.*[\\/]##;
my $scriptname = 'weblist.pl';
sub weblist {
my $path = shift;
warn "[making weblist.pl listing of $path]\n";
my $style = 'SIMPLE';
%q = ();
$q{dir} = -1;
my $footer = '';
undef $nadpis;
print "\n";
$showicons = 0 unless (defined $showicons);
$showname = 1 unless (defined $showname);
$showdate = 1 unless (defined $showdate);
$showsize = 1 unless (defined $showsize);
$showdescription = 0 unless (defined $showdescription);
$noupdir = 1 unless (defined $noupdir);
$head_name="Name" unless defined $head_name;
$head_date="Last modified" unless defined $head_date;
$head_size="Size" unless defined $head_size;
sub line {
print "";
print "$_[0] | " if $showicons;
print " \n$_[1] | " if $showname;
print " $_[2] | " if $showdate;
print " $_[3] | " if $showsize;
print " | $_[4] | " if $showdescription;
print "
\n";
}
sub fline {
my $name = shift;
#return if (lc $name eq lc $scriptname);
return if ($name =~ /\.dsc$/i or $name =~ /\.\$\$\$$/i);
#Skip SVN dirs
return if ($name =~ /\.svn$/);
return if ($name =~ /^index\.html$/);
# If you're using Programmer's File Editor, you know why I leave out *.$$$ :-)
if ($showdescription and open FILE,"<$name.dsc") {
$desc = join "\n",;
close FILE;
}
$desc ||= "";
if (-d $name) {
if ($ENV{QUERY_STRING} and (-e "$name/$scriptname")) {
line "",
qq{$name/},
$showdate ? ustime ((stat $name)[9]) : 0,
"-",
$showname ? $desc
: ($desc ? "$desc/"
: "$name/");
} else {
line "",
qq{$name/},
$showdate ? ustime ((stat $name)[9]) : 0,
"-",
$showname ? $desc : ($desc ? "$desc/" : "$name/");
}
return;
}
if ($showicons) {
$_=$name;
SWITCH : {
$typ='IMG',last if (/\.gif$/i or /\.jpg$/i);
$typ='TXT',last if (/\.txt/ or /\.c$/i or /\.cpp$/i or /\.h$/i or /\.pl$/i or /\.plx$/i or /\.fot$/i or /\.ift$/i);
$typ='WWW',last if (/\.htm$/i or /\.html$/i or /\.asp$/i or /\.stm$/i);
$typ='MOV',last if (/\.mov$/i or /\.avi$/i);
$typ='SND',last if (/\.mid$/i or /\.waw$/i);
$typ='TAR',last if (/\.tar$/i);
$typ='ZIP',last if (/\.zip$/i);
$typ='BIN';
}
}
if ($showsize) {
$size=(stat $name)[7];
if ($size > 5*1024) {
$size = int(($size+512) / 1024)."K";
} else {
$size .= 'B';
}
}
line (($showicons ? "" : "no"),
qq{$name},
$showdate ? ustime ((stat $name)[9]) : 0,
$size,
$showname ? $desc : ($desc ? "$desc" : "$name"));
}
@months=(Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
sub ustime {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
= localtime(shift);
# 04-Jun-97 18:21
return sprintf ("%2d-%s-%4d %02d:%02d", $mday, $months[$mon], $year+1900,
$hour, $min);
}
sub splitdirs {
my (@dirs,@files);
foreach $file (@_) {
if (-d $file) {
push @dirs,$file;
} else {
push @files,$file;
}
}
return (\@dirs,\@files);
}
#$path=$ENV{PATH_INFO};
$path =~ s/$scriptname//o;
$uppath = $path;#$uppath =~ s#/[^/]+/?$##;
$uppath =~ s#/$##;$uppath =~ s#/[^/]*$#/#;
#print "scriptname=$scriptname\npath=$path\nuppath=$uppath\n\n";
$background="background=\"$background\"" if $background;
($bgcolor =~ s/#//,$bgcolor="bgcolor=\"#$bgcolor\"") if $bgcolor;
($text =~ s/#//,$text="text=\"#$text\"") if $text;
($link =~ s/#//,$link="link=\"#$link\"") if $link;
($alink =~ s/#//,$alink="alink=\"#$alink\"") if $alink;
($vlink =~ s/#//,$vlink="vlink=\"#$vlink\"") if $vlink;
$nadpis = $heading unless $nadpis;
$nadpis = "Index of $path" unless $nadpis;
#print <<"*END*";
#
#
#$nadpis
#
#
#
#*END*
$background ||= '';
$bgcolor ||= '';
$text ||= '';
$link ||= '';
$alink ||= '';
$vlink ||= '';
print "\n";
print "$nadpis
\n";
print $message;
if (! $q{file}) {
$q{file} = $file;
} elsif ($q{file} eq '*.*') {
delete $q{file};
}
if (uc($style) eq 'SIMPLE') { goto list; }
if (defined $q{dir}) { $opt{$q{dir}}='SELECTED'; }
print <<"*END*";
*END*
list:
print "\n";
print "";
print " | " if $showicons;
print "$head_name | " if $showname;
print "$head_date | " if $showdate;
print "$head_size | " if $showsize;
print " | ";
print "
\n";
print " |
\n";
if (!$noupdir and $path ne '/') {
line '',
"Parent Directory",
$showdate ? ustime ((stat '..')[9]) : 0,
'-';
}
if (! $q{grep} and ! $q{file} and ! $q{dir}) {
while (<*.*>) {
fline $_;
}
goto done;
}
opendir(DIR, '.');
@files =readdir(DIR);
shift @files;
shift @files;
if ($q{file}) {
$mask = $q{file};
$mask =~ s/\./\\./g;
$mask =~ s/\*/.*/g;
$mask =~ s/\?/./g;
@files = grep {/$mask/io} @files;
}
if ($q{grep}) {
@files = grep {/$q{grep}/io} @files;
}
if ($q{dir} and $q{sort}) {
} elsif ($q{dir}) {
($dirs,$files) = splitdirs @files;
undef @files;
if ($q{dir} == 1) {
foreach $file (@$dirs) {
fline $file;
}
foreach $file (@$files) {
fline $file;
}
} elsif ($q{dir} == 2) {
foreach $file (@$files) {
fline $file;
}
} elsif ($q{dir} == 3) {
foreach $file (@$dirs) {
fline $file;
}
} else {
foreach $file (sort @$files) {
fline $file;
}
foreach $file (sort @$dirs) {
fline $file;
}
}
} else {
foreach $file (@files) {
fline $file;
}
}
closedir DIR;
done:
print "
\n";
#'if ($footer) {
#'print $footer,"\n";
#'} else {
#'print qq{
}
#'}
}
1;