--- loncom/interface/lonindexer.pm 2001/08/29 12:07:55 1.19 +++ loncom/interface/lonindexer.pm 2003/05/29 01:08:05 1.64 @@ -1,7 +1,30 @@ # The LearningOnline Network with CAPA -# # Directory Indexer # +# $Id: lonindexer.pm,v 1.64 2003/05/29 01:08:05 www Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# # YEAR=1999 # 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 @@ -11,20 +34,38 @@ # 05/9-05/19/2001 H. K. Ng # 05/21/2001 H. K. Ng # 05/23/2001 H. K. Ng -# 5/31,6/1,6/2,6/15 Scott Harrison # 6/26,7/8 H. K. Ng -# 8/6,8/7,8/10 Scott Harrison # 8/14 H. K. Ng -# 8/28 Scott Harrison +# 11/30 Matthew Hall +# YEAR=2002 +# 6/29/2002 H. K. Ng +# +### + +############################################################################### +## ## +## ORGANIZATION OF THIS PERL MODULE ## +## ## +## 1. Description of functions ## +## 2. Modules used by this module ## +## 3. Choices for different output views (detailed, summary, xml, etc) ## +## 4. BEGIN block (to be run once after compilation) ## +## 5. Handling routine called via Apache and mod_perl ## +## 6. Other subroutines ## +## ## +############################################################################### package Apache::lonindexer; +# ------------------------------------------------- modules used by this module use strict; use Apache::lonnet(); +use Apache::loncommon(); use Apache::Constants qw(:common); use Apache::File; use GDBM_File; +# ---------------------------------------- variables used throughout the module my %hash; # tied to a user-specific gdbm file my %dirs; # keys are directories, values are the open/close status my %language; # has the reference information present in language.tab @@ -35,26 +76,28 @@ my $extrafield; # default extra table ce my $fnum; # file counter my $dnum; # directory counter -# ---------------------------------------------------------------------- BEGIN -sub BEGIN { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. - '/language.tab'); - map { - $_=~/(\w+)\s+([\w\s\-]+)/; - $language{$1}=$2; - } <$fh>; -} +# ----- Used to include or exclude files with certain extensions. +my @Only = (); +my @Omit = (); -# ---------------------------------------------------------------- Main Handler + +# ----------------------------- Handling routine called via Apache and mod_perl sub handler { my $r = shift; $r->content_type('text/html'); + &Apache::loncommon::no_cache($r); $r->send_http_header; return OK if $r->header_only; $fnum=0; $dnum=0; + untie %hash; + + # Deal with stupid global variables (is there a way around making + # these global to this package? It is just so wrong....) + undef (@Only); + undef (@Omit); -# --------------------------------------------- machine configuration variables +# ------------------------------------- read in machine configuration variables my $iconpath= $r->dir_config('lonIconsURL') . "/"; my $domain = $r->dir_config('lonDefDomain'); my $role = $r->dir_config('lonRole'); @@ -70,8 +113,11 @@ sub handler { my $uri=$r->uri; # -------------------------------------- see if called from an interactive mode - &get_unprocessed_cgi(); - + # Get the parameters from the query string + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['catalogmode','launch','acts','mode','form','element', + 'only','omit']); + #------------------------------------------------------------------- my $closebutton=''; my $groupimportbutton=''; my $colspan=''; @@ -80,22 +126,15 @@ sub handler { my $diropendb = "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_indexer.db"; - if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { + if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT(),0640)) { if ($ENV{'form.launch'} eq '1') { &start_fresh_session(); - } - + } # -------------------- refresh environment with user database values (in %hash) - if ($hash{'mode_catalog'} eq 'interactive') { - $ENV{'form.catalogmode'}='interactive'; - } - if ($hash{'mode_catalog'} eq 'groupimport') { - $ENV{'form.catalogmode'}='groupimport'; - } + &setvalues(\%hash,'form.catalogmode',\%ENV,'form.catalogmode' ); # --------------------- define extra fields and buttons in case of special mode if ($ENV{'form.catalogmode'} eq 'interactive') { - $hash{'mode_catalog'}='interactive'; $extrafield=''. ''; @@ -105,7 +144,6 @@ sub handler { END } elsif ($ENV{'form.catalogmode'} eq 'groupimport') { - $hash{'mode_catalog'}='groupimport'; $extrafield=''. ''; @@ -118,35 +156,136 @@ END onClick="javascript:select_group()"> END } - + # Additions made by Matthew to make the browser a little easier to deal + # with in the future. + # + # $mode (at this time) indicates if we are in edit mode. + # $form is the name of the form that the URL is placed when the + # selection is made. + # $element is the name of the element in $formname which receives + # the URL. + # &Apache::lonxml::debug('Checking mode, form, element'); + &setvalues(\%hash,'form.mode' ,\%ENV,'form.mode' ); + &setvalues(\%hash,'form.form' ,\%ENV,'form.form' ); + &setvalues(\%hash,'form.element',\%ENV,'form.element'); + &setvalues(\%hash,'form.only' ,\%ENV,'form.only' ); + &setvalues(\%hash,'form.omit' ,\%ENV,'form.omit' ); + + # Deal with 'omit' and 'only' + if (exists $ENV{'form.omit'}) { + @Omit = split(',',$ENV{'form.omit'}); + } + if (exists $ENV{'form.only'}) { + @Only = split(',',$ENV{'form.only'}); + } + + my $mode = $ENV{'form.mode'}; + my ($form,$element); + if ($mode eq 'edit' || $mode eq 'parmset') { + $form = $ENV{'form.form'}; + $element = $ENV{'form.element'}; + } + &Apache::lonxml::debug("mode=$mode form=$form element=$element"); # ------ set catalogmodefunctions to have extra needed javascript functionality my $catalogmodefunctions=''; if ($ENV{'form.catalogmode'} eq 'interactive' or $ENV{'form.catalogmode'} eq 'groupimport') { - $catalogmodefunctions=< - ENDHEADER - +$r->print(&Apache::loncommon::bodytag('Browse Resources')); # - Evaluate actions from previous page (both cumulatively and chronologically) if ($ENV{'form.catalogmode'} eq 'groupimport') { my $acts=$ENV{'form.acts'}; @@ -197,14 +332,14 @@ ENDHEADER my %achash; my $ac=0; # some initial hashes for working with data - map { + foreach (@Acts) { my ($state,$ref)=split(/a/); $ahash{$ref}=$state; $achash{$ref}=$ac; $ac++; - } (@Acts); + } # sorting through the actions and changing the tied database hash - map { + foreach (sort {$achash{$a}<=>$achash{$b}} (keys %ahash)) { my $key=$_; if ($ahash{$key} eq '1') { $hash{'store_'.$hash{'pre_'.$key.'_link'}}= @@ -218,9 +353,9 @@ ENDHEADER delete $hash{'store_'.$hash{'pre_'.$key.'_link'}}; } } - } sort {$achash{$a}<=>$achash{$b}} (keys %ahash); + } # deleting the previously cached listing - map { + foreach (keys %hash) { if ($_ =~ /^pre_/ && $_ =~/link$/) { my $key = $_; $key =~ s/^pre_//; @@ -228,40 +363,38 @@ ENDHEADER delete $hash{'pre_'.$key.'_title'}; delete $hash{'pre_'.$key.'_link'}; } - } keys %hash; + } } -# output title - $r->print('

The LearningOnline With CAPA '. - 'Network Directory Browser

'."\n"); -# get state of file attributes to be showing - if ($ENV{'form.attrs'} ne "") { - for (my $i=0; $i<=6; $i++) { +# ---------------------------------- get state of file attributes to be showing + if ($ENV{'form.attrs'} ne '') { + for (my $i=0; $i<=8; $i++) { delete $hash{'display_attrs_'.$i}; if ($ENV{'form.attr'.$i} == 1) { - $attrchk[$i] = "checked"; + $attrchk[$i] = 'checked'; $hash{'display_attrs_'.$i} = 1; } } } else { - for (my $i=0; $i<=6; $i++) { - $attrchk[$i] = "checked" if $hash{'display_attrs_'.$i} == 1; + for (my $i=0; $i<=8; $i++) { + $attrchk[$i] = 'checked' if $hash{'display_attrs_'.$i} == 1; } } -# output state of file attributes to be showing +# ------------------------------- output state of file attributes to be showing $r->print(<Display file attributes
+Display file attributes
- - - - - - - - + + + + + + + + +
Size Last access Last modified All versions
Author Keywords Language Title Size Last access Last modified All versions
Author Keywords Language Show Resource  
@@ -273,33 +406,40 @@ $groupimportbutton
END - # output starting row to the indexed file/directory hierarchy +# ----------------- output starting row to the indexed file/directory hierarchy my $titleclr="#ddffff"; - $r->print("
\n"); - $r->print("\n"); - $r->print("\n"); - $r->print("\n") if ($hash{'display_attrs_0'} == 1); - $r->print("\n") - if ($hash{'display_attrs_1'} == 1); - $r->print("\n") +# $r->print(&initdebug()); +# $r->print(&writedebug("Omit:@Omit")) if (@Omit); +# $r->print(&writedebug("Only:@Only")) if (@Only); + $r->print("
NameSize (bytes) ". - "Last accessedLast modified
\n"); + $r->print("\n"); + $r->print("\n"); + $r->print("\n") + if ($hash{'display_attrs_0'} == 1); + $r->print("\n") if ($hash{'display_attrs_1'} == 1); + $r->print("\n") if ($hash{'display_attrs_2'} == 1); - $r->print("\n") + $r->print("\n") if ($hash{'display_attrs_3'} == 1); - $r->print("\n") + $r->print("\n") if ($hash{'display_attrs_4'} == 1); - $r->print("\n") + $r->print("\n") if ($hash{'display_attrs_5'} == 1); - $r->print(""); + $r->print("\n") + if ($hash{'display_attrs_6'} == 1); + $r->print("\n") + if ($hash{'display_attrs_7'} == 1); + $r->print(''); - # read in what directories have previously been set to "open" - map { +# ----------------- read in what directories have previously been set to "open" + foreach (keys %hash) { 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'}; @@ -322,7 +462,7 @@ END my $indent = 0; $uri = $uri.'/' if $uri !~ /.*\/$/; - if ($bredir ne "on") { + if ($bredir ne 'on') { $hash{'top.level'} = $uri; $toplevel = $uri; @@ -330,8 +470,8 @@ END $toplevel = $hash{'top.level'}; } - # if not at top level, provide an uplink arrow - if ($toplevel ne "/res/"){ +# -------------------------------- if not at top level, provide an uplink arrow + if ($toplevel ne '/res/'){ my (@uri_com) = split(/\//,$uri); pop @uri_com; my $upone = join('/',@uri_com); @@ -340,19 +480,19 @@ END $indent = 1; } - # recursively go through all the directories and output as appropriate +# -------- recursively go through all the directories and output as appropriate &scanDir ($r,$toplevel,$indent,\%hash); - # information useful for group import +# ---------------------------- embed hidden information useful for group import $r->print(""); $r->print(""); - # end the tables - $r->print("
NameTitleSize (bytes) ". + "Last accessedAuthor(s)Last modifiedKeywordsAuthor(s)LanguageKeywords
LanguageResource
"); - $r->print("
"); +# -------------------------------------------------------------- end the tables + $r->print('
'); + $r->print(''); - # end the output and return - $r->print("\n"); +# --------------------------------------------------- end the output and return + $r->print(''."\n"); untie(%hash); } else { $r->print('Unable to tie hash to db '. @@ -362,7 +502,6 @@ END return OK; } - # ----------------------------------------------- recursive scan of a directory sub scanDir { my ($r,$startdir,$indent,$hashref)=@_; @@ -373,37 +512,38 @@ sub scanDir { my %dupdirs = %dirs; my @list=&get_list($r,$startdir); foreach my $line (@list) { - my ($strip,$dom,$foo,$testdir,$foo)=split(/\&/,$line,5); + my ($strip,$dom,undef,$testdir,undef)=split(/\&/,$line,5); next if $strip =~ /.*\.meta$/; my (@fileparts) = split(/\./,$strip); - if ($hash{'display_attrs_6'} != 1) { + if ($hash{'display_attrs_8'} != 1) { if (scalar(@fileparts) >= 3) { my $fext = pop @fileparts; my $ov = pop @fileparts; my $fname = join ('.',@fileparts,$fext); - next if (grep /$fname/,@list and $ov =~ /\d+/); + next if (grep /\Q$fname\E/,@list and $ov =~ /\d+/); } } - if ($dom eq "domain") { - $compuri = join('',$strip,"/"); # dom list has /res/ + if ($dom eq 'domain') { + $compuri = join('',$strip,'/'); # dom list has /res/ $curdir = $compuri; } else { # user, dir & file have name only, i.e., w/o path - $compuri = join('',$startdir,$strip,"/"); + $compuri = join('',$startdir,$strip,'/'); $curdir = $startdir; } - my $diropen = "closed"; + my $diropen = 'closed'; if (($dirptr&$testdir) or ($dom =~ /^(domain|user)$/)) { while (my ($key,$val)= each %dupdirs) { if ($key eq $compuri and $val eq "open") { $diropen = "opened"; - delete $dupdirs{key},$dirs{$key}; + delete($dupdirs{$key}); + delete($dirs{$key}); } } } &display_line($r,$diropen,$line,$indent,$curdir,$hashref,@list); - &scanDir ($r,$compuri,$indent) if $diropen eq "opened"; + &scanDir ($r,$compuri,$indent) if $diropen eq 'opened'; } $indent--; } @@ -412,13 +552,12 @@ sub scanDir { sub get_list { my ($r,$uri)=@_; my @list; - my $luri = $uri; - $luri =~ s/\//_/g; + (my $luri = $uri) =~ s/\//_/g; - if ($ENV{'form.attrs'} eq "Refresh") { - map { + if ($ENV{'form.attrs'} eq 'Refresh') { + foreach (keys %hash) { delete $hash{$_} if ($_ =~ /^dirlist_files_/); - } keys %hash; + } } if ($hash{'dirlist_files'.$luri}) { @@ -430,6 +569,29 @@ sub get_list { return @list=&match_ext($r,@list); } +sub initdebug { + return < +var debugging = true; +if (debugging) { + var debuggingWindow = window.open('','Debug','width=400,height=300',true); +} + +function output(text) { + if (debugging) { + debuggingWindow.document.writeln(text); + } +} +output("Debugging Window
");   
+
+ENDJS
+}
+
+sub writedebug {
+    my $text = shift;
+    return "";
+}
+
 # -------------------- filters out files based on extensions (returns an array)
 sub match_ext {
     my ($r,@packlist)=@_;
@@ -438,29 +600,19 @@ sub match_ext {
     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 "..");
+	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;
-	    }
+	    my $embstyle = &Apache::loncommon::fileembstyle($fext);
+            push @trimlist,$line if (defined($embstyle) && 
+				     ($embstyle ne 'hdn' or $fext eq 'meta'));
 	} else {
 	    push @trimlist,$line;
 	}
@@ -470,33 +622,35 @@ sub match_ext {
 }
 
 # ------------------------------- displays one line in appropriate table format
-sub display_line{
+sub display_line {
     my ($r,$diropen,$line,$indent,$startdir,$hashref,@list)=@_;
-    my (@pathfn, $fndir, $fnptr);
+    my (@pathfn, $fndir);
     my $dirptr=16384;
     my $fileclr="#ffffe6";
-    my $iconpath= $r->dir_config('lonIconsURL') . "/";
+    my $iconpath= $r->dir_config('lonIconsURL') . '/';
 
     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 eq "opened";
+    $msg = 'Close '.$filecom[0].' directory' if $diropen eq 'opened';
 
-    my $tabtag="";
+    my $tabtag='';
     my $i=0;
 
-    while ($i<=5) {
-	$tabtag=join('',$tabtag," ")
+    while ($i<=7) {
+	$tabtag=join('',$tabtag," ")
 	    if $hash{'display_attrs_'.$i} == 1;
 	$i++;
     }
+	
+    my $valign = ($hash{'display_attrs_7'} == 1 ? 'top' : 'bottom');
 
 # display uplink arrow
-    if ($filecom[1] eq "viewOneUp") {
-	$r->print("$extrafield");
-	$r->print("\n");
+    if ($filecom[1] eq 'viewOneUp') {
+	$r->print("$extrafield");
+	$r->print("\n");
 	$r->print ('
\n"); return OK; } +# Do we have permission to look at this? + + return OK if (!&Apache::lonnet::allowed('bre',$startdir.$filecom[0])); # display domain - if ($filecom[1] eq "domain") { + if ($filecom[1] eq 'domain') { $r->print (''."\n") if ($ENV{'form.dirPointer'} eq "on"); - $r->print("$extrafield"); - $r->print(""); + $r->print("$extrafield"); + $r->print(""); &begin_form ($r,$filecom[0].'/'); my $anchor = $filecom[0].'/'; $anchor =~ s/\///g; @@ -531,14 +688,19 @@ sub display_line{ $r->print ('
print (' border="0" />'."\n"); - $r->print("Domain - $listname $tabtag\n"); + $r->print ("Domain - $listname "); + if ($Apache::lonnet::domaindescription{$listname}) { + $r->print("(".$Apache::lonnet::domaindescription{$listname}. + ")"); + } + $r->print (" $tabtag\n"); return OK; # display user directory } - if ($filecom[1] eq "user") { - $r->print("$extrafield"); - $r->print("\n"); + if ($filecom[1] eq 'user') { + $r->print("$extrafield"); + $r->print("\n"); my $curdir = $startdir.$filecom[0].'/'; my $anchor = $curdir; $anchor =~ s/\///g; @@ -553,34 +715,56 @@ sub display_line{ $r->print (''); - $r->print ($listname.$tabtag.''."\n"); + my $domain=(split(m|/|,$startdir))[2]; + my $plainname=&Apache::loncommon::plainname($listname,$domain); + $r->print ($listname); + if (defined($plainname) && $plainname) { $r->print(" ($plainname) "); } + $r->print ($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]; + if ($fnptr == 0 and $filecom[3] ne '') { my $filelink = $startdir.$filecom[0]; - $r->print(""); - my $metafile = grep /^$filecom[0]\.meta\&/, @list; + my @file_ext = split (/\./,$listname); + my $curfext = $file_ext[-1]; + if (@Omit) { + foreach (@Omit) { return OK if ($curfext eq $_); } + } + if (@Only) { + my $skip = 1; + foreach (@Only) { $skip = 0 if ($curfext eq $_); } + return OK if ($skip > 0); + } + # Set the icon for the file + my $iconname = "unknown.gif"; + my $embstyle = &Apache::loncommon::fileembstyle($curfext); + # The unless conditional that follows is a bit of overkill + $iconname = $curfext.".gif" unless + (!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn'); + # + $r->print(""); + my $metafile = grep /^\Q$filecom[0]\E\.meta\&/, @list; my $title; if ($ENV{'form.catalogmode'} eq 'interactive') { $title=$listname; $title = &Apache::lonnet::metadata($filelink,'title') if ($metafile == 1); $title=$listname unless $title; - $r->print(""); + my $titleesc=HTML::Entities::encode($title); + $titleesc=~s/\'/\\'/; #' (clean up this spare quote) + $r->print(""); $r->print("". "\n"); - $r->print(""); + $r->print(""); } elsif ($ENV{'form.catalogmode'} eq 'groupimport') { $title=$listname; $title = &Apache::lonnet::metadata($filelink,'title') if ($metafile == 1); $title=$listname unless $title; + my $titleesc=&HTML::Entities::encode($title); $r->print("
\n"); $r->print("\n"); + "value='$titleesc'>\n"); $r->print("
\n"); - $r->print(""); + $r->print(""); $hash{"pre_${fnum}_link"}=$filelink; - $hash{"pre_${fnum}_title"}=$title; + $hash{"pre_${fnum}_title"}=$titleesc; $fnum++; } @@ -614,7 +798,7 @@ sub display_line{ ".gif border='0' />\n") if $rem > 0; } - $r->print("\n"); + $r->print("\n"); $r->print (" $listname "); @@ -624,38 +808,58 @@ sub display_line{ "TARGET=_self>metadata) ") if ($metafile == 1); $r->print("\n"); - $r->print(" ", + if ($hash{'display_attrs_0'} == 1) { + my $title = &Apache::lonnet::metadata($filelink,'title') + if ($metafile == 1); + $r->print(' '.($title eq '' ? ' ' : $title). + ' '."\n"); + } + $r->print(' ', $filecom[8]," \n") - if $hash{'display_attrs_0'} == 1; - $r->print(" ". - (localtime($filecom[9]))." \n") if $hash{'display_attrs_1'} == 1; - $r->print(" ". - (localtime($filecom[10]))." \n") + $r->print(' '. + (localtime($filecom[9]))." \n") if $hash{'display_attrs_2'} == 1; + $r->print(' '. + (localtime($filecom[10]))." \n") + if $hash{'display_attrs_3'} == 1; - if ($hash{'display_attrs_3'} == 1) { + if ($hash{'display_attrs_4'} == 1) { my $author = &Apache::lonnet::metadata($filelink,'author') if ($metafile == 1); - $author = ' ' if (!$author); - $r->print(" ".$author. + $r->print(' '.($author eq '' ? ' ' : $author). " \n"); } - if ($hash{'display_attrs_4'} == 1) { + if ($hash{'display_attrs_5'} == 1) { my $keywords = &Apache::lonnet::metadata($filelink,'keywords') if ($metafile == 1); - $keywords = ' ' if (!$keywords); - $r->print(" ".$keywords. + # $keywords = ' ' if (!$keywords); + $r->print(' '.($keywords eq '' ? ' ' : $keywords). " \n"); } - if ($hash{'display_attrs_5'} == 1) { + if ($hash{'display_attrs_6'} == 1) { my $lang = &Apache::lonnet::metadata($filelink,'language') if ($metafile == 1); - $lang = $language{$lang}; - $lang = ' ' if (!$lang); - $r->print(" ".$lang. + $lang = &Apache::loncommon::languagedescription($lang); + $r->print(' '.($lang eq '' ? ' ' : $lang). " \n"); } + if ($hash{'display_attrs_7'} == 1) { + my $output=''; + my $embstyle=&Apache::loncommon::fileembstyle($curfext); + if ($embstyle eq 'ssi') { + $output=&Apache::lonnet::ssi_body($filelink); + $output=''.$output.''; + } elsif ($embstyle eq 'img') { + $output=''; + } elsif ($filelink=~/^\/res\/(\w+)\/(\w+)\//) { + $output=''; + } + $r->print(' '.($output eq '' ? ' ':$output). + " \n"); + } $r->print("\n"); } @@ -666,7 +870,7 @@ sub display_line{ my $curdir = $startdir.$filecom[0].'/'; my $anchor = $curdir; $anchor =~ s/\///g; - $r->print("$extrafield"); + $r->print("$extrafield"); &begin_form ($r,$curdir); my $indentm1 = $indent-1; if ($indentm1 < 11 and $indentm1 > 0) { @@ -713,30 +917,180 @@ sub begin_form { $dnum++; } -# ----------- grab unprocessed CGI variables that may have been appended to URL -sub get_unprocessed_cgi { - map { - my ($name, $value) = split(/=/,$_); - $value =~ tr/+/ /; - $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - if ($name eq 'catalogmode' or $name eq 'launch' or $name eq 'acts') { - $ENV{'form.'.$name}=$value; - } - } (split(/&/,$ENV{'QUERY_STRING'})); -} - # --------- settings whenever the user causes the indexer window to be launched sub start_fresh_session { - delete $hash{'mode_catalog'}; - map { - if ($_ =~ /^pre_/) { - delete $hash{$_}; - } - if ($_ =~ /^store/) { - delete $hash{$_}; - } - } keys %hash; + delete $hash{'form.catalogmode'}; + delete $hash{'form.mode'}; + delete $hash{'form.form'}; + delete $hash{'form.element'}; + delete $hash{'form.omit'}; + delete $hash{'form.only'}; + foreach (keys %hash) { + delete $hash{$_} if (/^(pre_|store)/); + } +} + +# ------------------------------------------------------------------- setvalues +sub setvalues { + # setvalues is used in registerurl to synchronize the database + # hash and environment hashes + my ($H1,$h1key,$H2,$h2key) =@_; + # + if (exists $H2->{$h2key}) { + $H1->{$h1key} = $H2->{$h2key}; + } elsif (exists $H1->{$h1key}) { + $H2->{$h2key} = $H1->{$h1key}; + } } 1; -__END__ + +sub cleanup { + if (tied(%hash)){ + &Apache::lonnet::logthis('Cleanup indexer: hash'); + unless (untie(%hash)) { + &Apache::lonnet::logthis('Failed cleanup indexer: hash'); + } + } +} + +=head1 NAME + +Apache::lonindexer - mod_perl module for cross server filesystem browsing + +=head1 SYNOPSIS + +Invoked by /etc/httpd/conf/srm.conf: + + + SetHandler perl-script + PerlHandler Apache::lonindexer + + +=head1 INTRODUCTION + +This module enables a scheme of browsing across a cross server. + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + +=head1 BEGIN SUBROUTINE + +This routine is only run once after compilation. + +=over 4 + +=item * + +Initializes %language hash table. + +=back + +=head1 HANDLER SUBROUTINE + +This routine is called by Apache and mod_perl. + +=over 4 + +=item * + +read in machine configuration variables + +=item * + +see if called from an interactive mode + +=item * + +refresh environment with user database values (in %hash) + +=item * + +define extra fields and buttons in case of special mode + +=item * + +set catalogmodefunctions to have extra needed javascript functionality + +=item * + +print header + +=item * + +evaluate actions from previous page (both cumulatively and chronologically) + +=item * + +output title + +=item * + +get state of file attributes to be showing + +=item * + +output state of file attributes to be showing + +=item * + +output starting row to the indexed file/directory hierarchy + +=item * + +read in what directories have previously been set to "open" + +=item * + +if not at top level, provide an uplink arrow + +=item * + +recursively go through all the directories and output as appropriate + +=item * + +information useful for group import + +=item * + +end the tables + +=item * + +end the output and return + +=back + +=head1 OTHER SUBROUTINES + +=over 4 + +=item * + +scanDir - recursive scan of a directory + +=item * + +get_list - get complete matched list based on the uri (returns an array) + +=item * + +match_ext - filters out files based on extensions (returns an array) + +=item * + +display_line - displays one line in appropriate table format + +=item * + +begin_form - prints the beginning of a form for directory or file link + +=item * + +start_fresh_session - settings whenever the user causes the indexer window +to be launched + +=back + +=cut 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.