--- loncom/publisher/lonpublisher.pm 2004/05/21 20:01:15 1.168
+++ loncom/publisher/lonpublisher.pm 2006/01/13 19:19:34 1.205
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.168 2004/05/21 20:01:15 www Exp $
+# $Id: lonpublisher.pm,v 1.205 2006/01/13 19:19:34 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -121,7 +121,7 @@ use HTML::LCParser;
use Apache::lonxml;
use Apache::loncacc;
use DBI;
-use Apache::lonnet();
+use Apache::lonnet;
use Apache::loncommon();
use Apache::lonmysql;
use Apache::lonlocal;
@@ -138,6 +138,9 @@ my $docroot;
my $cuname;
my $cudom;
+my $registered_cleanup;
+my $modified_urls;
+
=pod
=item B
@@ -199,7 +202,8 @@ sub metaeval {
}
}
my $newentry=$parser->get_text('/'.$entry);
- if ($entry eq 'customdistributionfile') {
+ if (($entry eq 'customdistributionfile') ||
+ ($entry eq 'sourcerights')) {
$newentry=~s/^\s*//;
if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }
}
@@ -322,26 +326,47 @@ sub textfield {
$value=~s/\s+$//gs;
$value=~s/\s+/ /gs;
$title=&mt($title);
- $ENV{'form.'.$name}=$value;
+ $env{'form.'.$name}=$value;
return "\n$title:".
"
".
' ';
}
+sub text_with_browse_field {
+ my ($title,$name,$value,$restriction)=@_;
+ $value=~s/^\s+//gs;
+ $value=~s/\s+$//gs;
+ $value=~s/\s+/ /gs;
+ $title=&mt($title);
+ $env{'form.'.$name}=$value;
+ return "\n$title:".
+ "
".
+ ' '.
+ 'Select '.
+ 'Search ';
+
+}
+
sub hiddenfield {
my ($name,$value)=@_;
- $ENV{'form.'.$name}=$value;
+ $env{'form.'.$name}=$value;
return "\n".' ';
}
+sub checkbox {
+ my ($name,$text)=@_;
+ return "\n ".
+ &mt($text)." ";
+}
+
sub selectbox {
my ($title,$name,$value,$functionref,@idlist)=@_;
$title=&mt($title);
$value=(split(/\s*,\s*/,$value))[-1];
if (defined($value)) {
- $ENV{'form.'.$name}=$value;
+ $env{'form.'.$name}=$value;
} else {
- $ENV{'form.'.$name}=$idlist[0];
+ $env{'form.'.$name}=$idlist[0];
}
my $selout="\n$title:".
'
';
@@ -357,8 +382,8 @@ sub selectbox {
sub select_level_form {
my ($value,$name)=@_;
- $ENV{'form.'.$name}=$value;
- if (!defined($value)) { $ENV{'form.'.$name}=0; }
+ $env{'form.'.$name}=$value;
+ if (!defined($value)) { $env{'form.'.$name}=0; }
return &Apache::loncommon::select_level_form($value,$name);
}
#########################################
@@ -471,7 +496,8 @@ sub get_subscribed_hosts {
while ($filename=readdir(DIR)) {
if ($filename=~/\Q$srcf\E\.(\w+)$/) {
my $subhost=$1;
- if (($subhost ne 'meta' && $subhost ne 'subscription') &&
+ if (($subhost ne 'meta' && $subhost ne 'subscription' &&
+ $subhost ne 'tmp') &&
($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {
push(@subscribed,$subhost);
}
@@ -482,7 +508,6 @@ sub get_subscribed_hosts {
if ( $sh=Apache::File->new("$target.subscription") ) {
&Apache::lonnet::logthis("opened $target.subscription");
while (my $subline=<$sh>) {
- &Apache::lonnet::logthis("Trying $subline");
if ($subline =~ /(^\w+):/) {
if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) {
push(@subscribed,$1);
@@ -528,7 +553,8 @@ sub get_max_ids_indices {
my $counter;
if ($counter=$addid{$token->[1]}) {
if ($counter eq 'id') {
- if (defined($token->[2]->{'id'})) {
+ if (defined($token->[2]->{'id'}) &&
+ $token->[2]->{'id'} !~ /^\s*$/) {
$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
if (exists($allids{$token->[2]->{'id'}})) {
$duplicateids=1;
@@ -540,7 +566,8 @@ sub get_max_ids_indices {
$needsfixup=1;
}
} else {
- if (defined($token->[2]->{'index'})) {
+ if (defined($token->[2]->{'index'}) &&
+ $token->[2]->{'index'} !~ /^\s*$/) {
$maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
} else {
$needsfixup=1;
@@ -582,11 +609,11 @@ sub get_all_text_unbalanced {
} elsif ($token->[0] eq 'E') {
$result.=$token->[2];
}
- if ($result =~ /(.*)\Q$tag\E(.*)/s) {
+ if ($result =~ /\Q$tag\E/s) {
+ ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is;
#&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);
#&Apache::lonnet::logthis('Result is :'.$1);
- $result=$1;
- my $redo=$tag.$2;
+ $redo=$tag.$redo;
push (@$pars,HTML::LCParser->new(\$redo));
$$pars[-1]->xml_mode('1');
last;
@@ -649,30 +676,37 @@ sub fix_ids_and_indices {
$allow{$token->[2]->{'src'}}=1;
next;
}
+ if ($lctag eq 'base') { next; }
my %parms=%{$token->[2]};
$counter=$addid{$tag};
if (!$counter) { $counter=$addid{$lctag}; }
if ($counter) {
if ($counter eq 'id') {
- unless (defined($parms{'id'})) {
+ unless (defined($parms{'id'}) &&
+ $parms{'id'}!~/^\s*$/) {
$maxid++;
$parms{'id'}=$maxid;
- print $logfile 'ID: '.$tag.':'.$maxid."\n";
+ print $logfile 'ID(new) : '.$tag.':'.$maxid."\n";
+ } else {
+ print $logfile 'ID(kept): '.$tag.':'.$parms{'id'}."\n";
}
} elsif ($counter eq 'index') {
- unless (defined($parms{'index'})) {
+ unless (defined($parms{'index'}) &&
+ $parms{'index'}!~/^\s*$/) {
$maxindex++;
$parms{'index'}=$maxindex;
print $logfile 'Index: '.$tag.':'.$maxindex."\n";
}
}
}
- foreach my $type ('src','href','background','bgimg') {
- foreach my $key (keys(%parms)) {
- if ($key =~ /^$type$/i) {
- $parms{$key}=&set_allow(\%allow,$logfile,
- $target,$tag,
- $parms{$key});
+ unless ($parms{'type'} eq 'zombie') {
+ foreach my $type ('src','href','background','bgimg') {
+ foreach my $key (keys(%parms)) {
+ if ($key =~ /^$type$/i) {
+ $parms{$key}=&set_allow(\%allow,$logfile,
+ $target,$tag,
+ $parms{$key});
+ }
}
}
}
@@ -801,55 +835,56 @@ sub store_metadata {
&Apache::lonnet::logthis($error);
return ($error,undef);
}
+ my $dbh = &Apache::lonmysql::get_dbh();
if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv') ||
($metadata{'copyright'} eq 'custom')) {
-# remove this entry
- $status=&Apache::lonmysql::remove_from_table
- ('metadata','url',$metadata{'url'});
+ # remove this entry
+ $status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef,
+ $metadata{'url'});
} else {
-# store new data
-# adjust some values to metadatadatabase (e.g., "usage" is a reserved word)
- $metadata{'creationdate'}=
- &Apache::lonmysql::sqltime($metadata{'creationdate'});
- $metadata{'lastrevisiondate'}=
- &Apache::lonmysql::sqltime($metadata{'lastrevisiondate'});
- $metadata{'sequsage'}=$metadata{'usage'};
- $metadata{'sequsage_list'}=$metadata{'usage_list'};
- my %newmetadata=();
-# see if we have old entries
- my @oldmeta=&Apache::lonmysql::get_rows('metadata',
- "url LIKE BINARY '".
- $metadata{'url'}."'");
- if ($#oldmeta==0) {
-# yes, there is one old entry, transfer to newmetadata
- %newmetadata=&LONCAPA::lonmetadata::metadata_col_to_hash(@{$oldmeta[0]});
-# remove old entry
- $status=&Apache::lonmysql::remove_from_table
- ('metadata','url',$metadata{'url'});
- } elsif ($#oldmeta>0) {
-# more than one entry fit - how did that happen?
- $error='Error occured retrieving old values in '.
- 'metadata table in LON-CAPA database: '.$#oldmeta.
- ' matches ';
- &Apache::lonnet::logthis($error);
- return ($error,undef);
- }
-# store new data on top of it
- foreach (keys %metadata) {
- $newmetadata{$_}=$metadata{$_};
- }
- $status = &Apache::lonmysql::store_row('metadata',\%newmetadata);
+ $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,
+ \%metadata);
}
- if (! defined($status)) {
+ if (defined($status) && $status ne '') {
$error='Error occured storing new values in '.
'metadata table in LON-CAPA database ';
&Apache::lonnet::logthis($error);
+ &Apache::lonnet::logthis($status);
return ($error,undef);
}
return (undef,$status);
}
+# ========================================== Parse file for errors and warnings
+
+sub checkonthis {
+ my ($r,$source)=@_;
+ my $uri=&Apache::lonnet::hreflocation($source);
+ $uri=~s/\/$//;
+ my $result=&Apache::lonnet::ssi_body($uri,
+ ('grade_target'=>'web',
+ 'return_only_error_and_warning_counts' => 1));
+ my ($errorcount,$warningcount)=split(':',$result);
+ if (($errorcount) || ($warningcount)) {
+ $r->print(''.$uri.' : ');
+ if ($errorcount) {
+ $r->print(''.
+ $errorcount.' '.
+ &mt('error(s)').' ');
+ }
+ if ($warningcount) {
+ $r->print(''.
+ $warningcount.' '.
+ &mt('warning(s)').' ');
+ }
+ } else {
+ #$r->print(''.&mt('ok').' ');
+ }
+ $r->rflush();
+ return ($warningcount,$errorcount);
+}
+
# ============================================== Parse file itself for metadata
#
# parses a file with target meta, sets global %metadatafields %metadatakeys
@@ -903,7 +938,7 @@ sub publish {
return (''.&mt('No write permission to user directory, FAIL').' ',1);
}
print $logfile
-"\n\n================= Publish ".localtime()." Phase One ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";
+"\n\n================= Publish ".localtime()." Phase One ================\n".$env{'user.name'}.'@'.$env{'user.domain'}."\n";
if (($style eq 'ssi') || ($style eq 'rat') || ($style eq 'prv')) {
# ------------------------------------------------------- This needs processing
@@ -956,7 +991,7 @@ sub publish {
}
}
}
- $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s;
+ $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;
# ------------------------------------------------------------- Write modified.
@@ -990,11 +1025,11 @@ sub publish {
}
# ------------------------------------------------ First, check out environment
- unless (-e $source.'.meta') {
- $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
- $ENV{'environment.middlename'}.' '.
- $ENV{'environment.lastname'}.' '.
- $ENV{'environment.generation'};
+ if ((!(-e $source.'.meta')) || ($env{'form.forceoverride'})) {
+ $metadatafields{'author'}=$env{'environment.firstname'}.' '.
+ $env{'environment.middlename'}.' '.
+ $env{'environment.lastname'}.' '.
+ $env{'environment.generation'};
$metadatafields{'author'}=~s/\s+/ /g;
$metadatafields{'author'}=~s/\s+$//;
$metadatafields{'owner'}=$cuname.'@'.$cudom;
@@ -1015,6 +1050,7 @@ sub publish {
$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
$prefix=~s|^\.\./||;
}
+
# ----------------------------------------------------------- Parse file itself
# read %metadatafields from file itself
@@ -1039,10 +1075,18 @@ sub publish {
delete $metadatafields{$_};
}
}
+# ------------------------------------------------------------- Save some stuff
+ my %savemeta=();
+ foreach ('title') {
+ $savemeta{$_}=$metadatafields{$_};
+ }
# ------------------------------------------ See if anything new in file itself
$allmeta=&parseformeta($source,$style);
-
+# ----------------------------------------------------------- Restore the stuff
+ foreach (keys %savemeta) {
+ $metadatafields{$_}=$savemeta{$_};
+ }
}
@@ -1115,21 +1159,22 @@ sub publish {
# interactive mode html goes into $intr_scrout
# batch mode throws away this HTML
# additionally all of the field functions have a by product of setting
-# $ENV{'from.'..} so that it can be used by the phase two handler in
+# $env{'from.'..} so that it can be used by the phase two handler in
# batch mode
my $intr_scrout.=
'';
+ &mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication').'" />
';
}
return($scrout,0);
}
@@ -1308,10 +1388,10 @@ Returns:
=over 4
-=item Scalar string
+=item integer
-String contains status (errors and warnings) and information associated with
-the server's attempts at publication.
+0: fail
+1: success
=cut
@@ -1323,13 +1403,29 @@ sub phasetwo {
my ($r,$source,$target,$style,$distarget,$batch)=@_;
$source=~s/\/+/\//g;
$target=~s/\/+/\//g;
-
- if ($target=~/\_\_\_/) {
- $r->print(
- ''.&mt('Unsupported character combination').
- ' "___ " '.&mt('in filename, FAIL').' ');
- return 0;
+#
+# Unless trying to get rid of something, check name validity
+#
+ unless ($env{'form.obsolete'}) {
+ if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {
+ $r->print(
+ ''.&mt('Unsupported character combination').
+ ' "'.$1.' " '.&mt('in filename, FAIL').' ');
+ return 0;
+ }
+ unless ($target=~/\.(\w+)$/) {
+ $r->print(''.&mt('No valid extension found in filename, FAIL').' ');
+ return 0;
+ }
+ if ($target=~/\.(\d+)\.(\w+)$/) {
+ $r->print(''.&mt('Cannot publish versioned resource, FAIL').' ');
+ return 0;
+ }
}
+
+#
+# End name check
+#
$distarget=~s/\/+/\//g;
my $logfile;
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
@@ -1339,47 +1435,48 @@ sub phasetwo {
return 0;
}
print $logfile
- "\n================= Publish ".localtime()." Phase Two ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";
+ "\n================= Publish ".localtime()." Phase Two ================\n".$env{'user.name'}.'@'.$env{'user.domain'}."\n";
%metadatafields=();
%metadatakeys=();
- &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));
+ &metaeval(&Apache::lonnet::unescape($env{'form.allmeta'}));
- $metadatafields{'title'}=$ENV{'form.title'};
- $metadatafields{'author'}=$ENV{'form.author'};
- $metadatafields{'subject'}=$ENV{'form.subject'};
- $metadatafields{'notes'}=$ENV{'form.notes'};
- $metadatafields{'abstract'}=$ENV{'form.abstract'};
- $metadatafields{'mime'}=$ENV{'form.mime'};
- $metadatafields{'language'}=$ENV{'form.language'};
- $metadatafields{'creationdate'}=$ENV{'form.creationdate'};
- $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
- $metadatafields{'owner'}=$ENV{'form.owner'};
- $metadatafields{'copyright'}=$ENV{'form.copyright'};
- $metadatafields{'standards'}=$ENV{'form.standards'};
- $metadatafields{'lowestgradelevel'}=$ENV{'form.lowestgradelevel'};
- $metadatafields{'highestgradelevel'}=$ENV{'form.highestgradelevel'};
+ $metadatafields{'title'}=$env{'form.title'};
+ $metadatafields{'author'}=$env{'form.author'};
+ $metadatafields{'subject'}=$env{'form.subject'};
+ $metadatafields{'notes'}=$env{'form.notes'};
+ $metadatafields{'abstract'}=$env{'form.abstract'};
+ $metadatafields{'mime'}=$env{'form.mime'};
+ $metadatafields{'language'}=$env{'form.language'};
+ $metadatafields{'creationdate'}=$env{'form.creationdate'};
+ $metadatafields{'lastrevisiondate'}=$env{'form.lastrevisiondate'};
+ $metadatafields{'owner'}=$env{'form.owner'};
+ $metadatafields{'copyright'}=$env{'form.copyright'};
+ $metadatafields{'standards'}=$env{'form.standards'};
+ $metadatafields{'lowestgradelevel'}=$env{'form.lowestgradelevel'};
+ $metadatafields{'highestgradelevel'}=$env{'form.highestgradelevel'};
$metadatafields{'customdistributionfile'}=
- $ENV{'form.customdistributionfile'};
- $metadatafields{'obsolete'}=$ENV{'form.obsolete'};
+ $env{'form.customdistributionfile'};
+ $metadatafields{'sourceavail'}=$env{'form.sourceavail'};
+ $metadatafields{'obsolete'}=$env{'form.obsolete'};
$metadatafields{'obsoletereplacement'}=
- $ENV{'form.obsoletereplacement'};
- $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
- $metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'.
- $ENV{'user.domain'};
+ $env{'form.obsoletereplacement'};
+ $metadatafields{'dependencies'}=$env{'form.dependencies'};
+ $metadatafields{'modifyinguser'}=$env{'user.name'}.'@'.
+ $env{'user.domain'};
$metadatafields{'authorspace'}=$cuname.'@'.$cudom;
- my $allkeywords=$ENV{'form.addkey'};
- if (exists($ENV{'form.keywords'})) {
- if (ref($ENV{'form.keywords'})) {
- $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}});
+ my $allkeywords=$env{'form.addkey'};
+ if (exists($env{'form.keywords'})) {
+ if (ref($env{'form.keywords'})) {
+ $allkeywords .= ','.join(',',@{$env{'form.keywords'}});
} else {
- $allkeywords .= ','.$ENV{'form.keywords'};
+ $allkeywords .= ','.$env{'form.keywords'};
}
}
- $allkeywords=~s/[\;\,]/\,/;
$allkeywords=~s/[\"\']//g;
+ $allkeywords=~s/\s*[\;\,]\s*/\,/g;
$allkeywords=~s/\s+/ /g;
$allkeywords=~s/^[ \,]//;
$allkeywords=~s/[ \,]$//;
@@ -1389,18 +1486,20 @@ sub phasetwo {
if ($metadatafields{'copyright'} eq 'custom') {
my $file=$metadatafields{'customdistributionfile'};
unless ($file=~/\.rights$/) {
- return
+ $r->print(
''.&mt('No valid custom distribution rights file specified, FAIL').
- ' ';
+ '');
+ return 0;
}
}
{
print $logfile "\nWrite metadata file for ".$source;
my $mfh;
unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
- return
+ $r->print(
''.&mt('Could not write metadata, FAIL').
- ' ';
+ '');
+ return 0;
}
foreach (sort keys %metadatafields) {
unless ($_=~/\./) {
@@ -1451,7 +1550,9 @@ sub phasetwo {
my $srcd=$1;
unless ($srcd=~/^\/home\/httpd\/html\/res/) {
print $logfile "\nPANIC: Target dir is ".$srcd;
- return "Invalid target directory, FAIL ";
+ $r->print(
+ "Invalid target directory, FAIL ");
+ return 0;
}
opendir(DIR,$srcd);
while ($filename=readdir(DIR)) {
@@ -1476,8 +1577,9 @@ sub phasetwo {
$r->print(''.&mt('Copied old target file').'
');
} else {
print $logfile "Unable to write ".$copyfile.':'.$!."\n";
- return "".&mt('Failed to copy old target').
- ", $!, ".&mt('FAIL')." ";
+ $r->print("".&mt('Failed to copy old target').
+ ", $!, ".&mt('FAIL')." ");
+ return 0;
}
# --------------------------------------------------------------- Copy Metadata
@@ -1490,9 +1592,10 @@ sub phasetwo {
} else {
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
if (-e $target.'.meta') {
- return
+ $r->print(
"".
-&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')." ";
+&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."");
+ return 0;
}
}
@@ -1523,8 +1626,9 @@ sub phasetwo {
$r->print(''.&mt('Copied source file').'
');
} else {
print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
- return "".
- &mt('Failed to copy source').", $!, ".&mt('FAIL')." ";
+ $r->print("".
+ &mt('Failed to copy source').", $!, ".&mt('FAIL')." ");
+ return 0;
}
# --------------------------------------------------------------- Copy Metadata
@@ -1536,50 +1640,28 @@ sub phasetwo {
$r->print(''.&mt('Copied metadata').'
');
} else {
print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
- return
- "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')." ";
+ $r->print(
+ "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')." ");
+ return 0;
}
$r->rflush;
-# --------------------------------------------------- Send update notifications
- my @subscribed=&get_subscribed_hosts($target);
- foreach my $subhost (@subscribed) {
- $r->print(''.&mt('Notifying host').' '.$subhost.':');$r->rflush;
- print $logfile "\nNotifying host ".$subhost.':';
- my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
- $r->print($reply.'
');$r->rflush;
- print $logfile $reply;
+# ------------------------------------------------------------- Trigger updates
+ push(@{$modified_urls},[$target,$source]);
+ unless ($registered_cleanup) {
+ $r->register_cleanup(\¬ify);
+ $registered_cleanup=1;
}
-
-# ---------------------------------------- Send update notifications, meta only
- my @subscribedmeta=&get_subscribed_hosts("$target.meta");
- foreach my $subhost (@subscribedmeta) {
- $r->print(''.
-&mt('Notifying host for metadata only').' '.$subhost.':');$r->rflush;
- print $logfile "\nNotifying host for metadata only ".$subhost.':';
- my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
- $subhost);
- $r->print($reply.'
');$r->rflush;
- print $logfile $reply;
- }
-
-# --------------------------------------------------- Notify subscribed courses
- my %courses=&coursedependencies($target);
- my $now=time;
- foreach (keys %courses) {
- $r->print(''.&mt('Notifying course').' '.$_.':');$r->rflush;
- print $logfile "\nNotifying host ".$_.':';
- my ($cdom,$cname)=split(/\_/,$_);
- my $reply=&Apache::lonnet::cput
- ('versionupdate',{$target => $now},$cdom,$cname);
- $r->print($reply.'
');$r->rflush;
- print $logfile $reply;
- }
+# ---------------------------------------------------------- Clear local caches
+ my $thisdistarget=$target;
+ $thisdistarget=~s/^\Q$docroot\E//;
+ &Apache::lonnet::devalidate_cache_new('resversion',$target);
+ &Apache::lonnet::devalidate_cache_new('meta',
+ &Apache::lonnet::declutter($thisdistarget));
+
# ------------------------------------------------ Provide link to new resource
unless ($batch) {
- my $thisdistarget=$target;
- $thisdistarget=~s/^\Q$docroot\E//;
my $thissrc=$source;
$thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;
@@ -1597,15 +1679,54 @@ sub phasetwo {
'">'.
&mt('Back to Source Directory').' ');
}
- return ''.&mt('Done').'
';
+ $logfile->close();
+ $r->print(''.&mt('Done').'
');
+ return 1;
+}
+
+# =============================================================== Notifications
+sub notify {
+# --------------------------------------------------- Send update notifications
+ foreach my $targetsource (@{$modified_urls}){
+ my ($target,$source)=@{$targetsource};
+ my $logfile=Apache::File->new('>>'.$source.'.log');
+ print $logfile "\nCleanup phase: Notifications\n";
+ my @subscribed=&get_subscribed_hosts($target);
+ foreach my $subhost (@subscribed) {
+ print $logfile "\nNotifying host ".$subhost.':';
+ my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
+ print $logfile $reply;
+ }
+# ---------------------------------------- Send update notifications, meta only
+ my @subscribedmeta=&get_subscribed_hosts("$target.meta");
+ foreach my $subhost (@subscribedmeta) {
+ print $logfile "\nNotifying host for metadata only ".$subhost.':';
+ my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
+ $subhost);
+ print $logfile $reply;
+ }
+# --------------------------------------------------- Notify subscribed courses
+ my %courses=&coursedependencies($target);
+ my $now=time;
+ foreach (keys %courses) {
+ print $logfile "\nNotifying course ".$_.':';
+ my ($cdom,$cname)=split(/\_/,$_);
+ my $reply=&Apache::lonnet::cput
+ ('versionupdate',{$target => $now},$cdom,$cname);
+ print $logfile $reply;
+ }
+ print $logfile "\n============ Done ============\n";
+ $logfile->close();
+ }
+ return OK;
}
#########################################
sub batchpublish {
my ($r,$srcfile,$targetfile)=@_;
- #publication pollutes %ENV with form.* values
- my %oldENV=%ENV;
+ #publication pollutes %env with form.* values
+ my %oldenv=%env;
$srcfile=~s/\/+/\//g;
$targetfile=~s/\/+/\//g;
my $thisdisfn=$srcfile;
@@ -1633,13 +1754,13 @@ sub batchpublish {
$r->print(''.$outstring.'
');
# phase two takes
# my ($source,$target,$style,$distarget,batch)=@_;
-# $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},...
+# $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...
if (!$error) {
$r->print('');
&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
$r->print('
');
}
- %ENV=%oldENV;
+ %env=%oldenv;
return '';
}
@@ -1656,47 +1777,59 @@ sub publishdirectory {
&mt('Target').': '.$resdir.' ');
my $dirptr=16384; # Mask indicating a directory in stat.cmode.
-
- opendir(DIR,$fn);
- my @files=sort(readdir(DIR));
- foreach my $filename (@files) {
- my ($cdev,$cino,$cmode,$cnlink,
- $cuid,$cgid,$crdev,$csize,
- $catime,$cmtime,$cctime,
- $cblksize,$cblocks)=stat($fn.'/'.$filename);
-
- my $extension='';
- if ($filename=~/\.(\w+)$/) { $extension=$1; }
- if ($cmode&$dirptr) {
- if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {
- &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
- }
- } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
- ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
+ unless ($env{'form.phase'} eq 'two') {
+# ask user what they want
+ $r->print('');
+ } else {
+# actually publish things
+ opendir(DIR,$fn);
+ my @files=sort(readdir(DIR));
+ foreach my $filename (@files) {
+ my ($cdev,$cino,$cmode,$cnlink,
+ $cuid,$cgid,$crdev,$csize,
+ $catime,$cmtime,$cctime,
+ $cblksize,$cblocks)=stat($fn.'/'.$filename);
+
+ my $extension='';
+ if ($filename=~/\.(\w+)$/) { $extension=$1; }
+ if ($cmode&$dirptr) {
+ if (($filename!~/^\./) && ($env{'form.pubrec'})) {
+ &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
+ }
+ } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
+ ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
# find out publication status and/or exiting metadata
- my $publishthis=0;
- if (-e $resdir.'/'.$filename) {
- my ($rdev,$rino,$rmode,$rnlink,
- $ruid,$rgid,$rrdev,$rsize,
- $ratime,$rmtime,$rctime,
- $rblksize,$rblocks)=stat($resdir.'/'.$filename);
- if (($rmtime<$cmtime) || ($ENV{'form.forcerepub'})) {
+ my $publishthis=0;
+ if (-e $resdir.'/'.$filename) {
+ my ($rdev,$rino,$rmode,$rnlink,
+ $ruid,$rgid,$rrdev,$rsize,
+ $ratime,$rmtime,$rctime,
+ $rblksize,$rblocks)=stat($resdir.'/'.$filename);
+ if (($rmtime<$cmtime) || ($env{'form.forcerepub'})) {
# previously published, modified now
- $publishthis=1;
- }
- } else {
+ $publishthis=1;
+ }
+ } else {
# never published
- $publishthis=1;
- }
- if ($publishthis) {
- &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
- } else {
- $r->print(' '.&mt('Skipping').' '.$filename.' ');
+ $publishthis=1;
+ }
+ if ($publishthis) {
+ &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
+ } else {
+ $r->print(' '.&mt('Skipping').' '.$filename.' ');
+ }
+ $r->rflush();
}
- $r->rflush();
}
+ closedir(DIR);
}
- closedir(DIR);
}
#########################################
@@ -1809,9 +1942,12 @@ sub handler {
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['filename']);
+# -------------------------------------- Flag and buffer for registered cleanup
+ $registered_cleanup=0;
+ @{$modified_urls}=();
# -------------------------------------------------------------- Check filename
- my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
+ my $fn=&Apache::lonnet::unescape($env{'form.filename'});
($cuname,$cudom)=
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
@@ -1830,7 +1966,7 @@ sub handler {
unless (($cuname) && ($cudom)) {
$r->log_reason($cuname.' at '.$cudom.
- ' trying to publish file '.$ENV{'form.filename'}.
+ ' trying to publish file '.$env{'form.filename'}.
' ('.$fn.') - not authorized',
$r->filename);
return HTTP_NOT_ACCEPTABLE;
@@ -1842,7 +1978,7 @@ sub handler {
foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; } }
unless ($allowed) {
$r->log_reason($cuname.' at '.$cudom.
- ' trying to publish file '.$ENV{'form.filename'}.
+ ' trying to publish file '.$env{'form.filename'}.
' ('.$fn.') - not homeserver ('.$home.')',
$r->filename);
return HTTP_NOT_ACCEPTABLE;
@@ -1856,7 +1992,7 @@ sub handler {
if ($1 ne $cuname) {
$r->log_reason($cuname.' at '.$cudom.
' trying to publish unowned file '.
- $ENV{'form.filename'}.' ('.$fn.')',
+ $env{'form.filename'}.' ('.$fn.')',
$r->filename);
return HTTP_NOT_ACCEPTABLE;
} else {
@@ -1867,43 +2003,42 @@ sub handler {
unless (-e $fn) {
$r->log_reason($cuname.' at '.$cudom.
' trying to publish non-existing file '.
- $ENV{'form.filename'}.' ('.$fn.')',
+ $env{'form.filename'}.' ('.$fn.')',
$r->filename);
return HTTP_NOT_FOUND;
}
- unless ($ENV{'form.phase'} eq 'two') {
-
# -------------------------------- 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;
- }
+ %addid=();
+
+ {
+ my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
+ while (<$fh>=~/(\w+)\s+(\w+)/) {
+ $addid{$1}=$2;
}
+ }
- %nokey=();
+ %nokey=();
- {
- my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
- while (<$fh>) {
- my $word=$_;
- chomp($word);
- $nokey{$word}=1;
- }
+ {
+ my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
+ while (<$fh>) {
+ my $word=$_;
+ chomp($word);
+ $nokey{$word}=1;
}
-
}
# ---------------------------------------------------------- Start page output.
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
-
- $r->print('LON-CAPA Publishing ');
+
+ my $js=&Apache::loncommon::browser_and_searcher_javascript();
+ $r->print('LON-CAPA Publishing
+ ');
$r->print(&Apache::loncommon::bodytag('Resource Publication'));
@@ -1923,7 +2058,7 @@ sub handler {
if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory
&publishdirectory($r,$fn,$thisdisfn);
- $r->print(''.&mt('Done').' '.&mt('Return to Directory').' ');
@@ -1933,6 +2068,7 @@ sub handler {
$thisfn=~/\.(\w+)$/;
my $thistype=$1;
my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
+ if ($thistype eq 'page') { $thisembstyle = 'rat'; }
$r->print(''.&mt('Publishing').' '.
&Apache::loncommon::filedescription($thistype).' ');
@@ -1943,7 +2079,7 @@ ENDCAPTION
$r->print(' '.&mt('Target').': '.
$thisdistarget.' ');
- if (($cuname ne $ENV{'user.name'})||($cudom ne $ENV{'user.domain'})) {
+ if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) {
$r->print(''.&mt('Co-Author').': '.
$cuname.&mt(' at ').$cudom.' ');
}
@@ -1958,12 +2094,24 @@ ENDDIFF
# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.
- unless ($ENV{'form.phase'} eq 'two') {
- my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);
- $r->print(' '.$outstring);
+ unless ($env{'form.phase'} eq 'two') {
+# ---------------------------------------------------------- Parse for problems
+ my ($warningcount,$errorcount);
+ if ($thisembstyle eq 'ssi') {
+ ($warningcount,$errorcount)=&checkonthis($r,$thisfn);
+ }
+ unless ($errorcount) {
+ my ($outstring,$error)=
+ &publish($thisfn,$thistarget,$thisembstyle);
+ $r->print(' '.$outstring);
+ } else {
+ $r->print(''.
+ &mt('The document contains errors and cannot be published.').
+ ' ');
+ }
} else {
- $r->print(' '.
- &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget));
+ &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);
+ $r->print(' ');
}
}
$r->print('');