--- loncom/publisher/lonpublisher.pm 2005/05/20 18:28:22 1.195 +++ loncom/publisher/lonpublisher.pm 2008/03/18 23:31:31 1.232 @@ -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.232 2008/03/18 23:31:31 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; @@ -181,17 +183,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]->{$_}; @@ -278,9 +281,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); @@ -342,8 +344,8 @@ sub text_with_browse_field { return "\n
$title:". "
'.&mt('New parameters or stored values'). + $scrout.='
'.&mt('New parameters or saved values'). ': '.$chparms.'
'; } @@ -1108,16 +1123,23 @@ sub publish { if (($_=~/^parameter/) || ($_=~/^stores/)) { unless (($metadatafields{$_.'.name'}) || ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { - print $logfile 'Obsolete: '.$_."\n"; - $chparms.=$_.' '; + my $disp_key = $_; + $disp_key =~ tr/\0/_/; + print $logfile ('Obsolete: '.$disp_key."\n"); + $chparms.=$disp_key.' '; } } } if ($chparms) { - $scrout.=''.&mt('Obsolete parameters or stored values').': '. - $chparms.'
'. - &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'
'.&mt('Obsolete parameters or saved values').': '. + $chparms.'
'. + &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'
'. + &mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.').'
'.($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.= @@ -1278,6 +1300,9 @@ END $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'; } @@ -1294,12 +1319,12 @@ END $intr_scrout.=&selectbox('Copyright/Distribution','copyright', $defaultoption, \&Apache::loncommon::copyrightdescription, - (grep !/^public$/,(&Apache::loncommon::copyrightids))); + (grep !/^(public|priv)$/,(&Apache::loncommon::copyrightids))); } else { $intr_scrout.=&selectbox('Copyright/Distribution','copyright', $defaultoption, \&Apache::loncommon::copyrightdescription, - (&Apache::loncommon::copyrightids)); + (grep !/^priv$/,(&Apache::loncommon::copyrightids))); } my $copyright_help = Apache::loncommon::help_open_topic('Publishing_Copyright'); @@ -1309,15 +1334,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'. + $intr_scrout.='/ >
'. &text_with_browse_field('Suggested Replacement for Obsolete File', 'obsoletereplacement', $metadatafields{'obsoletereplacement'}); @@ -1383,10 +1408,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 @@ -1398,28 +1423,49 @@ 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(&Apache::lonnet::unescape($env{'form.allmeta'})); + &metaeval(&unescape($env{'form.allmeta'})); $metadatafields{'title'}=$env{'form.title'}; $metadatafields{'author'}=$env{'form.author'}; @@ -1442,9 +1488,10 @@ sub phasetwo { $metadatafields{'obsoletereplacement'}= $env{'form.obsoletereplacement'}; $metadatafields{'dependencies'}=$env{'form.dependencies'}; - $metadatafields{'modifyinguser'}=$env{'user.name'}.'@'. + $metadatafields{'modifyinguser'}=$env{'user.name'}.':'. $env{'user.domain'}; - $metadatafields{'authorspace'}=$cuname.'@'.$cudom; + $metadatafields{'authorspace'}=$cuname.':'.$cudom; + $metadatafields{'domain'}=$cudom; my $allkeywords=$env{'form.addkey'}; if (exists($env{'form.keywords'})) { @@ -1465,18 +1512,20 @@ sub phasetwo { if ($metadatafields{'copyright'} eq 'custom') { my $file=$metadatafields{'customdistributionfile'}; unless ($file=~/\.rights$/) { - return - ''.&mt('No valid custom distribution rights file specified, FAIL'). - ''; + $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 ($_=~/\./) { @@ -1527,7 +1576,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 +1603,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 +1618,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; } } @@ -1599,8 +1652,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 +1666,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 +1678,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 +1706,8 @@ sub phasetwo { &mt('Back to Source Directory').''); } $logfile->close(); - return ''.&mt('Done').'
'; + $r->print(''.&mt('Done').'
'); + return 1; } # =============================================================== Notifications @@ -1748,7 +1810,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'). ''.&mt('Copied source file').'
'); } else { - return "". - &mt('Failed to copy source').", $!, ".&mt('FAIL').""; + return "". + &mt('Failed to copy source').", $!, ".&mt('FAIL').""; } # --------------------------------------------------- Send update notifications @@ -1849,7 +1916,7 @@ sub defaultmetapublish { my $link=$fn; $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//; $r->print("".&mt('Back to Catalog Information').''); - $r->print('