--- loncom/publisher/lonpublisher.pm 2008/05/12 23:47:49 1.234
+++ loncom/publisher/lonpublisher.pm 2016/03/22 16:41:10 1.295
@@ -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.295 2016/03/22 16:41:10 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 '
';
}
#########################################
@@ -289,8 +293,8 @@ sub coursedependencies {
my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
$aauthor,$regexp);
my %courses=();
- foreach (keys %evaldata) {
- if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {
+ foreach my $item (keys(%evaldata)) {
+ if ($item=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {
$courses{$1}=1;
}
}
@@ -314,8 +318,12 @@ string which presents the form field (fo
=item B
+=item B
+
=item B
+=item B
+
=item B
=back
@@ -325,30 +333,34 @@ string which presents the form field (fo
#########################################
#########################################
sub textfield {
- my ($title,$name,$value)=@_;
+ my ($title,$name,$value,$noline)=@_;
$value=~s/^\s+//gs;
$value=~s/\s+$//gs;
$value=~s/\s+/ /gs;
$title=&mt($title);
$env{'form.'.$name}=$value;
- return "\n
'.
- &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 +1338,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 +1503,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 +1542,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 +1585,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 +1631,8 @@ Returns:
0: fail
1: success
+=back
+
=cut
#'stupid emacs
@@ -1440,7 +1658,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;
}
}
@@ -1468,7 +1686,33 @@ sub phasetwo {
%metadatakeys=();
&metaeval(&unescape($env{'form.allmeta'}));
-
+
+ if ($batch) {
+ my %commonaccess;
+ map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess');
+ if ($commonaccess{'dist'}) {
+ unless ($style eq 'prv') {
+ if ($env{'form.commondistselect'} eq 'custom') {
+ unless ($source =~ /\.rights$/) {
+ if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) {
+ $env{'form.customdistributionfile'} = $env{'form.commoncustomrights'};
+ $env{'form.copyright'} = $env{'form.commondistselect'};
+ }
+ }
+ } elsif ($env{'form.commondistselect'} =~ /^default|domain|public$/) {
+ $env{'form.copyright'} = $env{'form.commondistselect'};
+ }
+ }
+ }
+ unless ($style eq 'prv') {
+ if ($commonaccess{'source'}) {
+ if (($env{'form.commonsourceselect'} eq 'open') || ($env{'form.commonsourceselect'} eq 'closed')) {
+ $env{'form.sourceavail'} = $env{'form.commonsourceselect'};
+ }
+ }
+ }
+ }
+
$metadatafields{'title'}=$env{'form.title'};
$metadatafields{'author'}=$env{'form.author'};
$metadatafields{'subject'}=$env{'form.subject'};
@@ -1529,17 +1773,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 +1820,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 +1833,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 +1860,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 +1887,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').''.
- '