--- loncom/publisher/lonpublisher.pm 2006/01/13 19:19:34 1.205 +++ loncom/publisher/lonpublisher.pm 2008/02/13 14:18:59 1.230 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.205 2006/01/13 19:19:34 albertel Exp $ +# $Id: lonpublisher.pm,v 1.230 2008/02/13 14:18:59 bisitz 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.'
'; } @@ -1113,16 +1118,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.= @@ -1283,6 +1295,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'; } @@ -1299,12 +1314,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'); @@ -1408,17 +1423,17 @@ sub phasetwo { # unless ($env{'form.obsolete'}) { if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) { - $r->print( - ''.&mt('Unsupported character combination'). - ' "'.$1.'" '.&mt('in filename, FAIL').''); + $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').''); + $r->print(''.&mt('No valid extension found in filename, FAIL').''); return 0; } if ($target=~/\.(\d+)\.(\w+)$/) { - $r->print(''.&mt('Cannot publish versioned resource, FAIL').''); + $r->print(''.&mt('Cannot publish versioned resource, FAIL').''); return 0; } } @@ -1430,17 +1445,22 @@ sub phasetwo { 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'}; @@ -1463,9 +1483,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'})) { @@ -1487,8 +1508,8 @@ sub phasetwo { my $file=$metadatafields{'customdistributionfile'}; unless ($file=~/\.rights$/) { $r->print( - ''.&mt('No valid custom distribution rights file specified, FAIL'). - ''); + ''.&mt('No valid custom distribution rights file specified, FAIL'). + ''); return 0; } } @@ -1497,8 +1518,8 @@ sub phasetwo { my $mfh; unless ($mfh=Apache::File->new('>'.$source.'.meta')) { $r->print( - ''.&mt('Could not write metadata, FAIL'). - ''); + ''.&mt('Could not write metadata, FAIL'). + ''); return 0; } foreach (sort keys %metadatafields) { @@ -1551,7 +1572,7 @@ sub phasetwo { unless ($srcd=~/^\/home\/httpd\/html\/res/) { print $logfile "\nPANIC: Target dir is ".$srcd; $r->print( - "Invalid target directory, FAIL"); + "Invalid target directory, FAIL"); return 0; } opendir(DIR,$srcd); @@ -1577,8 +1598,8 @@ sub phasetwo { $r->print(''.&mt('Copied old target file').'
'); } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; - $r->print("".&mt('Failed to copy old target'). - ", $!, ".&mt('FAIL').""); + $r->print("".&mt('Failed to copy old target'). + ", $!, ".&mt('FAIL').""); return 0; } @@ -1593,8 +1614,8 @@ sub phasetwo { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { $r->print( - "". -&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL').""); + "". +&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL').""); return 0; } } @@ -1626,8 +1647,8 @@ sub phasetwo { $r->print(''.&mt('Copied source file').'
'); } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - $r->print("". - &mt('Failed to copy source').", $!, ".&mt('FAIL').""); + $r->print("". + &mt('Failed to copy source').", $!, ".&mt('FAIL').""); return 0; } @@ -1641,7 +1662,7 @@ sub phasetwo { } else { print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; $r->print( - "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL').""); + "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL').""); return 0; } $r->rflush; @@ -1664,7 +1685,7 @@ sub phasetwo { unless ($batch) { 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/\/[^\/]+$/\//; @@ -1784,7 +1805,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 @@ -1885,7 +1911,7 @@ sub defaultmetapublish { my $link=$fn; $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//; $r->print("".&mt('Back to Catalog Information').''); - $r->print('