# 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(< The LearningOnline Network With CAPA Directory Browser ENDHEADER my $line; my (@attrchk,@openpath); my $uri=$r->uri; my $iconpath="/res/adm/pages/indexericons/"; $r->print("

The LearningOnline With CAPA Network Directory Browser

\n"); for (my $i=0; $i<=5; $i++) { $attrchk[$i] = "checked" if $ENV{'form.attr'.$i} == 1; } $r->print(<Display file attributes
Size Last access Last modified
Author Keywords Language
 
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("
\n"); $r->print("\n"); $r->print("\n"); $r->print("\n") if ($ENV{'form.attr0'} == 1); $r->print("\n") if ($ENV{'form.attr1'} == 1); $r->print("\n") if ($ENV{'form.attr2'} == 1); $r->print("\n") if ($ENV{'form.attr3'} == 1); $r->print("\n") if ($ENV{'form.attr4'} == 1); $r->print("\n") if ($ENV{'form.attr5'} == 1); $r->print(""); 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("
NameSize (bytes) Last accessedLast modifiedAuthor(s)KeywordsLanguage
"); $r->print("
"); $r->print("\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/ $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=""; my $i=0; while ($i<=5) { my $key="form.attr".$i; $tabtag=join('',$tabtag," ") if $ENV{$key} == 1; $i++; } if ($filecom[1] eq "domain") { $r->print(""); $r->print(""); &begin_form ($r,$filecom[0].'/'); my $anchor = $filecom[0].'/'; $anchor =~ s/\///g; $r->print ("\nprint (" name=\"$msg\" height=\"22\" type=\"image\" border=\"0\">\n"); $r->print("Domain - $listname $tabtag\n"); return OK; } if ($filecom[1] eq "user") { $r->print(""); $r->print("\n"); my $curdir = $startdir.$filecom[0].'/'; &begin_form ($r,$curdir); my $anchor = $curdir; $anchor =~ s/\///g; # $r->print ("\n\n"); $r->print ("\n\n"); $r->print ("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 ("\n"); $r->print ("$listname $tabtag\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(""); if ($indent < 11) { $r->print("\n"); } else { my $ten = int($indent/10.); my $rem = $indent%10.0; my $count = 0; while ($count < $ten) { $r->print("\n"); $count++; } $r->print("\n") if $rem > 0; } $r->print("\n"); $r->print(" ",$listname,"\n"); my $metafile = grep /^$filecom[0]\.meta\&/, @list; $r->print (" (metadata) ") if ($metafile == 1); $r=>print("\n"); $r->print(" ",$filecom[8]," \n") if $ENV{'form.attr0'} == 1; $r->print(" ".(localtime($filecom[9]))." \n") if $ENV{'form.attr1'} == 1; $r->print(" ".(localtime($filecom[10]))." \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(" ".$author." \n"); } if ($ENV{'form.attr4'} == 1) { my $keywords = &Apache::lonnet::metadata($filelink,'keywords') if ($metafile == 1); $keywords = ' ' if (!$keywords); $r->print(" ".$keywords." \n"); } if ($ENV{'form.attr5'} == 1) { my $lang = &Apache::lonnet::metadata($filelink,'language') if ($metafile == 1); $lang = $language{$lang}; $lang = ' ' if (!$lang); $r->print(" ".$lang." \n"); } $r->print("\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(""); &begin_form ($r,$curdir); my $indentm1 = $indent-1; if ($indentm1 < 11) { $r->print("\n"); } else { my $ten = int($indentm1/10.); my $rem = $indentm1%10.0; my $count = 0; while ($count < $ten) { $r->print("\n"); $count++; } $r->print("\n") if $rem > 0; } $r->print ("\nprint ("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("\n") if $diropen == 0; $r->print("\n") if $diropen == 1; $r->print("$listname $tabtag\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 ("
\n"); $r->print ("\n"); for (my $i=0; $i<=5; $i++) { $r->print ("\n") if $ENV{'form.attr'.$i} == 1; } } 1; __END__