#!/usr/bin/perl 
#
#	webls.pl
#	Paul Venezia, pvenezia@jpj.net  
#	08.20.02
#	v0.8 - 02.16.04
#
#	This script is designed to be run from /perl or /cgi-bin on an Apache
#	webserver. Given a root directory, it will create dynamic pages based
#	on the contents of the directory that's referenced. As it navigates
#	the directory hierarchy via user choices, it determines if it's
#	already created a page for that dir, and creates a cache page in that
#	directory, pushing the cached page to the next request unless the
#	directory contents changes, when it will regenerate the cache page.
#
#	In short, it gets faster the more it's used.
#
#	Enhanced data display for MP3 files via MP3::Info (can be found at CPAN).
#
#	Note: If changes are made to the webls.pl script, run
#
#	$ find . -name \*pindex\* -exec rm {} \;
#
#	from the root of the tree. Also, all dirs in the tree need to be chgrp to the Apache user, and mode 0776.
#
#	Code should be self explanatory, and needs work to be more portable and modular. 
#
#


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


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

$version = "0.8";			# Version string


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


$title = "groove.jpj.net resources";	# Default 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";           	# Cache file name
$titlefile = ".ptitle.txt";           	# Cache file name
$url="http://groove.jpj.net/pub";	# Abolut URL
$PATH = "/var/www/html/pub";		# Equivalent FS path
$FILEPATTERN = "*";			# Pull every file

#$debug = "1";				# Turn on debugging


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

sub error_msg {
	print header('text/html'),
		start_html("Action Denied"),
		h2("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;
	
	$count = 0;
	$countdirs = 0;
	$countfiles = 0;
foreach  $file (<@PATTERN>) {
	$count++;
        next if ($file =~ /($indexfile|$notesfile|$titlefile)/);
	
	 ($type, $size, $sec) = (stat($file)) [2,7,9];

	if (S_ISDIR($type)) {  $typename = "Directory";  $icon = "$icondir/dir.png"; $countdirs++ }
	if (S_ISREG($type)) {  $typename = "File";  $icon = "$icondir/unknown.gif"; $countfiles++ }
 	if (S_ISLNK($type)) {  $typename = "Link";  $icon = "$icondir/link.png"; }
	$icon = "$icondir/sound.gif" if ($file =~ /\.(wav|wma)$/i);
	$icon = "$icondir/image2.gif" if ($file =~ /\.(bmp|jpg|gif|png)$/i);
	$icon = "$icondir/compressed.gif" if ($file =~ /\.(gz|tar|zip|bz|sit|sea|hqx|iso|tgz)$/i);
	$icon = "$icondir/rpm.png" if ($file =~ /\.rpm$/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$/i && $size > 0) {
                 $info = new MP3::Info $file;;
                ($length, $bitrate) = split (" ", sprintf "%s %s", $info->TIME, $info->BITRATE);
		$icon = "$icondir/sound2.gif";
		$htype = "Length/Type";
		$typename = "$length\m - $bitrate\kbps";	
		
        }
        if ($file =~ /\.ogg$/i && $size > 0) {
                use Ogg::Vorbis;
                $ogg = Ogg::Vorbis->new;
                open(INPUT, "< $file");
                $ogg->open(INPUT);
                $info = $ogg->info;
                ($length, $bitrate) = split (" ", sprintf "%.2f %.0f", $ogg->time_total/60, $ogg->bitrate/1000);
                $icon = "$icondir/sound2.gif";
                $htype = "Length/Type";
                $typename = "$length\m - $bitrate\kbps";        
                close(INPUT);

        }


	 $date = (localtime($sec));
	 $date =~ s/:\d+//;

#------------------------------------------------------------------------------------
#	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/$lscwd/$name";
	 $link =~ s/\/\//\//g;
#------------------------------------------------------------------------------------
#	Push data for files list table into @DETAILS
#------------------------------------------------------------------------------------
        
		if (S_ISDIR($type)) {
			push (@DETAILS,a({href=>"$script_url?page=$lscwd/$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;
		$lscwd = $cwd;
		$lscwd =~ s/\/$//;
		$precwd = dirname $cwd if $cwd;
		$cwd =~ s/\s+/\\ /g;

	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";
		&error_msg("Illegal Path: $cwd") if (! -d "$PATH/$lscwd");	# Bail if $PATH doesn't exist
		$PATH = "$PATH/$cwd";


	@PATTERN="$PATH/$FILEPATTERN";			# Files list pattern match
	$script_url = url(-relative=>1);	# Pull relative URL into $script_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 foo
#------------------------------------------------------------------------------------

	&getparams; 				# Seed parameters

$weblsindex = "$PATH/$indexfile";


#if ( -f $weblsindex ) {
if ( 1 eq 2 ) {
	($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 () {
	undef $pagetitle;	
	if ( -f "$PATH/$titlefile") {
		open(TITLE, "<$PATH/$titlefile") || next;
		$pagetitle = <TITLE>;
		chomp($pagetitle);
	}

print header('text/html'),
	start_html("$title - $cwd"),
	h2("<center>$title</center>");
	print h3("<center>$pagetitle</center>") if ($pagetitle);

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

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

		while ($lscwd =~ /\G\/?([0-9A-Za-z'.,\s+-]+)/g) {
			$prelink = $1;
			$refcwd = "$refcwd/$1";
	
			if (! ($pwd =~ /$1/)) { 
				push(@TAGCWD, a({href=>"$script_url?page=$refcwd"}, $prelink), "/");
			}
			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=>"85%",-border=>"0"}),
		Tr({-align=>"LEFT",-valign=>"TOP",-bgcolor=>$tbbgcolor,-fontcolor=>$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=>"50%",-border=>"0"}),
			Tr({-align=>"LEFT",-valign=>"TOP"},[td(h3("Notes")),td($notes)]);
			print end_table();
			close (NOTES);
		}

		
      	print hr,em,small("<CENTER>$countfiles files<br>$countdirs directories<br>Generated by <A HREF=\"http://groove.jpj.net/perl/webls.pl?page=/Projects/webls\">webls.pl</a> v$version</CENTER>"),
		end_html();
}