version 1.181, 2005/01/05 20:11:19
|
version 1.186, 2005/03/03 21:14:10
|
Line 138 my $docroot;
|
Line 138 my $docroot;
|
my $cuname; |
my $cuname; |
my $cudom; |
my $cudom; |
|
|
|
my $registered_cleanup; |
|
my $modified_urls; |
|
|
=pod |
=pod |
|
|
=item B<metaeval> |
=item B<metaeval> |
Line 545 sub get_max_ids_indices {
|
Line 548 sub get_max_ids_indices {
|
my $counter; |
my $counter; |
if ($counter=$addid{$token->[1]}) { |
if ($counter=$addid{$token->[1]}) { |
if ($counter eq 'id') { |
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; |
$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid; |
if (exists($allids{$token->[2]->{'id'}})) { |
if (exists($allids{$token->[2]->{'id'}})) { |
$duplicateids=1; |
$duplicateids=1; |
Line 557 sub get_max_ids_indices {
|
Line 561 sub get_max_ids_indices {
|
$needsfixup=1; |
$needsfixup=1; |
} |
} |
} else { |
} else { |
if (defined($token->[2]->{'index'})) { |
if (defined($token->[2]->{'index'}) && |
|
$token->[2]->{'index'} !~ /^\s*$/) { |
$maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex; |
$maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex; |
} else { |
} else { |
$needsfixup=1; |
$needsfixup=1; |
Line 671 sub fix_ids_and_indices {
|
Line 676 sub fix_ids_and_indices {
|
if (!$counter) { $counter=$addid{$lctag}; } |
if (!$counter) { $counter=$addid{$lctag}; } |
if ($counter) { |
if ($counter) { |
if ($counter eq 'id') { |
if ($counter eq 'id') { |
unless (defined($parms{'id'})) { |
unless (defined($parms{'id'}) && |
|
$parms{'id'}!~/^\s*$/) { |
$maxid++; |
$maxid++; |
$parms{'id'}=$maxid; |
$parms{'id'}=$maxid; |
print $logfile 'ID: '.$tag.':'.$maxid."\n"; |
print $logfile 'ID: '.$tag.':'.$maxid."\n"; |
} |
} |
} elsif ($counter eq 'index') { |
} elsif ($counter eq 'index') { |
unless (defined($parms{'index'})) { |
unless (defined($parms{'index'}) && |
|
$parms{'index'}!~/^\s*$/) { |
$maxindex++; |
$maxindex++; |
$parms{'index'}=$maxindex; |
$parms{'index'}=$maxindex; |
print $logfile 'Index: '.$tag.':'.$maxindex."\n"; |
print $logfile 'Index: '.$tag.':'.$maxindex."\n"; |
Line 839 sub store_metadata {
|
Line 846 sub store_metadata {
|
} |
} |
|
|
|
|
|
# ========================================== Parse file for errors and warnings |
|
|
|
sub checkonthis { |
|
my ($r,$source)=@_; |
|
my $oldpath=$ENV{'request.filename'}; |
|
$ENV{'request.filename'}=$source; |
|
&Apache::lonxml::xmlparse($r,'web', |
|
&Apache::lonnet::getfile($source)); |
|
undef($Apache::lonhomework::parsing_a_problem); |
|
$ENV{'request.filename'}=$oldpath; |
|
if (($Apache::lonxml::errorcount) || |
|
($Apache::lonxml::warningcount)) { |
|
if ($Apache::lonxml::errorcount) { |
|
$r->print('<img src="/adm/lonMisc/bomb.gif" /><font color="red"><b>'. |
|
$Apache::lonxml::errorcount.' '. |
|
&mt('error(s)').'</b></font> '); |
|
} |
|
if ($Apache::lonxml::warningcount) { |
|
$r->print('<font color="blue">'. |
|
$Apache::lonxml::warningcount.' '. |
|
&mt('warning(s)').'</font>'); |
|
} |
|
} else { |
|
$r->print('<font color="green">'.&mt('ok').'</font>'); |
|
} |
|
$r->rflush(); |
|
return ($Apache::lonxml::warningcount,$Apache::lonxml::errorcount); |
|
} |
|
|
# ============================================== Parse file itself for metadata |
# ============================================== Parse file itself for metadata |
# |
# |
# parses a file with target meta, sets global %metadatafields %metadatakeys |
# parses a file with target meta, sets global %metadatafields %metadatakeys |
Line 1004 sub publish {
|
Line 1040 sub publish {
|
$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix); |
$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix); |
$prefix=~s|^\.\./||; |
$prefix=~s|^\.\./||; |
} |
} |
|
|
# ----------------------------------------------------------- Parse file itself |
# ----------------------------------------------------------- Parse file itself |
# read %metadatafields from file itself |
# read %metadatafields from file itself |
|
|
Line 1543 sub phasetwo {
|
Line 1580 sub phasetwo {
|
$r->rflush; |
$r->rflush; |
|
|
# ------------------------------------------------------------- Trigger updates |
# ------------------------------------------------------------- Trigger updates |
$ENV{'internal.publication.target'}=$target; |
push(@{$modified_urls},[$target,$source]); |
$ENV{'internal.publication.source'}=$source; |
unless ($registered_cleanup) { |
$r->register_cleanup(\¬ify); |
$r->register_cleanup(\¬ify); |
|
$registered_cleanup=1; |
|
} |
# ------------------------------------------------ Provide link to new resource |
# ------------------------------------------------ Provide link to new resource |
unless ($batch) { |
unless ($batch) { |
my $thisdistarget=$target; |
my $thisdistarget=$target; |
Line 1575 sub phasetwo {
|
Line 1613 sub phasetwo {
|
# =============================================================== Notifications |
# =============================================================== Notifications |
sub notify { |
sub notify { |
# --------------------------------------------------- Send update notifications |
# --------------------------------------------------- Send update notifications |
my $target=$ENV{'internal.publication.target'}; |
foreach my $targetsource (@{$modified_urls}){ |
my $source=$ENV{'internal.publication.source'}; |
my ($target,$source)=@{$targetsource}; |
my $logfile=Apache::File->new('>>'.$source.'.log'); |
my $logfile=Apache::File->new('>>'.$source.'.log'); |
print $logfile "\nCleanup phase: Notifications\n"; |
print $logfile "\nCleanup phase: Notifications\n"; |
my @subscribed=&get_subscribed_hosts($target); |
my @subscribed=&get_subscribed_hosts($target); |
foreach my $subhost (@subscribed) { |
foreach my $subhost (@subscribed) { |
print $logfile "\nNotifying host ".$subhost.':'; |
print $logfile "\nNotifying host ".$subhost.':'; |
my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); |
my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); |
print $logfile $reply; |
print $logfile $reply; |
} |
} |
# ---------------------------------------- Send update notifications, meta only |
# ---------------------------------------- Send update notifications, meta only |
my @subscribedmeta=&get_subscribed_hosts("$target.meta"); |
my @subscribedmeta=&get_subscribed_hosts("$target.meta"); |
foreach my $subhost (@subscribedmeta) { |
foreach my $subhost (@subscribedmeta) { |
print $logfile "\nNotifying host for metadata only ".$subhost.':'; |
print $logfile "\nNotifying host for metadata only ".$subhost.':'; |
my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', |
my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', |
$subhost); |
$subhost); |
print $logfile $reply; |
print $logfile $reply; |
} |
} |
# --------------------------------------------------- Notify subscribed courses |
# --------------------------------------------------- Notify subscribed courses |
my %courses=&coursedependencies($target); |
my %courses=&coursedependencies($target); |
my $now=time; |
my $now=time; |
foreach (keys %courses) { |
foreach (keys %courses) { |
print $logfile "\nNotifying course ".$_.':'; |
print $logfile "\nNotifying course ".$_.':'; |
my ($cdom,$cname)=split(/\_/,$_); |
my ($cdom,$cname)=split(/\_/,$_); |
my $reply=&Apache::lonnet::cput |
my $reply=&Apache::lonnet::cput |
('versionupdate',{$target => $now},$cdom,$cname); |
('versionupdate',{$target => $now},$cdom,$cname); |
print $logfile $reply; |
print $logfile $reply; |
|
} |
|
print $logfile "\n============ Done ============\n"; |
|
$logfile->close(); |
} |
} |
print $logfile "\n============ Done ============\n"; |
return OK; |
$logfile->close(); |
|
} |
} |
|
|
######################################### |
######################################### |
Line 1687 sub publishdirectory {
|
Line 1727 sub publishdirectory {
|
$ruid,$rgid,$rrdev,$rsize, |
$ruid,$rgid,$rrdev,$rsize, |
$ratime,$rmtime,$rctime, |
$ratime,$rmtime,$rctime, |
$rblksize,$rblocks)=stat($resdir.'/'.$filename); |
$rblksize,$rblocks)=stat($resdir.'/'.$filename); |
if (($rmtime<$cmtime) || ($ENV{'form.forcerepub'})) { |
if (($rmtime<$cmtime) || ($ENV{'form.forcerepub'} eq 'ON')) { |
# previously published, modified now |
# previously published, modified now |
$publishthis=1; |
$publishthis=1; |
} |
} |
Line 1816 sub handler {
|
Line 1856 sub handler {
|
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, |
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, |
['filename']); |
['filename']); |
|
|
|
# -------------------------------------- Flag and buffer for registered cleanup |
|
$registered_cleanup=0; |
|
@{$modified_urls}=(); |
# -------------------------------------------------------------- Check filename |
# -------------------------------------------------------------- Check filename |
|
|
my $fn=&Apache::lonnet::unescape($ENV{'form.filename'}); |
my $fn=&Apache::lonnet::unescape($ENV{'form.filename'}); |
Line 1969 ENDDIFF
|
Line 2012 ENDDIFF
|
# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. |
# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. |
|
|
unless ($ENV{'form.phase'} eq 'two') { |
unless ($ENV{'form.phase'} eq 'two') { |
|
# ---------------------------------------------------------- Parse for problems |
|
&checkonthis($r,$thisfn); |
my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle); |
my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle); |
$r->print('<hr />'.$outstring); |
$r->print('<hr />'.$outstring); |
} else { |
} else { |