File:  [LON-CAPA] / loncom / interface / lonindexer.pm
Revision 1.68: download - view: text, annotated - select for diffs
Mon Jun 16 22:09:02 2003 UTC (21 years ago) by albertel
Branches: MAIN
CVS tags: version_0_99_3, HEAD
- BUG 1615, use scoping to force perl to frree the tie variable, so that the tie goes away.
   (At least it looks like it goes away now, and it remebers my last setup)

    1: # The LearningOnline Network with CAPA
    2: # Directory Indexer
    3: #
    4: # $Id: lonindexer.pm,v 1.68 2003/06/16 22:09:02 albertel Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: # YEAR=1999
   29: # 5/21/99, 5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer)
   30: # 11/23 Gerd Kortemeyer
   31: # YEAR=2000
   32: # 07/20-08/04 H.K. Ng
   33: # YEAR=2001
   34: # 05/9-05/19/2001 H. K. Ng
   35: # 05/21/2001 H. K. Ng
   36: # 05/23/2001 H. K. Ng
   37: # 6/26,7/8 H. K. Ng
   38: # 8/14 H. K. Ng
   39: # 11/30 Matthew Hall
   40: # YEAR=2002
   41: # 6/29/2002 H. K. Ng
   42: #
   43: ###
   44: 
   45: ###############################################################################
   46: ##                                                                           ##
   47: ## ORGANIZATION OF THIS PERL MODULE                                          ##
   48: ##                                                                           ##
   49: ## 1. Description of functions                                               ##
   50: ## 2. Modules used by this module                                            ##
   51: ## 3. Choices for different output views (detailed, summary, xml, etc)       ##
   52: ## 4. BEGIN block (to be run once after compilation)                         ##
   53: ## 5. Handling routine called via Apache and mod_perl                        ##
   54: ## 6. Other subroutines                                                      ##
   55: ##                                                                           ##
   56: ###############################################################################
   57: 
   58: package Apache::lonindexer;
   59: 
   60: # ------------------------------------------------- modules used by this module
   61: use strict;
   62: use Apache::lonnet();
   63: use Apache::loncommon();
   64: use Apache::Constants qw(:common);
   65: use Apache::File;
   66: use GDBM_File;
   67: 
   68: # ---------------------------------------- variables used throughout the module
   69: my %hash; # tied to a user-specific gdbm file
   70: my %dirs; # keys are directories, values are the open/close status
   71: my %language; # has the reference information present in language.tab
   72: 
   73: # ----- Values which are set by the handler subroutine and are accessible to
   74: # -----     other methods.
   75: my $extrafield; # default extra table cell
   76: my $fnum; # file counter
   77: my $dnum; # directory counter
   78: 
   79: # ----- Used to include or exclude files with certain extensions.
   80: my @Only = ();
   81: my @Omit = ();
   82: 
   83: 
   84: # ----------------------------- Handling routine called via Apache and mod_perl
   85: sub handler {
   86:     my $r = shift;
   87:     my $c = $r->connection();
   88:     $r->content_type('text/html');
   89:     &Apache::loncommon::no_cache($r);
   90:     $r->send_http_header;
   91:     return OK if $r->header_only;
   92:     $fnum=0;
   93:     $dnum=0;
   94: 
   95:     # Deal with stupid global variables (is there a way around making
   96:     # these global to this package?  It is just so wrong....)
   97:     undef (@Only);
   98:     undef (@Omit);
   99: 
  100: # ------------------------------------- read in machine configuration variables
  101:     my $iconpath= $r->dir_config('lonIconsURL') . "/";
  102:     my $domain  = $r->dir_config('lonDefDomain');
  103:     my $role    = $r->dir_config('lonRole');
  104:     my $loadlim = $r->dir_config('lonLoadLim');
  105:     my $servadm = $r->dir_config('lonAdmEMail');
  106:     my $sysadm  = $r->dir_config('lonSysEMail');
  107:     my $lonhost = $r->dir_config('lonHostID');
  108:     my $tabdir  = $r->dir_config('lonTabDir');
  109: 
  110:     my $fileclr='#ffffe6';
  111:     my $line;
  112:     my (@attrchk,@openpath);
  113:     my $uri=$r->uri;
  114: 
  115: # -------------------------------------- see if called from an interactive mode
  116:     # Get the parameters from the query string
  117:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  118: 	     ['catalogmode','launch','acts','mode','form','element',
  119:               'only','omit']);
  120:     #-------------------------------------------------------------------
  121:     my $closebutton='';
  122:     my $groupimportbutton='';
  123:     my $colspan=''; 
  124: 
  125:     $extrafield='';
  126:     my $diropendb = 
  127: 	"/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_indexer.db";
  128:     %hash = ();
  129:     {
  130: 	my %dbfile;
  131: 	if (tie(%dbfile,'GDBM_File',$diropendb,&GDBM_WRCREAT(),0640)) {
  132: 	    while(my($key,$value)=each(%dbfile)) {
  133: 		$hash{$key}=$value;
  134: 	    }
  135: 	    untie(%dbfile);
  136: 	}
  137:     }
  138:     {
  139: 	if ($ENV{'form.launch'} eq '1') {
  140: 	    &start_fresh_session();
  141:         }
  142: # -------------------- refresh environment with user database values (in %hash)
  143: 	&setvalues(\%hash,'form.catalogmode',\%ENV,'form.catalogmode'   );
  144: 
  145: # --------------------- define extra fields and buttons in case of special mode
  146: 	if ($ENV{'form.catalogmode'} eq 'interactive') {
  147: 	    $extrafield='<td bgcolor="'.$fileclr.'" valign="bottom">'.
  148: 		'<a name="$anchor"><img src="'.$iconpath.'whitespace1.gif"'.
  149: 		' border="0" /></td>';
  150: 	    $colspan=" colspan='2' ";
  151:             $closebutton=<<END;
  152: <input type="button" name="close" value='CLOSE' onClick="self.close()">
  153: END
  154:         }
  155: 	elsif ($ENV{'form.catalogmode'} eq 'groupimport') {
  156: 	    $extrafield='<td bgcolor="'.$fileclr.'" valign="bottom">'.
  157: 		'<a name="$anchor"><img src="'.$iconpath.'whitespace1.gif"'.
  158: 		' border="0" /></td>';
  159: 	    $colspan=" colspan='2' ";
  160:             $closebutton=<<END;
  161: <input type="button" name="close" value='CLOSE' onClick="self.close()">
  162: END
  163:             $groupimportbutton=<<END;
  164: <input type="button" name="groupimport" value='GROUP IMPORT'
  165: onClick="javascript:select_group()">
  166: END
  167:         }
  168: 	# Additions made by Matthew to make the browser a little easier to deal
  169: 	# with in the future.
  170: 	#
  171: 	# $mode (at this time) indicates if we are in edit mode.
  172: 	# $form is the name of the form that the URL is placed when the
  173: 	#       selection is made.
  174: 	# $element is the name of the element in $formname which receives
  175: 	#       the URL.
  176: 	# &Apache::lonxml::debug('Checking mode, form, element');
  177: 	&setvalues(\%hash,'form.mode'   ,\%ENV,'form.mode'   );
  178: 	&setvalues(\%hash,'form.form'   ,\%ENV,'form.form'   );
  179: 	&setvalues(\%hash,'form.element',\%ENV,'form.element');
  180: 	&setvalues(\%hash,'form.only'   ,\%ENV,'form.only'   );
  181: 	&setvalues(\%hash,'form.omit'   ,\%ENV,'form.omit'   );
  182: 
  183:         # Deal with 'omit' and 'only' 
  184:         if (exists $ENV{'form.omit'}) {
  185:             @Omit = split(',',$ENV{'form.omit'});
  186:         }
  187:         if (exists $ENV{'form.only'}) {
  188:             @Only = split(',',$ENV{'form.only'});
  189:         }
  190:         
  191: 	my $mode = $ENV{'form.mode'};
  192: 	my ($form,$element);
  193: 	if ($mode eq 'edit' || $mode eq 'parmset') {
  194: 	    $form    = $ENV{'form.form'};
  195: 	    $element = $ENV{'form.element'};
  196: 	}
  197: 	&Apache::lonxml::debug("mode=$mode form=$form element=$element");
  198: # ------ set catalogmodefunctions to have extra needed javascript functionality
  199: 	my $catalogmodefunctions='';
  200: 	if ($ENV{'form.catalogmode'} eq 'interactive' or
  201: 	    $ENV{'form.catalogmode'} eq 'groupimport') {
  202: 	    # The if statement below sets us up to use the old version
  203: 	    # by default (ie. if $mode is undefined).  This is the easy
  204: 	    # way out.  Hopefully in the future I'll find a way to get 
  205: 	    # the calls dealt with in a more comprehensive manner.
  206: 
  207: #
  208: # There is now also mode "simple", which is for the simple version of the rat
  209: #
  210: #
  211: 	    if (!defined($mode) || ($mode ne 'edit' && $mode ne 'parmset')) {
  212:                 my $location = "/adm/groupsort?catalogmode=groupimport&";
  213:                 $location .= "mode=".$mode."&";
  214:                 $location .= "acts=";
  215: 		$catalogmodefunctions=<<"END";
  216: function select_data(title,url) {
  217:     changeTitle(title);
  218:     changeURL(url);
  219:     self.close();
  220: }
  221: function select_group() {
  222:     window.location="$location"+document.forms.fileattr.acts.value;
  223: }
  224: function changeTitle(val) {
  225:     if (opener.inf) {
  226:         if (opener.inf.document.forms.resinfo.elements.t) {
  227:             opener.inf.document.forms.resinfo.elements.t.value=val;
  228:         }
  229:     }
  230: }
  231: function changeURL(val) {
  232:     if (opener.inf) {
  233:         if (opener.inf.document.forms.resinfo.elements.u) {
  234: 	    opener.inf.document.forms.resinfo.elements.u.value=val;
  235:         }
  236:     }
  237: }
  238: END
  239:             } elsif ($mode eq 'edit') { # we are in 'edit' mode
  240:                 my $location = "/adm/groupsort?catalogmode=interactive&";
  241:                 $location .= "form=$form&element=$element&mode=edit&acts=";
  242: 		$catalogmodefunctions=<<END;
  243: // mode = $mode
  244: function select_data(title,url) {
  245:     changeURL(url);
  246:     self.close();
  247: }
  248: 
  249: function select_group() {
  250:     window.location="$location"+document.forms.fileattr.acts.value;
  251: }
  252: 
  253: function changeURL(val) {
  254:     if (window.opener.document) {
  255: 	window.opener.document.forms["$form"].elements["$element"].value=val;
  256:     } else {
  257: 	    alert("The file you selected is: "+val);
  258:     }
  259: }
  260: 
  261: END
  262:             } elsif ($mode eq 'parmset') {
  263:                 my $location = "/adm/groupsort?catalogmode=interactive&";
  264:                 $location .= "form=$form&element=$element&mode=parmset&acts=";
  265: 		$catalogmodefunctions=<<END;
  266: // mode = $mode
  267: function select_data(title,url) {
  268:     changeURL(url);
  269:     self.close();
  270: }
  271: 
  272: function select_group() {
  273:     window.location="$location"+document.forms.fileattr.acts.value;
  274: }
  275: 
  276: function changeURL(val) {
  277:     if (window.opener.document) {
  278:         var elementname  = "$element"+"_value";
  279:         var checkboxname = "$element"+"_setparmval";
  280: 	window.opener.document.forms["$form"].elements[elementname].value=val;
  281:         window.opener.document.forms["$form"].elements[checkboxname].checked=true;
  282:     } else {
  283: 	    alert("The file you selected is: "+val);
  284:     }
  285: }
  286: 
  287: END
  288:             }
  289:         }
  290:         $catalogmodefunctions.=<<END;
  291: var acts='';
  292: function rep_dirpath(suffix,val) {
  293:     eval("document.forms.dirpath"+suffix+".acts.value=val");
  294: }
  295: END
  296: 	if ($ENV{'form.catalogmode'} eq 'groupimport') {
  297:             $catalogmodefunctions.=<<END;
  298: function queue(val) {
  299:     if (eval("document.forms."+val+".filelink.checked")) {
  300: 	var l=val.length;
  301: 	var v=val.substring(4,l);
  302: 	document.forms.fileattr.acts.value+='1a'+v+'b';
  303:     }
  304:     else {
  305: 	var l=val.length;
  306: 	var v=val.substring(4,l);
  307: 	document.forms.fileattr.acts.value+='0a'+v+'b';
  308:     }
  309: }
  310: END
  311: 	}
  312: 
  313: # ---------------------------------------------------------------- Print Header
  314: 	$r->print(<<ENDHEADER);
  315: <html>
  316: <head>
  317: <title>The LearningOnline Network With CAPA Directory Browser</title>
  318: 
  319: <script type="text/javascript">
  320: $catalogmodefunctions
  321: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
  322:     var options = "width=" + w + ",height=" + h + ",";
  323:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
  324:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
  325:     var newWin = window.open(url, wdwName, options);
  326:     newWin.focus();
  327: }
  328: function gothere(val) {
  329:     window.location=val+'?acts='+document.forms.fileattr.acts.value;
  330: }
  331: </script>
  332: 
  333: </head>
  334: ENDHEADER
  335: $r->print(&Apache::loncommon::bodytag('Browse Resources'));
  336: # - Evaluate actions from previous page (both cumulatively and chronologically)
  337:         if ($ENV{'form.catalogmode'} eq 'groupimport') {
  338: 	    my $acts=$ENV{'form.acts'};
  339: 	    my @Acts=split(/b/,$acts);
  340: 	    my %ahash;
  341: 	    my %achash;
  342: 	    my $ac=0;
  343: 	    # some initial hashes for working with data
  344: 	    foreach (@Acts) {
  345: 		my ($state,$ref)=split(/a/);
  346: 		$ahash{$ref}=$state;
  347: 		$achash{$ref}=$ac;
  348: 		$ac++;
  349: 	    }
  350: 	    # sorting through the actions and changing the tied database hash
  351: 	    foreach (sort {$achash{$a}<=>$achash{$b}} (keys %ahash)) {
  352: 		my $key=$_;
  353: 		if ($ahash{$key} eq '1') {
  354: 		    $hash{'store_'.$hash{'pre_'.$key.'_link'}}=
  355: 			$hash{'pre_'.$key.'_title'};
  356: 		    $hash{'storectr_'.$hash{'pre_'.$key.'_link'}}=
  357: 			$hash{'storectr'}+0;
  358: 		    $hash{'storectr'}++;
  359: 		}
  360: 		if ($ahash{$key} eq '0') {
  361: 		    if ($hash{'store_'.$hash{'pre_'.$key.'_link'}}) {
  362: 			delete $hash{'store_'.$hash{'pre_'.$key.'_link'}};
  363: 		    }
  364: 		}
  365: 	    }
  366: 	    # deleting the previously cached listing
  367: 	    foreach (keys %hash) {
  368: 		if ($_ =~ /^pre_/ && $_ =~/link$/) {
  369: 		    my $key = $_;
  370: 		    $key =~ s/^pre_//;
  371: 		    $key =~ s/_[^_]*$//;
  372: 		    delete $hash{'pre_'.$key.'_title'};
  373: 		    delete $hash{'pre_'.$key.'_link'};
  374: 		}
  375: 	    }
  376: 	}
  377: 	
  378: # ---------------------------------- get state of file attributes to be showing
  379: 	if ($ENV{'form.attrs'} ne '') {
  380: 	    for (my $i=0; $i<=8; $i++) {
  381: 		delete $hash{'display_attrs_'.$i};
  382: 		if ($ENV{'form.attr'.$i} == 1) {
  383: 		    $attrchk[$i] = 'checked';
  384: 		    $hash{'display_attrs_'.$i} = 1;
  385: 		}
  386: 	    }
  387: 	} else {
  388: 	    for (my $i=0; $i<=8; $i++) {
  389: 		$attrchk[$i] = 'checked' if $hash{'display_attrs_'.$i} == 1;
  390: 	    }
  391: 	}
  392: # ------------------------------- output state of file attributes to be showing
  393: 	$r->print(<<END);
  394: <form method="post" name="fileattr" action="$uri"
  395:  enctype="application/x-www-form-urlencoded">
  396: <b><font color="#666666">Display file attributes</font></b><br />
  397: <table border=0><tr>
  398: <td><input type="checkbox" name="attr0" value="1" $attrchk[0] /> Title</td>
  399: <td><input type="checkbox" name="attr1" value="1" $attrchk[1] /> Size</td>
  400: <td><input type="checkbox" name="attr2" value="1" $attrchk[2] /> Last access</td>
  401: <td><input type="checkbox" name="attr3" value="1" $attrchk[3] /> Last modified</td>
  402: <td><input type="checkbox" name="attr8" value="1" $attrchk[8] /> All versions</td></tr><tr>
  403: <td><input type="checkbox" name="attr4" value="1" $attrchk[4] /> Author</td>
  404: <td><input type="checkbox" name="attr5" value="1" $attrchk[5] /> Keywords</td>
  405: <td><input type="checkbox" name="attr6" value="1" $attrchk[6] /> Language</td>
  406: <td><input type="checkbox" name="attr7" value="1" $attrchk[7] /> Show Resource</td>
  407: <td>&nbsp;</td>
  408: </tr></table>
  409: <input type="hidden" name="dirPointer" value="on" />
  410: <input type="hidden" name="acts" value="" />
  411: <input type="submit" name="attrs" value="Review" />&nbsp;
  412: <input type="submit" name="attrs" value="Refresh" />
  413: $closebutton
  414: $groupimportbutton
  415: </form>
  416: END
  417: 
  418: # ----------------- output starting row to the indexed file/directory hierarchy
  419:         my $titleclr="#ddffff";
  420: #        $r->print(&initdebug());
  421: #        $r->print(&writedebug("Omit:@Omit")) if (@Omit);
  422: #        $r->print(&writedebug("Only:@Only")) if (@Only);
  423:         $r->print("<table width='100\%' border=0><tr><td bgcolor=#777777>\n");
  424: 	$r->print("<table width='100\%' border=0><tr bgcolor=$titleclr>\n");
  425: 	$r->print("<td $colspan><b>Name</b></td>\n");
  426: 	$r->print("<td><b>Title</b></td>\n") 
  427: 	    if ($hash{'display_attrs_0'} == 1);
  428: 	$r->print("<td align=right><b>Size (bytes) ".
  429: 		  "</b></td>\n") if ($hash{'display_attrs_1'} == 1);
  430: 	$r->print("<td><b>Last accessed</b></td>\n") 
  431: 	    if ($hash{'display_attrs_2'} == 1);
  432: 	$r->print("<td><b>Last modified</b></td>\n")
  433: 	    if ($hash{'display_attrs_3'} == 1);
  434: 	$r->print("<td><b>Author(s)</b></td>\n")
  435: 	    if ($hash{'display_attrs_4'} == 1);
  436: 	$r->print("<td><b>Keywords</b></td>\n")
  437: 	    if ($hash{'display_attrs_5'} == 1);
  438: 	$r->print("<td><b>Language</b></td>\n")
  439: 	    if ($hash{'display_attrs_6'} == 1);
  440: 	$r->print("<td><b>Resource</b></td>\n")
  441: 	    if ($hash{'display_attrs_7'} == 1);
  442: 	$r->print('</tr>');
  443: 
  444: # ----------------- read in what directories have previously been set to "open"
  445: 	foreach (keys %hash) {
  446: 	    if ($_ =~ /^diropen_status_/) {
  447: 		my $key = $_;
  448: 		$key =~ s/^diropen_status_//;
  449: 		$dirs{$key} = $hash{$_};
  450: 	    }
  451: 	}
  452: 
  453: 	if ($ENV{'form.openuri'}) {  # take care of review and refresh options
  454: 	    my $uri=$ENV{'form.openuri'};
  455: 	    if (exists($hash{'diropen_status_'.$uri})) {
  456: 		my $cursta = $hash{'diropen_status_'.$uri};
  457: 		$dirs{$uri} = 'open';
  458: 		$hash{'diropen_status_'.$uri} = 'open';
  459: 		if ($cursta eq 'open') {
  460: 		    $dirs{$uri} = 'closed';
  461: 		    $hash{'diropen_status_'.$uri} = 'closed';
  462: 		}
  463: 	    } else {
  464: 		$hash{'diropen_status_'.$uri} = 'open';
  465: 		$dirs{$uri} = 'open';
  466: 	    }
  467: 	}
  468: 	
  469: 	my $bredir = $ENV{'form.dirPointer'};
  470: 	my $toplevel;
  471: 	my $indent = 0;
  472: 	$uri = $uri.'/' if $uri !~ /.*\/$/;
  473: 
  474: 	if ($bredir ne 'on') {
  475: 	    $hash{'top.level'} = $uri;
  476: 	    $toplevel = $uri;
  477: 
  478: 	} else {
  479: 	    $toplevel = $hash{'top.level'};
  480: 	}
  481: 
  482: # -------------------------------- if not at top level, provide an uplink arrow
  483: 	if ($toplevel ne '/res/'){
  484: 	    my (@uri_com) = split(/\//,$uri);
  485: 	    pop @uri_com;
  486: 	    my $upone = join('/',@uri_com);
  487: 	    my @list = qw (0);
  488: 	    &display_line ($r,'opened',$upone.'&viewOneUp',0,$upone,@list);
  489: 	    $indent = 1;
  490: 	}
  491: 
  492: # -------- recursively go through all the directories and output as appropriate
  493: 	&scanDir ($r,$toplevel,$indent,\%hash);
  494: 	
  495: # ---------------------------- embed hidden information useful for group import
  496: 	$r->print("<form name='fnum'>");
  497: 	$r->print("<input type='hidden' name='fnum' value='$fnum'></form>");
  498: 
  499: # -------------------------------------------------------------- end the tables
  500: 	$r->print('</table>');
  501: 	$r->print('</td></tr></table>');
  502: 
  503: # --------------------------------------------------- end the output and return
  504: 	$r->print('</body></html>'."\n");
  505: #    } else {
  506: #	$r->print('<html><head></head><body>Unable to tie hash to db '.
  507: #		  'file</body></html>');
  508: #	return OK;
  509:     }
  510:     if(! $c->aborted()) {
  511: 	my %dbfile;
  512:         if (tie(%dbfile,'GDBM_File',$diropendb,&GDBM_NEWDB(),0640)) {
  513:             while (my($key,$value) = each(%hash)) {
  514:                 $dbfile{$key}=$value;
  515:             }
  516:             untie(%dbfile);
  517:         }
  518:     }
  519: 
  520:     return OK;
  521: }
  522: 
  523: # ----------------------------------------------- recursive scan of a directory
  524: sub scanDir {
  525:     my ($r,$startdir,$indent,$hashref)=@_;
  526:     my $c = $r->connection();
  527:     my ($compuri,$curdir);
  528:     my $dirptr=16384;
  529:     $indent++;
  530: 
  531:     my %dupdirs = %dirs;
  532:     my @list=&get_list($r,$startdir);
  533:     foreach my $line (@list) {
  534:         return if ($c->aborted());
  535: 	my ($strip,$dom,undef,$testdir,undef)=split(/\&/,$line,5); 
  536: 	next if $strip =~ /.*\.meta$/;
  537: 	my (@fileparts) = split(/\./,$strip);
  538: 	if ($hash{'display_attrs_8'} != 1) {
  539: 	    if (scalar(@fileparts) >= 3) {
  540: 		my $fext = pop @fileparts;
  541: 		my $ov = pop @fileparts;
  542: 		my $fname = join ('.',@fileparts,$fext);
  543: 		next if (grep /\Q$fname\E/,@list and $ov =~ /\d+/);
  544: 	    }
  545: 	}
  546: 
  547: 	if ($dom eq 'domain') {
  548: 	    $compuri = join('',$strip,'/');  # dom list has /res/<domain name>
  549: 	    $curdir = $compuri;
  550: 	} else {
  551: 	    # user, dir & file have name only, i.e., w/o path
  552: 	    $compuri = join('',$startdir,$strip,'/');
  553: 	    $curdir = $startdir;
  554: 	}
  555: 	my $diropen = 'closed';
  556: 	if (($dirptr&$testdir) or ($dom =~ /^(domain|user)$/)) {
  557: 	    while (my ($key,$val)= each %dupdirs) {
  558: 		if ($key eq $compuri and $val eq "open") {
  559: 		    $diropen = "opened";
  560: 		    delete($dupdirs{$key});
  561: 		    delete($dirs{$key});
  562: 		}
  563: 	    }
  564: 	}
  565: 	&display_line($r,$diropen,$line,$indent,$curdir,$hashref,@list);
  566: 	&scanDir ($r,$compuri,$indent) if $diropen eq 'opened';
  567:     }
  568:     $indent--;
  569: }
  570: 
  571: # --------------- get complete matched list based on the uri (returns an array)
  572: sub get_list {
  573:     my ($r,$uri)=@_;
  574:     my @list;
  575:     (my $luri = $uri) =~ s/\//_/g;
  576: 
  577:     if ($ENV{'form.attrs'} eq 'Refresh') {
  578: 	foreach (keys %hash) {
  579: 	    delete $hash{$_} if ($_ =~ /^dirlist_files_/);
  580: 	    }
  581:     }
  582: 
  583:     if ($hash{'dirlist_files'.$luri}) {
  584: 	@list = split(/\n/,$hash{'dirlist_files_'.$luri});
  585:     } else {
  586: 	@list = &Apache::lonnet::dirlist($uri);
  587: 	$hash{'dirlist_files_'.$luri} = join('\n',@list);
  588:     }
  589:     return @list=&match_ext($r,@list);
  590: }
  591: 
  592: sub initdebug {
  593:     return <<ENDJS;
  594: <script>
  595: var debugging = true;
  596: if (debugging) {
  597:     var debuggingWindow = window.open('','Debug','width=400,height=300',true);
  598: } 
  599: 
  600: function output(text) {
  601:     if (debugging) {
  602:         debuggingWindow.document.writeln(text);
  603:     }
  604: }
  605: output("<html><head><title>Debugging Window</title></head><body><pre>");   
  606: </script>
  607: ENDJS
  608: }
  609: 
  610: sub writedebug {
  611:     my $text = shift;
  612:     return "<script>output('$text');</script>";
  613: }
  614: 
  615: # -------------------- filters out files based on extensions (returns an array)
  616: sub match_ext {
  617:     my ($r,@packlist)=@_;
  618:     my @trimlist;
  619:     my $nextline;
  620:     my @fileext;
  621:     my $dirptr=16384;
  622: 
  623:     foreach my $line (@packlist) {
  624: 	chomp $line;
  625: 	$line =~ s/^\/home\/httpd\/html//;
  626: 	my @unpackline = split (/\&/,$line);
  627: 	next if ($unpackline[0] eq '.');
  628: 	next if ($unpackline[0] eq '..');
  629: 	my @filecom = split (/\./,$unpackline[0]);
  630: 	my $fext = pop(@filecom);
  631: 	my $fnptr = $unpackline[3]&$dirptr;
  632:  	if ($fnptr == 0 and $unpackline[3] ne "") {
  633: 	    my $embstyle = &Apache::loncommon::fileembstyle($fext);
  634:             push @trimlist,$line if (defined($embstyle) && 
  635: 				     ($embstyle ne 'hdn' or $fext eq 'meta'));
  636: 	} else {
  637: 	    push @trimlist,$line;
  638: 	}
  639:     }
  640:     @trimlist = sort (@trimlist);
  641:     return @trimlist;
  642: }
  643: 
  644: # ------------------------------- displays one line in appropriate table format
  645: sub display_line {
  646:     my ($r,$diropen,$line,$indent,$startdir,$hashref,@list)=@_;
  647:     my (@pathfn, $fndir);
  648:     my $dirptr=16384;
  649:     my $fileclr="#ffffe6";
  650:     my $iconpath= $r->dir_config('lonIconsURL') . '/';
  651: 
  652:     my @filecom = split (/\&/,$line);
  653:     my @pathcom = split (/\//,$filecom[0]);
  654:     my $listname = $pathcom[scalar(@pathcom)-1];
  655:     my $fnptr = $filecom[3]&$dirptr;
  656:     my $msg = 'View '.$filecom[0].' resources';
  657:     $msg = 'Close '.$filecom[0].' directory' if $diropen eq 'opened';
  658: 
  659:     my $tabtag='</td>';
  660:     my $i=0;
  661: 
  662:     while ($i<=7) {
  663: 	$tabtag=join('',$tabtag,"<td>&nbsp;</td>")
  664: 	    if $hash{'display_attrs_'.$i} == 1;
  665: 	$i++;
  666:     }
  667: 	
  668:     my $valign = ($hash{'display_attrs_7'} == 1 ? 'top' : 'bottom');
  669: 
  670: # display uplink arrow
  671:     if ($filecom[1] eq 'viewOneUp') {
  672: 	$r->print("<tr bgcolor=$fileclr>$extrafield");
  673: 	$r->print("<td valign=$valign>\n");
  674: 	$r->print ('<form method="post" name="dirpathUP" action="'.$startdir.
  675: 		   '/" '.
  676: 		   'onSubmit="return rep_dirpath(\'UP\','.
  677: 		   'document.forms.fileattr.acts.value)" '.
  678: 		   'enctype="application/x-www-form-urlencoded"'.
  679:                    '>'."\n");
  680: 	$r->print ('<input type=hidden name=openuri value="'.
  681: 		   $startdir.'">'."\n");
  682: 	$r->print ('<input type="hidden" name="acts" value="">'."\n");
  683: 	$r->print ('<input src="'.$iconpath.'arrow_up.gif"');
  684: 	$r->print (' name="'.$msg.'" height="22" type="image" border="0">'.
  685: 		   "\n");
  686: 	$r->print("Up $tabtag</tr></form>\n");
  687: 	return OK;
  688:     }
  689: # Do we have permission to look at this?
  690: 
  691:     return OK if (!&Apache::lonnet::allowed('bre',$startdir.$filecom[0]));
  692: 
  693: # display domain
  694:     if ($filecom[1] eq 'domain') {
  695: 	$r->print ('<input type="hidden" name="dirPointer" value="on">'."\n")
  696: 	    if ($ENV{'form.dirPointer'} eq "on");
  697: 	$r->print("<tr bgcolor=$fileclr>$extrafield");
  698: 	$r->print("<td valign=$valign>");
  699: 	&begin_form ($r,$filecom[0].'/');
  700: 	my $anchor = $filecom[0].'/';
  701: 	$anchor =~ s/\///g;
  702: 	$r->print ('<a name="'.$anchor.'">');
  703: 	$r->print ('<input type="hidden" name="acts" value="">');
  704: 	$r->print ('<input src="'.$iconpath.'folder_pointer_'.
  705: 		   $diropen.'.gif"'); 
  706: 	$r->print (' name="'.$msg.'" height="22" type="image" border="0">'.
  707: 		   "\n");
  708: 	$r->print ('<a href="javascript:gothere(\''.$filecom[0].
  709: 		   '/\')"><img src="'.$iconpath.'server.gif"');
  710: 	$r->print (' border="0" /></a>'."\n");
  711: 	$r->print ("Domain - $listname ");
  712: 	if ($Apache::lonnet::domaindescription{$listname}) {
  713: 	    $r->print("(".$Apache::lonnet::domaindescription{$listname}.
  714: 		      ")");
  715: 	}
  716: 	$r->print (" $tabtag</tr></form>\n");
  717: 	return OK;
  718: 
  719: # display user directory
  720:     }
  721:     if ($filecom[1] eq 'user') {
  722: 	$r->print("<tr bgcolor=$fileclr>$extrafield");
  723: 	$r->print("<td valign=$valign nowrap>\n");
  724: 	my $curdir = $startdir.$filecom[0].'/';
  725: 	my $anchor = $curdir;
  726: 	$anchor =~ s/\///g;
  727: 	&begin_form ($r,$curdir);
  728: 	$r->print ('<a name="'.$anchor.'"><img src="'.$iconpath.
  729: 		   'whitespace1.gif" border="0" />'."\n");
  730: 	$r->print ('<input type="hidden" name="acts" value="">');
  731: 	$r->print ('<input src="'.$iconpath.'folder_pointer_'.$diropen.
  732: 		   '.gif"'); 
  733: 	$r->print (' name="'.$msg.'" height="22" type="image" border="0">'.
  734: 		   "\n");
  735: 	$r->print ('<a href="javascript:gothere(\''.$curdir.'\')"><img src='.
  736: 		   $iconpath.'quill.gif border="0" name="'.$msg.
  737: 		   '" height="22" /></a>');
  738: 	my $domain=(split(m|/|,$startdir))[2];
  739: 	my $plainname=&Apache::loncommon::plainname($listname,$domain);
  740: 	$r->print ($listname);
  741: 	if (defined($plainname) && $plainname) { $r->print(" ($plainname) "); }
  742: 	$r->print ($tabtag.'</tr></form>'."\n");
  743: 	return OK;
  744:     }
  745: 
  746: # display file
  747:     if ($fnptr == 0 and $filecom[3] ne '') {
  748: 	my $filelink = $startdir.$filecom[0];
  749: 	my @file_ext = split (/\./,$listname);
  750: 	my $curfext = $file_ext[-1];
  751:         if (@Omit) {
  752:             foreach (@Omit) { return OK if ($curfext eq $_); }
  753:         }
  754:         if (@Only) {
  755:             my $skip = 1;
  756:             foreach (@Only) { $skip = 0 if ($curfext eq $_); }
  757:             return OK if ($skip > 0);
  758:         }
  759: 	# Set the icon for the file
  760: 	my $iconname = "unknown.gif";
  761: 	my $embstyle = &Apache::loncommon::fileembstyle($curfext);
  762: 	# The unless conditional that follows is a bit of overkill
  763: 	$iconname = $curfext.".gif" unless
  764: 	    (!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn');
  765: 	#
  766: 	$r->print("<tr bgcolor=$fileclr><td nowrap valign='$valign'>");
  767: 	my $metafile = grep /^\Q$filecom[0]\E\.meta\&/, @list;
  768: 	my $title;
  769:         if ($ENV{'form.catalogmode'} eq 'interactive') {
  770: 	    $title=$listname;
  771: 	    $title = &Apache::lonnet::metadata($filelink,'title')
  772: 		if ($metafile == 1);
  773: 	    $title=$listname unless $title;
  774: 	    my $titleesc=HTML::Entities::encode($title);
  775: 	    $titleesc=~s/\'/\\'/; #' (clean up this spare quote)
  776:             $r->print("<a href=\"javascript:select_data(\'",
  777:                       $titleesc,"','",$filelink,"')\">");
  778: 	    $r->print("<img src='",$iconpath,"select.gif' border='0' /></a>".
  779: 		      "\n");
  780: 	    $r->print("</td><td valign='$valign' nowrap>");
  781: 	}
  782:         elsif ($ENV{'form.catalogmode'} eq 'groupimport') {
  783: 	    $title=$listname;
  784: 	    $title = &Apache::lonnet::metadata($filelink,'title')
  785: 		if ($metafile == 1);
  786: 	    $title=$listname unless $title;
  787: 	    my $titleesc=&HTML::Entities::encode($title);
  788: 	    $r->print("<form name='form$fnum'>\n");
  789: 	    $r->print("<input type='checkbox' name='filelink"."' ".
  790: 		      "value='$filelink' onClick='".
  791: 		      "javascript:queue(\"form$fnum\")' ");
  792: 	    if ($hash{'store_'.$filelink}) {
  793: 		$r->print("checked");
  794: 	    }
  795: 	    $r->print(">\n");
  796: 	    $r->print("<input type='hidden' name='title"."' ".
  797: 		      "value='$titleesc'>\n");
  798: 	    $r->print("</form>\n");
  799: 	    $r->print("</td><td valign='$valign' nowrap>");
  800: 	    $hash{"pre_${fnum}_link"}=$filelink;
  801: 	    $hash{"pre_${fnum}_title"}=$titleesc;
  802:   	    $fnum++;
  803: 	}
  804: 
  805: 	if ($indent > 0 and $indent < 11) {
  806: 	    $r->print("<img src=",$iconpath,"whitespace",$indent,
  807: 		      ".gif border='0' />\n");
  808: 	} elsif ($indent >0) {
  809: 	    my $ten = int($indent/10.);
  810: 	    my $rem = $indent%10.0;
  811: 	    my $count = 0;
  812: 	    while ($count < $ten) {
  813: 		$r->print("<img src=",$iconpath,
  814: 			  "whitespace10.gif border='0' />\n");
  815: 	    $count++;
  816: 	    }
  817: 	    $r->print("<img src=",$iconpath,"whitespace",$rem,
  818: 		      ".gif border='0' />\n") if $rem > 0;
  819: 	}
  820: 
  821: 	$r->print("<img src=$iconpath$iconname border='0' />\n");
  822: 	$r->print (" <a href=\"javascript:openWindow('".$filelink.
  823: 		   "', 'metadatafile', '450', '500', 'no', 'yes')\";".
  824: 		   " TARGET=_self>$listname</a> ");
  825: 
  826: 	$r->print (" (<a href=\"javascript:openWindow('".$filelink.
  827: 		   ".meta', 'metadatafile', '400', '450', 'no', 'yes')\"; ".
  828: 		   "TARGET=_self>metadata</a>) ") if ($metafile == 1);
  829: 
  830: 	$r->print("</td>\n");
  831: 	if ($hash{'display_attrs_0'} == 1) {
  832: 	    my $title = &Apache::lonnet::metadata($filelink,'title')
  833: 		if ($metafile == 1);
  834: 	    $r->print('<td valign=$valign> '.($title eq '' ? '&nbsp;' : $title).
  835: 		      ' </td>'."\n");
  836: 	}
  837: 	$r->print('<td align=right valign=$valign> ',
  838: 		  $filecom[8]," </td>\n") 
  839: 	    if $hash{'display_attrs_1'} == 1;
  840: 	$r->print('<td valign=$valign> '.
  841: 		  (localtime($filecom[9]))." </td>\n") 
  842: 	    if $hash{'display_attrs_2'} == 1;
  843: 	$r->print('<td valign=$valign> '.
  844: 		  (localtime($filecom[10]))." </td>\n") 
  845: 	    if $hash{'display_attrs_3'} == 1;
  846: 
  847: 	if ($hash{'display_attrs_4'} == 1) {
  848: 	    my $author = &Apache::lonnet::metadata($filelink,'author')
  849: 		if ($metafile == 1);
  850: 	    $r->print('<td valign=$valign> '.($author eq '' ? '&nbsp;' : $author).
  851: 		      " </td>\n");
  852: 	}
  853: 	if ($hash{'display_attrs_5'} == 1) {
  854: 	    my $keywords = &Apache::lonnet::metadata($filelink,'keywords')
  855: 		if ($metafile == 1);
  856: 	    # $keywords = '&nbsp;' if (!$keywords);
  857: 	    $r->print('<td valign=$valign> '.($keywords eq '' ? '&nbsp;' : $keywords).
  858: 		      " </td>\n");
  859: 	}
  860: 	if ($hash{'display_attrs_6'} == 1) {
  861: 	    my $lang = &Apache::lonnet::metadata($filelink,'language')
  862: 		if ($metafile == 1);
  863: 	    $lang = &Apache::loncommon::languagedescription($lang);
  864: 	    $r->print('<td valign=$valign> '.($lang eq '' ? '&nbsp;' : $lang).
  865: 		      " </td>\n");
  866: 	}
  867:         if ($hash{'display_attrs_7'} == 1) {
  868:             my $output='';
  869:             my $embstyle=&Apache::loncommon::fileembstyle($curfext);
  870: 	    if ($embstyle eq 'ssi') {
  871: 	       $output=&Apache::lonnet::ssi_body($filelink);
  872:                $output='<font size="-2">'.$output.'</font>';
  873: 	   } elsif ($embstyle eq 'img') {
  874:                $output='<img src="'.$filelink.'" />';
  875:            } elsif ($filelink=~/^\/res\/(\w+)\/(\w+)\//) {
  876:                $output='<img src="http://'.
  877: 		 $Apache::lonnet::hostname{&Apache::lonnet::homeserver($2,$1)}.
  878:                  '/cgi-bin/thumbnail.gif?url='.$filelink.'" />';
  879:            }
  880: 	   $r->print('<td valign=$valign> '.($output eq '' ? '&nbsp;':$output).
  881: 		      " </td>\n");
  882:         }
  883: 	$r->print("</tr>\n");
  884:     }
  885: 
  886: # -- display directory
  887:     if ($fnptr == $dirptr) {
  888: 	my @file_ext = split (/\./,$listname);
  889: 	my $curfext = $file_ext[scalar(@file_ext)-1];
  890: 	my $curdir = $startdir.$filecom[0].'/';
  891: 	my $anchor = $curdir;
  892: 	$anchor =~ s/\///g;
  893: 	$r->print("<tr bgcolor=$fileclr>$extrafield<td valign=$valign>");
  894: 	&begin_form ($r,$curdir);
  895: 	my $indentm1 = $indent-1;
  896: 	if ($indentm1 < 11 and $indentm1 > 0) {
  897: 	    $r->print("<img src=",$iconpath,"whitespace",$indentm1,
  898: 		      ".gif border='0' />\n");
  899: 	} else {
  900: 	    my $ten = int($indentm1/10.);
  901: 	    my $rem = $indentm1%10.0;
  902: 	    my $count = 0;
  903: 	    while ($count < $ten) {
  904: 		$r->print ("<img src=",$iconpath
  905: 			   ,"whitespace10.gif border='0' />\n");
  906: 		$count++;
  907: 	    }
  908: 	    $r->print ("<img src=",$iconpath,"whitespace",$rem,
  909: 		       ".gif border='0' />\n") if $rem > 0;
  910: 	}
  911: 	$r->print ('<input type="hidden" name="acts" value="">');
  912: 	$r->print ('<a name="'.$anchor.'"><input src="'.$iconpath.
  913: 		   'folder_pointer_'.$diropen.'.gif"');
  914: 	$r->print (' name="'.$msg.'" height="22" type="image" border="0">'.
  915: 		   "\n");
  916: 	$r->print ('<a href="javascript:gothere(\''.$curdir.'\')"><img src="'.
  917: 		   $iconpath.'folder_'.$diropen.'.gif" border="0" /></a>'.
  918: 		   "\n");
  919: 	$r->print ("$listname$tabtag</tr></form>\n");
  920:     }
  921: 
  922: }
  923: 
  924: # ------------------- prints the beginning of a form for directory or file link
  925: sub begin_form {
  926:     my ($r,$uri) = @_;
  927:     my $anchor = $uri;
  928:     $anchor =~ s/\///g;
  929:     $r->print ('<form method="post" name="dirpath'.$dnum.'" action="'.$uri.
  930: 	       '#'.$anchor.
  931: 	       '" onSubmit="return rep_dirpath(\''.$dnum.'\''.
  932: 	       ',document.forms.fileattr.acts.value)" '.
  933: 	       'enctype="application/x-www-form-urlencoded">'."\n");
  934:     $r->print ('<input type="hidden" name="openuri" value="'.$uri.'">'.
  935: 	       "\n");
  936:     $r->print ('<input type="hidden" name="dirPointer" value="on">'."\n");
  937:     $dnum++;
  938: }
  939: 
  940: # --------- settings whenever the user causes the indexer window to be launched
  941: sub start_fresh_session {
  942:     delete $hash{'form.catalogmode'};
  943:     delete $hash{'form.mode'};
  944:     delete $hash{'form.form'};
  945:     delete $hash{'form.element'};
  946:     delete $hash{'form.omit'};
  947:     delete $hash{'form.only'};
  948:     foreach (keys %hash) {
  949:         delete $hash{$_} if (/^(pre_|store)/);
  950:     }
  951: }
  952: 
  953: # ------------------------------------------------------------------- setvalues
  954: sub setvalues {
  955:     # setvalues is used in registerurl to synchronize the database
  956:     # hash and environment hashes
  957:     my ($H1,$h1key,$H2,$h2key) =@_;
  958:     #
  959:     if (exists $H2->{$h2key}) {
  960: 	$H1->{$h1key} = $H2->{$h2key};
  961:     } elsif (exists $H1->{$h1key}) {
  962: 	$H2->{$h2key} = $H1->{$h1key};
  963:     } 
  964: }
  965: 
  966: 1;
  967: 
  968: sub cleanup {
  969:     if (tied(%hash)){
  970: 	&Apache::lonnet::logthis('Cleanup indexer: hash');
  971:     }
  972: }
  973: 
  974: =head1 NAME
  975: 
  976: Apache::lonindexer - mod_perl module for cross server filesystem browsing
  977: 
  978: =head1 SYNOPSIS
  979: 
  980: Invoked by /etc/httpd/conf/srm.conf:
  981: 
  982:  <LocationMatch "^/res.*/$">
  983:  SetHandler perl-script
  984:  PerlHandler Apache::lonindexer
  985:  </LocationMatch>
  986: 
  987: =head1 INTRODUCTION
  988: 
  989: This module enables a scheme of browsing across a cross server.
  990: 
  991: This is part of the LearningOnline Network with CAPA project
  992: described at http://www.lon-capa.org.
  993: 
  994: =head1 BEGIN SUBROUTINE
  995: 
  996: This routine is only run once after compilation.
  997: 
  998: =over 4
  999: 
 1000: =item *
 1001: 
 1002: Initializes %language hash table.
 1003: 
 1004: =back
 1005: 
 1006: =head1 HANDLER SUBROUTINE
 1007: 
 1008: This routine is called by Apache and mod_perl.
 1009: 
 1010: =over 4
 1011: 
 1012: =item *
 1013: 
 1014: read in machine configuration variables
 1015: 
 1016: =item *
 1017: 
 1018: see if called from an interactive mode
 1019: 
 1020: =item *
 1021: 
 1022: refresh environment with user database values (in %hash)
 1023: 
 1024: =item *
 1025: 
 1026: define extra fields and buttons in case of special mode
 1027: 
 1028: =item *
 1029: 
 1030: set catalogmodefunctions to have extra needed javascript functionality
 1031: 
 1032: =item *
 1033: 
 1034: print header
 1035: 
 1036: =item *
 1037: 
 1038: evaluate actions from previous page (both cumulatively and chronologically)
 1039: 
 1040: =item *
 1041: 
 1042: output title
 1043: 
 1044: =item *
 1045: 
 1046: get state of file attributes to be showing
 1047: 
 1048: =item *
 1049: 
 1050: output state of file attributes to be showing
 1051: 
 1052: =item *
 1053: 
 1054: output starting row to the indexed file/directory hierarchy
 1055: 
 1056: =item *
 1057: 
 1058: read in what directories have previously been set to "open"
 1059: 
 1060: =item *
 1061: 
 1062: if not at top level, provide an uplink arrow
 1063: 
 1064: =item *
 1065: 
 1066: recursively go through all the directories and output as appropriate
 1067: 
 1068: =item *
 1069: 
 1070: information useful for group import
 1071: 
 1072: =item *
 1073: 
 1074: end the tables
 1075: 
 1076: =item *
 1077: 
 1078: end the output and return
 1079: 
 1080: =back
 1081: 
 1082: =head1 OTHER SUBROUTINES
 1083: 
 1084: =over 4
 1085: 
 1086: =item *
 1087: 
 1088: scanDir - recursive scan of a directory
 1089: 
 1090: =item *
 1091: 
 1092: get_list - get complete matched list based on the uri (returns an array)
 1093: 
 1094: =item *
 1095: 
 1096: match_ext - filters out files based on extensions (returns an array)
 1097: 
 1098: =item *
 1099: 
 1100: display_line - displays one line in appropriate table format
 1101: 
 1102: =item *
 1103: 
 1104: begin_form - prints the beginning of a form for directory or file link
 1105: 
 1106: =item *
 1107: 
 1108: start_fresh_session - settings whenever the user causes the indexer window
 1109: to be launched
 1110: 
 1111: =back
 1112: 
 1113: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>