--- loncom/publisher/lonpubdir.pm 2001/12/15 20:48:47 1.17
+++ loncom/publisher/lonpubdir.pm 2019/08/11 15:15:43 1.172
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
-# (Publication Handler
+# Authoring Space Directory Lister
#
-# $Id: lonpubdir.pm,v 1.17 2001/12/15 20:48:47 harris41 Exp $
+# $Id: lonpubdir.pm,v 1.172 2019/08/11 15:15:43 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,19 +25,6 @@
#
# http://www.lon-capa.org/
#
-#
-# (TeX Content Handler
-#
-# YEAR=2000
-# 05/29/00,05/30,10/11 Gerd Kortemeyer)
-#
-# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
-# YEAR=2001
-# 03/23 Guy Albertelli
-# 03/24,03/29 Gerd Kortemeyer)
-# 03/31,04/03,05/09,06/23,08/18,08/20 Gerd Kortemeyer
-# 12/15 Scott Harrison
-#
###
package Apache::lonpubdir;
@@ -46,181 +33,1159 @@ use strict;
use Apache::File;
use File::Copy;
use Apache::Constants qw(:common :http :methods);
-use Apache::loncacc;
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();
- }
-
- my $uname;
- my $udom;
-
- ($uname,$udom)=
- &Apache::loncacc::constructaccess(
- $fn,$r->dir_config('lonDefDomain'));
- unless (($uname) && ($udom)) {
- $r->log_reason($uname.' at '.$udom.
- ' trying to publish file '.$ENV{'form.filename'}.
- ' ('.$fn.') - not authorized',
- $r->filename);
- return HTTP_NOT_ACCEPTABLE;
- }
-
- $fn=~s/\/$//;
-
- 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 $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();
+ my $js = '';
+ $r->print(&Apache::loncommon::start_page('Authoring Space', $js).
+ '
'.
+ '
'.
+ &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.
+
+ my $cstr = 'author';
+ my ($crsauthor,$crstype);
+ if ($env{'request.course.id'}) {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ if ($thisdisfn =~ m{^/\Q$cdom/$cnum\E}) {
+ $crsauthor = 1;
+ $cstr = 'course';
+ $crstype = &Apache::loncommon::course_type();
+ }
+ }
+
+ my %bombs=&Apache::lonmsg::all_url_author_res_msg($uname,$udom);
+
+ my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
+ my $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,
+ "$londocroot/priv/$udom/$uname"); # expressed in kB
+ my $disk_quota = &Apache::loncommon::get_user_quota($uname,$udom,
+ $cstr,$crstype); # expressed in MB
+
+ # Put out the start of page.
+ &startpage($r, $uname, $udom, $thisdisfn, $current_disk_usage, $disk_quota, $crsauthor);
+
+ 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;
+ }
+
+ # Put out actions for directory, browse/upload + new file page.
+ &dircontrols($r,$uname,$udom,$thisdisfn, $current_disk_usage, $disk_quota);
+ &resourceactions($r,$uname,$udom,$thisdisfn); # Put out form used for printing/deletion etc.
- $r->content_type('text/html');
- $r->send_http_header;
+ my $numdir = 0;
+ my $numres = 0;
+
+ 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}) ?
+ '
');
+# Output the header of the page. This includes:
+# - The HTML header
+# - The H1/H3 stuff which includes the directory.
+#
+# startpage($r, $uame, $udom, $thisdisfn, $current_disk_usage, $disk_quota);
+# $r - The apache request object.
+# $uname - User name.
+# $udom - Domain name the user is logged in under.
+# $thisdisfn - Displayable version of the filename.
+# $current_disk_usage - User's current disk usage (in kB).
+# $disk_quota - Disk quota for user's authoring space (in MB).
+# $crstype - Course type, if this is for "course author"
+
+sub startpage {
+ my ($r, $uname, $udom, $thisdisfn, $current_disk_usage, $disk_quota, $crsauthor) = @_;
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+
+ my $formaction='/priv'.$thisdisfn.'/';
+ $formaction=~s|/+|/|g;
+
+ my $title;
+ if ($crsauthor) {
+ $title = 'Course Authoring';
+ } else {
+ $title = 'Authoring Space';
+ &Apache::lonhtmlcommon::store_recent('construct',$formaction,$formaction);
+ }
+
+ &Apache::lonhtmlcommon::clear_breadcrumbs();
+ &Apache::lonhtmlcommon::add_breadcrumb({
+ 'text' => $title,
+ 'href' => &Apache::loncommon::authorspace($formaction),
+ });
+ # breadcrumbs (and tools) will be created
+ # in start_page->bodytag->innerregister
+
+ $env{'request.noversionuri'}=$formaction;
+ my $js = '';
+ $r->print(&Apache::loncommon::start_page($title, $js));
+
+ $disk_quota = 1024 * $disk_quota; # convert from MB to kB
+
+ $r->print(&Apache::loncommon::head_subbox(
+ '
'.
+ &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;
+}
+
+sub prepareJsonTranslations {
+ my $json =
+ '{"translations":{'.
+ '"edit":"'.&mt('Edit').'",'.
+ '"editxml":"'.&mt('EditXML').'",'.
+ '"editmeta":"'.&mt('Edit Metadata').'",'.
+ '"obsolete":"'.&mt('Obsolete').'",'.
+ '"modified":"'.&mt('Modified').'",'.
+ '"published":"'.&mt('Published').'",'.
+ '"unpublished":"'.&mt('Unpublished').'",'.
+ '"diff":"'.&mt('Diff').'",'.
+ '"retrieve":"'.&mt('Retrieve').'",'.
+ '"directory":"'.&mt('Directory').'",'.
+ '"results":"'.&mt('Show results for keyword:').'"'.
+ '}}';
+}
+
+# gathers all files in the working directory except the ones that are already on screen
+sub prepareJsonData {
+ my ($uname, $udom, $pathToSkip) = @_;
+ my $path = "/home/httpd/html/priv/$udom/$uname/";
+
+ # maximum number of entries, to limit workload and required storage space
+ my $entries = 100;
+ my $firstfile = 1;
+ my $firstdir = 1;
+
+ my $json = '{"resources":[';
+ $json .= &prepareJsonData_rec($path, \$entries, \$firstfile, \$firstdir, $pathToSkip);
+ $json .= ']}';
+
+ # if the json string is invalid the whole search breaks.
+ # so we want to make sure that the string is valid in any case.
+ $json =~ s/,\s*,/,/g;
+ $json =~ s/\}\s*\{/\},\{/g;
+ $json =~ s/\}\s*,\s*\]/\}\]/g;
+ return $json;
+}
+
+# recursive part of json file gathering
+sub prepareJsonData_rec {
+ my ($path, $entries, $firstfile, $firstdir, $pathToSkip) = @_;
+ my $json;
+ my $skipThisFolder = $path =~ m/$pathToSkip\/$/?1:0;
+
+ my @dirs;
+ my @resources;
+ my @ignored = qw(bak log meta save . ..);
+
+# Phase 1: Gathering
+ opendir(DIR,$path);
+ my @files=sort {uc($a) cmp uc($b)} (readdir(DIR));
+ foreach my $filename (@files) {
+ next if ($filename eq '.DS_Store');
+
+ # gather all resources
+ if ($filename !~ /\./) {
+ # its a folder
+ push(@dirs, $filename);
+ } else {
+ # only push files we dont want to ignore
+ next if ($skipThisFolder);
+
+ $filename =~ /\.(\w+?)$/;
+ unless (grep /$1/, @ignored) {
+ push(@resources, $filename);
+ }
+ }
+ }
+ closedir(DIR);
+ # nothing to do here if both lists are empty
+ return unless ( @dirs || @resources );
+
+# Phase 2: Working
+ $$firstfile = 1;
+
+ foreach (@dirs) {
+ $json .= '{"name":"'.$_.'",'.
+ '"path":"'.$path.$_.'",'.
+ '"title":"",'.
+ '"status":"",'.
+ '"cmtime":""},';
+ }
+
+ foreach (@resources) {
+ last if ($$entries < 1);
+ my $title = &getTitleString($path.$_);
+
+ my $privpath = $path.$_;
+ my $respath = $privpath;
+ $respath =~ s/httpd\/html\/priv\//httpd\/html\/res\//;
+
+ my $cmtime = (stat($privpath))[9];
+ my $rmtime = (stat($respath))[9];
+
+ unless ($$firstfile) { $json .= ','; } else { $$firstfile = 0; }
+
+ my $status = 'unpublished';
+
+ # if a resource is published, the published version (/html/res/filepath) gets its own modification time
+ # this is newer or equal then the version in your authoring space (/html/priv/filepath)
+ if ($rmtime >= $cmtime) {
+ # obsolete
+ if (&Apache::lonnet::metadata($respath, 'obsolete')) {
+ $status = 'obsolete';
+ }else{
+ $status = 'published';
+ }
+ } else {
+ $status = 'modified';
+ }
+
+ $json .= '{"name":"'.$_.'",'.
+ '"path":"'.$path.'",'.
+ '"title":"'.$title.'",'.
+ '"status":"'.$status.'",'.
+ '"cmtime":"'.&Apache::lonlocal::locallocaltime($cmtime).'"}';
+ $$entries--;
+ }
+
+ foreach(@dirs) {
+ next if ($$entries < 1);
+ $json .= ',';
+ $json .= &prepareJsonData_rec
+ ($path.$_.'/', $entries, $firstfile, $firstdir, $pathToSkip);
+ }
+ return $json;
+}
1;
__END__
+
=head1 NAME
-Apache::lonpubdir - Publication Handler for Directories
+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
-
+
+ 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 enables cookie based authentication and is used
-to control access for many different LON-CAPA URIs.
-
-Whenever the client sends the cookie back to the server,
-this cookie is handled by either lonacc.pm or loncacc.pm
-(see srm.conf for what is invoked when). If
-the cookie is missing or invalid, the user is re-challenged
-for login information.
+This module publishes a directory of files.
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
@@ -245,4 +1210,47 @@ run through list of files and attempt to
=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