--- loncom/publisher/lonpublisher.pm 2005/05/20 18:28:22 1.195
+++ loncom/publisher/lonpublisher.pm 2007/01/26 22:16:33 1.218
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.195 2005/05/20 18:28:22 www Exp $
+# $Id: lonpublisher.pm,v 1.218 2007/01/26 22:16:33 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -129,6 +129,8 @@ use Apache::loncfile;
use LONCAPA::lonmetadata;
use Apache::lonmsg;
use vars qw(%metadatafields %metadatakeys);
+use LONCAPA qw(:DEFAULT :match);
+
my %addid;
my %nokey;
@@ -278,9 +280,8 @@ sub metaread {
sub coursedependencies {
my $url=&Apache::lonnet::declutter(shift);
$url=~s/\.meta$//;
- my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);
- my $regexp=$url;
- $regexp=~s/(\W)/\\$1/g;
+ my ($adomain,$aauthor)=($url=~ m{^($match_domain)/($match_username)/});
+ my $regexp=quotemeta($url);
$regexp='___'.$regexp.'___course';
my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
$aauthor,$regexp);
@@ -355,7 +356,8 @@ sub hiddenfield {
sub checkbox {
my ($name,$text)=@_;
- return "\n
".&mt($text);
+ return "\n
";
}
sub selectbox {
@@ -469,7 +471,7 @@ sub set_allow {
($newurl !~ /^\#/)) {
$$allow{&absoluteurl($newurl,$target)}=1;
}
- return $return_url
+ return $return_url;
}
#########################################
@@ -493,7 +495,7 @@ sub get_subscribed_hosts {
my $srcf=$2;
opendir(DIR,$1);
while ($filename=readdir(DIR)) {
- if ($filename=~/\Q$srcf\E\.(\w+)$/) {
+ if ($filename=~/\Q$srcf\E\.($match_lonid)$/) {
my $subhost=$1;
if (($subhost ne 'meta' && $subhost ne 'subscription' &&
$subhost ne 'tmp') &&
@@ -505,19 +507,13 @@ sub get_subscribed_hosts {
closedir(DIR);
my $sh;
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 ($subline =~ /^($match_lonid):/) {
if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) {
push(@subscribed,$1);
}
- } else {
- &Apache::lonnet::logthis("No Match for $subline");
}
}
- } else {
- &Apache::lonnet::logthis("Unable to open $target.subscription");
}
return @subscribed;
}
@@ -547,6 +543,7 @@ sub get_max_ids_indices {
my %duplicatedids;
my $parser=HTML::LCParser->new($content);
+ $parser->xml_mode(1);
my $token;
while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {
@@ -676,6 +673,7 @@ 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}; }
@@ -685,7 +683,9 @@ sub fix_ids_and_indices {
$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'}) &&
@@ -696,12 +696,14 @@ sub fix_ids_and_indices {
}
}
}
- 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});
+ }
}
}
}
@@ -712,6 +714,7 @@ sub fix_ids_and_indices {
($lctag eq 'image')) {
my $next_token=$parser[-1]->get_token();
if ($next_token->[0] eq 'T') {
+ $next_token->[1] =~ s/[\n\r\f]+//g;
$next_token->[1]=&set_allow(\%allow,$logfile,
$target,$tag,
$next_token->[1]);
@@ -837,7 +840,7 @@ sub store_metadata {
$status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef,
$metadata{'url'});
} else {
- $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,
+ $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,undef,
\%metadata);
}
if (defined($status) && $status ne '') {
@@ -847,7 +850,7 @@ sub store_metadata {
&Apache::lonnet::logthis($status);
return ($error,undef);
}
- return (undef,$status);
+ return (undef,'success');
}
@@ -933,7 +936,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
@@ -978,7 +981,7 @@ sub publish {
my %temphash=(&Apache::lonnet::declutter($target).'___'.
&Apache::lonnet::declutter($thisdep).'___usage'
=> time);
- $thisdep=~/^\/res\/(\w+)\/(\w+)\//;
+ $thisdep=~m{^/res/($match_domain)/($match_username)/};
if ((defined($1)) && (defined($2))) {
&Apache::lonnet::put('nohist_resevaldata',\%temphash,
$1,$2);
@@ -1027,7 +1030,7 @@ sub publish {
$env{'environment.generation'};
$metadatafields{'author'}=~s/\s+/ /g;
$metadatafields{'author'}=~s/\s+$//;
- $metadatafields{'owner'}=$cuname.'@'.$cudom;
+ $metadatafields{'owner'}=$cuname.':'.$cudom;
# ------------------------------------------------ Check out directory hierachy
@@ -1162,7 +1165,7 @@ sub publish {
''.($env{'form.makeobsolete'}?'':'').'
'.
&hiddenfield('phase','two').
&hiddenfield('filename',$env{'form.filename'}).
- &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
+ &hiddenfield('allmeta',&escape($allmeta)).
&hiddenfield('dependencies',join(',',keys %allow));
unless ($env{'form.makeobsolete'}) {
$intr_scrout.=
@@ -1309,15 +1312,15 @@ END
$defaultsourceoption,
\&Apache::loncommon::source_copyrightdescription,
(&Apache::loncommon::source_copyrightids));
- $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
+# $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
my $uctitle=&mt('Obsolete');
$intr_scrout.=
- "\n$uctitle:".
+ "\n');
+ 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 ($_=~/\./) {
@@ -1527,7 +1549,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)) {
@@ -1552,8 +1576,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
@@ -1566,9 +1591,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;
}
}
@@ -1599,8 +1625,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
@@ -1612,8 +1639,9 @@ 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;
@@ -1623,13 +1651,19 @@ sub phasetwo {
$r->register_cleanup(\¬ify);
$registered_cleanup=1;
}
+
+# ---------------------------------------------------------- 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/;
+ $thissrc=~s{^/home/($match_username)/public_html}{/priv/$1};
my $thissrcdir=$thissrc;
$thissrcdir=~s/\/[^\/]+$/\//;
@@ -1645,7 +1679,8 @@ sub phasetwo {
&mt('Back to Source Directory').'');
}
$logfile->close();
- return ''.&mt('Done').'
';
+ $r->print(''.&mt('Done').'
');
+ return 1;
}
# =============================================================== Notifications
@@ -1748,7 +1783,7 @@ sub publishdirectory {
&hiddenfield('filename',$env{'form.filename'}).
&checkbox('pubrec','include subdirectories').
&checkbox('forcerepub','force republication of previously published files').
- &checkbox('forceobsolete','make file(s) obsolete').
+ &checkbox('obsolete','make file(s) obsolete').
&checkbox('forceoverride','force directory level catalog information over existing').
'
');
} else {
@@ -1780,10 +1815,16 @@ sub publishdirectory {
# previously published, modified now
$publishthis=1;
}
+ my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];
+ my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];
+ if ( $meta_rmtime<$meta_cmtime ) {
+ $publishthis=1;
+ }
} else {
# never published
$publishthis=1;
}
+
if ($publishthis) {
&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
} else {
@@ -1812,8 +1853,7 @@ sub defaultmetapublish {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
- $r->print('LON-CAPA Publishing');
- $r->print(&Apache::loncommon::bodytag('Catalog Information Publication'));
+ $r->print(&Apache::loncommon::start_page('Catalog Information Publication'));
# ---------------------------------------------------------------- Write Source
my $copyfile=$target;
@@ -1849,7 +1889,7 @@ sub defaultmetapublish {
my $link=$fn;
$link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;
$r->print("".&mt('Back to Catalog Information').'');
- $r->print('