--- loncom/interface/lonindexer.pm 2001/05/18 21:10:48 1.2
+++ loncom/interface/lonindexer.pm 2001/05/21 18:11:31 1.5
@@ -6,6 +6,7 @@
# 07/20-08/04 H.K. Ng
#
# 05/9-05/19/2001 H. K. Ng
+# 05/21/2001 H. K. Ng
#
package Apache::lonindexer;
@@ -15,6 +16,7 @@ use Apache::Constants qw(:common);
use Apache::File;
use GDBM_File;
+my %hash;
my %dirs;
my %language;
@@ -46,6 +48,7 @@ sub handler {
The LearningOnline Network With CAPA Directory Browser
+
+
ENDHEADER
@@ -86,43 +90,53 @@ ENDHEADER
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("
\n");
- $r->print("
\n");
- $r->print("
Name
\n");
- $r->print("
Size (bytes)
\n") if ($ENV{'form.attr0'} == 1);
- $r->print("
Last accessed
\n") if ($ENV{'form.attr1'} == 1);
- $r->print("
Last modified
\n") if ($ENV{'form.attr2'} == 1);
- $r->print("
Author(s)
\n") if ($ENV{'form.attr3'} == 1);
- $r->print("
Keywords
\n") if ($ENV{'form.attr4'} == 1);
- $r->print("
Language
\n") if ($ENV{'form.attr5'} == 1);
- $r->print("
");
+ my $titleclr="#ddffff";
+ $r->print("
\n");
+ $r->print("
\n");
+ $r->print("
Name
\n");
+ $r->print("
Size (bytes)
\n") if ($ENV{'form.attr0'} == 1);
+ $r->print("
Last accessed
\n") if ($ENV{'form.attr1'} == 1);
+ $r->print("
Last modified
\n") if ($ENV{'form.attr2'} == 1);
+ $r->print("
Author(s)
\n") if ($ENV{'form.attr3'} == 1);
+ $r->print("
Keywords
\n") if ($ENV{'form.attr4'} == 1);
+ $r->print("
Language
\n") if ($ENV{'form.attr5'} == 1);
+ $r->print("
");
+
+ my $diropen = "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_indexer.db";
+
+ if (tie(%hash,'GDBM_File',$diropen,&GDBM_WRCREAT,0640)) {
+ 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($dirs{$uri})) {
- my $cursta = $dirs{$uri};
+ if (exists($hash{'diropen_status_'.$uri})) {
+ my $cursta = $hash{'diropen_status_'.$uri};
$dirs{$uri} = 'open';
- $dirs{$uri} = 'closed' if $cursta eq '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';
}
}
- sort keys %dirs;
-
my $toplevel = "/res/";
- my $indent = -1;
+ my $indent = 0;
&scanDir ($r,$toplevel,$indent);
$r->print("
");
$r->print("
");
$r->print("\n");
- untie(%dirs);
+ untie(%hash);
} else {
$r->print("Unable to tie hash to db file");
}
@@ -132,25 +146,32 @@ END
# --------------------recursive scan of a directory
sub scanDir {
my ($r,$startdir,$indent)=@_;
- my $compuri;
+ my ($compuri,$curdir);
+ my $dirptr=16384;
$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/
+ my ($strip,$dom,$foo,$testdir,$foo)=split(/\&/,$line,5);
+ next if $strip =~ /.*\.meta$/;
+ if ($dom eq "domain") {
+ $compuri = join('',$strip,"/"); # domain list has /res/
+ $curdir = $compuri;
} else {
$compuri = join('',$startdir,$strip,"/"); # user, dir & file having name only, i.e., w/o path
+ $curdir = $startdir;
}
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");
+ if (($dirptr&$testdir) or ($dom =~ /^(domain|user)$/)) {
+ while (my ($key,$val)= each %dupdirs) {
+ if ($key eq $compuri and $val eq "open") {
+ $diropen = 1;
+ delete $dupdirs{key},$dirs{$key};
+ }
+ }
}
- &display_line($r,$diropen,$line,$indent,$startdir) if ($domusr ne "domain");
+ &display_line($r,$diropen,$line,$indent,$curdir,@list);
&scanDir ($r,$compuri,$indent) if $diropen == 1;
}
$indent--;
@@ -161,31 +182,20 @@ 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);
+ map {
+ delete $hash{$_} if ($_ =~ /^dirlist_files_/);
+ } keys %hash;
}
- my $dirlist = "/home/httpd/perl/tmp/$domain$ENV{'user.name'}_dirlist$luri.tmp";
- if (-e $dirlist) {
- my $FH = Apache::File->new($dirlist);
- @list=<$FH>;
+ if ($hash{'dirlist_files'.$luri}) {
+ @list = split(/\n/,$hash{'dirlist_files_'.$luri});
} else {
- @list=&Apache::lonnet::dirlist($uri);
- my $FH = Apache::File->new(">$dirlist");
- print $FH join("\n",@list);
+ @list = &Apache::lonnet::dirlist($uri);
+ $hash{'dirlist_files_'.$luri} = join('\n',@list);
}
- @list = sort(@list);
return @list=&match_ext($r,@list);
}
@@ -215,7 +225,6 @@ sub match_ext {
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) {
@@ -225,12 +234,13 @@ sub match_ext {
push @trimlist,$line;
}
}
+ @trimlist = sort (@trimlist);
return @trimlist;
}
#------------------- displays one line in appropriate table format
sub display_line{
- my ($r,$diropen,$line,$indent,$startdir)=@_;
+ my ($r,$diropen,$line,$indent,$startdir,@list)=@_;
my (@pathfn, $fndir, $fnptr);
my $dirptr=16384;
my $fileclr="#ffffe6";
@@ -240,6 +250,8 @@ sub display_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="";
my $i=0;
@@ -253,9 +265,10 @@ sub display_line{
$r->print("
\n");
@@ -343,8 +374,9 @@ sub display_line{
#---------------------prints the beginning of a form for directory or file link
sub begin_form {
my ($r,$uri) = @_;
-
- $r->print ("