# The LearningOnline Network with CAPA
# Directory Indexer
#
# $Id: lonindexer.pm,v 1.42 2002/05/31 21:50:30 albertel 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
# YEAR=2000
# 07/20-08/04 H.K. Ng
# YEAR=2001
# 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,10/15,11/28,11/29 Scott Harrison
# 11/30 Matthew Hall
# 12/11,12/13 Scott Harrison
# YEAR=2002
# 1/17 Scott Harrison
#
###
###############################################################################
## ##
## 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
# ----- 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;
$r->content_type('text/html');
$r->send_http_header;
return OK if $r->header_only;
$fnum=0;
$dnum=0;
untie %hash;
# ------------------------------------- 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']);
#-------------------------------------------------------------------
my $closebutton='';
my $groupimportbutton='';
my $colspan='';
$extrafield='';
my $diropendb =
"/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_indexer.db";
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';
}
# --------------------- define extra fields and buttons in case of special mode
if ($ENV{'form.catalogmode'} eq 'interactive') {
$hash{'mode_catalog'}='interactive';
$extrafield='
'.
' | ';
$colspan=" colspan='2' ";
$closebutton=<
END
}
elsif ($ENV{'form.catalogmode'} eq 'groupimport') {
$hash{'mode_catalog'}='groupimport';
$extrafield=''.
' | ';
$colspan=" colspan='2' ";
$closebutton=<
END
$groupimportbutton=<
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') {
# 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=<print(<
The LearningOnline Network With CAPA Directory Browser
ENDHEADER
# - 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 tied 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'};
}
}
}
# ---------------------------------------------------------------- output title
$r->print(
'The LearningOnline Network 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++) {
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<=6; $i++) {
$attrchk[$i] = "checked" if $hash{'display_attrs_'.$i} == 1;
}
}
# ------------------------------- output state of file attributes to be showing
$r->print(<Display file attributes
END
# ----------------- 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("\n");
$r->print("\n");
$r->print("Name | \n");
$r->print("Size (bytes) ".
" | \n") if ($hash{'display_attrs_0'} == 1);
$r->print("Last accessed | \n")
if ($hash{'display_attrs_1'} == 1);
$r->print("Last modified | \n")
if ($hash{'display_attrs_2'} == 1);
$r->print("Author(s) | \n")
if ($hash{'display_attrs_3'} == 1);
$r->print("Keywords | \n")
if ($hash{'display_attrs_4'} == 1);
$r->print("Language | \n")
if ($hash{'display_attrs_5'} == 1);
$r->print(" ");
# ----------------- 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 $bredir = $ENV{'form.dirPointer'};
my $toplevel;
my $indent = 0;
$uri = $uri.'/' if $uri !~ /.*\/$/;
if ($bredir 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("");
# -------------------------------------------------------------- end the tables
$r->print(" ");
$r->print(" |
");
# --------------------------------------------------- end the output and return
$r->print("