#!/usr/bin/perl 

use CGI qw/:standard *table start_ul/;
use File::Basename;
use MP3::Info;
use Fcntl ':mode';


undef  @PATTERN;
undef  @FILEPATTERN;
undef  @HEADERS;
undef  @DETAILS;    
undef  $cwd;
undef $debug;

$version = "0.7";            # Version string


#---------------------------------------------------------
#       Configuration
#---------------------------------------------------------


$title = "groove.jpj.net resources";    # Page title
$tbbgcolor = "#C0C0C0";                # Title bar background
$tbfcolor = "black";                # Title bar text
$bgcolor = "#cccccc";               # Table item background
$fcolor = "black";                  # Table text
$icondir = "/icons/small";        # Apache Icons directory

$indexfile = ".pindex.html";               # Cache file name
$notesfile = ".pnotes.txt";             # Notes file name
#$debug = "1";                # Turn on debugging

    
#-----------------------------------------------------------
#    Error msg sub
#-----------------------------------------------------------

sub error_msg {
    print header,
        start_html("Action Denied"),
        h1("Action Denied"),
        h3("$_[0]"),
        h3(a{href=>"$script_url"},"Return"),
        end_html;
        exit;
}

#-----------------------------------------------------------
#    Get stats on files in $cwd
#-----------------------------------------------------------
sub getfiles {

    undef $htype;
    undef $size;
    undef $date;
    undef $link;
    undef $icon;
    undef $typename;
    undef $file;
    

foreach  $file (<@PATTERN>) {
        #next if ($file =~ /(index.html|notes.txt)/);
        next if ($file =~ /($indexfile|$notesfile)/);
    
     ($type, $size, $sec) = (stat($file)) [2,7,9];

    if (S_ISDIR($type)) {  $typename = "Directory";  $icon = "$icondir
+/dir.png"; }
    if (S_ISREG($type)) {  $typename = "File";  $icon = "$icondir/unkn
+own.gif"; }
     if (S_ISLNK($type)) {  $typename = "Link";  $icon = "$icondir/lin
+k.png"; }
    $icon = "$icondir/sound2.gif" if ($file =~ /\.wav/);
    $icon = "$icondir/image2.gif" if ($file =~ /\.(bmp|jpg|gif|png)/i)
+;
    $icon = "$icondir/compressed.gif" if ($file =~ /\.(gz|tar|zip|bz|r
+pm|sit|sea|hqx)/i);
    $icon = "$icondir/text.gif" if ($file =~ /\.(txt|pl|sh)/i);
    $icon = "$icondir/movie.gif" if ($file =~ /\.(mov|avi|wmf|fli|asf)
+/i);
    $icon = "$icondir/index.gif" if ($file =~ /\.(html)/i);

#-----------------------------------------------------------
#    Call MP3::Info if file is an MP3
#-----------------------------------------------------------
        if ($file =~ /\.mp3$/) {
                 $info = new MP3::Info $file;;
                ($length, $bitrate) = split (" ", sprintf "%s %s", $in
+fo->TIME, $info->BITRATE);
        $icon = "$icondir/sound2.gif";
        $htype = "Length/Type";
        $typename = "$length\m - $bitrate\kbps";    
        
        }

     $date = (localtime($sec));

#--------------------------------------------------------------
#    Do type/size calc
#--------------------------------------------------------------
    if (S_ISDIR($type)) {
         $psize = "--";
    }
    elsif ($size < 1024 ) {
         $psize = "$size bytes" 
    }
    elsif ($size < 1024000 ) {
         $psize = sprintf "%.1f kb", $size / 1024;
    }
    else {
         $psize = sprintf "%.2f MB", $size / 1024 / 1024;
    }
    
     $name = basename $file;

     $link = "/pub/$cwd/$name";
     $link =~ s/\/\//\//g;
#--------------------------------------------------------------
#    Push data for files list table into @DETAILS
#--------------------------------------------------------------
        if (S_ISDIR($type)) {
            push (@DETAILS,a({href=>"$script_url?page=$cwd/$name"},img
+({-border=>undef,src=>$icon}),"$name"), $psize, $date, "$typename<tr>
+");
            }
        elsif (S_ISREG($type)) {
            push (@DETAILS,a({href=>"$link"},img({-border=>undef,src=>
+$icon}),"$name"), "$psize", "$date", "$typename<tr>");
    
        }
        
    }
            $htype = "Type" unless ($htype);
            push (@HEADERS, qw(Name Size Date), $htype);
} # End getfiles sub


#--------------------------------------------------------------
#    Get parameters passed from URL, seed 
#       "Previous Directory" link.
#--------------------------------------------------------------

sub getparams {
    if (param('page')) {
        $cwd = param('page');
        &error_msg("Illegal Path: $cwd") if ($cwd =~ /\.\./);
        undef $cwd if ($cwd =~ /(\.|\/)$/);
        $dirname = basename $PATH;
        $precwd = dirname $cwd; # unless ($precwd =~ /\.$/);

    push (@DETAILS,a({href=>"$script_url?page=$precwd"},img({-border=>
+undef,src=>"$icondir/back.gif"}),"Previous Directory"),"","","<tr>") 
+unless (! $cwd);

    }

    else {
        $cwd = "";
        $is_index = "1";
        $dirname = $PATH;
    }
    $url = "$url/$cwd";
    $PATH = "$PATH/$cwd";

        &error_msg("Illegal Path: $cwd") if (! -d PATH);    # Bail if 
+$PATH doesn't exist

    @PATTERN="$PATH/$FILEPATTERN";            # Files list pattern mat
+ch
    $script_url = url(-relative=>1);    # Pull relative URL into $scri
+pt_url

}    # getparams

#--------------------------------------------------------------
#      Start script, pass static `.pindex.html` page
#       through if no changes to dir mtime, or call
#       getfiles, write_html to create page and store in
#       .pindex.html
#--------------------------------------------------------------

    &getparams;                 # Seed parameters

$weblsindex = "$PATH/$indexfile";


if ( -f $weblsindex ) {
    ($pubmtime) = (stat($weblsindex)) [10];
    ($pathmtime) = (stat($PATH)) [10];

    if ( $pathmtime le $pubmtime ) {
    
                        open (PUBLSINDEX, "<$weblsindex");
                        print <PUBLSINDEX>;
                print "\nDEBUG\n$weblsindex\n" if ($debug);
                print "$pubmtime, $pathmtime\n" if ($debug);
                        close (PUBLSINDEX);
            exit;
    }
}

    &getfiles;
    &write_html;

            print small,(" (created)") if ($debug);

            print "\nDEBUG\n$weblsindex\n" if ($debug);
                        print "$pubmtime, $pathmtime\n" if ($debug);


    local *STDOUT;
    open (STDOUT, ">$weblsindex");
    &write_html();
    print small,(" (cached)");
    close (STDOUT);

#-------------------------------------------------------------
#    write_html sub to create page
#-------------------------------------------------------------

sub write_html () {

print header,
    start_html("$title - $cwd"),
    h1("<center>$title</center>");

#-------------------------------------------------------------
#    Generate linked path        
#-------------------------------------------------------------

    unless (! $cwd) { 
        undef  $refcwd;
        undef  $pwd;
        undef  @TAGCWD;
        $pwd = basename $cwd;
        push(@TAGCWD, a({href=>"$script_url"},"<h3><CENTER>/"));

        while ($cwd =~ /\G\/?([0-9A-Za-z'.-]+)/g) {
                        $prelink = $1;
            $refcwd = "$refcwd/$1";
    
            if (! ($1 =~ /$pwd$/)) { 
                push(@TAGCWD, a({href=>"$script_url?page=$refcwd"}, $p
+relink), "/");
            }
            else {
                push(@TAGCWD, $pwd, "/");
            }
        }
        
    print @TAGCWD[0..$#TAGCWD];
    print "</H3></CENTER>";

    }    

#-------------------------------------------------------------
#    Build file list table with data from getfiles sub
#-------------------------------------------------------------
    print hr,
    table({-align=>"center",-width=>"70%",-border=>"0"}),
        Tr({-align=>"LEFT",-valign=>"TOP",-bgcolor=>$tbbgcolor,-fontco
+lor=>$tbfcolor},
        [th(\@HEADERS),td({-bgcolor=>$bgcolor},\@DETAILS)]);
    print end_table();

        if ( -f "$PATH/$notesfile" ) {
            open (NOTES, "<$PATH/$notesfile") || next;
            undef $/;
            $notes = <NOTES>;
            $/ = "\n";
            
            print table({-align=>"center",-width=>"70%",-border=>"0"})
+,
            Tr({-align=>"LEFT",-valign=>"TOP"},[td(h3("Notes")),td($no
+tes)]);
            print end_table();
            close (NOTES);
        }

        
          print hr,
        em,small("Generated by webls.pl v$version"),
        end_html();
}