--- loncom/publisher/lonpublisher.pm 2008/06/30 18:10:24 1.239
+++ loncom/publisher/lonpublisher.pm 2013/12/01 21:29:15 1.287
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.239 2008/06/30 18:10:24 bisitz Exp $
+# $Id: lonpublisher.pm,v 1.287 2013/12/01 21:29:15 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -66,10 +66,10 @@ invocation by F:
=head1 OVERVIEW
-Authors can only write-access the C~authorname/> space. They can
-copy resources into the resource area through the publication step,
-and move them back through a recover step. Authors do not have direct
-write-access to their resource space.
+Authors can only write-access the C space.
+They can copy resources into the resource area through the
+publication step, and move them back through a recover step.
+Authors do not have direct write-access to their resource space.
During the publication step, several events will be
triggered. Metadata is gathered, where a wizard manages default
@@ -102,8 +102,6 @@ to publication space.
Many of the undocumented subroutines implement various magical
parsing shortcuts.
-=over 4
-
=cut
######################################################################
@@ -118,11 +116,13 @@ use Apache::File;
use File::Copy;
use Apache::Constants qw(:common :http :methods);
use HTML::LCParser;
+use HTML::Entities;
+use Encode::Encoder;
use Apache::lonxml;
-use Apache::loncacc;
use DBI;
use Apache::lonnet;
use Apache::loncommon();
+use Apache::lonhtmlcommon;
use Apache::lonmysql;
use Apache::lonlocal;
use Apache::loncfile;
@@ -147,6 +147,8 @@ my $lock;
=pod
+=over 4
+
=item B
Evaluates a string that contains metadata. This subroutine
@@ -263,8 +265,9 @@ sub metaread {
my ($logfile,$fn,$prefix)=@_;
unless (-e $fn) {
print($logfile 'No file '.$fn."\n");
- return ' '.&mt('No file').':'.
- &Apache::loncfile::display($fn).'';
+ return '
');
} else {
#$r->print(''.&mt('ok').'');
}
@@ -935,7 +992,7 @@ backup copies, performs any automatic pr
especially for rat and ssi files),
Returns a 2 element array, the first is the string to be shown to the
-user, the second is an error code, either 1 (an error occured) or 0
+user, the second is an error code, either 1 (an error occurred) or 0
(no error occurred)
I
@@ -978,32 +1035,37 @@ sub publish {
if ($error) { return ($outstring,$error); }
# ------------------------------------------------------------ Construct Allows
- $scrout.='
'.&mt('Dependencies').'
';
+ my $outdep=''; # Collect dependencies output data
my $allowstr='';
foreach my $thisdep (sort(keys(%allow))) {
if ($thisdep !~ /[^\s]/) { next; }
if ($thisdep =~/\$/) {
- $scrout.=' '
+ $outdep.='
'
.&mt('The resource depends on another resource with variable filename, i.e., [_1].',''.$thisdep.'').' '
.&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<allow>')
- .' ';
+ ."
';
if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {
- $scrout.='';
+ $outdep.='';
}
- $scrout.=''.$thisdep.'';
+ $outdep.=''.$thisdep.'';
if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {
- $scrout.='';
+ $outdep.='';
if (
&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
$thisdep.'.meta') eq '-1') {
- $scrout.= ' - '.&mt('Currently not available').
+ $outdep.= ' - '.&mt('Currently not available').
'';
} else {
+#
+# Store the fact that the dependency has been used by the target file
+# Unfortunately, usage is erroneously named sequsage in lonmeta.pm
+# The translation happens in lonmetadata.pm
+#
my %temphash=(&Apache::lonnet::declutter($target).'___'.
&Apache::lonnet::declutter($thisdep).'___usage'
=> time);
@@ -1014,6 +1076,12 @@ sub publish {
}
}
}
+ $outdep.='
';
+ }
+
+ if ($outdep) {
+ $scrout.='
'.&mt('Dependencies').'
'
+ .$outdep
}
$outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;
@@ -1043,7 +1111,7 @@ sub publish {
my %oldparmstores=();
unless ($batch) {
- $scrout.='
';
}
@@ -1061,16 +1129,16 @@ sub publish {
# ------------------------------------------------ Check out directory hierachy
my $thisdisfn=$source;
- $thisdisfn=~s/^\/home\/\Q$cuname\E\///;
- my @urlparts=split(/\//,$thisdisfn);
+ $thisdisfn=~s/^\Q$docroot\E\/priv\/\Q$cudom\E\/\Q$cuname\E\///;
+ my @urlparts=('.',split(/\//,$thisdisfn));
$#urlparts--;
- my $currentpath='/home/'.$cuname.'/';
+ my $currentpath=$docroot.'/priv/'.$cudom.'/'.$cuname.'/';
my $prefix='../'x($#urlparts);
- foreach (@urlparts) {
- $currentpath.=$_.'/';
+ foreach my $subdir (@urlparts) {
+ $currentpath.=$subdir.'/';
$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
$prefix=~s|^\.\./||;
}
@@ -1102,7 +1170,7 @@ sub publish {
# ------------------------------------------------------------- Save some stuff
my %savemeta=();
foreach ('title') {
- $savemeta{$_}=$metadatafields{$_};
+ if ($metadatafields{$_}) { $savemeta{$_}=$metadatafields{$_}; }
}
# ------------------------------------------ See if anything new in file itself
@@ -1147,15 +1215,16 @@ sub publish {
}
}
if ($chparms) {
- $scrout.='
'.&mt('Obsolete parameters or saved values').': '.
- $chparms.'
'.&mt('Warning!').
- '
'.
- &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'
';
+ $scrout.='
'.&mt('Obsolete parameters or saved values').': '
+ .$chparms.'
'
+ .'
'.&mt('Warning!').' '
+ .&mt('If this resource is in active use, student performance data from the previous version may become inaccessible.')
+ .'
';
}
if ($metadatafields{'copyright'} eq 'priv') {
- $scrout.='
'.&mt('Warning!').
- '
'.
- &mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.').'
';
+ $scrout.='
'.&mt('Warning!').' '
+ .&mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.')
+ .'
';
}
# ------------------------------------------------------- Now have all metadata
@@ -1167,17 +1236,22 @@ sub publish {
$textonly=~s/\';
- $r->print(&Apache::loncommon::start_page('Resource Publication',$js));
-
-
- my $thisfn=$fn;
-
- my $thistarget=$thisfn;
-
- $thistarget=~s/^\/home/$targetdir/;
- $thistarget=~s/\/public\_html//;
-
- my $thisdistarget=$thistarget;
- $thisdistarget=~s/^\Q$docroot\E//;
-
- my $thisdisfn=$thisfn;
- $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;
+ $r->print(&Apache::loncommon::start_page('Resource Publication',$js)
+ .&Apache::lonhtmlcommon::breadcrumbs()
+ .&Apache::loncommon::head_subbox(
+ &Apache::loncommon::CSTR_pageheader($docroot.$fn))
+ );
+
+ my $thisdisfn=&HTML::Entities::encode($fn,'<>&"');
+ my $thistarget=$fn;
+ $thistarget=~s/^\/priv\//\/res\//;
+ my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"');
if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory
- &publishdirectory($r,$fn,$thisdisfn);
- $r->print(''.&mt('Return to Directory').'');
-
-
+ &publishdirectory($r,$docroot.$fn,$thisdisfn);
+ $r->print(''.&mt('Return to Directory').'');
} else {
# ---------------------- Evaluate individual file, and then output information.
- $thisfn=~/\.(\w+)$/;
+ $fn=~/\.(\w+)$/;
my $thistype=$1;
my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
if ($thistype eq 'page') { $thisembstyle = 'rat'; }
- $r->print('