--- loncom/publisher/lonpublisher.pm 2008/05/12 23:47:49 1.234
+++ loncom/publisher/lonpublisher.pm 2014/12/12 18:27:34 1.294
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.234 2008/05/12 23:47:49 www Exp $
+# $Id: lonpublisher.pm,v 1.294 2014/12/12 18:27:34 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
@@ -198,12 +200,12 @@ sub metaeval {
if (defined($token->[2]->{'name'})) {
$unikey.="\0".$token->[2]->{'name'};
}
- foreach (@{$token->[3]}) {
- $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
+ foreach my $item (@{$token->[3]}) {
+ $metadatafields{$unikey.'.'.$item}=$token->[2]->{$item};
if ($metadatakeys{$unikey}) {
- $metadatakeys{$unikey}.=','.$_;
+ $metadatakeys{$unikey}.=','.$item;
} else {
- $metadatakeys{$unikey}=$_;
+ $metadatakeys{$unikey}=$item;
}
}
my $newentry=$parser->get_text('/'.$entry);
@@ -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').'');
}
@@ -921,7 +1039,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
@@ -954,7 +1072,7 @@ sub publish {
print $logfile "Copied original file to ".$copyfile."\n";
} else {
print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
- return ("Failed to write backup copy, $!,FAIL",1);
+ return ("".&mt("Failed to write backup copy, [_1], FAIL",$1)."",1);
}
# ------------------------------------------------------------- IDs and indices
@@ -964,32 +1082,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);
@@ -1000,6 +1123,12 @@ sub publish {
}
}
}
+ $outdep.='
';
+ }
+
+ if ($outdep) {
+ $scrout.='
'.&mt('Dependencies').'
'
+ .$outdep
}
$outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;
@@ -1029,8 +1158,8 @@ sub publish {
my %oldparmstores=();
unless ($batch) {
- $scrout.='
';
}
@@ -1047,16 +1176,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|^\.\./||;
}
@@ -1068,9 +1197,9 @@ sub publish {
# ------------------- Clear out parameters and stores (there should not be any)
- foreach (keys %metadatafields) {
- if (($_=~/^parameter/) || ($_=~/^stores/)) {
- delete $metadatafields{$_};
+ foreach my $field (keys(%metadatafields)) {
+ if (($field=~/^parameter/) || ($field=~/^stores/)) {
+ delete $metadatafields{$field};
}
}
@@ -1079,23 +1208,21 @@ sub publish {
$scrout.=&metaread($logfile,$source.'.meta');
- foreach (keys %metadatafields) {
- if (($_=~/^parameter/) || ($_=~/^stores/)) {
- $oldparmstores{$_}=1;
- delete $metadatafields{$_};
+ foreach my $field (keys(%metadatafields)) {
+ if (($field=~/^parameter/) || ($field=~/^stores/)) {
+ $oldparmstores{$field}=1;
+ delete $metadatafields{$field};
}
}
# ------------------------------------------------------------- Save some stuff
my %savemeta=();
- foreach ('title') {
- $savemeta{$_}=$metadatafields{$_};
- }
+ if ($metadatafields{'title'}) { $savemeta{'title'}=$metadatafields{'title'}; }
# ------------------------------------------ See if anything new in file itself
$allmeta=&parseformeta($source,$style);
# ----------------------------------------------------------- Restore the stuff
- foreach (keys %savemeta) {
- $metadatafields{$_}=$savemeta{$_};
+ foreach my $item (keys(%savemeta)) {
+ $metadatafields{$item}=$savemeta{$item};
}
}
@@ -1103,11 +1230,11 @@ sub publish {
# ---------------- Find and document discrepancies in the parameters and stores
my $chparms='';
- foreach (sort keys %metadatafields) {
- if (($_=~/^parameter/) || ($_=~/^stores/)) {
- unless ($_=~/\.\w+$/) {
- unless ($oldparmstores{$_}) {
- my $disp_key = $_;
+ foreach my $field (sort(keys(%metadatafields))) {
+ if (($field=~/^parameter/) || ($field=~/^stores/)) {
+ unless ($field=~/\.\w+$/) {
+ unless ($oldparmstores{$field}) {
+ my $disp_key = $field;
$disp_key =~ tr/\0/_/;
print $logfile ('New: '.$disp_key."\n");
$chparms .= $disp_key.' ';
@@ -1121,11 +1248,11 @@ sub publish {
}
$chparms='';
- foreach (sort keys %oldparmstores) {
- if (($_=~/^parameter/) || ($_=~/^stores/)) {
- unless (($metadatafields{$_.'.name'}) ||
- ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {
- my $disp_key = $_;
+ foreach my $olditem (sort(keys(%oldparmstores))) {
+ if (($olditem=~/^parameter/) || ($olditem=~/^stores/)) {
+ unless (($metadatafields{$olditem.'.name'}) ||
+ ($metadatafields{$olditem.'.package'}) || ($olditem=~/\.\w+$/)) {
+ my $disp_key = $olditem;
$disp_key =~ tr/\0/_/;
print $logfile ('Obsolete: '.$disp_key."\n");
$chparms.=$disp_key.' ';
@@ -1133,15 +1260,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
@@ -1153,17 +1281,22 @@ sub publish {
$textonly=~s/\
-
$KEYWORDS:
- $keywords_help
-
-
-
-
END
- $keywordout.='
';
+ $keywordout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Keywords'))
+ .$keywords_help
+ .''
+ .''
+ .' '
+ .&Apache::loncommon::start_data_table();
+ my $cols_per_row = 10;
my $colcount=0;
+ my $wordcount=0;
+ my $numkeywords = scalar(keys(%keywords));
- foreach (sort keys %keywords) {
- $keywordout.='
".
- &select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').
- &textfield('Standards','standards',$metadatafields{'standards'});
-
-
-
+ $intr_scrout.=&textfield('Standards','standards',$metadatafields{'standards'});
$intr_scrout.=&hiddenfield('mime',$1);
@@ -1293,9 +1446,12 @@ END
$intr_scrout.=&hiddenfield('lastrevisiondate',time);
-
+ my $pubowner_last;
+ if ($style eq 'prv') {
+ $pubowner_last = 1;
+ }
$intr_scrout.=&textfield('Publisher/Owner','owner',
- $metadatafields{'owner'});
+ $metadatafields{'owner'},$pubowner_last);
# ---------------------------------------------- Retrofix for unused copyright
if ($metadatafields{'copyright'} eq 'free') {
@@ -1329,25 +1485,24 @@ END
(grep !/^priv$/,(&Apache::loncommon::copyrightids)));
}
my $copyright_help =
- Apache::loncommon::help_open_topic('Publishing_Copyright');
- $intr_scrout =~ s/Distribution:/'Distribution: ' . $copyright_help/ge;
- $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights').$copyright_help;
+ &Apache::loncommon::help_open_topic('Publishing_Copyright');
+ my $replace=&mt('Copyright/Distribution:');
+ $intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge;
+
+ $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights');
$intr_scrout.=&selectbox('Source Distribution','sourceavail',
$defaultsourceoption,
\&Apache::loncommon::source_copyrightdescription,
(&Apache::loncommon::source_copyrightids));
# $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
my $uctitle=&mt('Obsolete');
- $intr_scrout.=
- "\n'.
- &text_with_browse_field('Suggested Replacement for Obsolete File',
+ my $obsolete_checked=($metadatafields{'obsolete'})?' checked="checked"':'';
+ $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle)
+ .''
+ .&Apache::lonhtmlcommon::row_closure(1);
+ $intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File',
'obsoletereplacement',
- $metadatafields{'obsoletereplacement'});
+ $metadatafields{'obsoletereplacement'},'',1);
} else {
$intr_scrout.=&hiddenfield('copyright','private');
}
@@ -1373,11 +1528,15 @@ END
&hiddenfield('obsolete',1).
&text_with_browse_field('Suggested Replacement for Obsolete File',
'obsoletereplacement',
- $metadatafields{'obsoletereplacement'});
+ $metadatafields{'obsoletereplacement'},'',1);
}
if (!$batch) {
- $scrout.=$intr_scrout.'';
+ $scrout.=$intr_scrout
+ .&Apache::lonhtmlcommon::end_pick_box()
+ .''
+ .'';
}
return($scrout,0);
}
@@ -1415,6 +1574,8 @@ Returns:
0: fail
1: success
+=back
+
=cut
#'stupid emacs
@@ -1440,7 +1601,7 @@ sub phasetwo {
return 0;
}
if ($target=~/\.(\d+)\.(\w+)$/) {
- $r->print(''.&mt('Cannot publish versioned resource, FAIL').'');
+ $r->print(''.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'');
return 0;
}
}
@@ -1529,17 +1690,17 @@ sub phasetwo {
'');
return 0;
}
- foreach (sort keys %metadatafields) {
- unless ($_=~/\./) {
- my $unikey=$_;
+ foreach my $field (sort(keys(%metadatafields))) {
+ unless ($field=~/\./) {
+ my $unikey=$field;
$unikey=~/^([A-Za-z]+)/;
my $tag=$1;
$tag=~tr/A-Z/a-z/;
print $mfh "\n\<$tag";
- foreach (split(/\,/,$metadatakeys{$unikey})) {
- my $value=$metadatafields{$unikey.'.'.$_};
+ foreach my $item (split(/\,/,$metadatakeys{$unikey})) {
+ my $value=$metadatafields{$unikey.'.'.$item};
$value=~s/\"/\'\'/g;
- print $mfh ' '.$_.'="'.$value.'"';
+ print $mfh ' '.$item.'="'.$value.'"';
}
print $mfh '>'.
&HTML::Entities::encode($metadatafields{$unikey},'<>&"')
@@ -1576,10 +1737,11 @@ sub phasetwo {
my $srcf=$2;
my $srct=$3;
my $srcd=$1;
- unless ($srcd=~/^\/home\/httpd\/html\/res/) {
+ my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
+ unless ($srcd=~/^\Q$docroot\E\/res/) {
print $logfile "\nPANIC: Target dir is ".$srcd;
$r->print(
- "Invalid target directory, FAIL");
+ "".&mt('Invalid target directory, FAIL')."");
return 0;
}
opendir(DIR,$srcd);
@@ -1588,25 +1750,24 @@ sub phasetwo {
unlink($srcd.'/'.$filename);
unlink($srcd.'/'.$filename.'.meta');
} else {
- if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {
+ if ($filename=~/^\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {
$maxversion=($1>$maxversion)?$1:$maxversion;
}
}
}
closedir(DIR);
$maxversion++;
- $r->print('
Creating old version '.$maxversion.'
');
+ $r->print('
'.&mt('Creating old version [_1]',$maxversion).'
');
print $logfile "\nCreating old version ".$maxversion."\n";
my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
if (copy($target,$copyfile)) {
print $logfile "Copied old target to ".$copyfile."\n";
- $r->print('
'.&mt('Copied old target file').'
');
+ $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file')));
} else {
print $logfile "Unable to write ".$copyfile.':'.$!."\n";
- $r->print("".&mt('Failed to copy old target').
- ", $!, ".&mt('FAIL')."");
+ $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1));
return 0;
}
@@ -1616,13 +1777,12 @@ sub phasetwo {
if (copy($target.'.meta',$copyfile)) {
print $logfile "Copied old target metadata to ".$copyfile."\n";
- $r->print('
'.&mt('Copied old metadata').'
')
+ $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata')));
} else {
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
if (-e $target.'.meta') {
- $r->print(
- "".
-&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."");
+ $r->print(&Apache::lonhtmlcommon::confirm_success(
+ &mt('Failed to write old metadata copy').", $!",1));
return 0;
}
}
@@ -1644,32 +1804,38 @@ sub phasetwo {
$path.="/$parts[$count]";
if ((-e $path)!=1) {
print $logfile "\nCreating directory ".$path;
- $r->print('
');
+
# ------------------------------------------------ Provide link to new resource
unless ($batch) {
- my $thissrc=$source;
- $thissrc=~s{^/home/($match_username)/public_html}{/priv/$1};
-
+ my $thissrc=&Apache::loncfile::url($source);
my $thissrcdir=$thissrc;
$thissrcdir=~s/\/[^\/]+$/\//;
-
$r->print(
- ''.
- &mt('View Published Version').''.
- '