=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 <TITLE> of the page, default is "Index of <path>"
$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 "<!-- generator: a hacked up version of weblist.pl 0.4 by
	 Jan Krynicky <Jenda\@Krynicky.cz>, http://Jenda.Krynicky.cz -->\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 "<TR>";
 print "<TD width=20>$_[0]</TD>" if $showicons;
 print "<TD>&nbsp;\n$_[1]</TD>" if $showname;
 print "<TD><NOBR>&nbsp; $_[2]</NOBR></TD>" if $showdate;
 print "<TD align=right><NOBR>&nbsp; &nbsp; $_[3]</NOBR></TD>" if $showsize;
 print "<TD>&nbsp;</TD><TD>$_[4]</TD>" if $showdescription;
 print "</TR>\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",<FILE>;
  close FILE;
 }
 $desc ||= "";

 if (-d $name) {
  if ($ENV{QUERY_STRING} and (-e "$name/$scriptname")) {
   line "<IMG SRC='/Icons/DIR.gif' ALT='[DIR]'>",
        qq{<A href="$name/$scriptname?$ENV{QUERY_STRING}">$name/</A>},
        $showdate ? ustime ((stat $name)[9]) : 0,
        "-",
        $showname ? $desc
                  : ($desc ? "<A href='$name/$scriptname?$ENV{QUERY_STRING}'>$desc/</A>"
                           : "<A href='$name/$scriptname?$ENV{QUERY_STRING}'>$name/</A>");
  } else {
   line "<IMG SRC='/Icons/DIR.gif' ALT='[DIR]'>",
        qq{<A href="$name/">$name/</A>},
        $showdate ? ustime ((stat $name)[9]) : 0,
        "-",
        $showname ? $desc : ($desc ? "<A href='$name/'>$desc/</A>" : "<A href='$name/'>$name/</A>");
  }
  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 ? "<IMG SRC='/Icons/$typ.gif' ALT='[$typ]'>" : "no"),
      qq{<A href="$name">$name</A>},
      $showdate ? ustime ((stat $name)[9]) : 0,
      $size,
      $showname ? $desc : ($desc ? "<A href='$name'>$desc</A>" : "<A href='$name'>$name</A>"));
}

@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*";
#<HTML>
 #<HEAD>
  #<TITLE>$nadpis</TITLE>
  #<META name='generator' content='weblist.pl 0.4 by Jan Krynicky <Jenda\@Krynicky.cz>, http://Jenda.Krynicky.cz'>
  #<META name='author' content='mailto:Jenda\@Krynicky.cz'>
 #</HEAD>
#*END*

$background ||= '';
$bgcolor ||= '';
$text ||= '';
$link ||= '';
$alink ||= '';
$vlink ||= '';
print "<body $background $bgcolor $text $link $alink $vlink>\n";

print "<h1 align=center>$nadpis</H1>\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*";
<FORM action=$scriptname method=get>
<div align=center><B>
<table align=center>
 <tr>
  <td>Filemask</TD>
  <TD> : <INPUT type=text name=file value="$q{file}" size="20"></TD>
  <TD><SELECT name=dir>
       <OPTION value=0 $opt{0}>Directories shown with files</OPTION>
       <OPTION value=1 $opt{1}>Directories shown before files</OPTION>
       <OPTION value=-1 $opt{-1}>Directories shown after files</OPTION>
       <OPTION value=2 $opt{2}>Only files</OPTION>
       <OPTION value=3 $opt{3}>Only directories</OPTION>
      </SELECT>
  </TD>
 </TR>
 <tr>
  <td>Perl regexp</TD>
  <TD> : <INPUT type=text name=grep value="$q{grep}" size="20"></TD>
  <TD align=center><INPUT type=submit value="              List               "></TD>
 </TR>
</TABLE>
</B></div>
</FORM>
*END*

list:

print "<TABLE>\n";

print "<TR>";
print "<TH width=20></TH>" if $showicons;
print "<TH align=left>$head_name</TH>" if $showname;
print "<TH align=left><NOBR>$head_date</NOBR></TH>" if $showdate;
print "<TH align=right>$head_size</TH>" if $showsize;
print "<TH>&nbsp; </TH>";
print "</TR>\n";

print "<TR><TD colspan=6></TD></TR>\n";

if (!$noupdir and $path ne '/') {
 line '<IMG SRC="/icons/back.gif" ALT="[DIR]">',
      "<A HREF='..'>Parent Directory</A>",
      $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 "</TABLE>\n";

#'if ($footer) {
#'print $footer,"\n";
#'} else {
#'print qq{<HR width="75%">}
#'}
}

1;