--- loncom/publisher/lonpubdir.pm 2001/04/03 10:48:08 1.2
+++ loncom/publisher/lonpubdir.pm 2016/09/14 16:48:02 1.160.2.2
@@ -1,16 +1,31 @@
# The LearningOnline Network with CAPA
+# Authoring Space Directory Lister
#
-# (Publication Handler
-#
-# (TeX Content Handler
+# $Id: lonpubdir.pm,v 1.160.2.2 2016/09/14 16:48:02 raeburn Exp $
#
-# 05/29/00,05/30,10/11 Gerd Kortemeyer)
+# Copyright Michigan State University Board of Trustees
#
-# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
-# 03/23 Guy Albertelli
-# 03/24,03/29 Gerd Kortemeyer)
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
-# 03/31,04/03 Gerd Kortemeyer
+# 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;
@@ -18,92 +33,1020 @@ 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 qw(:DEFAULT :match);
sub handler {
- my $r=shift;
+ my $r=shift;
- my $fn;
+ # Validate access to the construction space and get username:domain.
- if ($ENV{'form.filename'}) {
- $fn=$ENV{'form.filename'};
- $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
- $fn=~s/\/[^\/]+$//;
- } else {
- $fn=$r->filename();
- }
-
-
- unless ($fn) {
- $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
- ' trying to list empty directory', $r->filename);
- return HTTP_NOT_FOUND;
- }
+ my ($uname,$udom)=&Apache::lonnet::constructaccess($r->uri);
+ unless (($uname) && ($udom)) {
+ return HTTP_NOT_ACCEPTABLE;
+ }
# ----------------------------------------------------------- Start page output
- my $uname=$ENV{'user.name'};
- my $udom=$ENV{'user.domain'};
+ my $fn=$r->filename;
+ $fn=~s/\/$//;
+ my $thisdisfn=$fn;
+
+ my $docroot=$r->dir_config('lonDocRoot'); # Apache londocument root.
+ if ($thisdisfn eq "$docroot/priv/$udom") {
+ if ((-d "/home/$uname/public_html/") && (!-e "$docroot/priv/$udom/$uname")) {
+ my ($version) = ($r->dir_config('lonVersion') =~ /^\'?(\d+\.\d+)\./);
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+
+ &Apache::lonhtmlcommon::clear_breadcrumbs();
+ $r->print(&Apache::loncommon::start_page('Authoring Space').
+ '
'.
+ '
'.
+ &mt('Your Authoring Space is currently in the location used by LON-CAPA version 2.10 and older, but your domain is using a newer LON-CAPA version ([_1]).',$version).'
'.
+ '
'.
+ &mt('Please ask your Domain Coordinator to move your Authoring Space to the new location.').
+ '
'.
+ '
'.
+ &Apache::loncommon::end_page());
+ return OK;
+ }
+ }
+ $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.
- $r->content_type('text/html');
- $r->send_http_header;
+ my %bombs=&Apache::lonmsg::all_url_author_res_msg($uname,$udom);
- $r->print('LON-CAPA Construction Space');
+ &startpage($r, $uname, $udom, $thisdisfn); # Put out the start of page.
- $r->print(
- '');
+ if (!-d $fn) {
+ if (-e $fn) {
+ $r->print('
'.&mt('Requested item is a file not a directory.').'
');
+ } else {
+ $r->print('
'.&mt('The requested subdirectory does not exist.').'
');
+ $r->print(&Apache::loncommon::end_page());
+ return OK;
+ }
- my $thisdisfn=$fn;
- $thisdisfn=~s/^\/home\/$uname\/public_html//;
+ &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;
- $r->print('
Construction Space Directory '.$thisdisfn.'
');
+ if ((@files == 0) && ($thisdisfn =~ m{^/$match_domain/$match_username})) {
+ if ($thisdisfn =~ m{^/$match_domain/$match_username$}) {
+ $r->print('
'.&mt('This Authoring Space is currently empty.').'
');
+ } else {
+ $r->print('
'.&mt('This subdirectory is currently empty.').'
');
+ }
+ $r->print(&Apache::loncommon::end_page());
+ return OK;
+ }
+
+ # Retrieving value for "sortby" and "sortorder" from QUERY_STRING
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['sortby','sortorder']);
+
+ # Sort by name as default, not reversed
+ if (! exists($env{'form.sortby'})) { $env{'form.sortby'} = 'filename' }
+ if (! exists($env{'form.sortorder'})) { $env{'form.sortorder'} = '' }
+ my $sortby = $env{'form.sortby'};
+ my $sortorder = $env{'form.sortorder'};
+
+ # Order in which columns are displayed from left to right
+ my @order = ('filetype','actions','filename','title',
+ 'pubstatus','cmtime','size');
+
+ # Up and down arrows to indicate sort order
+ my @arrows = (' ▲',' ▼','');
+
+ # Default sort order and column title
+ my %columns = (
+ filetype => {
+ order => 'ascending',
+ text => &mt('Type'),
+ },
+ actions => {
+ # Not sortable
+ text => &mt('Actions'),
+ },
+ filename => {
+ order => 'ascending',
+ text => &mt('Name'),
+ },
+ title => {
+ order => 'ascending',
+ text => &mt('Title'),
+ },
+ pubstatus => {
+ order => 'ascending',
+ text => &mt('Status'),
+ colspan => '2',
+ },
+ cmtime => {
+ order => 'descending',
+ text => &mt('Last Modified'),
+ },
+ size => {
+ order => 'ascending',
+ text => &mt('Size').' (kB)',
+ },
+ );
+
+ # Print column headers
+ my $output = '';
+ foreach my $key (@order) {
+ my $idx;
+ # Append an up or down arrow to sorted column
+ if ($sortby eq $key) {
+ $idx = ($columns{$key}{order} eq 'ascending') ? 0:1;
+ if ($sortorder eq 'rev') { $idx ++; }
+ $idx = $idx%2;
+ } else { $idx = 2; } # No arrow if column is not sorted
+ $output .= (($columns{$key}{order}) ?
+ '
'.
+ &Apache::loncommon::end_data_table_row()
+ );
+ return;
}
+
+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 ++;
+ }
+ }
+ closedir(DIR);
+ 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