--- loncom/publisher/lonpublisher.pm 2004/05/21 19:27:02 1.167 +++ loncom/publisher/lonpublisher.pm 2005/04/04 23:51:54 1.190 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.167 2004/05/21 19:27:02 albertel Exp $ +# $Id: lonpublisher.pm,v 1.190 2005/04/04 23:51:54 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -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; } } @@ -328,6 +332,21 @@ sub textfield { ''; } +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; @@ -471,7 +490,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); } @@ -528,7 +548,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 +561,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 +604,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; @@ -654,13 +676,15 @@ sub fix_ids_and_indices { 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"; } } 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"; @@ -801,55 +825,57 @@ 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 ($errorcount,$warningcount); + 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 @@ -956,7 +982,7 @@ sub publish { } } } - $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s; + $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s; # ------------------------------------------------------------- Write modified. @@ -1015,6 +1041,7 @@ sub publish { $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix); $prefix=~s|^\.\./||; } + # ----------------------------------------------------------- Parse file itself # read %metadatafields from file itself @@ -1102,8 +1129,13 @@ sub publish { } - foreach (split(/\W+/,$metadatafields{'keywords'})) { - $keywords{$_}=1; + foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) { + $addkey=~s/\s+/ /g; + $addkey=~s/^\s//; + $addkey=~s/\s$//; + if ($addkey=~/\w/) { + $keywords{$addkey}=1; + } } # --------------------------------------------------- Now we also have keywords # ============================================================================= @@ -1153,7 +1185,7 @@ END my $colcount=0; foreach (sort keys %keywords) { - $keywordout.=''; + $keywordout.=' />'.$_.''; if ($colcount>10) { $keywordout.="\n"; $colcount=0; @@ -1228,11 +1260,20 @@ END $intr_scrout.=&textfield('Publisher/Owner','owner', $metadatafields{'owner'}); -# -------------------------------------------------- Correct copyright for rat. +# ---------------------------------------------- Retrofix for unused copyright + if ($metadatafields{'copyright'} eq 'free') { + $metadatafields{'copyright'}='default'; + $metadatafields{'sourceavail'}='open'; + } +# ------------------------------------------------ Dial in reasonable defaults my $defaultoption=$metadatafields{'copyright'}; unless ($defaultoption) { $defaultoption='default'; } + my $defaultsourceoption=$metadatafields{'sourceavail'}; + unless ($defaultsourceoption) { $defaultsourceoption='closed'; } unless ($style eq 'prv') { +# -------------------------------------------------- Correct copyright for rat. if ($style eq 'rat') { +# -------------------------------------- Retrofix for non-applicable copyright if ($metadatafields{'copyright'} eq 'public') { delete $metadatafields{'copyright'}; $defaultoption='default'; @@ -1241,33 +1282,35 @@ END $defaultoption, \&Apache::loncommon::copyrightdescription, (grep !/^public$/,(&Apache::loncommon::copyrightids))); - } else { - $intr_scrout.=&selectbox('Copyright/Distribution','copyright', - $defaultoption, - \&Apache::loncommon::copyrightdescription, - (&Apache::loncommon::copyrightids)); - } - - my $copyright_help = - Apache::loncommon::help_open_topic('Publishing_Copyright'); - $intr_scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; - $intr_scrout.=&textfield('Custom Distribution File','customdistributionfile', - $metadatafields{'customdistributionfile'}). - $copyright_help; - my $uctitle=&mt('Obsolete'); - $intr_scrout.= - "\n

$uctitle:". - ' $uctitle:". + '

'; @@ -1357,6 +1400,7 @@ sub phasetwo { $metadatafields{'highestgradelevel'}=$ENV{'form.highestgradelevel'}; $metadatafields{'customdistributionfile'}= $ENV{'form.customdistributionfile'}; + $metadatafields{'sourceavail'}=$ENV{'form.sourceavail'}; $metadatafields{'obsolete'}=$ENV{'form.obsolete'}; $metadatafields{'obsoletereplacement'}= $ENV{'form.obsoletereplacement'}; @@ -1373,8 +1417,11 @@ sub phasetwo { $allkeywords .= ','.$ENV{'form.keywords'}; } } - $allkeywords=~s/\W+/\,/; - $allkeywords=~s/^\,//; + $allkeywords=~s/[\"\']//g; + $allkeywords=~s/\s*[\;\,]\s*/\,/g; + $allkeywords=~s/\s+/ /g; + $allkeywords=~s/^[ \,]//; + $allkeywords=~s/[ \,]$//; $metadatafields{'keywords'}=$allkeywords; # check if custom distribution file is specified @@ -1532,41 +1579,12 @@ sub phasetwo { "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL').""; } $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; - } - -# ---------------------------------------- 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; +# ------------------------------------------------------------- Trigger updates + push(@{$modified_urls},[$target,$source]); + unless ($registered_cleanup) { + $r->register_cleanup(\¬ify); + $registered_cleanup=1; } # ------------------------------------------------ Provide link to new resource unless ($batch) { @@ -1589,9 +1607,47 @@ sub phasetwo { '">'. &mt('Back to Source Directory').'

'); } + $logfile->close(); return '

'.&mt('Done').'

'; } +# =============================================================== 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 { @@ -1672,7 +1728,7 @@ sub publishdirectory { $ruid,$rgid,$rrdev,$rsize, $ratime,$rmtime,$rctime, $rblksize,$rblocks)=stat($resdir.'/'.$filename); - if (($rmtime<$cmtime) || ($ENV{'form.forcerepub'})) { + if (($rmtime<$cmtime) || ($ENV{'form.forcerepub'} eq 'ON')) { # previously published, modified now $publishthis=1; } @@ -1801,6 +1857,9 @@ 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'}); @@ -1894,8 +1953,11 @@ sub handler { &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')); @@ -1951,8 +2013,20 @@ ENDDIFF # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. unless ($ENV{'form.phase'} eq 'two') { - my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle); - $r->print('
'.$outstring); +# ---------------------------------------------------------- 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));