--- loncom/publisher/lonpublisher.pm 2003/11/01 17:38:58 1.142 +++ loncom/publisher/lonpublisher.pm 2008/05/12 20:59:22 1.233 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.142 2003/11/01 17:38:58 www Exp $ +# $Id: lonpublisher.pm,v 1.233 2008/05/12 20:59:22 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,24 +25,6 @@ # # http://www.lon-capa.org/ # -# -# (TeX Content Handler -# -# 05/29/00,05/30,10/11 Gerd Kortemeyer) -# -# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer -# 03/23 Guy Albertelli -# 03/24,03/29,04/03 Gerd Kortemeyer -# 05/03,05/05,05/07 Gerd Kortemeyer -# 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer -# 12/04,12/05 Guy Albertelli -# 12/05 Gerd Kortemeyer -# 12/05 Guy Albertelli -# 12/06,12/07 Gerd Kortemeyer -# 12/25 Gerd Kortemeyer -# YEAR=2002 -# 1/17 Gerd Kortemeyer -# ### ############################################################################### @@ -139,11 +121,16 @@ 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; +use Apache::loncfile; +use LONCAPA::lonmetadata; +use Apache::lonmsg; use vars qw(%metadatafields %metadatakeys); +use LONCAPA qw(:DEFAULT :match); + my %addid; my %nokey; @@ -153,6 +140,11 @@ my $docroot; my $cuname; my $cudom; +my $registered_cleanup; +my $modified_urls; + +my $lock; + =pod =item B @@ -180,6 +172,10 @@ nothing ######################################### ######################################### +# +# Modifies global %metadatafields %metadatakeys +# + sub metaeval { my ($metastring,$prefix)=@_; @@ -189,17 +185,18 @@ sub metaeval { if ($token->[0] eq 'S') { my $entry=$token->[1]; my $unikey=$entry; + next if ($entry =~ m/^(?:parameter|stores)_/); if (defined($token->[2]->{'package'})) { - $unikey.='_package_'.$token->[2]->{'package'}; + $unikey.="\0package\0".$token->[2]->{'package'}; } if (defined($token->[2]->{'part'})) { - $unikey.='_'.$token->[2]->{'part'}; + $unikey.="\0".$token->[2]->{'part'}; } if (defined($token->[2]->{'id'})) { - $unikey.='_'.$token->[2]->{'id'}; + $unikey.="\0".$token->[2]->{'id'}; } if (defined($token->[2]->{'name'})) { - $unikey.='_'.$token->[2]->{'name'}; + $unikey.="\0".$token->[2]->{'name'}; } foreach (@{$token->[3]}) { $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_}; @@ -210,11 +207,15 @@ 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; } } - unless ($metadatafields{$unikey}=~/\w/) { +# actually store + if ( $entry eq 'rule' && exists($metadatafields{$unikey})) { + $metadatafields{$unikey}.=','.$newentry; + } else { $metadatafields{$unikey}=$newentry; } } @@ -262,7 +263,8 @@ sub metaread { my ($logfile,$fn,$prefix)=@_; unless (-e $fn) { print($logfile 'No file '.$fn."\n"); - return '
No file: '.$fn.''; + return '
'.&mt('No file').': '. + &Apache::loncfile::display($fn).''; } print($logfile 'Processing '.$fn."\n"); my $metastring; @@ -271,7 +273,8 @@ sub metaread { $metastring=join('',<$metafh>); } &metaeval($metastring,$prefix); - return '
Processed file: '.$fn.''; + return '
'.&mt('Processed file').': '. + &Apache::loncfile::display($fn).''; } ######################################### @@ -280,9 +283,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); @@ -328,23 +330,49 @@ sub textfield { $value=~s/\s+$//gs; $value=~s/\s+/ /gs; $title=&mt($title); - my $uctitle=uc($title); - return "\n

$uctitle:". + $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:". + "


". + ''. + ''.&mt('Select').' '. + ''.&mt('Search').''; + +} + sub hiddenfield { my ($name,$value)=@_; + $env{'form.'.$name}=$value; return "\n".''; } +sub checkbox { + my ($name,$text)=@_; + return "\n
"; +} + sub selectbox { my ($title,$name,$value,$functionref,@idlist)=@_; $title=&mt($title); - my $uctitle=uc($title); $value=(split(/\s*,\s*/,$value))[-1]; - my $selout="\n

$uctitle:". + if (defined($value)) { + $env{'form.'.$name}=$value; + } else { + $env{'form.'.$name}=$idlist[0]; + } + my $selout="\n

$title:". '


'. - &hiddenfield('phase','two'). - &hiddenfield('filename',$ENV{'form.filename'}). - &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)). - &hiddenfield('dependencies',join(',',keys %allow)). - &textfield('Title','title',$metadatafields{'title'}). - &textfield('Author(s)','author',$metadatafields{'author'}). - &textfield('Subject','subject',$metadatafields{'subject'}); - -# --------------------------------------------------- Scan content for keywords - - my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords"); - my $keywordout=<<"END"; +# 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 +# batch mode + + my $intr_scrout.= + '
'. + '

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

'. + &hiddenfield('phase','two'). + &hiddenfield('filename',$env{'form.filename'}). + &hiddenfield('allmeta',&escape($allmeta)). + &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 + + my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords"); + my $KEYWORDS=&mt('Keywords'); + my $CheckAll=&mt('check all'); + my $UncheckAll=&mt('uncheck all'); + my $keywordout=<<"END"; -

KEYWORDS: +

$KEYWORDS: $keywords_help - - + +


END - $keywordout.=''; - my $colcount=0; + $keywordout.='
'; + my $colcount=0; - foreach (sort keys %keywords) { - $keywordout.='\n"; - $colcount=0; - } - $colcount++; + } elsif (&Apache::loncommon::keyword($_)) { + $keywordout.=' checked="on"'; + $env{'form.keywords'}.=$_.','; + } + $keywordout.=' />'.$_.''; + if ($colcount>10) { + $keywordout.="\n"; + $colcount=0; } + $colcount++; + } + $env{'form.keywords'}=~s/\,$//; - $keywordout.='
'; - if ($colcount>10) { - $keywordout.="
'; + $keywordout.=''; - $scrout.=$keywordout; + $intr_scrout.=$keywordout; - $scrout.=&textfield('Additional Keywords','addkey',''); + $intr_scrout.=&textfield('Additional Keywords','addkey',''); - $scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); + $intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); - $scrout.= - "\n

ABSTRACT:". - "


". - '

'; + $intr_scrout.= + "\n

".&mt('Abstract').":". + "


". + '

'; - $source=~/\.(\w+)$/; + $source=~/\.(\w+)$/; - $scrout.=&hiddenfield('mime',$1); - my $defaultlanguage=$metadatafields{'language'}; - $defaultlanguage =~ s/\s*notset\s*//g; - $defaultlanguage =~ s/^,\s*//g; - $defaultlanguage =~ s/,\s*$//g; + $intr_scrout.= + "\n

". + &mt('Lowest Grade Level').':'. + "


". + &select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel'). + "\n

". + &mt('Highest Grade Level').':'. + "


". + &select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel'). + &textfield('Standards','standards',$metadatafields{'standards'}); + - $scrout.=&selectbox('Language','language', - $defaultlanguage, - \&Apache::loncommon::languagedescription, - (&Apache::loncommon::languageids), - ); - unless ($metadatafields{'creationdate'}) { - $metadatafields{'creationdate'}=time; - } - $scrout.=&hiddenfield('creationdate', - &Apache::loncommon::unsqltime($metadatafields{'creationdate'})); - $scrout.=&hiddenfield('lastrevisiondate',time); + $intr_scrout.=&hiddenfield('mime',$1); + my $defaultlanguage=$metadatafields{'language'}; + $defaultlanguage =~ s/\s*notset\s*//g; + $defaultlanguage =~ s/^,\s*//g; + $defaultlanguage =~ s/,\s*$//g; - $scrout.=&textfield('Publisher/Owner','owner', - $metadatafields{'owner'}); + $intr_scrout.=&selectbox('Language','language', + $defaultlanguage, + \&Apache::loncommon::languagedescription, + (&Apache::loncommon::languageids), + ); + unless ($metadatafields{'creationdate'}) { + $metadatafields{'creationdate'}=time; + } + $intr_scrout.=&hiddenfield('creationdate', + &Apache::lonmysql::unsqltime($metadatafields{'creationdate'})); + + $intr_scrout.=&hiddenfield('lastrevisiondate',time); + + + $intr_scrout.=&textfield('Publisher/Owner','owner', + $metadatafields{'owner'}); + +# ---------------------------------------------- Retrofix for unused copyright + if ($metadatafields{'copyright'} eq 'free') { + $metadatafields{'copyright'}='default'; + $metadatafields{'sourceavail'}='open'; + } + if ($metadatafields{'copyright'} eq 'priv') { + $metadatafields{'copyright'}='domain'; + } +# ------------------------------------------------ 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. - my $defaultoption=$metadatafields{'copyright'}; - unless ($defaultoption) { $defaultoption='default'; } - unless ($style eq 'prv') { - if ($style eq 'rat') { - if ($metadatafields{'copyright'} eq 'public') { - delete $metadatafields{'copyright'}; - $defaultoption='default'; - } - $scrout.=&selectbox('Copyright/Distribution','copyright', - $defaultoption, - \&Apache::loncommon::copyrightdescription, - (grep !/^public$/,(&Apache::loncommon::copyrightids))); - } else { - $scrout.=&selectbox('Copyright/Distribution','copyright', - $defaultoption, - \&Apache::loncommon::copyrightdescription, - (&Apache::loncommon::copyrightids)); - } - - my $copyright_help = - Apache::loncommon::help_open_topic('Publishing_Copyright'); - $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; - $scrout.=&textfield('Custom Distribution File','customdistributionfile', - $metadatafields{'customdistributionfile'}). - $copyright_help; - my $uctitle=uc(&mt('Obsolete')); - $scrout.= - "\n

$uctitle:". - '

',0); -# ============================================================================= -# BATCH MODE -# + $intr_scrout.='/ >

'. + &text_with_browse_field('Suggested Replacement for Obsolete File', + 'obsoletereplacement', + $metadatafields{'obsoletereplacement'}); } else { -# Transfer metadata directly to environment for stage 2 - foreach (keys %metadatafields) { - $ENV{'form.'.$_}=$metadatafields{$_}; - } - $ENV{'form.addkey'}=''; - $ENV{'form.keywords'}=''; - foreach (keys %keywords) { - if ($metadatafields{'keywords'}) { - if ($metadatafields{'keywords'}=~/\Q$_\E/) { - $ENV{'form.keywords'}.=$_.','; - } - } elsif (&Apache::loncommon::keyword($_)) { - $ENV{'form.keywords'}.=$_.','; - } - } - $ENV{'form.keywords'}=~s/\,$//; - unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; } - $ENV{'form.lastrevisiondate'}=time; - if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) || - (!$ENV{'form.copyright'})) { - $ENV{'form.copyright'}='default'; - } - $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta); - return ($scrout,0); + $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.'

'; + } + return($scrout,0); } ######################################### @@ -1266,10 +1410,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 @@ -1281,66 +1425,109 @@ 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] in filename, FAIL.',"'.$1.'"). + ''); + 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')) { $r->print( - ''. - &mt('No write permission to user directory, FAIL').''); + ''. + &mt('No write permission to user directory, FAIL').''); return 0; } + + if ($source =~ /\.rights$/) { + $r->print('

'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'

'); + } + 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(&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{'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'}; + $env{'form.obsoletereplacement'}; + $metadatafields{'dependencies'}=$env{'form.dependencies'}; + $metadatafields{'modifyinguser'}=$env{'user.name'}.':'. + $env{'user.domain'}; + $metadatafields{'authorspace'}=$cuname.':'.$cudom; + $metadatafields{'domain'}=$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/\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 + if ($metadatafields{'copyright'} eq 'custom') { + my $file=$metadatafields{'customdistributionfile'}; + unless ($file=~/\.rights$/) { + $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 - ''.&mt('Could not write metadata, FAIL'). - ''; + $r->print( + ''.&mt('Could not write metadata, FAIL'). + ''); + return 0; } foreach (sort keys %metadatafields) { unless ($_=~/\./) { @@ -1355,7 +1542,7 @@ sub phasetwo { print $mfh ' '.$_.'="'.$value.'"'; } print $mfh '>'. - &HTML::Entities::encode($metadatafields{$unikey}) + &HTML::Entities::encode($metadatafields{$unikey},'<>&"') .''; } } @@ -1367,21 +1554,19 @@ sub phasetwo { $metadatafields{'url'} = $distarget; $metadatafields{'version'} = 'current'; - unless ($metadatafields{'copyright'} eq 'priv') { - my ($error,$success) = &store_metadata(\%metadatafields); - if ($success) { - $r->print('

'.&mt('Synchronized SQL metadata database').'

'); - print $logfile "\nSynchronized SQL metadata database"; - } else { - $r->print($error); - print $logfile "\n".$error; - } + + my ($error,$success) = &store_metadata(%metadatafields); + if ($success) { + $r->print('

'.&mt('Synchronized SQL metadata database').'

'); + print $logfile "\nSynchronized SQL metadata database"; } else { - $r->print('

'. - &mt('Private Publication - did not synchronize database').'

'); - print $logfile "\nPrivate: Did not synchronize data into ". - "SQL metadata database"; + $r->print($error); + print $logfile "\n".$error; } +# --------------------------------------------- Delete author resource messages + my $delresult=&Apache::lonmsg::del_url_author_res_msg($target); + $r->print('

'.&mt('Removing error messages:').' '.$delresult.'

'); + print $logfile "\nRemoving error messages: $delresult"; # ----------------------------------------------------------- Copy old versions if (-e $target) { @@ -1393,7 +1578,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)) { @@ -1418,8 +1605,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 @@ -1432,9 +1620,10 @@ sub phasetwo { } else { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { - return - "". -&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL').""; + $r->print( + "". +&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL').""); + return 0; } } @@ -1465,8 +1654,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 @@ -1478,53 +1668,31 @@ 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/; + $thissrc=~s{^/home/($match_username)/public_html}{/priv/$1}; my $thissrcdir=$thissrc; $thissrcdir=~s/\/[^\/]+$/\//; @@ -1539,14 +1707,55 @@ sub phasetwo { '">'. &mt('Back to Source Directory').'

'); } + $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(); + } + if ($lock) { &Apache::lonnet::remove_lock($lock); } + 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; @@ -1574,13 +1783,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 ''; } @@ -1593,51 +1802,127 @@ sub publishdirectory { my $resdir= $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'. $thisdisfn; - $r->print('

Directory '.$thisdisfn.'

'. - 'Target: '.$resdir.'
'); + $r->print('

'.&mt('Directory').' '.$thisdisfn.'

'. + &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('obsolete','make file(s) obsolete'). + &checkbox('forceoverride','force directory level catalog information over existing'). + '
'); + $lock=0; + } else { + unless ($lock) { $lock=&Apache::lonnet::set_lock('Publishing '.$fn); } +# 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; + } + 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 { - $r->print('
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); +} + +######################################### +# publish a default.meta file + +sub defaultmetapublish { + my ($r,$fn,$cuname,$cudom)=@_; + $fn=~s/^\/\~$cuname\//\/home\/$cuname\/public_html\//; + unless (-e $fn) { + return HTTP_NOT_FOUND; + } + my $target=$fn; + $target=~s/^\/home\/$cuname\/public_html\//$Apache::lonnet::perlvar{'lonDocRoot'}\/res\/$cudom\/$cuname\//; + + + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + + $r->print(&Apache::loncommon::start_page('Catalog Information Publication')); + +# ---------------------------------------------------------------- Write Source + my $copyfile=$target; + + my @parts=split(/\//,$copyfile); + my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; + + my $count; + for ($count=5;$count<$#parts;$count++) { + $path.="/$parts[$count]"; + if ((-e $path)!=1) { + $r->print('

'.&mt('Created directory').' '.$parts[$count].'

'); + mkdir($path,0777); + } + } + + if (copy($fn,$copyfile)) { + $r->print('

'.&mt('Copied source file').'

'); + } else { + return "". + &mt('Failed to copy source').", $!, ".&mt('FAIL').""; + } + +# --------------------------------------------------- Send update notifications + + my @subscribed=&get_subscribed_hosts($target); + foreach my $subhost (@subscribed) { + $r->print('

'.&mt('Notifying host').' '.$subhost.':');$r->rflush; + my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); + $r->print($reply.'


');$r->rflush; + } +# ------------------------------------------------------------------- Link back + my $link=$fn; + $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//; + $r->print("".&mt('Back to Catalog Information').''); + $r->print(&Apache::loncommon::end_page()); + return OK; } ######################################### @@ -1693,10 +1978,21 @@ 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=&unescape($env{'form.filename'}); + + ($cuname,$cudom)= + &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); +# special publication: default.meta file + if ($fn=~/\/default.meta$/) { + return &defaultmetapublish($r,$fn,$cuname,$cudom); + } + $fn=~s/\.meta$//; unless ($fn) { $r->log_reason($cuname.' at '.$cudom. @@ -1704,35 +2000,35 @@ sub handler { return HTTP_NOT_FOUND; } - ($cuname,$cudom)= - &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); 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; } - unless (&Apache::lonnet::homeserver($cuname,$cudom) - eq $r->dir_config('lonHostID')) { + my $home=&Apache::lonnet::homeserver($cuname,$cudom); + my $allowed=0; + my @ids=&Apache::lonnet::current_machine_ids(); + 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'}. - ' ('.$fn.') - not homeserver ('. - &Apache::lonnet::homeserver($cuname,$cudom).')', + ' trying to publish file '.$env{'form.filename'}. + ' ('.$fn.') - not homeserver ('.$home.')', $r->filename); return HTTP_NOT_ACCEPTABLE; } - $fn=~s/^http\:\/\/[^\/]+//; - $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/; + $fn=~s{^http://[^/]+}{}; + $fn=~s{^/~($match_username)}{/home/$1/public_html}; my $targetdir=''; $docroot=$r->dir_config('lonDocRoot'); 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 { @@ -1743,44 +2039,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'); - $r->print(&Apache::loncommon::bodytag('Resource Publication')); + + my $js=''; + $r->print(&Apache::loncommon::start_page('Resource Publication',$js)); my $thisfn=$fn; @@ -1799,7 +2093,7 @@ sub handler { if ($fn=~/\/$/) { # -------------------------------------------------------- This is a directory &publishdirectory($r,$fn,$thisdisfn); - $r->print('
'.&mt('Done').'
'.&mt('Return to Directory').''); @@ -1809,6 +2103,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).' '); @@ -1819,7 +2114,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.'

'); } @@ -1834,15 +2129,27 @@ 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); + $r->print('
'); } } - $r->print(''); + $r->print(&Apache::loncommon::end_page()); return OK; }