[LON-CAPA-cvs] cvs: loncom /publisher lonpublisher.pm
raeburn
raeburn at source.lon-capa.org
Sat Jun 18 21:08:01 EDT 2016
raeburn Sun Jun 19 01:08:01 2016 EDT
Modified files:
/loncom/publisher lonpublisher.pm
Log:
- Allow &batchpublish() to be called by other packages.
- %addid hash made a global (populated in BEGIN() block.
- %nokey hash passed as a reference to &batchpublish(),
&publishdirectory(), &publish().
- New routine: &getnokey() populates %nokey hash.
- New arg -- $usebuffer -- passed to &batchpublish() and
&phasetwo(), when true causes output to be stored in scalar
instead of sent to $r->print().
-------------- next part --------------
Index: loncom/publisher/lonpublisher.pm
diff -u loncom/publisher/lonpublisher.pm:1.295 loncom/publisher/lonpublisher.pm:1.296
--- loncom/publisher/lonpublisher.pm:1.295 Tue Mar 22 16:41:10 2016
+++ loncom/publisher/lonpublisher.pm Sun Jun 19 01:08:01 2016
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.295 2016/03/22 16:41:10 raeburn Exp $
+# $Id: lonpublisher.pm,v 1.296 2016/06/19 01:08:01 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -128,13 +128,9 @@
use Apache::loncfile;
use LONCAPA::lonmetadata;
use Apache::lonmsg;
-use vars qw(%metadatafields %metadatakeys);
+use vars qw(%metadatafields %metadatakeys %addid $readit);
use LONCAPA qw(:DEFAULT :match);
-
-my %addid;
-my %nokey;
-
my $docroot;
my $cuname;
@@ -1107,7 +1103,7 @@
#########################################
sub publish {
- my ($source,$target,$style,$batch)=@_;
+ my ($source,$target,$style,$batch,$nokeyref)=@_;
my $logfile;
my $scrout='';
my $allmeta='';
@@ -1347,7 +1343,7 @@
$textonly=~s/[^a-z^ü^ä^ö^ß\s]//g; #dont delete german "Umlaute"
foreach ($textonly=~m/[^\s]+/g) { #match all but whitespaces
- unless ($nokey{$_}) {
+ unless ($nokeyref->{$_}) {
$keywords{$_}=1;
}
}
@@ -1598,6 +1594,18 @@
return($scrout,0);
}
+sub getnokey {
+ my ($includedir) = @_;
+ my $nokey={};
+ my $fh=Apache::File->new($includedir.'/un_keyword.tab');
+ while (<$fh>) {
+ my $word=$_;
+ chomp($word);
+ $nokey->{$word}=1;
+ }
+ return $nokey;
+}
+
#########################################
#########################################
@@ -1620,13 +1628,21 @@
=item I<$distarget>
+=item I<$batch>
+
+=item I<$usebuffer>
+
=back
Returns:
=over 4
-=item integer
+=item integer or array
+
+if $userbuffer arg is true, and if caller wants an array
+then the array ($output,$rtncode) will be returned, otherwise
+just the $rtncode will be returned. $rtncode is an integer:
0: fail
1: success
@@ -1640,26 +1656,54 @@
#########################################
sub phasetwo {
- my ($r,$source,$target,$style,$distarget,$batch)=@_;
+ my ($r,$source,$target,$style,$distarget,$batch,$usebuffer)=@_;
$source=~s/\/+/\//g;
$target=~s/\/+/\//g;
#
# Unless trying to get rid of something, check name validity
#
+ my $output;
unless ($env{'form.obsolete'}) {
if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {
- $r->print('<span class="LC_error">'.
+ $output = '<span class="LC_error">'.
&mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").
- '</span>');
- return 0;
+ '</span>';
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ $r->print($output);
+ return 0;
+ }
}
unless ($target=~/\.(\w+)$/) {
- $r->print('<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>');
- return 0;
+ $output = '<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>';
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ $r->print($output);
+ return 0;
+ }
}
if ($target=~/\.(\d+)\.(\w+)$/) {
- $r->print('<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>');
- return 0;
+ $output = '<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>';
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ $r->print($output);
+ return 0;
+ }
}
}
@@ -1669,14 +1713,25 @@
$distarget=~s/\/+/\//g;
my $logfile;
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
- $r->print(
- '<span class="LC_error">'.
- &mt('No write permission to user directory, FAIL').'</span>');
- return 0;
+ $output = '<span class="LC_error">'.
+ &mt('No write permission to user directory, FAIL').'</span>';
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ return 0;
+ }
}
if ($source =~ /\.rights$/) {
- $r->print('<p><span class="LC_warning">'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'</span></p>');
+ $output = '<p><span class="LC_warning">'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'</span></p>';
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
}
print $logfile
@@ -1758,20 +1813,36 @@
if ($metadatafields{'copyright'} eq 'custom') {
my $file=$metadatafields{'customdistributionfile'};
unless ($file=~/\.rights$/) {
- $r->print(
- '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').
- '</span>');
- return 0;
+ $output .= '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').
+ '</span>';
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ $r->print($output);
+ return 0;
+ }
}
}
{
print $logfile "\nWrite metadata file for ".$source;
my $mfh;
unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
- $r->print(
- '<span class="LC_error">'.&mt('Could not write metadata, FAIL').
- '</span>');
- return 0;
+ $output .= '<span class="LC_error">'.&mt('Could not write metadata, FAIL').
+ '</span>';
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ $r->print($output);
+ return 0;
+ }
}
foreach my $field (sort(keys(%metadatafields))) {
unless ($field=~/\./) {
@@ -1790,7 +1861,12 @@
.'</'.$tag.'>';
}
}
- $r->print('<p>'.&mt('Wrote Metadata').'</p>');
+
+ $output .= '<p>'.&mt('Wrote Metadata').'</p>';
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
print $logfile "\nWrote metadata";
}
@@ -1801,15 +1877,23 @@
my ($error,$success) = &store_metadata(%metadatafields);
if ($success) {
- $r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>');
+ $output .= '<p>'.&mt('Synchronized SQL metadata database').'</p>';
print $logfile "\nSynchronized SQL metadata database";
} else {
- $r->print($error);
+ $output .= $error;
print $logfile "\n".$error;
}
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
# --------------------------------------------- Delete author resource messages
my $delresult=&Apache::lonmsg::del_url_author_res_msg($target);
- $r->print('<p>'.&mt('Removing error messages:').' '.$delresult.'</p>');
+ $output .= '<p>'.&mt('Removing error messages:').' '.$delresult.'</p>';
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
print $logfile "\nRemoving error messages: $delresult";
# ----------------------------------------------------------- Copy old versions
@@ -1823,9 +1907,18 @@
my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
unless ($srcd=~/^\Q$docroot\E\/res/) {
print $logfile "\nPANIC: Target dir is ".$srcd;
- $r->print(
- "<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>");
- return 0;
+ $output .=
+ "<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>";
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ $r->print($output);
+ return 0;
+ }
}
opendir(DIR,$srcd);
while ($filename=readdir(DIR)) {
@@ -1840,18 +1933,35 @@
}
closedir(DIR);
$maxversion++;
- $r->print('<p>'.&mt('Creating old version [_1]',$maxversion).'</p>');
+ $output .= '<p>'.&mt('Creating old version [_1]',$maxversion).'</p>';
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
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(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file')));
+ $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file'));
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
} else {
print $logfile "Unable to write ".$copyfile.':'.$!."\n";
- $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1));
- return 0;
+ $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1);
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ $r->print($output);
+ return 0;
+ }
}
# --------------------------------------------------------------- Copy Metadata
@@ -1860,19 +1970,34 @@
if (copy($target.'.meta',$copyfile)) {
print $logfile "Copied old target metadata to ".$copyfile."\n";
- $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata')));
+ $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata'));
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
} else {
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
if (-e $target.'.meta') {
- $r->print(&Apache::lonhtmlcommon::confirm_success(
- &mt('Failed to write old metadata copy').", $!",1));
- return 0;
+ $output .= &Apache::lonhtmlcommon::confirm_success(
+ &mt('Failed to write old metadata copy').", $!",1);
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ $r->print($output);
+ return 0;
+ }
}
}
-
-
} else {
- $r->print('<p>'.&mt('Initial version').'</p>');
+ $output .= '<p>'.&mt('Initial version').'</p>';
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
print $logfile "\nInitial version";
}
@@ -1888,22 +2013,38 @@
if ((-e $path)!=1) {
print $logfile "\nCreating directory ".$path;
mkdir($path,0777);
- $r->print('<p>'
- .&mt('Created directory [_1]'
- ,'<span class="LC_filename">'.$parts[$count].'</span>')
- .'</p>'
- );
+ $output .= '<p>'
+ .&mt('Created directory [_1]'
+ ,'<span class="LC_filename">'.$parts[$count].'</span>')
+ .'</p>';
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
}
}
if (copy($source,$copyfile)) {
print $logfile "\nCopied original source to ".$copyfile."\n";
- $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied source file')));
+ $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied source file'));
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
} else {
print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
- $r->print(&Apache::lonhtmlcommon::confirm_success(
- &mt('Failed to copy source').", $!",1));
- return 0;
+ $output .= &Apache::lonhtmlcommon::confirm_success(
+ &mt('Failed to copy source').", $!",1);
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ $r->print($output);
+ return 0;
+ }
}
# ---------------------------------------------- Delete local tmp-preview files
@@ -1914,14 +2055,29 @@
if (copy($source.'.meta',$copyfile)) {
print $logfile "\nCopied original metadata to ".$copyfile."\n";
- $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata')));
+ $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata'));
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
} else {
print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
- $r->print(&Apache::lonhtmlcommon::confirm_success(
- &mt('Failed to write metadata copy').", $!",1));
- return 0;
+ $output .= &Apache::lonhtmlcommon::confirm_success(
+ &mt('Failed to write metadata copy').", $!",1);
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,0);
+ } else {
+ return 0;
+ }
+ } else {
+ $r->print($output);
+ return 0;
+ }
+ }
+ unless ($usebuffer) {
+ $r->rflush;
}
- $r->rflush;
# ------------------------------------------------------------- Trigger updates
push(@{$modified_urls},[$target,$source]);
@@ -1940,7 +2096,11 @@
# ------------------------------------------------------------- Everything done
$logfile->close();
- $r->print('<p class="LC_success">'.&mt('Done').'</p>');
+ $output .= '<p class="LC_success">'.&mt('Done').'</p>';
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
# ------------------------------------------------ Provide link to new resource
unless ($batch) {
@@ -1949,7 +2109,7 @@
my $thissrcdir=$thissrc;
$thissrcdir=~s/\/[^\/]+$/\//;
- $r->print(
+ $output .=
&Apache::lonhtmlcommon::actionbox([
'<a href="'.$thisdistarget.'">'.
&mt('View Published Version').
@@ -1959,10 +2119,26 @@
'</a>',
'<a href="'.$thissrcdir.'">'.
&mt('Back to Source Directory').
- '</a>'])
- );
+ '</a>']);
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
+ }
+
+ if ($usebuffer) {
+ if (wantarray) {
+ return ($output,1);
+ } else {
+ return 1;
+ }
+ } else {
+ if (wantarray) {
+ return ('',1);
+ } else {
+ return 1;
+ }
}
- return 1;
}
# =============================================================== Notifications
@@ -2006,12 +2182,11 @@
#########################################
sub batchpublish {
- my ($r,$srcfile,$targetfile)=@_;
+ my ($r,$srcfile,$targetfile,$nokeyref,$usebuffer)=@_;
#publication pollutes %env with form.* values
my %oldenv=%env;
$srcfile=~s/\/+/\//g;
$targetfile=~s/\/+/\//g;
- $srcfile=~s/\/+/\//g;
my $docroot=$r->dir_config('lonDocRoot');
my $thisdistarget=$targetfile;
@@ -2026,31 +2201,46 @@
my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
- $r->print('<h2>'
+ my $output = '<h2>'
.&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))
- .'</h2>'
- );
+ .'</h2>';
+ unless ($usebuffer) {
+ $r->print($output);
+ $output = '';
+ }
# phase one takes
# my ($source,$target,$style,$batch)=@_;
- my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1);
- $r->print('<p>'.$outstring.'</p>');
+ my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1,$nokeyref);
+
+ if ($usebuffer) {
+ $output .= '<p>'.$outstring.'</p>';
+ } else {
+ $r->print('<p>'.$outstring.'</p>');
+ }
# phase two takes
# my ($source,$target,$style,$distarget,batch)=@_;
# $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...
if (!$error) {
- $r->print('<p>');
- &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
- $r->print('</p>');
+ if ($usebuffer) {
+ my ($result,$error) = &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1,$usebuffer);
+ $output .= '<p>'.$result.'</p>';
+ } else {
+ &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
+ }
}
%env=%oldenv;
- return '';
+ if ($usebuffer) {
+ return $output;
+ } else {
+ return '';
+ }
}
#########################################
sub publishdirectory {
- my ($r,$fn,$thisdisfn)=@_;
+ my ($r,$fn,$thisdisfn,$nokeyref)=@_;
$fn=~s/\/+/\//g;
$thisdisfn=~s/\/+/\//g;
my $thisdisresdir=$thisdisfn;
@@ -2105,7 +2295,7 @@
if ($filename=~/\.(\w+)$/) { $extension=$1; }
if ($cmode&$dirptr) {
if (($filename!~/^\./) && ($env{'form.pubrec'})) {
- &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
+ &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename,$nokeyref);
}
} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
@@ -2131,7 +2321,7 @@
}
if ($publishthis) {
- &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
+ &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename,$nokeyref);
} else {
$r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');
}
@@ -2293,29 +2483,7 @@
return HTTP_NOT_FOUND;
}
-# -------------------------------- File is there and owned, init lookup tables.
-
- %addid=();
-
- {
- my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
- while (<$fh>=~/(\w+)\s+(\w+)/) {
- $addid{$1}=$2;
- }
- }
-
- %nokey=();
-
- {
- my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
- while (<$fh>) {
- my $word=$_;
- chomp($word);
- $nokey{$word}=1;
- }
- }
-
-# ---------------------------------------------------------- Start page output.
+# --------------------------------- File is there and owned, start page output
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
@@ -2390,10 +2558,11 @@
my $thistarget=$fn;
$thistarget=~s/^\/priv\//\/res\//;
my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"');
+ my $nokeyref = &getnokey($r->dir_config('lonIncludes'));
if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory
- &publishdirectory($r,$docroot.$fn,$thisdisfn);
+ &publishdirectory($r,$docroot.$fn,$thisdisfn,$nokeyref);
$r->print(
'<br /><br />'.
&Apache::lonhtmlcommon::actionbox([
@@ -2466,7 +2635,7 @@
}
unless ($errorcount) {
my ($outstring,$error)=
- &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle);
+ &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle,undef,$nokeyref);
$r->print($outstring);
} else {
$r->print('<h3 class="LC_error">'.
@@ -2474,7 +2643,9 @@
'</h3>');
}
} else {
- &phasetwo($r,$docroot.$fn,$docroot.$thistarget,$thisembstyle,$thisdistarget);
+ my ($output,$error) = &phasetwo($r,$docroot.$fn,$docroot.$thistarget,
+ $thisembstyle,$thisdistarget);
+ $r->print($output);
}
}
$r->print(&Apache::loncommon::end_page());
@@ -2482,6 +2653,24 @@
return OK;
}
+BEGIN {
+
+# ----------------------------------- Read addid.tab
+ unless ($readit) {
+ %addid=();
+
+ {
+ my $tabdir = $Apache::lonnet::perlvar{'lonTabDir'};
+ my $fh=Apache::File->new($tabdir.'/addid.tab');
+ while (<$fh>=~/(\w+)\s+(\w+)/) {
+ $addid{$1}=$2;
+ }
+ }
+ }
+ $readit=1;
+}
+
+
1;
__END__
More information about the LON-CAPA-cvs
mailing list