# 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
# 05/21/2001 H. K. Ng
#
package Apache::lonindexer;
use strict;
use Apache::lonnet();
use Apache::Constants qw(:common);
use Apache::File;
use GDBM_File;
my %hash;
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(%hash,'GDBM_File',$diropen,&GDBM_WRCREAT,0640)) {
my $titleclr="#ddffff";
$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>");
map {
if ($_ =~ /^diropen_status_/) {
my $key = $_;
$key =~ s/^diropen_status_//;
$dirs{$key} = $hash{$_};
}
} keys %hash;
if ($ENV{'form.openuri'}) { # take care of review and refresh options
my $uri=$ENV{'form.openuri'};
if (exists($hash{'diropen_status_'.$uri})) {
my $cursta = $hash{'diropen_status_'.$uri};
$dirs{$uri} = 'open';
$hash{'diropen_status_'.$uri} = 'open';
if ($cursta eq 'open') {
$dirs{$uri} = 'closed';
$hash{'diropen_status_'.$uri} = 'closed';
}
} else {
$hash{'diropen_status_'.$uri} = 'open';
$dirs{$uri} = 'open';
}
}
my $toplevel = "/res/";
my $indent = 0;
&scanDir ($r,$toplevel,$indent);
$r->print("</table>");
$r->print("</td></tr></table>");
$r->print("</body></html>\n");
untie(%hash);
} 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,$curdir);
my $dirptr=16384;
$indent++;
my %dupdirs = %dirs;
my @list=&get_list($r,$startdir);
foreach my $line (@list) {
my ($strip,$domusr,$foo,$testdir,$foo)=split(/\&/,$line,5);
next if $strip =~ /.*\.meta$/;
if ($domusr eq "domain") {
$compuri = join('',$strip,"/"); # domain list has /res/<domain name>
$curdir = $compuri;
} else {
$compuri = join('',$startdir,$strip,"/"); # user, dir & file having name only, i.e., w/o path
$curdir = $startdir;
}
my $diropen = 0;
if (($dirptr&$testdir) or ($domusr =~ /^(domain|user)$/)) {
while (my ($key,$val)= each %dupdirs) {
$diropen = 1 if ($key eq $compuri and $val eq "open");
}
}
&display_line($r,$diropen,$line,$indent,$curdir,@list);
&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;
$luri =~ s/\//_/g;
if ($ENV{'form.dirlistattr'} eq "Refresh") {
map {
delete $hash{$_} if ($_ =~ /^dirlist_files_/);
} keys %hash;
}
if ($hash{'dirlist_files'.$luri}) {
@list = split(/\n/,$hash{'dirlist_files_'.$luri});
} else {
@list = &Apache::lonnet::dirlist($uri);
$hash{'dirlist_files_'.$luri} = join('\n',@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);
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;
}
}
@trimlist = sort (@trimlist);
return @trimlist;
}
#------------------- displays one line in appropriate table format
sub display_line{
my ($r,$diropen,$line,$indent,$startdir,@list)=@_;
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 $msg = 'View '.$filecom[0].' resources';
$msg = 'Close '.$filecom[0].' directory' if $diropen == 1;
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].'/');
my $anchor = $filecom[0].'/';
$anchor =~ s/\///g;
$r->print ("<a name=\"".$anchor."\">\n<input src=\"".$iconpath."comp.blue.gif\"");
$r->print (" name=\"$msg\" 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);
my $anchor = $curdir;
$anchor =~ s/\///g;
# $r->print ("<a name=\"$anchor\">\n<img src=",$iconpath,"white_space_20_22.gif border=0>\n");
$r->print ("<a name=\"$anchor\">\n<img src=",$iconpath,"whitespace1.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=\"$msg\" 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];
$r->print("<tr><td bgcolor=$fileclr>");
if ($indent < 11) {
$r->print("<img src=",$iconpath,"whitespace",$indent,".gif border=0>\n");
} else {
my $ten = int($indent/10.);
my $rem = $indent%10.0;
my $count = 0;
while ($count < $ten) {
$r->print("<img src=",$iconpath,"whitespace10.gif border=0>\n");
$count++;
}
$r->print("<img src=",$iconpath,"whitespace",$rem,".gif border=0>\n") if $rem > 0;
}
$r->print("<img src=$iconpath$curfext.gif border=0>\n");
$r->print(" <a href=$filelink>",$listname,"</a>\n");
my $metafile = grep /^$filecom[0]\.meta\&/, @list;
$r->print (" (<a href=\"javascript:openWindow('".$filelink.".meta', 'metadatafile', '400', '450', 'no', 'yes')\"; TARGET=_self>metadata</a>) ") if ($metafile == 1);
$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') if ($metafile == 1);
$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') if ($metafile == 1);
$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') if ($metafile == 1);
$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].'/';
my $anchor = $curdir;
$anchor =~ s/\///g;
$r->print("<tr><td bgcolor=$fileclr valign=bottom>");
&begin_form ($r,$curdir);
my $indentm1 = $indent-1;
if ($indentm1 < 11) {
$r->print("<img src=",$iconpath,"whitespace",$indentm1,".gif border=0>\n");
} else {
my $ten = int($indentm1/10.);
my $rem = $indentm1%10.0;
my $count = 0;
while ($count < $ten) {
$r->print("<img src=",$iconpath,"whitespace10.gif border=0>\n");
$count++;
}
$r->print("<img src=",$iconpath,"whitespace",$rem,".gif border=0>\n") if $rem > 0;
}
$r->print ("<a name=\"$anchor\">\n<input src=\"$iconpath");
$r->print ("folder_pointer_closed.gif\"") if $diropen == 0;
$r->print ("folder_pointer_opened.gif\"") if $diropen == 1;
$r->print (" name=\"$msg\" 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) = @_;
my $anchor = $uri;
$anchor =~ s/\///g;
$r->print ("<form method=\"post\" name=\"dirpath\" action=\"/res/\#$anchor\" 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>