# The LearningOnline Network with CAPA
# Directory Indexer
# (Login Screen
# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer)
# 11/23 Gerd Kortemeyer
# 07/20-08/04 H.K. Ng
#
# 05/9-05/19/2001 H. K. Ng
#
package Apache::lonindexer;
use strict;
use Apache::lonnet();
use Apache::Constants qw(:common);
use Apache::File;
use GDBM_File;
my %dirs;
my %language;
sub BEGIN {
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/language.tab');
map {
$_=~/(\w+)\s+([\w\s\-]+)/;
$language{$1}=$2;
} <$fh>;
}
sub handler {
my $r = shift;
$r->content_type('text/html');
$r->send_http_header;
return OK if $r->header_only;
my $iconpath= $r->dir_config('lonIconsURL');
my $domain = $r->dir_config('lonDefDomain');
my $role = $r->dir_config('lonRole');
my $loadlim = $r->dir_config('lonLoadLim');
my $servadm = $r->dir_config('lonAdmEMail');
my $sysadm = $r->dir_config('lonSysEMail');
my $lonhost = $r->dir_config('lonHostID');
my $tabdir = $r->dir_config('lonTabDir');
# ---------------------------------------------------------------- Print Header
$r->print(<<ENDHEADER);
<html>
<head>
<title>The LearningOnline Network With CAPA Directory Browser</title>
<SCRIPT language="javascript">
function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
var options = "width=" + w + ",height=" + h + ",";
options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
var newWin = window.open(url, wdwName, options);
newWin.focus();
}
</SCRIPT>
</head>
<body bgcolor="#FFFFFF">
ENDHEADER
my $line;
my (@attrchk,@openpath);
my $uri=$r->uri;
my $iconpath="/res/adm/pages/indexericons/";
$r->print("<h2><font color=\"\#888888\">The LearningOnline With CAPA Network Directory Browser</font></h2>\n");
for (my $i=0; $i<=5; $i++) {
$attrchk[$i] = "checked" if $ENV{'form.attr'.$i} == 1;
}
$r->print(<<END);
<b><font color="#666666">Display file attributes</font></b><br>
<form method="post" name="fileattr" action="$uri" enctype="application/x-www-form-urlencoded">
<table border=0><tr>
<td><input type=checkbox name=attr0 value="1" $attrchk[0]> Size</td>
<td><input type=checkbox name=attr1 value="1" $attrchk[1]> Last access</td>
<td><input type=checkbox name=attr2 value="1" $attrchk[2]> Last modified</td>
</tr><tr>
<td><input type=checkbox name=attr3 value="1" $attrchk[3]> Author</td>
<td><input type=checkbox name=attr4 value="1" $attrchk[4]> Keywords</td>
<td><input type=checkbox name=attr5 value="1" $attrchk[5]> Language</td>
</tr></table>
<input type="submit" name="dirlistattr" value="Review">
<input type="submit" name="dirlistattr" value="Refresh">
</form>
END
my $diropen = "/home/httpd/perl/tmp/$domain$ENV{'user.name'}_diropen.db";
if (tie(%dirs,'GDBM_File',$diropen,&GDBM_WRCREAT,0640)) {
my $titleclr="#ddffff";
# my $fileclr="#ffffdd";
$r->print("<table border=0><tr><td bgcolor=#eeeeee>\n");
$r->print("<table border=0><tr>\n");
$r->print("<td bgcolor=$titleclr><b>Name</b></td>\n");
$r->print("<td bgcolor=$titleclr align=right><b>Size (bytes) </b></td>\n") if ($ENV{'form.attr0'} == 1);
$r->print("<td bgcolor=$titleclr><b>Last accessed</b></td>\n") if ($ENV{'form.attr1'} == 1);
$r->print("<td bgcolor=$titleclr><b>Last modified</b></td>\n") if ($ENV{'form.attr2'} == 1);
$r->print("<td bgcolor=$titleclr><b>Author(s)</b></td>\n") if ($ENV{'form.attr3'} == 1);
$r->print("<td bgcolor=$titleclr><b>Keywords</b></td>\n") if ($ENV{'form.attr4'} == 1);
$r->print("<td bgcolor=$titleclr><b>Language</b></td>\n") if ($ENV{'form.attr5'} == 1);
$r->print("</tr>");
if ($ENV{'form.openuri'}) { # take care of review and refresh options
my $uri=$ENV{'form.openuri'};
if (exists($dirs{$uri})) {
my $cursta = $dirs{$uri};
$dirs{$uri} = 'open';
$dirs{$uri} = 'closed' if $cursta eq 'open';
} else {
$dirs{$uri} = 'open';
}
}
sort keys %dirs;
my $toplevel = "/res/";
my $indent = -1;
&scanDir ($r,$toplevel,$indent);
$r->print("</table>");
$r->print("</td></tr></table>");
$r->print("</body></html>\n");
untie(%dirs);
} else {
$r->print("Unable to tie hash to db file");
}
return OK;
}
# --------------------recursive scan of a directory
sub scanDir {
my ($r,$startdir,$indent)=@_;
my $compuri;
$indent++;
my %dupdirs = %dirs;
sort keys %dupdirs;
my @list=&get_list($r,$startdir);
foreach my $line (@list) {
my ($strip,$domusr,$foo,$testdir,$foo)=split(/\&/,$line,5);
if ($domusr eq "domain") {
$compuri=join('',$strip,"/"); # domain list has /res/<domain name>
} else {
$compuri = join('',$startdir,$strip,"/"); # user, dir & file having name only, i.e., w/o path
}
my $diropen = 0;
&display_line($r,$diropen,$line,$indent,$strip."/") if $domusr eq "domain";
while (my ($key,$val)= each %dupdirs) {
$diropen = 1 if ($key eq $compuri and $val eq "open");
}
&display_line($r,$diropen,$line,$indent,$startdir) if ($domusr ne "domain");
&scanDir ($r,$compuri,$indent) if $diropen == 1;
}
$indent--;
}
# ----------------- get complete matched list based on the uri ------
sub get_list {
my ($r,$uri)=@_;
my @list;
my $luri = $uri;
my $domain = $r->dir_config('lonDefDomain');
$luri =~ s/\//_/g;
if ($ENV{'form.dirlistattr'} eq "Refresh") {
my $tmpdir="/home/httpd/perl/tmp";
my $filename;
opendir(DIR,$tmpdir);
while ($filename=readdir(DIR)) {
if ($filename=~/^$domain$ENV{'user.name'}_dirlist.*\.tmp$/) {
unlink($tmpdir.'/'.$filename);
}
}
closedir(DIR);
}
my $dirlist = "/home/httpd/perl/tmp/$domain$ENV{'user.name'}_dirlist$luri.tmp";
if (-e $dirlist) {
my $FH = Apache::File->new($dirlist);
@list=<$FH>;
} else {
@list=&Apache::lonnet::dirlist($uri);
my $FH = Apache::File->new(">$dirlist");
print $FH join("\n",@list);
}
@list = sort(@list);
return @list=&match_ext($r,@list);
}
#-------------------------- filters out files based on extensions
sub match_ext {
my ($r,@packlist)=@_;
my @trimlist;
my $nextline;
my @fileext;
my $dirptr=16384;
my $tabdir = $r->dir_config('lonTabDir');
my $fn = $tabdir."/filetypes.tab";
if (-e $fn) {
my $FH=Apache::File->new($fn);
my @content=<$FH>;
foreach my $line (@content) {
(my $ext,my $foo) = split /\s+/,$line;
push @fileext,$ext;
}
}
foreach my $line (@packlist) {
chomp $line;
$line =~ s/^\/home\/httpd\/html//;
my @unpackline = split (/\&/,$line);
next if ($unpackline[0] eq ".");
next if ($unpackline[0] eq "..");
my @filecom = split (/\./,$unpackline[0]);
my $fext = pop(@filecom);
next if $fext eq "meta";
my $fnptr = $unpackline[3]&$dirptr;
if ($fnptr == 0 and $unpackline[3] ne "") {
foreach my $nextline (@fileext) {
push @trimlist,$line if $nextline eq $fext;
}
} else {
push @trimlist,$line;
}
}
return @trimlist;
}
#------------------- displays one line in appropriate table format
sub display_line{
my ($r,$diropen,$line,$indent,$startdir)=@_;
my (@pathfn, $fndir, $fnptr);
my $dirptr=16384;
my $fileclr="#ffffe6";
my $iconpath="/res/adm/pages/indexericons/";
my @filecom = split (/\&/,$line);
my @pathcom = split (/\//,$filecom[0]);
my $listname = $pathcom[scalar(@pathcom)-1];
my $fnptr = $filecom[3]&$dirptr;
my $tabtag="</td>";
my $i=0;
while ($i<=5) {
my $key="form.attr".$i;
$tabtag=join('',$tabtag,"<td bgcolor=",$fileclr,"> </td>") if $ENV{$key} == 1;
$i++;
}
if ($filecom[1] eq "domain") {
$r->print("<tr>");
$r->print("<td bgcolor=$fileclr valign=bottom>");
&begin_form ($r,$filecom[0].'/');
$r->print ("<input src=\"$iconpath");
$r->print ("comp.blue.gif\"");
$r->print (" name=\"View $filecom[0]/ resources\" height=\"22\" type=\"image\" border=\"0\">\n");
$r->print("Domain - $listname $tabtag</tr></form>\n");
return OK;
}
if ($filecom[1] eq "user") {
$r->print("<tr>");
$r->print("<td bgcolor=$fileclr valign=bottom>\n");
my $curdir = $startdir.$filecom[0].'/';
&begin_form ($r,$curdir);
$r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n");
$r->print ("<input src=\"$iconpath");
$r->print ("folder_pointer_closed.gif\"") if $diropen == 0;
$r->print ("folder_pointer_opened.gif\"") if $diropen == 1;
$r->print (" name=\"View $curdir resources\" height=\"22\" type=\"image\" border=\"0\">\n");
$r->print("<img src=",$iconpath,"quill.gif border=0>\n");
$r->print("$listname $tabtag</tr></form>\n");
return OK;
}
# display file
if ($fnptr == 0 and $filecom[3] ne "") {
my @file_ext = split (/\./,$listname);
my $curfext = $file_ext[scalar(@file_ext)-1];
my $filelink = $startdir.$filecom[0];
my $count = 0;
$r->print("<tr><td bgcolor=$fileclr>");
while ($count < $indent) {
$r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n");
$count++;
}
$r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n");
$r->print("<img src=$iconpath$curfext.gif border=0>\n");
$r->print(" <a href=$filelink>",$listname,"</a>");
my $metafile = '/home/httpd/html'.$filelink.'.meta';
$r->print (" (<a href=\"javascript:openWindow('".$filelink.".meta', 'metadata', '400', '450', 'no', 'yes')\"; TARGET=_self>metadata</a>) ") if (-e $metafile);
# $r->print(" (<a href=$filelink.meta target=cat>metadata</a>)") if (-e $metafile);
$r=>print("</td>\n");
$r->print("<td bgcolor=$fileclr align=right valign=bottom> ",$filecom[8]," </td>\n") if $ENV{'form.attr0'} == 1;
$r->print("<td bgcolor=$fileclr valign=bottom> ".(localtime($filecom[9]))." </td>\n") if $ENV{'form.attr1'} == 1;
$r->print("<td bgcolor=$fileclr valign=bottom> ".(localtime($filecom[10]))." </td>\n") if $ENV{'form.attr2'} == 1;
if ($ENV{'form.attr3'} == 1) {
my $author = &Apache::lonnet::metadata($filelink,'author');
$author = ' ' if (!$author);
$r->print("<td bgcolor=$fileclr valign=bottom> ".$author." </td>\n");
}
if ($ENV{'form.attr4'} == 1) {
my $keywords = &Apache::lonnet::metadata($filelink,'keywords');
$keywords = ' ' if (!$keywords);
$r->print("<td bgcolor=$fileclr valign=bottom> ".$keywords." </td>\n");
}
if ($ENV{'form.attr5'} == 1) {
my $lang = &Apache::lonnet::metadata($filelink,'language');
$lang = $language{$lang};
$lang = ' ' if (!$lang);
$r->print("<td bgcolor=$fileclr valign=bottom> ".$lang." </td>\n");
}
$r->print("</tr>\n");
}
# -- display directory
if ($fnptr == $dirptr) {
my @file_ext = split (/\./,$listname);
my $curfext = $file_ext[scalar(@file_ext)-1];
my $curdir = $startdir.$filecom[0].'/';
$r->print("<tr><td bgcolor=$fileclr valign=bottom>");
&begin_form ($r,$curdir);
my $count = 0;
while ($count < $indent) {
$r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n");
$count++;
}
$r->print ("<input src=\"$iconpath");
$r->print ("folder_pointer_closed.gif\"") if $diropen == 0;
$r->print ("folder_pointer_opened.gif\"") if $diropen == 1;
$r->print (" name=\"View $curdir resources\" height=\"22\" type=\"image\" border=\"0\">\n");
$r->print("<img src=",$iconpath,"folder_closed.gif border=0>\n") if $diropen == 0;
$r->print("<img src=",$iconpath,"folder_opened.gif border=0>\n") if $diropen == 1;
$r->print("$listname $tabtag</tr></form>\n");
}
}
#---------------------prints the beginning of a form for directory or file link
sub begin_form {
my ($r,$uri) = @_;
$r->print ("<form method=\"post\" name=\"dirpath\" action=\"/res/\" enctype=\"application/x-www-form-urlencoded\">\n");
$r->print ("<input type=hidden name=openuri value=\"$uri\">\n");
for (my $i=0; $i<=5; $i++) {
$r->print ("<input type=hidden name=attr$i value=\"1\">\n") if $ENV{'form.attr'.$i} == 1;
}
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>