#!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 "\n"; print "\n"; print "NRC Statistics - ERROR\n"; print "\n"; print "\n"; print "

ERROR occured...

\n"; print "

 @tail

"; print "

@error

\n"; print "\n"; print "\n\n"; } print"Content-type:text/html\n\n"; print"\n"; print" \n"; print" DIR\n"; print" \n"; print" \n"; print" \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}
\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"\n"; print"\n"; print"\n"; print"\n"; print"

\n"; openDIR($root_dir, $current_dir); print"

\n"; print" \n"; print"\n"; sub openDIR{ opendir(DIR, "$_[0]"); my @dir = readdir DIR; my $next_dir; # print"$_[1] - $_[0]
"; 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]\/$_
"; print"\n"; print"\n"; print"\n"; print"\n"; print"\n"; print"\n"; print"\n"; print"\n"; print"

\n"; my $link = "$_[0]\/$_"; $link =~ s/I:\/pictures/http:\/\/www.laru.gotdns.org\/pics/; #print " --open $link \n"; if($_[0] eq $_[1]){print""} if(-e "$_[0]\\$_\\index.html"){ print " $_ \n"; }else{ print " $_\n"; } if($_[0] eq $_[1]){print""} print"	\n"; print"
\n"; print"	\n"; if($next_dir eq "$_[0]\/$_"){ unless(-e "$_[0]\\$_\\index.html"){ openDIR($next_dir, $_[1]); } } print"

\n"; } } return @dirtree; }