--- loncom/publisher/lonpublisher.pm 2004/09/02 19:34:46 1.178 +++ loncom/publisher/lonpublisher.pm 2005/05/30 16:56:46 1.196 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.178 2004/09/02 19:34:46 albertel Exp $ +# $Id: lonpublisher.pm,v 1.196 2005/05/30 16:56:46 www 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 @@ -323,26 +326,46 @@ 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:". '


'. + '

'.($env{'form.makeobsolete'}?'':'').'

'. &hiddenfield('phase','two'). - &hiddenfield('filename',$ENV{'form.filename'}). + &hiddenfield('filename',$env{'form.filename'}). &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)). - &hiddenfield('dependencies',join(',',keys %allow)). + &hiddenfield('dependencies',join(',',keys %allow)); + unless ($env{'form.makeobsolete'}) { + $intr_scrout.= &textfield('Title','title',$metadatafields{'title'}). &textfield('Author(s)','author',$metadatafields{'author'}). &textfield('Subject','subject',$metadatafields{'subject'}); - -# --------------------------------------------------- Scan content for keywords + # --------------------------------------------------- Scan content for keywords my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords"); my $KEYWORDS=&mt('Keywords'); @@ -1132,24 +1198,24 @@ END my $colcount=0; foreach (sort keys %keywords) { - $keywordout.=''; + $keywordout.=' />'.$_.''; if ($colcount>10) { $keywordout.="\n"; $colcount=0; } $colcount++; } - $ENV{'form.keywords'}=~s/\,$//; + $env{'form.keywords'}=~s/\,$//; $keywordout.=''; @@ -1237,16 +1303,13 @@ END } 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; + $intr_scrout =~ s/Distribution:/'Distribution: ' . $copyright_help/ge; + $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights').$copyright_help; $intr_scrout.=&selectbox('Source Distribution','sourceavail', $defaultsourceoption, \&Apache::loncommon::source_copyrightdescription, (&Apache::loncommon::source_copyrightids)); - $intr_scrout.=&textfield('Source Custom Distribution File','sourcerights', - $metadatafields{'sourcerights'}); + $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights'); my $uctitle=&mt('Obsolete'); $intr_scrout.= "\n

$uctitle:". @@ -1255,15 +1318,39 @@ END $intr_scrout.=' checked="1" '; } $intr_scrout.='/ >

'. - &textfield('Suggested Replacement for Obsolete File', - 'obsoletereplacement', - $metadatafields{'obsoletereplacement'}); + &text_with_browse_field('Suggested Replacement for Obsolete File', + 'obsoletereplacement', + $metadatafields{'obsoletereplacement'}); } else { $intr_scrout.=&hiddenfield('copyright','private'); } + } else { + $intr_scrout.= + &hiddenfield('title',$metadatafields{'title'}). + &hiddenfield('author',$metadatafields{'author'}). + &hiddenfield('subject',$metadatafields{'subject'}). + &hiddenfield('keywords',$metadatafields{'keywords'}). + &hiddenfield('abstract',$metadatafields{'abstract'}). + &hiddenfield('notes',$metadatafields{'notes'}). + &hiddenfield('mime',$metadatafields{'mime'}). + &hiddenfield('creationdate',$metadatafields{'creationdate'}). + &hiddenfield('lastrevisiondate',time). + &hiddenfield('owner',$metadatafields{'owner'}). + &hiddenfield('lowestgradelevel',$metadatafields{'lowestgradelevel'}). + &hiddenfield('standards',$metadatafields{'standards'}). + &hiddenfield('highestgradelevel',$metadatafields{'highestgradelevel'}). + &hiddenfield('language',$metadatafields{'language'}). + &hiddenfield('copyright',$metadatafields{'copyright'}). + &hiddenfield('sourceavail',$metadatafields{'sourceavail'}). + &hiddenfield('customdistributionfile',$metadatafields{'customdistributionfile'}). + &hiddenfield('obsolete',1). + &text_with_browse_field('Suggested Replacement for Obsolete File', + 'obsoletereplacement', + $metadatafields{'obsoletereplacement'}); + } if (!$batch) { $scrout.=$intr_scrout.'

'; + &mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication').'" />

'; } return($scrout,0); } @@ -1311,13 +1398,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')) { @@ -1327,44 +1430,44 @@ 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{'sourceavail'}=$ENV{'form.sourceavail'}; - $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/[\"\']//g; @@ -1529,41 +1632,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) { @@ -1586,15 +1660,53 @@ 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 { 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; @@ -1622,13 +1734,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 ''; } @@ -1645,47 +1757,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('
'. + &hiddenfield('phase','two'). + &hiddenfield('filename',$env{'form.filename'}). + &checkbox('pubrec','include subdirectories'). + &checkbox('forcerepub','force republication of previously published files'). + &checkbox('forceobsolete','make file(s) obsolete'). + &checkbox('forceoverride','force directory level catalog information over existing'). + '
'); + } 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); } ######################################### @@ -1798,9 +1922,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')); @@ -1819,7 +1946,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; @@ -1831,7 +1958,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; @@ -1845,7 +1972,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 { @@ -1856,12 +1983,12 @@ 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') { + unless ($env{'form.phase'} eq 'two') { # -------------------------------- File is there and owned, init lookup tables. @@ -1891,8 +2018,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')); @@ -1912,7 +2042,7 @@ sub handler { if ($fn=~/\/$/) { # -------------------------------------------------------- This is a directory &publishdirectory($r,$fn,$thisdisfn); - $r->print('
'.&mt('Done').'
'.&mt('Return to Directory').''); @@ -1932,7 +2062,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.'

'); } @@ -1947,9 +2077,21 @@ 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));