[BACK]Return to lonindexer.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface
File:  [LON-CAPA] / loncom / interface / lonindexer.pm
Revision 1.105: download - view: text, annotated - select for diffs
Tue May 11 07:35:12 2004 UTC (19 years, 11 months ago) by taceyjo1
Branches: MAIN
CVS tags: HEAD
There we go, titles are nice and happy for when you do a single pick, Group import is being left alone, as it works just great for group imports.  This should
work just fine, will work with all modes, however, it only seems to be useful in edit mode.  If there are more modes it needs to workwith.  it's just a quick
couple of lines of code in the data javascript function and everything is good.

I'm closing bug 2884 now, really, stop reopening it.... <cough> guy </cough> :P

# The LearningOnline Network with CAPA
# Directory Indexer
#
# $Id: lonindexer.pm,v 1.105 2004/05/11 07:35:12 taceyjo1 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/
#
###

###############################################################################
##                                                                           ##
## 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::lonhtmlcommon();
use Apache::lonsequence();
use Apache::Constants qw(:common);
use Apache::lonmeta;
use Apache::File;
use Apache::lonlocal;
use GDBM_File;

# ---------------------------------------- variables used throughout the module
my %hash; # global 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

# ----- Values which are set by the handler subroutine and are accessible to
# -----     other methods.
my $extrafield; # default extra table cell
my $fnum; # file counter
my $dnum; # directory counter

# ----- Used to include or exclude files with certain extensions.
my @Only = ();
my @Omit = ();


# ----------------------------- Handling routine called via Apache and mod_perl
sub handler {
    my $r = shift;
    my $c = $r->connection();
    &Apache::loncommon::content_type($r,'text/html');
    &Apache::loncommon::no_cache($r);
    $r->send_http_header;
    return OK if $r->header_only;
    $fnum=0;
    $dnum=0;

    # 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);

# ------------------------------------- read in machine configuration variables
    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');

    my $fileclr='#ffffe6';
    my $line;
    my (@attrchk,@openpath);
    my $uri=$r->uri;

# -------------------------------------- see if called from an interactive mode
    # Get the parameters from the query string
    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
	     ['catalogmode','launch','acts','mode','form','element',
              'only','omit','titleelement']);
    #-------------------------------------------------------------------
    my $closebutton='';
    my $groupimportbutton='';
    my $colspan=''; 

    $extrafield='';
    my $diropendb = 
	"/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_indexer.db";
    %hash = ();
    {
	my %dbfile;
	if (tie(%dbfile,'GDBM_File',$diropendb,&GDBM_READER(),0640)) {
	    while(my($key,$value)=each(%dbfile)) {
		$hash{$key}=$value;
	    }
	    untie(%dbfile);
	}
    }
    {
	if ($ENV{'form.launch'} eq '1') {
	    &start_fresh_session();
   }
  #Hijack lonindexer to verify a title and be close down.
   if ($ENV{'form.launch'} eq '2') {
   	#$r->content_type('text/html');
   	my $verify_title = &Apache::lonnet::gettitle($ENV{'form.acts'});
   	title: $verify_title");
   	$r->print(<<ENDSUBM);
		<html>
		<script type="text/javascript">
		function load() {
			window.opener.document.forms["$ENV{'form.form'}"].elements["$ENV{'form.element'}"].value='$ENV{'form.acts'}';
			window.opener.document.forms["$ENV{'form.form'}"].elements["$ENV{'form.titleelement'}"].value='$verify_title';
			window.close();
		}
   	</script>
    	<body onLoad=load();>
     	</body>
    	</html>
ENDSUBM
		return OK;
   }
    
# -------------------- refresh environment with user database values (in %hash)
	&setvalues(\%hash,'form.catalogmode',\%ENV,'form.catalogmode'   );

# --------------------- define extra fields and buttons in case of special mode
	if ($ENV{'form.catalogmode'} eq 'interactive') {
	    $extrafield='<td bgcolor="'.$fileclr.'" valign="bottom">'.
		'<a name="$anchor"><img src="'.$iconpath.'whitespace1.gif"'.
		' border="0" /></td>';
	    $colspan=" colspan='2' ";
            my $cl=&mt('Close');
            $closebutton=<<END;
<input type="button" name="close" value='$cl' onClick="self.close()">
END
        }
	elsif ($ENV{'form.catalogmode'} eq 'groupimport') {
	    $extrafield='<td bgcolor="'.$fileclr.'" valign="bottom">'.
		'<a name="$anchor"><img src="'.$iconpath.'whitespace1.gif"'.
		' border="0" /></td>';
	    $colspan=" colspan='2' ";
	    my $cl=&mt('Close');
            my $gi=&mt('Group Import');
            $closebutton=<<END;
<input type="button" name="close" value='$cl' onClick="self.close()">
END
            $groupimportbutton=<<END;
<input type="button" name="groupimport" value='$gi'
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.titleelement',\%ENV,'form.titleelement');
	&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,$titleelement);
	if ($mode eq 'edit' || $mode eq 'parmset') {
	    $form         = $ENV{'form.form'};
	    $element      = $ENV{'form.element'};
	    $titleelement = $ENV{'form.titleelement'};
	}
	#&Apache::lonxml::debug("mode=$mode form=$form element=$element titleelement=$titleelement");
# ------ set catalogmodefunctions to have extra needed javascript functionality
	my $catalogmodefunctions='';
	if ($ENV{'form.catalogmode'} eq 'interactive' or
	    $ENV{'form.catalogmode'} eq 'groupimport') {
	    # The if statement below sets us up to use the old version
	    # by default (ie. if $mode is undefined).  This is the easy
	    # way out.  Hopefully in the future I'll find a way to get 
	    # the calls dealt with in a more comprehensive manner.

#
# There is now also mode "simple", which is for the simple version of the rat
#
#
	    if (!defined($mode) || ($mode ne 'edit' && $mode ne 'parmset')) {
                my $location = "/adm/groupsort?catalogmode=groupimport&";
                $location .= "mode=".$mode."&";
                $location .= "acts=";
		$catalogmodefunctions=<<"END";
function select_data(title,url) {
    changeTitle(title);
    changeURL(url);
    self.close();
}
function select_group() {
    window.location="$location"+document.forms.fileattr.acts.value;
}
function changeTitle(val) {
    if (opener.inf) {
        if (opener.inf.document.forms.resinfo.elements.t) {
            opener.inf.document.forms.resinfo.elements.t.value=val;
        }
    }
}
function changeURL(val) {
    if (opener.inf) {
        if (opener.inf.document.forms.resinfo.elements.u) {
	    opener.inf.document.forms.resinfo.elements.u.value=val;
        }
    }
}
END
            } elsif ($mode eq 'edit') { # we are in 'edit' mode
                my $location = "/adm/groupsort?catalogmode=interactive&";
                $location .= "form=$form&element=$element&mode=edit&acts=";
		$catalogmodefunctions=<<END;
// mode = $mode
function select_data(title,url) {
var location = "/res/?launch=2&form=$form&element=$element&titleelement=$titleelement&acts=" + url;
   window.location=location;
}
function select_group() {
    window.location="$location"+document.forms.fileattr.acts.value;
}

function changeURL(val) {
    if (window.opener.document) {
	window.opener.document.forms["$form"].elements["$element"].value=val;
    } else {
	    alert("The file you selected is: "+val);
    }
}
END
                if (!$titleelement) {
		    $catalogmodefunctions.='function changeTitle(val) {}';
		} else {
		    $catalogmodefunctions.=<<END;
function changeTitle(val) {
    if (window.opener.document) {
	    window.opener.document.forms["$form"].elements["$titleelement"].value=val;
    } else {
	    alert("The title of the file you selected is: "+val);
    }
}
END
                }
            } elsif ($mode eq 'parmset') {
                my $location = "/adm/groupsort?catalogmode=interactive&";
                $location .= "form=$form&element=$element&mode=parmset&acts=";
		$catalogmodefunctions=<<END;
// mode = $mode
function select_data(title,url) {
    changeURL(url);
    self.close();
}

function select_group() {
    window.location="$location"+document.forms.fileattr.acts.value;
}

function changeURL(val) {
    if (window.opener.document) {
        var elementname  = "$element"+"_value";
        var checkboxname = "$element"+"_setparmval";
	window.opener.document.forms["$form"].elements[elementname].value=val;
        window.opener.document.forms["$form"].elements[checkboxname].checked=true;
    } else {
	    alert("The file you selected is: "+val);
    }
}

END
            }
        }
        $catalogmodefunctions.=<<END;
var acts='';
function rep_dirpath(suffix,val) {
    eval("document.forms.dirpath"+suffix+".acts.value=val");
}
END
	if ($ENV{'form.catalogmode'} eq 'groupimport') {
            $catalogmodefunctions.=<<END;
function queue(val) {
    if (eval("document.forms."+val+".filelink.checked")) {
	var l=val.length;
	var v=val.substring(4,l);
	document.forms.fileattr.acts.value+='1a'+v+'b';
    }
    else {
	var l=val.length;
	var v=val.substring(4,l);
	document.forms.fileattr.acts.value+='0a'+v+'b';
    }
}
END
	}

# ---------------------------------------------------------------- Print Header
	$r->print(<<ENDHEADER);
<html>
<head>
<title>The LearningOnline Network With CAPA Directory Browser</title>

<script type="text/javascript">
$catalogmodefunctions
function openWindow(url, wdwName, w, h, toolbar,scrollbar,locationbar) {
    var xpos = (screen.width-w)/2;
    xpos = (xpos < 0) ? '0' : xpos;
    var ypos = (screen.height-h)/2-30;
    ypos = (ypos < 0) ? '0' : ypos;
    var options = "width=" + w + ",height=" + h + ",screenx="+xpos+",screeny="+ypos+",";
    options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
    options += "menubar=no,toolbar="+toolbar+",location="+locationbar+",directories=no";
    var newWin = window.open(url, wdwName, options);
    newWin.focus();
}
function gothere(val) {
    window.location=val+'?acts='+document.forms.fileattr.acts.value;
}
</script>

</head>
ENDHEADER
my ($headerdom)=($uri=~/^\/res\/(\w+)\//);
$r->print(&Apache::loncommon::bodytag('Browse Resources',undef,undef,undef,
				      $headerdom));
# - Evaluate actions from previous page (both cumulatively and chronologically)
        if ($ENV{'form.catalogmode'} eq 'groupimport') {
	    my $acts=$ENV{'form.acts'};
	    my @Acts=split(/b/,$acts);
	    my %ahash;
	    my %achash;
	    my $ac=0;
	    # some initial hashes for working with data
	    foreach (@Acts) {
		my ($state,$ref)=split(/a/);
		$ahash{$ref}=$state;
		$achash{$ref}=$ac;
		$ac++;
	    }
	    # sorting through the actions and changing the global database hash
	    foreach (sort {$achash{$a}<=>$achash{$b}} (keys %ahash)) {
		my $key=$_;
		if ($ahash{$key} eq '1') {
		    $hash{'store_'.$hash{'pre_'.$key.'_link'}}=
			$hash{'pre_'.$key.'_title'};
		    $hash{'storectr_'.$hash{'pre_'.$key.'_link'}}=
			$hash{'storectr'}+0;
		    $hash{'storectr'}++;
		}
		if ($ahash{$key} eq '0') {
		    if ($hash{'store_'.$hash{'pre_'.$key.'_link'}}) {
			delete $hash{'store_'.$hash{'pre_'.$key.'_link'}};
		    }
		}
	    }
	    # deleting the previously cached listing
	    foreach (keys %hash) {
		if ($_ =~ /^pre_/ && $_ =~/link$/) {
		    my $key = $_;
		    $key =~ s/^pre_//;
		    $key =~ s/_[^_]*$//;
		    delete $hash{'pre_'.$key.'_title'};
		    delete $hash{'pre_'.$key.'_link'};
		}
	    }
	}
	
# ---------------------------------- get state of file attributes to be showing
	if ($ENV{'form.attrs'}) {
	    for (my $i=0; $i<=9; $i++) {
		delete $hash{'display_attrs_'.$i};
		if ($ENV{'form.attr'.$i} == 1) {
		    $attrchk[$i] = 'checked';
		    $hash{'display_attrs_'.$i} = 1;
		}
	    }
	} else {
	    for (my $i=0; $i<=9; $i++) {
		$attrchk[$i] = 'checked' if $hash{'display_attrs_'.$i} == 1;
	    }
	}

# ------------------------------- output state of file attributes to be showing
#                                 All versions has to the last item
#                                 since it does not take an extra col
	my %lt=&Apache::lonlocal::texthash(
					   'ti' => 'Title',
					   'si' => 'Size',
					   'la' => 'Last access',
					   'lm' => 'Last modified',
					   'st' => 'Statistics',
					   'au' => 'Author',
					   'kw' => 'Keywords',
					   'ln' => 'Language',
					   'sr' => 'Show resource',
					   'av' => 'All versions',
					   'ud' => 'Update Display'
					   );
        my $Displayfileattributes=&mt('Display file attributes');
	$r->print(<<END);
<form method="post" name="fileattr" action="$uri"
 enctype="application/x-www-form-urlencoded">
<b><font color="#666666">$Displayfileattributes</font></b><br />
<table border=0><tr>
<td><input type="checkbox" name="attr0" value="1" $attrchk[0] onClick="this.form.submit();" /> $lt{'ti'}</td>
<td><input type="checkbox" name="attr1" value="1" $attrchk[1] onClick="this.form.submit();" /> $lt{'si'}</td>
<td><input type="checkbox" name="attr2" value="1" $attrchk[2] onClick="this.form.submit();" /> $lt{'la'}</td>
<td><input type="checkbox" name="attr3" value="1" $attrchk[3] onClick="this.form.submit();" /> $lt{'lm'}</td>
<td><input type="checkbox" name="attr8" value="1" $attrchk[8] onClick="this.form.submit();" /> $lt{'st'}</td>
</tr><tr>
<td><input type="checkbox" name="attr4" value="1" $attrchk[4] onClick="this.form.submit();" /> $lt{'au'}</td>
<td><input type="checkbox" name="attr5" value="1" $attrchk[5] onClick="this.form.submit();" /> $lt{'kw'}</td>
<td><input type="checkbox" name="attr6" value="1" $attrchk[6] onClick="this.form.submit();" /> $lt{'ln'}</td>
<td><input type="checkbox" name="attr7" value="1" $attrchk[7] onClick="this.form.submit();" /> $lt{'sr'}</td>
<td><input type="checkbox" name="attr9" value="1" $attrchk[9] onClick="this.form.submit();" /> $lt{'av'}</td>
<td>&nbsp;</td>
</tr></table>
<input type="hidden" name="attrs" value="1" />
<input type="submit" name="updatedisplay" value="$lt{'ud'}" />
<input type="hidden" name="acts" value="" />
$closebutton $groupimportbutton
END
# -------------- Filter out sequence containment in crumbs and "recent folders"
	my $storeuri=$uri;
	$storeuri='/'.(split(/\.(page|sequence)\/\//,$uri))[-1];
	$storeuri=~s/\/+/\//g;
# ---------------------------------------------------------------- Bread crumbs
        $r->print(&Apache::lonhtmlcommon::crumbs($storeuri,'','',
				(($ENV{'form.catalogmode'} eq 'groupimport')?
				 'document.forms.fileattr':'')).
		  &Apache::lonhtmlcommon::select_recent('residx','resrecent',
'this.form.action=this.form.resrecent.options[this.form.resrecent.selectedIndex].value;this.form.submit();'));
# -------------------------------------------------------- Resource Home Button
	my $reshome=$ENV{'course.'.$ENV{'request.course.id'}.'.reshome'};
	if ($reshome) {
	    $r->print("<font size='+2'><a href='");
	    if ($ENV{'form.catalogmode'} eq 'groupimport') {
		$r->print('javascript:document.forms.fileattr.action="'.$reshome.'";document.forms.fileattr.submit();');
	    } else {
		$r->print($reshome);
	    }
	    $r->print("'>".&mt('Home').'</a></font>');
	}
	$r->print('</form>');
# ------------------------------------------------------ Remember where we were
	&Apache::loncommon::storeresurl($storeuri);
	&Apache::lonhtmlcommon::store_recent('residx',$storeuri,$storeuri);
# ----------------- output starting row to the indexed file/directory hierarchy
        my $titleclr="#ddffff";
#        $r->print(&initdebug());
#        $r->print(&writedebug("Omit:@Omit")) if (@Omit);
#        $r->print(&writedebug("Only:@Only")) if (@Only);
        $r->print("<table width='100\%' border=0><tr><td bgcolor=#777777>\n");
	$r->print("<table width='100\%' border=0><tr bgcolor=$titleclr>\n");
	$r->print("<td $colspan><b>".&mt('Name')."</b></td>\n");
	$r->print("<td><b>".&mt('Title')."</b></td>\n") 
	    if ($hash{'display_attrs_0'} == 1);
	$r->print("<td align=right><b>".&mt("Size")." (".&mt("bytes").") ".
		  "</b></td>\n") if ($hash{'display_attrs_1'} == 1);
	$r->print("<td><b>".&mt("Last accessed")."</b></td>\n") 
	    if ($hash{'display_attrs_2'} == 1);
	$r->print("<td><b>".&mt("Last modified")."</b></td>\n")
	    if ($hash{'display_attrs_3'} == 1);
	$r->print("<td><b>".&mt("Author(s)")."</b></td>\n")
	    if ($hash{'display_attrs_4'} == 1);
	$r->print("<td><b>".&mt("Keywords")."</b></td>\n")
	    if ($hash{'display_attrs_5'} == 1);
	$r->print("<td><b>".&mt("Language")."</b></td>\n")
	    if ($hash{'display_attrs_6'} == 1);
	$r->print("<td><b>".&mt("Resource")."</b></td>\n")
	    if ($hash{'display_attrs_7'} == 1);
	$r->print("<td><b>".&mt("Usage Statistics")." <br />(".
		  &mt("Courses/Network Hits").")</b></td>\n")
	    if ($hash{'display_attrs_8'} == 1);
	$r->print('</tr>');

# ----------------- 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{$_};
	    }
	}

	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;
	my $indent = 0;
	$uri = $uri.'/' if $uri !~ /.*\/$/;

 	if ($ENV{'form.dirPointer'} ne 'on') {
 	    $hash{'top.level'} = $uri;
 	    $toplevel = $uri;
 	} else {
 	    $toplevel = $hash{'top.level'};
 	}

# -------------------------------- 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);
	    my @list = qw (0);
	    &display_line ($r,'opened',$upone.'&viewOneUp',0,$upone,@list);
	    $indent = 1;
	}

# -------- recursively go through all the directories and output as appropriate
	&scanDir ($r,$toplevel,$indent,\%hash);
	
# ---------------------------- embed hidden information useful for group import
	$r->print("<form name='fnum'>");
	$r->print("<input type='hidden' name='fnum' value='$fnum'></form>");

# -------------------------------------------------------------- end the tables
	$r->print('</table>');
	$r->print('</td></tr></table>');

# --------------------------------------------------- end the output and return
	$r->print('</body></html>'."\n");
    }
    if(! $c->aborted()) {
# write back into the temporary file
	my %dbfile;
        if (tie(%dbfile,'GDBM_File',$diropendb,&GDBM_NEWDB(),0640)) {
            while (my($key,$value) = each(%hash)) {
                $dbfile{$key}=$value;
            }
            untie(%dbfile);
        }
    }

    return OK;
}

# ----------------------------------------------- recursive scan of a directory
sub scanDir {
    my ($r,$startdir,$indent,$hashref)=@_;
    my $c = $r->connection();
    my ($compuri,$curdir);
    my $dirptr=16384;
    my $obs;
    $indent++;
    my %dupdirs = %dirs;
    my @list=&get_list($r,$startdir);
    foreach my $line (@list) {
        return if ($c->aborted());
	#This is a kludge, sorry aboot this
	my ($strip,$dom,undef,$testdir,undef,undef,undef,undef,undef,undef,undef,undef,undef,undef,$obs,undef)=split(/\&/,$line,16); 
	next if($strip =~ /.*\.meta$/ | $obs eq '1');
	my (@fileparts) = split(/\./,$strip);
	if ($hash{'display_attrs_9'} != 1) {
# if not all versions to be shown
	    if (scalar(@fileparts) >= 3) {
		my $fext = pop @fileparts;
		my $ov = pop @fileparts;
		my $fname = join ('.',@fileparts,$fext);
		next if (grep /\Q$fname\E/,@list and $ov =~ /^\d+$/);
	    }
	}

	if ($dom eq 'domain') {
	    # dom list has full path /res/<domain name>/ already
	    $curdir='';
	    $compuri = (split(/\&/,$line))[0];
	} else {
	    # user, dir & file have name only, i.e., w/o path
	    $compuri = join('',$startdir,$strip,'/');
	    $curdir = $startdir;
	}
	my $diropen = 'closed';
	if (($dirptr&$testdir) or ($dom =~ /^(domain|user)$/) or ($compuri=~/\.(sequence|page)\/$/)) {
	    while (my ($key,$val)= each %dupdirs) {
		if ($key eq $compuri and $val eq "open") {
		    $diropen = "opened";
		    delete($dupdirs{$key});
		    delete($dirs{$key});
		}
	    }
	}
	&display_line($r,$diropen,$line,$indent,$curdir,$hashref,@list);
	&scanDir ($r,$compuri,$indent) if $diropen eq 'opened';
    }
    $indent--;
}

# --------------- get complete matched list based on the uri (returns an array)
sub get_list {
    my ($r,$uri)=@_;
    my @list=();
    (my $luri = $uri) =~ s/\//_/g;
    if ($ENV{'form.updatedisplay'}) {
	foreach (keys %hash) {
	    delete $hash{$_} if ($_ =~ /^dirlist_files_/);
	}
    }

    if ($hash{'dirlist_files_'.$luri}) {
	@list = split(/\n/,$hash{'dirlist_files_'.$luri});
    } elsif ($uri=~/\.(page|sequence)\/$/) {
# is a page or a sequence
	$uri=~s/\/$//;
	$uri='/'.(split(/\.(page|sequence)\/\//,$uri))[-1];
	$uri=~s/\/+/\//g;
	foreach (&Apache::lonsequence::attemptread(&Apache::lonnet::filelocation('',$uri))) {
	    my @ratpart=split(/\:/,$_);
	    push @list,$ratpart[1];
	} 
	$hash{'dirlist_files_'.$luri} = join("\n",@list);
    } else {
# is really a directory
	@list = &Apache::lonnet::dirlist($uri);
	$hash{'dirlist_files_'.$luri} = join("\n",@list);
    }
    return @list=&match_ext($r,@list);
}

sub initdebug {
    return <<ENDJS;
<script>
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("<html><head><title>Debugging Window</title></head><body><pre>");   
</script>
ENDJS
}

sub writedebug {
    my $text = shift;
    return "<script>output('$text');</script>";
}

# -------------------- filters out files based on extensions (returns an array)
sub match_ext {
    my ($r,@packlist)=@_;
    my @trimlist;
    my $nextline;
    my @fileext;
    my $dirptr=16384;

    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) || ($fext=~/\.(page|sequence)$/);
 	if ($fnptr == 0 and $unpackline[3] ne "") {
	    my $embstyle = &Apache::loncommon::fileembstyle($fext);
            push @trimlist,$line if (defined($embstyle) && 
				     ($embstyle ne 'hdn' or $fext eq 'meta'));
	} else {
	    push @trimlist,$line;
	}
    }
    @trimlist = sort {uc($a) cmp uc($b)} (@trimlist);
    return @trimlist;
}

# ------------------------------- displays one line in appropriate table format
sub display_line {
    my ($r,$diropen,$line,$indent,$startdir,$hashref,@list)=@_;
    my (@pathfn, $fndir);
# there could be relative paths (files actually belonging into this directory)
# or absolute paths (for example, from sequences)
    my $absolute;
    my $pathprefix;
    if ($line=~/^\/res\//) {
	$absolute=1;
	$pathprefix='';
    } else {
	$absolute=0;
	$pathprefix=$startdir;
    }
    my $dirptr=16384;
    my $fileclr="#ffffe6";
    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 = &mt('View').' '.$filecom[0].' '.&mt('resources');
    $msg = &mt('Close').' '.$filecom[0].' '.&mt('directory') if $diropen eq 'opened';

    my $tabtag='</td>';
    my $i=0;
    while ($i<=8) {
	$tabtag=join('',$tabtag,"<td>&nbsp;</td>")
	    if $hash{'display_attrs_'.$i} == 1;
	$i++;
    }
	
    my $valign = ($hash{'display_attrs_7'} == 1 ? 'top' : 'bottom');

# display uplink arrow
    if ($filecom[1] eq 'viewOneUp') {
	my $updir=$startdir;
# -------------- Filter out sequence containment in crumbs and "recent folders"
	$updir='/'.(split(/\.(page|sequence)\/\//,$startdir))[-1];
	$updir=~s/\/+/\//g;

	$r->print("<tr valign='$valign' bgcolor=$fileclr>$extrafield");
	$r->print("<td>\n");
	$r->print ('<form method="post" name="dirpathUP" action="'.$updir.
		   '/" '.
		   'onSubmit="return rep_dirpath(\'UP\','.
		   'document.forms.fileattr.acts.value)" '.
		   'enctype="application/x-www-form-urlencoded"'.
                   '>'."\n");
	$r->print ('<input type=hidden name=openuri value="'.
		   $startdir.'">'."\n");
	$r->print ('<input type="hidden" name="acts" value="">'."\n");
	$r->print ('<input src="'.$iconpath.'arrow_up.gif"');
	$r->print (' name="'.$msg.'" height="22" type="image" border="0">'.
		   "\n");
	$r->print(&mt("Up")." $tabtag</tr></form>\n");
	return OK;
    }
# Do we have permission to look at this?

    if($filecom[15] ne '1') { return OK if (!&Apache::lonnet::allowed('bre',$pathprefix.$filecom[0])); }

# make absolute links appear on different background
    if ($absolute) { $fileclr='#aaaa88'; }

# display domain
    if ($filecom[1] eq 'domain') {
 	$r->print ('<input type="hidden" name="dirPointer" value="on">'."\n")
 	    if ($ENV{'form.dirPointer'} eq "on");
	$r->print("<tr valign='$valign' bgcolor=$fileclr>$extrafield");
	$r->print("<td>");
	&begin_form ($r,$filecom[0]);
	my $anchor = $filecom[0];
	$anchor =~ s/\///g;
	$r->print ('<a name="'.$anchor.'">');
	$r->print ('<input type="hidden" name="acts" value="">');
	$r->print ('<input src="'.$iconpath.'folder_pointer_'.
		   $diropen.'.gif"'); 
	$r->print (' name="'.$msg.'" height="22" type="image" border="0">'.
		   "\n");
	$r->print ('<a href="javascript:gothere(\''.$filecom[0].
		   '\')"><img src="'.$iconpath.'server.gif"');
	$r->print (' border="0" /></a>'."\n");
	$r->print (&mt("Domain")." - $listname ");
	if ($Apache::lonnet::domaindescription{$listname}) {
	    $r->print("(".$Apache::lonnet::domaindescription{$listname}.
		      ")");
	}
	$r->print (" $tabtag</tr></form>\n");
	return OK;

# display user directory
    }
    if ($filecom[1] eq 'user') {
	$r->print("<tr valign=$valign bgcolor=$fileclr>$extrafield");
	$r->print("<td nowrap>\n");
	my $curdir = $startdir.$filecom[0].'/';
	my $anchor = $curdir;
	$anchor =~ s/\///g;
	&begin_form ($r,$curdir);
	$r->print ('<a name="'.$anchor.'"><img src="'.$iconpath.
		   'whitespace1.gif" border="0" />'."\n");
	$r->print ('<input type="hidden" name="acts" value="">');
	$r->print ('<input src="'.$iconpath.'folder_pointer_'.$diropen.
		   '.gif"'); 
	$r->print (' name="'.$msg.'" height="22" type="image" border="0">'.
		   "\n");
	$r->print ('<a href="javascript:gothere(\''.$curdir.'\')"><img src='.
		   $iconpath.'quill.gif border="0" name="'.$msg.
		   '" height="22" /></a>');
	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.'</tr></form>'."\n");
	return OK;
    }

# display file
    if (($fnptr == 0 and $filecom[3] ne '') or $absolute) {
	my $filelink = $pathprefix.$filecom[0];
	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 = &Apache::loncommon::icon($listname);
	$r->print("<tr valign='$valign' bgcolor=$fileclr><td nowrap>");
	
	my $metafile = $Apache::lonnet::perlvar{'lonDocRoot'}.$pathprefix.
	    $filecom[0].'.meta';
	if (-e $metafile) {
	    $metafile=1;
	} else {
	    $metafile=0;
	}
	my $title;
        if ($ENV{'form.catalogmode'} eq 'interactive') {
	    $title=$listname;
	    $title = &Apache::lonnet::metadata($filelink,'title')
		if ($metafile == 1);
	    $title=$listname unless $title;
	    my $titleesc=HTML::Entities::encode($title,'<>&"');
	    $titleesc=~s/\'/\\'/; #' (clean up this spare quote)
            $r->print("<a href=\"javascript:select_data(\'",
                      $titleesc,"','",$filelink,"')\">");
	    $r->print("<img src='",$iconpath,"select.gif' border='0' /></a>".
		      "\n");
	    $r->print("</td><td nowrap>");
	} 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("<form name='form$fnum'>\n");
	    $r->print("<input type='checkbox' name='filelink"."' ".
		      "value='$filelink' onClick='".
		      "javascript:queue(\"form$fnum\")' ");
	    if ($hash{'store_'.$filelink}) {
		$r->print("checked");
	    }
	    $r->print(">\n");
	    $r->print("<input type='hidden' name='title"."' ".
		      "value='$titleesc'>\n");
	    $r->print("</form>\n");
	    $r->print("</td><td nowrap>");
	    $hash{"pre_${fnum}_link"}=$filelink;
	    $hash{"pre_${fnum}_title"}=$titleesc;
  	    $fnum++;
	}
# Form to open or close sequences
	if ($filelink=~/\.(page|sequence)$/) {
	    my $curdir = $startdir.$filecom[0].'/';
	    my $anchor = $curdir;
	    $anchor =~ s/\///g;
	    &begin_form($r,$curdir);
	    $indent--;
	}
# General indentation
	if ($indent > 0 and $indent < 11) {
	    $r->print("<img src=",$iconpath,"whitespace",$indent,
		      ".gif border='0' />\n");
	} elsif ($indent >0) {
	    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;
	}
# Sequence open/close icon
	if ($filelink=~/\.(page|sequence)$/) {
	    my $curdir = $startdir.$filecom[0].'/';
	    my $anchor = $curdir;
	    $anchor =~ s/\///g;
	    $r->print ('<input type="hidden" name="acts" value="">');
	    $r->print ('<a name="'.$anchor.'"><input src="'.$iconpath.
		       'folder_pointer_'.$diropen.'.gif"');
	    $r->print (' name="'.$msg.'" height="22" type="image" border="0">'.
		       "\n");
	}
# Filetype icons
	$r->print("<img src='$iconname' border='0' />\n");
# Close form to open/close sequence
	if ($filelink=~/\.(page|sequence)$/) {
	    $r->print('</form>');
	}
	$r->print (" <a href=\"javascript:openWindow('".$filelink.
		   "', 'previewfile', '450', '500', 'no', 'yes','yes')\";".
		   " TARGET=_self>$listname</a> ");

	$r->print (" (<a href=\"javascript:openWindow('".$filelink.
		   ".meta', 'metadatafile', '500', '550', 'no', 'yes','no')\"; ".
		   "TARGET=_self>metadata</a>) ");
	$r->print("</td>\n");
	if ($hash{'display_attrs_0'} == 1) {
	    my $title = &Apache::lonnet::gettitle($filelink,'title');
	    $r->print('<td> '.($title eq '' ? '&nbsp;' : $title).
		      ' </td>'."\n");
	}
	$r->print('<td align=right> ',
		  $filecom[8]," </td>\n") 
	    if $hash{'display_attrs_1'} == 1;
	$r->print('<td> '.
		  (localtime($filecom[9]))." </td>\n") 
	    if $hash{'display_attrs_2'} == 1;
	$r->print('<td> '.
		  (localtime($filecom[10]))." </td>\n") 
	    if $hash{'display_attrs_3'} == 1;

	if ($hash{'display_attrs_4'} == 1) {
	    my $author = &Apache::lonnet::metadata($filelink,'author');
	    $r->print('<td> '.($author eq '' ? '&nbsp;' : $author).
		      " </td>\n");
	}
	if ($hash{'display_attrs_5'} == 1) {
	    my $keywords = &Apache::lonnet::metadata($filelink,'keywords');
	    # $keywords = '&nbsp;' if (!$keywords);
	    $r->print('<td> '.($keywords eq '' ? '&nbsp;' : $keywords).
		      " </td>\n");
	}
	if ($hash{'display_attrs_6'} == 1) {
	    my $lang = &Apache::lonnet::metadata($filelink,'language');
	    $lang = &Apache::loncommon::languagedescription($lang);
	    $r->print('<td> '.($lang eq '' ? '&nbsp;' : $lang).
		      " </td>\n");
	}
        if ($hash{'display_attrs_7'} == 1) {
            my $output='';
            my $embstyle=&Apache::loncommon::fileembstyle($curfext);
	    if ($embstyle eq 'ssi') {
		my $cache=$Apache::lonnet::perlvar{'lonDocRoot'}.$filelink.
		    '.tmp';
		if ((!$ENV{'form.updatedisplay'}) &&
		    (-e $cache)) {
		    open(FH,$cache);
		    $output=join("\n",<FH>);
		    close(FH);
		} else {
		    $output=&Apache::lonnet::ssi_body($filelink);
		    open(FH,">$cache");
		    print FH $output;
		    close(FH);
		}
		$output='<font size="-2">'.$output.'</font>';
	   } elsif ($embstyle eq 'img') {
               $output='<img src="'.$filelink.'" />';
           } elsif ($filelink=~/^\/res\/(\w+)\/(\w+)\//) {
               $output='<img src="http://'.
		 $Apache::lonnet::hostname{&Apache::lonnet::homeserver($2,$1)}.
                 '/cgi-bin/thumbnail.gif?url='.$filelink.'" />';
           }
	   $r->print('<td> '.($output eq '' ? '&nbsp;':$output).
		      " </td>\n");
        }
	if ($hash{'display_attrs_8'} == 1) {
	    my (%stat) = &Apache::lonmeta::dynamicmeta($filelink);
	    my $stat = (exists($stat{'course'}) ? $stat{'course'} : '').
		((exists($stat{'course'}) || exists($stat{'count'})) ? '/' : '').
		(exists($stat{'count'}) ? $stat{'count'} : '');
	    $r->print('<td align=center> '.($stat eq '' ? '&nbsp;' : $stat).
		      ' </td>'."\n");
	}

	$r->print("</tr>\n");
    }

# -- display directory
    if ($fnptr == $dirptr) {
	my $curdir = $startdir.$filecom[0].'/';
	my $anchor = $curdir;
	$anchor =~ s/\///g;
	$r->print("<tr bgcolor=$fileclr>$extrafield<td valign=$valign>");
	&begin_form ($r,$curdir);
	my $indentm1 = $indent-1;
	if ($indentm1 < 11 and $indentm1 > 0) {
	    $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 ('<input type="hidden" name="acts" value="">');
	$r->print ('<a name="'.$anchor.'"><input src="'.$iconpath.
		   'folder_pointer_'.$diropen.'.gif"');
	$r->print (' name="'.$msg.'" height="22" type="image" border="0">'.
		   "\n");
	$r->print ('<a href="javascript:gothere(\''.$curdir.'\')"><img src="'.
		   $iconpath.'folder_'.$diropen.'.gif" border="0" /></a>'.
		   "\n");
	$r->print ("$listname</td>\n");
# Attributes
	my $filelink = $startdir.$filecom[0].'/default';

	if ($hash{'display_attrs_0'} == 1) {
	    my $title = &Apache::lonnet::gettitle($filelink,'title');
	    $r->print('<td> '.($title eq '' ? '&nbsp;' : $title).
		      ' </td>'."\n");
	}
	$r->print('<td align=right> ',
		  $filecom[8]," </td>\n") 
	    if $hash{'display_attrs_1'} == 1;
	$r->print('<td> '.
		  (localtime($filecom[9]))." </td>\n") 
	    if $hash{'display_attrs_2'} == 1;
	$r->print('<td> '.
		  (localtime($filecom[10]))." </td>\n") 
	    if $hash{'display_attrs_3'} == 1;

	if ($hash{'display_attrs_4'} == 1) {
	    my $author = &Apache::lonnet::metadata($filelink,'author');
	    $r->print('<td> '.($author eq '' ? '&nbsp;' : $author).
		      " </td>\n");
	}
	if ($hash{'display_attrs_5'} == 1) {
	    my $keywords = &Apache::lonnet::metadata($filelink,'keywords');
	    # $keywords = '&nbsp;' if (!$keywords);
	    $r->print('<td> '.($keywords eq '' ? '&nbsp;' : $keywords).
		      " </td>\n");
	}
	if ($hash{'display_attrs_6'} == 1) {
	    my $lang = &Apache::lonnet::metadata($filelink,'language');
	    $lang = &Apache::loncommon::languagedescription($lang);
	    $r->print('<td> '.($lang eq '' ? '&nbsp;' : $lang).
		      " </td>\n");
	}
        if ($hash{'display_attrs_7'} == 1) {
	   $r->print('<td>&nbsp;</td>');
        }
	if ($hash{'display_attrs_8'} == 1) {
	   $r->print('<td>&nbsp;</td>');
	}
	$r->print('</form></tr>');
    }

}

# ------------------- 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'.$dnum.'" action="'.$uri.
	       '#'.$anchor.
	       '" onSubmit="return rep_dirpath(\''.$dnum.'\''.
	       ',document.forms.fileattr.acts.value)" '.
	       'enctype="application/x-www-form-urlencoded">'."\n");
    $r->print ('<input type="hidden" name="openuri" value="'.$uri.'">'.
	       "\n");
    $r->print ('<input type="hidden" name="dirPointer" value="on">'."\n");
    $dnum++;
}

# --------- settings whenever the user causes the indexer window to be launched
sub start_fresh_session {
    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;

sub cleanup {
    if (tied(%hash)){
	&Apache::lonnet::logthis('Cleanup indexer: hash');
    }
}

=head1 NAME

Apache::lonindexer - mod_perl module for cross server filesystem browsing

=head1 SYNOPSIS

Invoked by /etc/httpd/conf/srm.conf:

 <LocationMatch "^/res.*/$">
 SetHandler perl-script
 PerlHandler Apache::lonindexer
 </LocationMatch>

=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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>