sourcecode
jpj
<CODE>
#!/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/unknown.gif"; }
if (S_ISLNK($type)) { $typename = "Link"; $icon = "$icondir/link.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|rpm|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", $info->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 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
#--------------------------------------------------------------
&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"}, $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=>"70%",-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=>"70%",-border=>"0"}),
Tr({-align=>"LEFT",-valign=>"TOP"},[td(h3("Notes")),td($notes)]);
print end_table();
close (NOTES);
}
print hr,
em,small("Generated by webls.pl v$version"),
end_html();
}
</CODE>
<p>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.
<p>In short, it gets faster the more it's used.
<p>Enhanced data display for MP3 files via MP3::Info
<p>Examples can be seen <A HREF="http://groove.jpj.net/perl/webls">here</a>. Project page is <A HREF="http://groove.jpj.net/perl/webls?page=/projects/webls">here</a>.
<p>Comments, criticism welcome. This is one of my first "real" perl scripts.
<p>-JPJ
Web Stuff
pvenezia at jpj dot net