--- loncom/publisher/lonpublisher.pm 2005/05/17 00:46:36 1.193 +++ 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.193 2005/05/17 00:46:36 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:". "


". ''. - 'Select '. - 'Search'; + ''.&mt('Select').' '. + ''.&mt('Search').''; } @@ -355,7 +357,8 @@ sub hiddenfield { sub checkbox { my ($name,$text)=@_; - return "\n
$text"; + return "\n
"; } sub selectbox { @@ -406,15 +409,14 @@ sub urlfixup { if ($url =~ /^mailto:/i) { return $url; } #internal document links need no fixing if ($url =~ /^\#/) { return $url; } - my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); - foreach (values %Apache::lonnet::hostname) { - if ($_ eq $host) { - $url=~s/^http\:\/\///; - $url=~s/^$host//; - } + my ($host)=($url=~m{(?:(?:http|https|ftp)://)*([^/]+)}); + my @lonids = &Apache::lonnet::machine_ids($host); + if (@lonids) { + $url=~s{^(?:http|https|ftp)://}{}; + $url=~s/^\Q$host\E//; } - if ($url=~/^http\:\/\//) { return $url; } - $url=~s/\~$cuname/res\/$cudom\/$cuname/; + if ($url=~m{^(?:http|https|ftp)://}) { return $url; } + $url=~s{\Q~$cuname\E}{res/$cudom/$cuname}; return $url; } @@ -465,11 +467,11 @@ sub set_allow { } if (($newurl !~ /^javascript:/i) && ($newurl !~ /^mailto:/i) && - ($newurl !~ /^http:/i) && + ($newurl !~ /^(?:http|https|ftp):/i) && ($newurl !~ /^\#/)) { $$allow{&absoluteurl($newurl,$target)}=1; } - return $return_url + return $return_url; } ######################################### @@ -492,11 +494,15 @@ sub get_subscribed_hosts { $target=~/(.*)\/([^\/]+)$/; my $srcf=$2; opendir(DIR,$1); + # cycle through listed files, subscriptions used to exist + # as "filename.lonid" while ($filename=readdir(DIR)) { - if ($filename=~/\Q$srcf\E\.(\w+)$/) { + if ($filename=~/\Q$srcf\E\.($match_lonid)$/) { my $subhost=$1; - if (($subhost ne 'meta' && $subhost ne 'subscription' && - $subhost ne 'tmp') && + if (($subhost ne 'meta' + && $subhost ne 'subscription' + && $subhost ne 'meta.subscription' + && $subhost ne 'tmp') && ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) { push(@subscribed,$subhost); } @@ -505,19 +511,13 @@ sub get_subscribed_hosts { closedir(DIR); my $sh; if ( $sh=Apache::File->new("$target.subscription") ) { - &Apache::lonnet::logthis("opened $target.subscription"); while (my $subline=<$sh>) { - &Apache::lonnet::logthis("Trying $subline"); - if ($subline =~ /(^\w+):/) { + if ($subline =~ /^($match_lonid):/) { if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) { push(@subscribed,$1); } - } else { - &Apache::lonnet::logthis("No Match for $subline"); } } - } else { - &Apache::lonnet::logthis("Unable to open $target.subscription"); } return @subscribed; } @@ -547,6 +547,7 @@ sub get_max_ids_indices { my %duplicatedids; my $parser=HTML::LCParser->new($content); + $parser->xml_mode(1); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { @@ -653,7 +654,7 @@ sub fix_ids_and_indices { join(', ',@duplicatedids)); if ($duplicateids) { print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n"; - my $outstring=''.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).''; + my $outstring=''.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).''; return ($outstring,1); } if ($needsfixup) { @@ -676,6 +677,7 @@ sub fix_ids_and_indices { $allow{$token->[2]->{'src'}}=1; next; } + if ($lctag eq 'base') { next; } my %parms=%{$token->[2]}; $counter=$addid{$tag}; if (!$counter) { $counter=$addid{$lctag}; } @@ -685,7 +687,9 @@ sub fix_ids_and_indices { $parms{'id'}!~/^\s*$/) { $maxid++; $parms{'id'}=$maxid; - print $logfile 'ID: '.$tag.':'.$maxid."\n"; + print $logfile 'ID(new) : '.$tag.':'.$maxid."\n"; + } else { + print $logfile 'ID(kept): '.$tag.':'.$parms{'id'}."\n"; } } elsif ($counter eq 'index') { unless (defined($parms{'index'}) && @@ -696,12 +700,14 @@ sub fix_ids_and_indices { } } } - foreach my $type ('src','href','background','bgimg') { - foreach my $key (keys(%parms)) { - if ($key =~ /^$type$/i) { - $parms{$key}=&set_allow(\%allow,$logfile, - $target,$tag, - $parms{$key}); + unless ($parms{'type'} eq 'zombie') { + foreach my $type ('src','href','background','bgimg') { + foreach my $key (keys(%parms)) { + if ($key =~ /^$type$/i) { + $parms{$key}=&set_allow(\%allow,$logfile, + $target,$tag, + $parms{$key}); + } } } } @@ -712,6 +718,7 @@ sub fix_ids_and_indices { ($lctag eq 'image')) { my $next_token=$parser[-1]->get_token(); if ($next_token->[0] eq 'T') { + $next_token->[1] =~ s/[\n\r\f]+//g; $next_token->[1]=&set_allow(\%allow,$logfile, $target,$tag, $next_token->[1]); @@ -818,15 +825,15 @@ sub store_metadata { # Determine if the table exists my $status = &Apache::lonmysql::check_table('metadata'); if (! defined($status)) { - $error='WARNING: Cannot connect to '. - 'database!'; + $error='WARNING: Cannot connect to '. + 'database!'; &Apache::lonnet::logthis($error); return ($error,undef); } if ($status == 0) { # It would be nice to actually create the table.... - $error ='WARNING: The metadata table does not '. - 'exist in the LON-CAPA database.'; + $error ='WARNING: The metadata table does not '. + 'exist in the LON-CAPA database.'; &Apache::lonnet::logthis($error); return ($error,undef); } @@ -834,20 +841,21 @@ sub store_metadata { if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv') || ($metadata{'copyright'} eq 'custom')) { # remove this entry - $status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef, - $metadata{'url'}); + my $delitem = 'url = '.$dbh->quote($metadata{'url'}); + $status = &LONCAPA::lonmetadata::delete_metadata($dbh,undef,$delitem); + } else { - $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef, + $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,undef, \%metadata); } if (defined($status) && $status ne '') { - $error='Error occured storing new values in '. - 'metadata table in LON-CAPA database'; + $error='Error occured saving new values in '. + 'metadata table in LON-CAPA database'; &Apache::lonnet::logthis($error); &Apache::lonnet::logthis($status); return ($error,undef); } - return (undef,$status); + return (undef,'success'); } @@ -864,9 +872,9 @@ sub checkonthis { if (($errorcount) || ($warningcount)) { $r->print('
'.$uri.': '); if ($errorcount) { - $r->print(''. + $r->print(''. $errorcount.' '. - &mt('error(s)').' '); + &mt('error(s)').' '); } if ($warningcount) { $r->print(''. @@ -930,10 +938,10 @@ sub publish { my %allow=(); unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return (''.&mt('No write permission to user directory, FAIL').'',1); + return (''.&mt('No write permission to user directory, FAIL').'',1); } print $logfile -"\n\n================= Publish ".localtime()." Phase One ================\n".$env{'user.name'}.'@'.$env{'user.domain'}."\n"; +"\n\n================= Publish ".localtime()." Phase One ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n"; if (($style eq 'ssi') || ($style eq 'rat') || ($style eq 'prv')) { # ------------------------------------------------------- This needs processing @@ -944,7 +952,7 @@ sub publish { print $logfile "Copied original file to ".$copyfile."\n"; } else { print $logfile "Unable to write backup ".$copyfile.':'.$!."\n"; - return ("Failed to write backup copy, $!,FAIL",1); + return ("Failed to write backup copy, $!,FAIL",1); } # ------------------------------------------------------------- IDs and indices @@ -956,29 +964,34 @@ sub publish { $scrout.='

'.&mt('Dependencies').'

'; my $allowstr=''; - foreach (sort(keys(%allow))) { - my $thisdep=$_; + foreach my $thisdep (sort(keys(%allow))) { if ($thisdep !~ /[^\s]/) { next; } + if ($thisdep =~/\$/) { + $scrout.='
' + .&mt('The resource depends on another resource with variable filename, i.e., [_1].',''.$thisdep.'').'
' + .&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<allow>') + .'
'; + } unless ($style eq 'rat') { $allowstr.="\n".''; } $scrout.='
'; - if ($thisdep!~/\*/ && $thisdep!~m|^/adm/|) { + if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) { $scrout.=''; } $scrout.=''.$thisdep.''; - if ($thisdep!~/\*/ && $thisdep!~m|^/adm/|) { + if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) { $scrout.=''; if ( &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'. $thisdep.'.meta') eq '-1') { - $scrout.= ' - '.&mt('Currently not available'). - ''; + $scrout.= ' - '.&mt('Currently not available'). + ''; } else { my %temphash=(&Apache::lonnet::declutter($target).'___'. &Apache::lonnet::declutter($thisdep).'___usage' => time); - $thisdep=~/^\/res\/(\w+)\/(\w+)\//; + $thisdep=~m{^/res/($match_domain)/($match_username)/}; if ((defined($1)) && (defined($2))) { &Apache::lonnet::put('nohist_resevaldata',\%temphash, $1,$2); @@ -994,9 +1007,9 @@ sub publish { my $org; unless ($org=Apache::File->new('>'.$source)) { print $logfile "No write permit to $source\n"; - return (''.&mt('No write permission to'). + return (''.&mt('No write permission to'). ' '.$source. - ', '.&mt('FAIL').'',1); + ', '.&mt('FAIL').'',1); } print($org $outstring); } @@ -1020,14 +1033,14 @@ sub publish { } # ------------------------------------------------ First, check out environment - unless (-e $source.'.meta') { + if ((!(-e $source.'.meta')) || ($env{'form.forceoverride'})) { $metadatafields{'author'}=$env{'environment.firstname'}.' '. $env{'environment.middlename'}.' '. $env{'environment.lastname'}.' '. $env{'environment.generation'}; $metadatafields{'author'}=~s/\s+/ /g; $metadatafields{'author'}=~s/\s+$//; - $metadatafields{'owner'}=$cuname.'@'.$cudom; + $metadatafields{'owner'}=$cuname.':'.$cudom; # ------------------------------------------------ Check out directory hierachy @@ -1070,10 +1083,18 @@ sub publish { delete $metadatafields{$_}; } } +# ------------------------------------------------------------- Save some stuff + my %savemeta=(); + foreach ('title') { + $savemeta{$_}=$metadatafields{$_}; + } # ------------------------------------------ See if anything new in file itself $allmeta=&parseformeta($source,$style); - +# ----------------------------------------------------------- Restore the stuff + foreach (keys %savemeta) { + $metadatafields{$_}=$savemeta{$_}; + } } @@ -1084,14 +1105,16 @@ sub publish { if (($_=~/^parameter/) || ($_=~/^stores/)) { unless ($_=~/\.\w+$/) { unless ($oldparmstores{$_}) { - print $logfile 'New: '.$_."\n"; - $chparms.=$_.' '; + my $disp_key = $_; + $disp_key =~ tr/\0/_/; + print $logfile ('New: '.$disp_key."\n"); + $chparms .= $disp_key.' '; } } } } if ($chparms) { - $scrout.='

'.&mt('New parameters or stored values'). + $scrout.='

'.&mt('New parameters or saved values'). ': '.$chparms.'

'; } @@ -1100,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('Warning!'). - '

'. - &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'

'; + $scrout.='

'.&mt('Obsolete parameters or saved values').': '. + $chparms.'

'.&mt('Warning!'). + '

'. + &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'

'; + } + if ($metadatafields{'copyright'} eq 'priv') { + $scrout.='

'.&mt('Warning!'). + '

'. + &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.').'

'; } # ------------------------------------------------------- Now have all metadata @@ -1151,16 +1181,17 @@ sub publish { my $intr_scrout.= '
'. - '

'. + '

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

'. &hiddenfield('phase','two'). &hiddenfield('filename',$env{'form.filename'}). - &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)). - &hiddenfield('dependencies',join(',',keys %allow)). + &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 + # --------------------------------------------------- Scan content for keywords my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords"); my $KEYWORDS=&mt('Keywords'); @@ -1269,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'; } @@ -1285,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'); @@ -1300,24 +1334,48 @@ 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

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

'; } return($scrout,0); } @@ -1350,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 @@ -1365,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'}; @@ -1409,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'})) { @@ -1432,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 ($_=~/\./) { @@ -1494,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)) { @@ -1519,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 @@ -1533,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; } } @@ -1566,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 @@ -1579,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; @@ -1590,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/\/[^\/]+$/\//; @@ -1612,7 +1706,8 @@ sub phasetwo { &mt('Back to Source Directory').'

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

'.&mt('Done').'

'; + $r->print('

'.&mt('Done').'

'); + return 1; } # =============================================================== Notifications @@ -1714,8 +1809,10 @@ sub publishdirectory { &hiddenfield('phase','two'). &hiddenfield('filename',$env{'form.filename'}). &checkbox('pubrec','include subdirectories'). - &checkbox('forcerepub','force republication of previously published files')); - $r->print(''); + &checkbox('forcerepub','force republication of previously published files'). + &checkbox('obsolete','make file(s) obsolete'). + &checkbox('forceoverride','force directory level catalog information over existing'). + '
'); } else { # actually publish things opendir(DIR,$fn); @@ -1745,10 +1842,16 @@ sub publishdirectory { # previously published, modified now $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 { @@ -1777,8 +1880,7 @@ sub defaultmetapublish { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; - $r->print('LON-CAPA Publishing'); - $r->print(&Apache::loncommon::bodytag('Catalog Information Publication')); + $r->print(&Apache::loncommon::start_page('Catalog Information Publication')); # ---------------------------------------------------------------- Write Source my $copyfile=$target; @@ -1798,8 +1900,8 @@ sub defaultmetapublish { if (copy($fn,$copyfile)) { $r->print('

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

'); } else { - return "". - &mt('Failed to copy source').", $!, ".&mt('FAIL').""; + return "". + &mt('Failed to copy source').", $!, ".&mt('FAIL').""; } # --------------------------------------------------- Send update notifications @@ -1814,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(''); + $r->print(&Apache::loncommon::end_page()); return OK; } ######################################### @@ -1876,7 +1978,7 @@ sub handler { @{$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')); @@ -1913,8 +2015,8 @@ sub handler { 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'); @@ -1937,30 +2039,26 @@ sub handler { 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. @@ -1968,11 +2066,10 @@ sub handler { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; - my $js=&Apache::loncommon::browser_and_searcher_javascript(); - $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; @@ -2001,6 +2098,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).' '); @@ -2042,11 +2140,11 @@ ENDDIFF '

'); } } else { - $r->print('
'. - &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget)); + &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); + $r->print('
'); } } - $r->print(''); + $r->print(&Apache::loncommon::end_page()); return OK; }