|
version 1.17, 2001/08/13 14:50:35
|
version 1.25, 2001/12/04 15:35:39
|
|
Line 1
|
Line 1
|
| # The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
| # |
|
| # Directory Indexer |
# Directory Indexer |
| # |
# |
| |
# $Id$ |
| |
# |
| |
# 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 |
# YEAR=1999 |
| # 5/21/99, 5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer) |
# 5/21/99, 5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer) |
| # 11/23 Gerd Kortemeyer |
# 11/23 Gerd Kortemeyer |
|
Line 14
|
Line 37
|
| # 5/31,6/1,6/2,6/15 Scott Harrison |
# 5/31,6/1,6/2,6/15 Scott Harrison |
| # 6/26,7/8 H. K. Ng |
# 6/26,7/8 H. K. Ng |
| # 8/6,8/7,8/10 Scott Harrison |
# 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 |
| |
# |
| |
### |
| |
|
| |
############################################################################### |
| |
## ## |
| |
## 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; |
package Apache::lonindexer; |
| |
|
| |
# ------------------------------------------------- modules used by this module |
| use strict; |
use strict; |
| use Apache::lonnet(); |
use Apache::lonnet(); |
| use Apache::Constants qw(:common); |
use Apache::Constants qw(:common); |
| use Apache::File; |
use Apache::File; |
| use GDBM_File; |
use GDBM_File; |
| |
|
| |
# ---------------------------------------- variables used throughout the module |
| my %hash; # tied to a user-specific gdbm file |
my %hash; # tied to a user-specific gdbm file |
| my %dirs; # keys are directories, values are the open/close status |
my %dirs; # keys are directories, values are the open/close status |
| my %language; # has the reference information present in language.tab |
my %language; # has the reference information present in language.tab |
|
Line 43 sub BEGIN {
|
Line 86 sub BEGIN {
|
| } <$fh>; |
} <$fh>; |
| } |
} |
| |
|
| # ---------------------------------------------------------------- Main Handler |
# ----------------------------- Handling routine called via Apache and mod_perl |
| sub handler { |
sub handler { |
| my $r = shift; |
my $r = shift; |
| $r->content_type('text/html'); |
$r->content_type('text/html'); |
|
Line 51 sub handler {
|
Line 94 sub handler {
|
| return OK if $r->header_only; |
return OK if $r->header_only; |
| $fnum=0; |
$fnum=0; |
| $dnum=0; |
$dnum=0; |
| |
untie %hash; |
| |
|
| # --------------------------------------------- machine configuration variables |
# ------------------------------------- read in machine configuration variables |
| my $iconpath= $r->dir_config('lonIconsURL') . "/"; |
my $iconpath= $r->dir_config('lonIconsURL') . "/"; |
| my $domain = $r->dir_config('lonDefDomain'); |
my $domain = $r->dir_config('lonDefDomain'); |
| my $role = $r->dir_config('lonRole'); |
my $role = $r->dir_config('lonRole'); |
|
Line 128 function select_data(title,url) {
|
Line 172 function select_data(title,url) {
|
| self.close(); |
self.close(); |
| } |
} |
| function select_group() { |
function select_group() { |
| window.location="/adm/groupsort?acts="+document.forms.fileattr.acts.value; |
window.location="/adm/groupsort?catalogmode=groupimport&acts="+document.forms.fileattr.acts.value; |
| } |
} |
| function changeTitle(val) { |
function changeTitle(val) { |
| if (opener.inf.document.forms.resinfo.elements.t) { |
if (opener.inf.document.forms.resinfo.elements.t) { |
|
Line 169 END
|
Line 213 END
|
| <head> |
<head> |
| <title>The LearningOnline Network With CAPA Directory Browser</title> |
<title>The LearningOnline Network With CAPA Directory Browser</title> |
| |
|
| <script language="javascript"> |
<script type="text/javascript"> |
| $catalogmodefunctions |
$catalogmodefunctions |
| function openWindow(url, wdwName, w, h, toolbar,scrollbar) { |
function openWindow(url, wdwName, w, h, toolbar,scrollbar) { |
| var options = "width=" + w + ",height=" + h + ","; |
var options = "width=" + w + ",height=" + h + ","; |
|
Line 229 ENDHEADER
|
Line 273 ENDHEADER
|
| } keys %hash; |
} keys %hash; |
| } |
} |
| |
|
| # output title |
# ---------------------------------------------------------------- output title |
| $r->print('<h2><font color="#888888">The LearningOnline With CAPA '. |
$r->print('<h2><font color="#888888">The LearningOnline With CAPA '. |
| 'Network Directory Browser</font></h2>'."\n"); |
'Network Directory Browser</font></h2>'."\n"); |
| # get state of file attributes to be showing |
# ---------------------------------- get state of file attributes to be showing |
| if ($ENV{'form.attrs'} ne "") { |
if ($ENV{'form.attrs'} ne "") { |
| for (my $i=0; $i<=5; $i++) { |
for (my $i=0; $i<=6; $i++) { |
| delete $hash{'display_attrs_'.$i}; |
delete $hash{'display_attrs_'.$i}; |
| if ($ENV{'form.attr'.$i} == 1) { |
if ($ENV{'form.attr'.$i} == 1) { |
| $attrchk[$i] = "checked"; |
$attrchk[$i] = "checked"; |
|
Line 242 ENDHEADER
|
Line 286 ENDHEADER
|
| } |
} |
| } |
} |
| } else { |
} else { |
| for (my $i=0; $i<=5; $i++) { |
for (my $i=0; $i<=6; $i++) { |
| $attrchk[$i] = "checked" if $hash{'display_attrs_'.$i} == 1; |
$attrchk[$i] = "checked" if $hash{'display_attrs_'.$i} == 1; |
| } |
} |
| } |
} |
| # output state of file attributes to be showing |
# ------------------------------- output state of file attributes to be showing |
| $r->print(<<END); |
$r->print(<<END); |
| <b><font color="#666666">Display file attributes</font></b><br /> |
<b><font color="#666666">Display file attributes</font></b><br /> |
| <form method="post" name="fileattr" action="$uri" |
<form method="post" name="fileattr" action="$uri" |
| enctype="application/x-www-form-urlencoded"> |
enctype="application/x-www-form-urlencoded"> |
| <table border=0><tr> |
<table border=0><tr> |
| <td><input type="checkbox" name="attr0" value="1" $attrchk[0] /> Size</td> |
<td><input type="checkbox" name="attr0" value="1" $attrchk[0] /> Size</td> |
| <td><input type="checkbox" name="attr1" value="1" $attrchk[1] /> Last |
<td><input type="checkbox" name="attr1" value="1" $attrchk[1] /> Last access</td> |
| access</td> |
<td><input type="checkbox" name="attr2" value="1" $attrchk[2] /> Last modified</td> |
| <td><input type="checkbox" name="attr2" value="1" $attrchk[2] /> Last |
<td><input type="checkbox" name="attr6" value="1" $attrchk[6] /> All versions</td> |
| modified</td> |
|
| </tr><tr> |
</tr><tr> |
| <td><input type="checkbox" name="attr3" value="1" $attrchk[3] /> Author</td> |
<td><input type="checkbox" name="attr3" value="1" $attrchk[3] /> Author</td> |
| <td><input type="checkbox" name="attr4" value="1" $attrchk[4] /> Keywords</td> |
<td><input type="checkbox" name="attr4" value="1" $attrchk[4] /> Keywords</td> |
| <td><input type="checkbox" name="attr5" value="1" $attrchk[5] /> Language</td> |
<td><input type="checkbox" name="attr5" value="1" $attrchk[5] /> Language</td> |
| |
<td> </td> |
| </tr></table> |
</tr></table> |
| <input type="hidden" name="dirPointer" value="on" /> |
<input type="hidden" name="dirPointer" value="on" /> |
| <input type="hidden" name="acts" value="" /> |
<input type="hidden" name="acts" value="" /> |
|
Line 271 $groupimportbutton
|
Line 315 $groupimportbutton
|
| </form> |
</form> |
| END |
END |
| |
|
| # output starting row to the indexed file/directory hierarchy |
# ----------------- output starting row to the indexed file/directory hierarchy |
| my $titleclr="#ddffff"; |
my $titleclr="#ddffff"; |
| $r->print("<table border=0><tr><td bgcolor=#eeeeee>\n"); |
$r->print("<table border=0><tr><td bgcolor=#eeeeee>\n"); |
| $r->print("<table border=0><tr>\n"); |
$r->print("<table border=0><tr>\n"); |
|
Line 290 END
|
Line 334 END
|
| if ($hash{'display_attrs_5'} == 1); |
if ($hash{'display_attrs_5'} == 1); |
| $r->print("</tr>"); |
$r->print("</tr>"); |
| |
|
| # read in what directories have previously been set to "open" |
# ----------------- read in what directories have previously been set to "open" |
| map { |
map { |
| if ($_ =~ /^diropen_status_/) { |
if ($_ =~ /^diropen_status_/) { |
| my $key = $_; |
my $key = $_; |
|
Line 328 END
|
Line 372 END
|
| $toplevel = $hash{'top.level'}; |
$toplevel = $hash{'top.level'}; |
| } |
} |
| |
|
| # if not at top level, provide an uplink arrow |
# -------------------------------- if not at top level, provide an uplink arrow |
| if ($toplevel ne "/res/"){ |
if ($toplevel ne "/res/"){ |
| my (@uri_com) = split(/\//,$uri); |
my (@uri_com) = split(/\//,$uri); |
| pop @uri_com; |
pop @uri_com; |
|
Line 338 END
|
Line 382 END
|
| $indent = 1; |
$indent = 1; |
| } |
} |
| |
|
| # recursively go through all the directories and output as appropriate |
# -------- recursively go through all the directories and output as appropriate |
| &scanDir ($r,$toplevel,$indent,\%hash); |
&scanDir ($r,$toplevel,$indent,\%hash); |
| |
|
| # information useful for group import |
# ---------------------------- embed hidden information useful for group import |
| $r->print("<form name='fnum'>"); |
$r->print("<form name='fnum'>"); |
| $r->print("<input type='hidden' name='fnum' value='$fnum'></form>"); |
$r->print("<input type='hidden' name='fnum' value='$fnum'></form>"); |
| |
|
| # end the tables |
# -------------------------------------------------------------- end the tables |
| $r->print("</table>"); |
$r->print("</table>"); |
| $r->print("</td></tr></table>"); |
$r->print("</td></tr></table>"); |
| |
|
| # end the output and return |
# --------------------------------------------------- end the output and return |
| $r->print("</body></html>\n"); |
$r->print("</body></html>\n"); |
| untie(%hash); |
untie(%hash); |
| } else { |
} else { |
|
Line 360 END
|
Line 404 END
|
| return OK; |
return OK; |
| } |
} |
| |
|
| |
|
| # ----------------------------------------------- recursive scan of a directory |
# ----------------------------------------------- recursive scan of a directory |
| sub scanDir { |
sub scanDir { |
| my ($r,$startdir,$indent,$hashref)=@_; |
my ($r,$startdir,$indent,$hashref)=@_; |
|
Line 373 sub scanDir {
|
Line 416 sub scanDir {
|
| foreach my $line (@list) { |
foreach my $line (@list) { |
| my ($strip,$dom,$foo,$testdir,$foo)=split(/\&/,$line,5); |
my ($strip,$dom,$foo,$testdir,$foo)=split(/\&/,$line,5); |
| next if $strip =~ /.*\.meta$/; |
next if $strip =~ /.*\.meta$/; |
| |
my (@fileparts) = split(/\./,$strip); |
| |
if ($hash{'display_attrs_6'} != 1) { |
| |
if (scalar(@fileparts) >= 3) { |
| |
my $fext = pop @fileparts; |
| |
my $ov = pop @fileparts; |
| |
my $fname = join ('.',@fileparts,$fext); |
| |
next if (grep /$fname/,@list and $ov =~ /\d+/); |
| |
} |
| |
} |
| |
|
| if ($dom eq "domain") { |
if ($dom eq "domain") { |
| $compuri = join('',$strip,"/"); # dom list has /res/<domain name> |
$compuri = join('',$strip,"/"); # dom list has /res/<domain name> |
| $curdir = $compuri; |
$curdir = $compuri; |
|
Line 426 sub match_ext {
|
Line 479 sub match_ext {
|
| my @fileext; |
my @fileext; |
| my $dirptr=16384; |
my $dirptr=16384; |
| |
|
| my $tabdir = $r->dir_config('lonTabDir'); |
|
| my $fn = $tabdir.'/filetypes.tab'; |
|
| if (-e $fn) { |
|
| my $FH=Apache::File->new($fn); |
|
| my @content=<$FH>; |
|
| foreach my $line (@content) { |
|
| (my $ext,my $foo) = split /\s+/,$line; |
|
| push @fileext,$ext; |
|
| } |
|
| } |
|
| foreach my $line (@packlist) { |
foreach my $line (@packlist) { |
| chomp $line; |
chomp $line; |
| $line =~ s/^\/home\/httpd\/html//; |
$line =~ s/^\/home\/httpd\/html//; |
|
Line 446 sub match_ext {
|
Line 489 sub match_ext {
|
| my $fext = pop(@filecom); |
my $fext = pop(@filecom); |
| my $fnptr = $unpackline[3]&$dirptr; |
my $fnptr = $unpackline[3]&$dirptr; |
| if ($fnptr == 0 and $unpackline[3] ne "") { |
if ($fnptr == 0 and $unpackline[3] ne "") { |
| foreach my $nextline (@fileext) { |
my $embstyle = &Apache::lonnet::fileembstyle($fext); |
| push @trimlist,$line if $nextline eq $fext; |
push @trimlist,$line if (defined($embstyle) && |
| } |
$embstyle ne 'hdn' ); |
| } else { |
} else { |
| push @trimlist,$line; |
push @trimlist,$line; |
| } |
} |
|
Line 458 sub match_ext {
|
Line 501 sub match_ext {
|
| } |
} |
| |
|
| # ------------------------------- displays one line in appropriate table format |
# ------------------------------- displays one line in appropriate table format |
| sub display_line{ |
sub display_line { |
| my ($r,$diropen,$line,$indent,$startdir,$hashref,@list)=@_; |
my ($r,$diropen,$line,$indent,$startdir,$hashref,@list)=@_; |
| my (@pathfn, $fndir, $fnptr); |
my (@pathfn, $fndir, $fnptr); |
| my $dirptr=16384; |
my $dirptr=16384; |
|
Line 548 sub display_line{
|
Line 591 sub display_line{
|
| # display file |
# display file |
| if ($fnptr == 0 and $filecom[3] ne "") { |
if ($fnptr == 0 and $filecom[3] ne "") { |
| my @file_ext = split (/\./,$listname); |
my @file_ext = split (/\./,$listname); |
| my $curfext = $file_ext[scalar(@file_ext)-1]; |
my $curfext = $file_ext[-1]; |
| |
# Set the icon for the file |
| |
my $iconname = "unknownfiletype.gif"; |
| |
my $embstyle = &Apache::lonnet::fileembstyle($curfext); |
| |
# The unless conditional that follows is a bit of overkill |
| |
$iconname = $curfext.".gif" unless |
| |
(!defined($embstyle) || $embstyle eq 'hdn'); |
| |
# |
| my $filelink = $startdir.$filecom[0]; |
my $filelink = $startdir.$filecom[0]; |
| $r->print("<tr><td nowrap valign='bottom' bgcolor=$fileclr>"); |
$r->print("<tr><td nowrap valign='bottom' bgcolor=$fileclr>"); |
| my $metafile = grep /^$filecom[0]\.meta\&/, @list; |
my $metafile = grep /^$filecom[0]\.meta\&/, @list; |
|
Line 602 sub display_line{
|
Line 652 sub display_line{
|
| ".gif border='0' />\n") if $rem > 0; |
".gif border='0' />\n") if $rem > 0; |
| } |
} |
| |
|
| $r->print("<img src=$iconpath$curfext.gif border='0' />\n"); |
$r->print("<img src=$iconpath$iconname border='0' />\n"); |
| $r->print (" <a href=\"javascript:openWindow('".$filelink. |
$r->print (" <a href=\"javascript:openWindow('".$filelink. |
| "', 'metadatafile', '450', '500', 'no', 'yes')\";". |
"', 'metadatafile', '450', '500', 'no', 'yes')\";". |
| " TARGET=_self>$listname</a> "); |
" TARGET=_self>$listname</a> "); |
|
Line 727 sub start_fresh_session {
|
Line 777 sub start_fresh_session {
|
| } |
} |
| |
|
| 1; |
1; |
| __END__ |
|
| |
=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 * |
| |
|
| |
get_unprocessed_cgi - grab unprocessed CGI variables that may have been |
| |
appended to URL |
| |
|
| |
=item * |
| |
|
| |
start_fresh_session - settings whenever the user causes the indexer window |
| |
to be launched |
| |
|
| |
=back |
| |
|
| |
=cut |
![[BACK]](/icons/back.gif){kind=icon}
Return to lonindexer.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface