Miscellany

#!c:/Perl/bin/Perl.exe


#################################
### EXECUTION ERROR PRINTTING ###
use CGI qw(:cgi);                       # Include CGI functions
use CGI::Carp qw(fatalsToBrowser);      # Send error messages to browser
use CGI qw(param);
use File::Temp ":mktemp";
use CGI;

$root_dir = "I:/pictures/Public";
$pl_file = "public.pl";


sub DIE_handler {
    my($signal) = @_;
    output_die_msg("$signal");
    exit;
}

sub output_die_msg {
  my @error = @_;
  my @tail = `tail -n 10 /var/log/httpd/error_log`;
  select (STDOUT);
  print "Content-Type: text/html\n\n";
  print "<HTML>\n";
  print "<HEAD>\n";
  print "<TITLE>NRC Statistics - ERROR</TITLE>\n";
  print "</HEAD>\n"; 
  print "<BODY\">\n";
  print "<H1> ERROR occured... </H1>\n";
  print "<PRE> @tail </PRE>";
  print "<H3> @error </H3>\n";
  
  print "</BODY>\n";
  print "</HTML>\n\n";
}



print"Content-type:text/html\n\n";
print"<html>\n";
print"   <head>\n";
print"      <title>DIR</title>\n";
    
print"      <STYLE TYPE=\"text/css\">\n";
#	color: #003300;
print"
 body {
	font-family: Verdana,Tahoma,Arial,Helvetica,Sans-serif,sans-serif; 
	font-size: small; 
	color: #ffff99; 
	font-weight: normal; 
	font-style: normal; 
	background-color: black; 
	background-image: none;
	margin: 0px;
	}
 a:link { 
	font-size: small; 
	color: #bfbfbf; 
	} 
 a:visited { 
	font-size: small; 
	color: #bfbfbf; 
	}
 a:hover { 
	font-size: large; 
	color: #e0e0e0; 
	}
 p {
	margin:0px 10px 10px 10px;
	font-size: small; 
	font-weight: normal; 
	font-style: normal; 
	font-variant: normal;
	}
 p.indent { 
	margin-left: 30pt;
	}
 table,tr,td {	
	padding: 0px;
	border-collapse: collapse;
	vertical-align: top;
	clear: left;
	}

";
#print"         td { color: blue; background-color: #F9F9FF; }\n";
#print"         body { color: black; background-color: #FFFBF0;}\n";
print"      </STYLE>\n";

print"   </head>\n";   
print"   <body>\n";


### READ PARAMETERS & BEGINING OF HTML:
#unless(param("reset") eq "ResetForm"){
unless(1 eq 2){   
    $key = "";
    foreach $key(param){
	
	@values = param($key);
	$value = join(",",@values);
	@values = split(/,/,$value);
	$value = "";
	foreach $value (@values){
	    $value =~ s/\[HASH\](.*)/\#$1/;
	    unless($value eq ""){
		$parameters{$key} = $value;                    
	    }
	}
    }
}

#### DEBUG PRINT
$key = "";    
foreach $key (keys %parameters){
#    print " key: $key - value: $parameters{$key} <br>\n";
}

#$root_dir =  "/local/apps/apache/1.3.31";
#$root_dir ="I:/pictures";

if($parameters{current_dir} ne ""){
    $current_dir = $parameters{current_dir};
    
}else{
    $current_dir = $root_dir;
}

print"<table border=0>\n";    
print"<tr>\n";
print"<td>\n";
openDIR($root_dir, $current_dir);
print"</td>\n";
print"</tr>\n";
print"</table>\n";

print"   </body>\n";
print"</html>\n";


sub openDIR{
    opendir(DIR, "$_[0]");
    my @dir = readdir DIR;
    my $next_dir;
#    print"$_[1] - $_[0]<br>";
    if($_[1] =~ m/^$_[0]\/(.*?)\//){
	$next_dir = "$_[0]/$1";
    }elsif($_[1] =~ m/^$_[0]\/(.*?)$/){
	$next_dir = "$_[0]/$1";
    }
    close (DIR);
   
    foreach (sort(@dir)){
	if(-d "$_[0]\/$_" && $_ ne "." && $_ ne ".."){
	    #print "$_[0]\/$_<br>";
	    print"<table border=0>\n";    
	    print"<tr>\n";
	    print"<td>\n";
	    my  $link = "$_[0]\/$_";
	    $link =~ s/I:\/pictures/http:\/\/www.laru.gotdns.org\/pics/;
	    
	    #print " --<a href=\"$link\">open $link</a><br>\n";
	    if($_[0] eq $_[1]){print"<b>"}
	    if(-e "$_[0]\\$_\\index.html"){
		print " <a target=\"pics\" href=\"$link\">$_</a><br>\n";
	    }else{
		print " <a href=\"$pl_file?current_dir=$_[0]\/$_\">$_</a>\n";
	    }
	    if($_[0] eq $_[1]){print"</b>"}
	    print"</td>\n";
	    print"<td>\n";
	    print"</td>\n";
	    print"</tr>\n";
	    print"<td>\n";
	    print"</td>\n";
	    print"<td>\n";
	    
	    if($next_dir eq "$_[0]\/$_"){
		unless(-e "$_[0]\\$_\\index.html"){
		    openDIR($next_dir, $_[1]);
		}
	    }
	    print"</td>\n";
	    print"</tr>\n";
	    print"</table>\n";    
	}	    
    }
    return @dirtree;
}