# The LearningOnline Network with CAPA
# Authoring Space Directory Lister
#
# $Id: lonpubdir.pm,v 1.145 2013/06/04 22:20:16 raeburn 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/
#
###
package Apache::lonpubdir;
use strict;
use Apache::File;
use File::Copy;
use Apache::Constants qw(:common :http :methods);
use Apache::loncommon();
use Apache::lonhtmlcommon();
use Apache::londiff();
use Apache::lonlocal;
use Apache::lonmsg;
use Apache::lonmenu;
use Apache::lonnet;
use LONCAPA;
sub handler {
my $r=shift;
# Validate access to the construction space and get username@domain.
my $uname;
my $udom;
($uname,$udom)=&Apache::lonnet::constructaccess($r->uri);
unless (($uname) && ($udom)) {
return HTTP_NOT_ACCEPTABLE;
}
# ----------------------------------------------------------- Start page output
my $fn=$r->filename;
$fn=~s/\/$//;
my $thisdisfn=$fn;
my $docroot=$r->dir_config('lonDocRoot'); # Apache londocument root.
$thisdisfn=~s/^\Q$docroot\E\/priv//;
my $resdir=$docroot.'/res'.$thisdisfn; # Resource directory
my $targetdir='/res'.$thisdisfn; # Publication target directory.
my $linkdir='/priv'.$thisdisfn; # Full URL name of constr space.
my %bombs=&Apache::lonmsg::all_url_author_res_msg($uname,$udom);
&startpage($r, $uname, $udom, $thisdisfn); # Put out the start of page.
&dircontrols($r,$uname,$udom,$thisdisfn); # Put out actions for directory,
# browse/upload + new file page.
&resourceactions($r,$uname,$udom,$thisdisfn); #Put out form used for printing/deletion etc.
my $numdir = 0;
my $numres = 0;
# Start off the directory table.
$r->print(&Apache::loncommon::start_data_table()
.&Apache::loncommon::start_data_table_header_row()
.'
'.&mt('Type').'
'
.'
'.&mt('Actions').'
'
.'
'.&mt('Name').'
'
.'
'.&mt('Title').'
'
.'
'.&mt('Status').'
'
.'
'.&mt('Last Modified').'
'
.&Apache::loncommon::end_data_table_header_row()
);
my $filename;
my $dirptr=16384; # Mask indicating a directory in stat.cmode.
opendir(DIR,$fn);
my @files=sort {uc($a) cmp uc($b)} (readdir(DIR));
foreach my $filename (@files) {
my ($cdev,$cino,$cmode,$cnlink,
$cuid,$cgid,$crdev,$csize,
$catime,$cmtime,$cctime,
$cblksize,$cblocks)=stat($fn.'/'.$filename);
my $extension='';
if ($filename=~/\.(\w+)$/) { $extension=$1; }
if ($cmode&$dirptr) {
&putdirectory($r, $thisdisfn, $linkdir, $filename, $cmtime,$targetdir,\%bombs,\$numdir);
} elsif (&Apache::loncommon::fileembstyle($extension) ne 'hdn') {
&putresource($r, $udom, $uname, $filename, $thisdisfn, $resdir,
$targetdir, $linkdir, $cmtime,\%bombs,\$numres);
} else {
# "hidden" extension and not a directory, so hide it away.
}
}
closedir(DIR);
$r->print(&Apache::loncommon::end_data_table()
.&Apache::loncommon::end_page()
);
return OK;
}
#
# Output the header of the page. This includes:
# - The HTML header
# - The H1/H3 stuff which includes the directory.
#
# startpage($r, $uame, $udom, $thisdisfn);
# $r - The apache request object.
# $uname - User name.
# $udom - Domain name the user is logged in under.
# $thisdisfn - Displayable version of the filename.
sub startpage {
my ($r, $uname, $udom, $thisdisfn) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $formaction='/priv'.$thisdisfn.'/';
$formaction=~s|/+|/|g;
&Apache::lonhtmlcommon::store_recent('construct',$formaction,$formaction);
&Apache::lonhtmlcommon::clear_breadcrumbs();
&Apache::lonhtmlcommon::add_breadcrumb({
'text' => 'Authoring Space',
'href' => &Apache::loncommon::authorspace($formaction),
});
# breadcrumbs (and tools) will be created
# in start_page->bodytag->innerregister
$env{'request.noversionuri'}=$formaction;
$r->print(&Apache::loncommon::start_page('Authoring Space',undef));
$r->print(&Apache::loncommon::head_subbox(
&Apache::loncommon::CSTR_pageheader()));
my $esc_thisdisfn = &Apache::loncommon::escape_single($thisdisfn);
my $doctitle = 'LON-CAPA '.&mt('Authoring Space');
my $newname = &mt('New Name');
my $pubdirscript=(<
top.document.title = '$esc_thisdisfn/ - $doctitle';
// Store directory location for menu bar to find
parent.lastknownpriv='/priv$esc_thisdisfn/';
// Confirmation dialogues
function currdiract(theform) {
if (theform.dirtask.options[theform.dirtask.selectedIndex].value == 'publish') {
document.publishdir.filename.value = theform.filename.value;
document.publishdir.submit();
}
if (theform.dirtask.options[theform.dirtask.selectedIndex].value == 'editmeta') {
top.location=theform.filename.value+'default.meta'
}
if (theform.dirtask.options[theform.dirtask.selectedIndex].value == 'printdir' ) {
document.printdir.postdata.value=theform.filename.value
document.printdir.submit();
}
if (theform.dirtask.options[theform.dirtask.selectedIndex].value == "delete") {
var delform = document.delresource
delform.filename.value = theform.filename.value
delform.submit()
}
}
function checkUpload(theform) {
if (theform.file == '') {
alert("Please use 'Browse..' to choose a file first, before uploading")
return
}
theform.submit()
}
function SetPubDir(theform,printForm) {
if (theform.diraction.options[theform.diraction.selectedIndex].value == "open") {
top.location = theform.openname.value
return
}
if (theform.diraction.options[theform.diraction.selectedIndex].value == "publish") {
theform.submit();
}
if (theform.diraction.options[theform.diraction.selectedIndex].value == "editmeta") {
top.location=theform.filename.value+'default.meta'
}
if (theform.diraction.options[theform.diraction.selectedIndex].value == "printdir") {
theform.action = '/adm/printout'
theform.postdata.value = theform.filename.value
theform.submit()
}
if (theform.diraction.options[theform.diraction.selectedIndex].value == "delete") {
var delform = document.delresource
delform.filename.value = theform.filename.value
delform.submit()
}
return
}
function SetResChoice(theform) {
var activity = theform.reschoice.options[theform.reschoice.selectedIndex].value
if ((activity == 'rename') || (activity == 'copy') || (activity == 'move')) {
changename(theform,activity)
}
if (activity == 'publish') {
var pubform = document.pubresource
pubform.filename.value = theform.filename.value
pubform.submit()
}
if (activity == 'delete') {
var delform = document.delresource
delform.filename.value = theform.filename.value
delform.submit()
}
if (activity == 'obsolete') {
var pubform = document.pubresource
pubform.filename.value = theform.filename.value
pubform.makeobsolete.value=1;
pubform.submit()
}
if (activity == 'print') {
document.printresource.postdata.value = theform.filename.value
document.printresource.submit()
}
if (activity == 'retrieve') {
document.retrieveres.filename.value = theform.filename.value
document.retrieveres.submit()
}
if (activity == 'cleanup') {
document.cleanup.filename.value = theform.filename.value
document.cleanup.submit()
}
return
}
function changename(theform,activity) {
var oldname=theform.dispfilename.value;
var newname=prompt('$newname',oldname);
if (newname == "" || !newname || newname == oldname) {
return
}
document.moveresource.newfilename.value = newname
document.moveresource.filename.value = theform.filename.value
document.moveresource.action.value = activity
document.moveresource.submit();
}
ENDPUBDIRSCRIPT
$r->print($pubdirscript);
}
sub dircontrols {
my ($r,$uname,$udom,$thisdisfn) = @_;
my %lt=&Apache::lonlocal::texthash(
cnpd => 'Cannot publish directory',
cnrd => 'Cannot retrieve directory',
mcdi => 'Must create new subdirectory inside a directory',
pubr => 'Publish this Resource',
pubd => 'Publish this Directory',
dedr => 'Delete Directory',
rtrv => 'Retrieve Old Version',
list => 'List Directory',
uplo => 'Upload file',
dele => 'Delete',
edit => 'Edit Metadata',
sela => 'Select Action',
nfil => 'New file',
nhtm => 'New HTML file',
nprb => 'New problem',
npag => 'New assembled page',
nseq => 'New assembled sequence',
ncrf => 'New custom rights file',
nsty => 'New style file',
nlib => 'New library file',
nbt => 'New bridgetask file',
nsub => 'New subdirectory',
renm => 'Rename current file to',
move => 'Move current file to',
copy => 'Copy current file to',
type => 'Type Name Here',
go => 'Go',
prnt => 'Print contents of directory',
crea => 'Create a new directory or LON-CAPA document',
acti => 'Actions for current directory',
updc => 'Upload a new document',
pick => 'Please select an action to perform using the new filename',
);
my $mytype = $lt{'type'}; # avoid conflict with " and ' in javascript
$r->print(<
END
}
sub resourceactions {
my ($r,$uname,$udom,$thisdisfn) = @_;
$r->print(<
END
}
#
# Get the title string or "[untitled]" if the file has no title metadata:
# Without the latter substitution, it's impossible to examine metadata for
# untitled resources. Resources may be legitimately untitled, to prevent
# searches from locating them.
#
# $str = getTitleString($fullname);
# $fullname - Fully qualified filename to check.
#
sub getTitleString {
my $fullname = shift;
my $title = &Apache::lonnet::metadata($fullname, 'title');
unless ($title) {
$title = "[".&mt('untitled')."]";
}
return $title;
}
sub getCopyRightString {
my $fullname = shift;
return &Apache::lonnet::metadata($fullname, 'copyright');
}
sub getSourceRightString {
my $fullname = shift;
return &Apache::lonnet::metadata($fullname, 'sourceavail');
}
#
# Put out a directory table row:
# putdirectory(r, base, here, dirname, modtime, targetdir, bombs, numdir)
# r - Apache request object.
# reqfile - File in request.
# here - Where we are in directory tree.
# dirname - Name of directory special file.
# modtime - Encoded modification time.
# targetdir - Publication target directory.
# bombs - Reference to hash of URLs with runtime error messages.
# numdir - Reference to scalar used to track number of sub-directories
# in directory (used in form name for each "actions" dropdown).
#
sub putdirectory {
my ($r, $reqfile, $here, $dirname, $modtime, $targetdir, $bombs, $numdir) = @_;
# construct the display filename: the directory name unless ..:
my $actionitem;
my $disfilename = $dirname;
# Don't display directory itself, and there is no way up from root directory
unless ((($dirname eq '..') && ($reqfile=~/^\/[^\/]+\/[^\/]+$/)) || ($dirname eq '.')) {
my $kaputt=0;
if (ref($bombs) eq 'HASH') {
foreach my $key (keys(%{$bombs})) {
my $currentdir = &Apache::lonnet::declutter("$targetdir/$disfilename");
if (($key) =~ m{^\Q$currentdir\E/}) { $kaputt=1; last; }
}
}
#
# Get the metadata from that directory's default.meta to display titles
#
%Apache::lonpublisher::metadatafields=();
%Apache::lonpublisher::metadatakeys=();
&Apache::lonpublisher::metaeval(
&Apache::lonnet::getfile($r->dir_config('lonDocRoot').$here.'/'.$dirname.'/default.meta')
);
if ($dirname eq '..') {
$actionitem = &mt('Go to ...');
$disfilename = ''.&mt('Parent Directory').'';
} else {
$actionitem =
'';
$$numdir ++;
}
$r->print('
'.
&Apache::loncommon::end_data_table_row()
);
return OK;
}
sub create_pubselect {
my ($r,$pub_select,$udom,$uname,$thisdisfn,$filename,$resdir,$pubstatus,$publish_button,$numres) = @_;
$$pub_select = '
';
$$numres ++;
}
sub check_for_versions {
my ($r,$fn,$udom,$uname) = @_;
my $versions = 0;
my $docroot=$r->dir_config('lonDocRoot');
my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn;
my $resdir=$resfn;
$resdir=~s/\/[^\/]+$/\//;
$fn=~/\/([^\/]+)\.(\w+)$/;
my $main=$1;
my $suffix=$2;
opendir(DIR,$resdir);
while (my $filename=readdir(DIR)) {
if ($filename=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/) {
$versions ++;
}
}
return $versions;
}
1;
__END__
=head1 NAME
Apache::lonpubdir - Authoring space directory lister
=head1 SYNOPSIS
Invoked (for various locations) by /etc/httpd/conf/srm.conf:
PerlAccessHandler Apache::loncacc
SetHandler perl-script
PerlHandler Apache::lonpubdir
ErrorDocument 403 /adm/login
ErrorDocument 404 /adm/notfound.html
ErrorDocument 406 /adm/unauthorized.html
ErrorDocument 500 /adm/errorhandler
PerlAccessHandler Apache::lonacc
SetHandler perl-script
PerlHandler Apache::lonpubdir
ErrorDocument 403 /adm/login
ErrorDocument 404 /adm/notfound.html
ErrorDocument 406 /adm/unauthorized.html
ErrorDocument 500 /adm/errorhandler
=head1 INTRODUCTION
This module publishes a directory of files.
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
=head1 HANDLER SUBROUTINE
This routine is called by Apache and mod_perl.
=over 4
=item *
read in information
=item *
start page output
=item *
run through list of files and attempt to publish unhidden files
=back
=head1 SUBROUTINES:
=over
=item startpage($r, $uame, $udom, $thisdisfn)
Output the header of the page. This includes:
- The HTML header
- The H1/H3 stuff which includes the directory.
startpage($r, $uame, $udom, $thisdisfn);
$r - The apache request object.
$uname - User name.
$udom - Domain name the user is logged in under.
$thisdisfn - Displayable version of the filename.
=item getTitleString($fullname)
Get the title string or "[untitled]" if the file has no title metadata:
Without the latter substitution, it's impossible to examine metadata for
untitled resources. Resources may be legitimately untitled, to prevent
searches from locating them.
$str = getTitleString($fullname);
$fullname - Fully qualified filename to check.
=item putdirectory($r, $base, $here, $dirname, $modtime, $targetdir, $bombs,
$numdir)
Put out a directory table row:
$r - Apache request object.
$reqfile - File in request.
$here - Where we are in directory tree.
$dirname - Name of directory special file.
$modtime - Encoded modification time.
targetdir - Publication target directory.
bombs - Reference to hash of URLs with runtime error messages.
numdir - Reference to scalar used to track number of sub-directories
in directory (used in form name for each "actions" dropdown).
=back
=cut
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.