--- loncom/publisher/lonpublisher.pm 2005/06/29 17:46:20 1.200 +++ loncom/publisher/lonpublisher.pm 2010/01/27 03:44:48 1.258.2.4 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.200 2005/06/29 17:46:20 raeburn Exp $ +# $Id: lonpublisher.pm,v 1.258.2.4 2010/01/27 03:44:48 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -118,17 +118,22 @@ use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); use HTML::LCParser; +use HTML::Entities; +use Encode::Encoder; use Apache::lonxml; use Apache::loncacc; use DBI; use Apache::lonnet; use Apache::loncommon(); +use Apache::lonhtmlcommon; 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; @@ -141,6 +146,8 @@ my $cudom; my $registered_cleanup; my $modified_urls; +my $lock; + =pod =item B @@ -181,17 +188,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]->{$_}; @@ -258,8 +266,9 @@ sub metaread { my ($logfile,$fn,$prefix)=@_; unless (-e $fn) { print($logfile 'No file '.$fn."\n"); - return '
'.&mt('No file').': '. - &Apache::loncfile::display($fn).''; + return '
' + .&mt('No file: [_1]' + ,' '.&Apache::loncfile::display($fn).'
'); } print($logfile 'Processing '.$fn."\n"); my $metastring; @@ -268,8 +277,9 @@ sub metaread { $metastring=join('',<$metafh>); } &metaeval($metastring,$prefix); - return '
'.&mt('Processed file').': '. - &Apache::loncfile::display($fn).''; + return '
' + .&mt('Processed file: [_1]' + ,' '.&Apache::loncfile::display($fn).'
'); } ######################################### @@ -278,9 +288,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); @@ -321,30 +330,34 @@ string which presents the form field (fo ######################################### ######################################### sub textfield { - my ($title,$name,$value)=@_; + my ($title,$name,$value,$noline)=@_; $value=~s/^\s+//gs; $value=~s/\s+$//gs; $value=~s/\s+/ /gs; $title=&mt($title); $env{'form.'.$name}=$value; - return "\n

$title:". - "


". - ''; + return "\n".&Apache::lonhtmlcommon::row_title($title) + .'' + .&Apache::lonhtmlcommon::row_closure($noline); } sub text_with_browse_field { - my ($title,$name,$value,$restriction)=@_; + my ($title,$name,$value,$restriction,$noline)=@_; $value=~s/^\s+//gs; $value=~s/\s+$//gs; $value=~s/\s+/ /gs; $title=&mt($title); $env{'form.'.$name}=$value; - return "\n

$title:". - "


". - ''. - 'Select '. - 'Search'; - + return "\n".&Apache::lonhtmlcommon::row_title($title) + .'' + .'
' + .'' + .&mt('Select') + .' ' + .'' + .&mt('Search') + .'' + .&Apache::lonhtmlcommon::row_closure($noline); } sub hiddenfield { @@ -355,7 +368,8 @@ sub hiddenfield { sub checkbox { my ($name,$text)=@_; - return "\n
".&mt($text); + return "\n
"; } sub selectbox { @@ -367,16 +381,17 @@ sub selectbox { } else { $env{'form.'.$name}=$idlist[0]; } - my $selout="\n

$title:". - '


'; foreach (@idlist) { - $selout.='';} + $selout.=' selected="selected"'; + } + $selout.='>'.&{$functionref}($_).''; } - return $selout.''; + $selout.=''.&Apache::lonhtmlcommon::row_closure(); + return $selout; } sub select_level_form { @@ -406,15 +421,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 +479,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 +506,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 +523,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 +559,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 +666,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) { @@ -662,6 +675,7 @@ sub fix_ids_and_indices { "Max Index: $maxindex (min 10)\n"; } my $outstring=''; + my $responsecounter=1; my @parser; $parser[0]=HTML::LCParser->new(\$content); $parser[-1]->xml_mode(1); @@ -676,6 +690,12 @@ sub fix_ids_and_indices { $allow{$token->[2]->{'src'}}=1; next; } + if ($lctag eq 'base') { next; } + if (($lctag eq 'part') || ($lctag eq 'problem')) { + $responsecounter=0; + } + if ($lctag=~/response$/) { $responsecounter++; } + if ($lctag eq 'import') { $responsecounter++; } my %parms=%{$token->[2]}; $counter=$addid{$tag}; if (!$counter) { $counter=$addid{$lctag}; } @@ -685,7 +705,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 +718,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 +736,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]); @@ -766,7 +791,7 @@ sub fix_ids_and_indices { } if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; } $outstring.='<'.$tag.$newparmstring.$endtag.'>'; - if ($lctag eq 'm' || $lctag eq 'script' + if ($lctag eq 'm' || $lctag eq 'script' || $lctag eq 'answer' || $lctag eq 'display' || $lctag eq 'tex') { $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser); } @@ -775,7 +800,12 @@ sub fix_ids_and_indices { unless ($token->[1] eq 'allow') { $outstring.='[1].'>'; } - } + } + if ((($token->[1] eq 'part') || ($token->[1] eq 'problem')) + && (!$responsecounter)) { + my $outstring=''.&mt('Found [_1] without responses. This resource cannot be published.',$token->[1]).''; + return ($outstring,1); + } } else { $outstring.=$token->[1]; } @@ -818,36 +848,39 @@ 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='' + .&mt('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 ='' + .&mt('WARNING: The metadata table does not exist in the LON-CAPA database!') + .''; &Apache::lonnet::logthis($error); return ($error,undef); } my $dbh = &Apache::lonmysql::get_dbh(); - if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv') || - ($metadata{'copyright'} eq 'custom')) { + if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv')) { # 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='' + .&mt('Error occurred 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'); } @@ -862,17 +895,21 @@ sub checkonthis { 'return_only_error_and_warning_counts' => 1)); my ($errorcount,$warningcount)=split(':',$result); if (($errorcount) || ($warningcount)) { - $r->print('
'.$uri.': '); - if ($errorcount) { - $r->print(''. - $errorcount.' '. - &mt('error(s)').' '); - } - if ($warningcount) { - $r->print(''. - $warningcount.' '. - &mt('warning(s)').''); - } + $r->print('

'.&mt('Warnings and Errors').'

'); + $r->print(''.$uri.':'); + $r->print(''); } else { #$r->print(''.&mt('ok').''); } @@ -911,7 +948,7 @@ backup copies, performs any automatic pr especially for rat and ssi files), Returns a 2 element array, the first is the string to be shown to the -user, the second is an error code, either 1 (an error occured) or 0 +user, the second is an error code, either 1 (an error occurred) or 0 (no error occurred) I @@ -930,10 +967,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 +981,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 ("".&mt("Failed to write backup copy, [_1], FAIL",$1)."",1); } # ------------------------------------------------------------- IDs and indices @@ -954,37 +991,48 @@ sub publish { if ($error) { return ($outstring,$error); } # ------------------------------------------------------------ Construct Allows - $scrout.='

'.&mt('Dependencies').'

'; + my $outdep=''; # Collect dependencies output data my $allowstr=''; - foreach (sort(keys(%allow))) { - my $thisdep=$_; + foreach my $thisdep (sort(keys(%allow))) { if ($thisdep !~ /[^\s]/) { next; } + if ($thisdep =~/\$/) { + $outdep.='
' + .&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>') + ."
\n"; + } unless ($style eq 'rat') { $allowstr.="\n".''; } - $scrout.='
'; - if ($thisdep!~/\*/ && $thisdep!~m|^/adm/|) { - $scrout.=''; + $outdep.='
'; + if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) { + $outdep.=''; } - $scrout.=''.$thisdep.''; - if ($thisdep!~/\*/ && $thisdep!~m|^/adm/|) { - $scrout.=''; + $outdep.=''.$thisdep.''; + if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) { + $outdep.=''; if ( &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'. $thisdep.'.meta') eq '-1') { - $scrout.= ' - '.&mt('Currently not available'). - ''; + $outdep.= ' - '.&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); } } } + $outdep.='

'; + } + + if ($outdep) { + $scrout.='

'.&mt('Dependencies').'

' + .$outdep } $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s; @@ -994,9 +1042,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); } @@ -1014,8 +1062,8 @@ sub publish { my %oldparmstores=(); unless ($batch) { - $scrout.='

'.&mt('Metadata Information').' ' . - Apache::loncommon::help_open_topic("Metadata_Description") + $scrout.='

'.&mt('Metadata').' ' . + &Apache::loncommon::help_open_topic("Metadata_Description") . '

'; } @@ -1027,7 +1075,7 @@ sub publish { $env{'environment.generation'}; $metadatafields{'author'}=~s/\s+/ /g; $metadatafields{'author'}=~s/\s+$//; - $metadatafields{'owner'}=$cuname.'@'.$cudom; + $metadatafields{'owner'}=$cuname.':'.$cudom; # ------------------------------------------------ Check out directory hierachy @@ -1092,14 +1140,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.'

'; } @@ -1108,16 +1158,24 @@ 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 @@ -1129,17 +1187,22 @@ sub publish { $textonly=~s/\//g; $textonly=~s/\[^\<]+\<\/m\>//g; $textonly=~s/\<[^\>]*\>//g; - $textonly=~tr/A-Z/a-z/; - $textonly=~s/[\$\&][a-z]\w*//g; - $textonly=~s/[^a-z\s]//g; - - foreach ($textonly=~m/(\w+)/g) { - unless ($nokey{$_}) { - $keywords{$_}=1; - } - } - } + #this is a work simplification for german authors for present + $textonly=HTML::Entities::decode($textonly); #decode HTML-character + $textonly=Encode::Encoder::encode('utf8', $textonly); #encode to perl internal unicode + $textonly=~tr/A-ZÜÄÖ/a-züäö/; #add lowercase rule for german "Umlaute" + $textonly=~s/[\$\&][a-z]\w*//g; + $textonly=~s/[^a-z^ü^ä^ö^ß\s]//g; #dont delete german "Umlaute" + + foreach ($textonly=~m/[^\s]+/g) { #match all but whitespaces + unless ($nokey{$_}) { + $keywords{$_}=1; + } + } + + + } foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) { $addkey=~s/\s+/ /g; @@ -1157,12 +1220,21 @@ sub publish { # $env{'from.'..} so that it can be used by the phase two handler in # batch mode - my $intr_scrout.= - '
'. - '

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

'. + my $intr_scrout.='
' + .''; + unless ($env{'form.makeobsolete'}) { + $intr_scrout.='

' + .&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.') + .'

' + .'

'; + } + $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box(); + $intr_scrout.= &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.= @@ -1171,10 +1243,7 @@ sub publish { &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 $keywords_help = &Apache::loncommon::help_open_topic("Publishing_Keywords"); my $keywordout=<<"END"; -

$KEYWORDS: - $keywords_help - - -

-
END - $keywordout.=''; + $keywordout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Keywords')) + .$keywords_help + .'' + .'' + .'


' + .&Apache::loncommon::start_data_table(); + my $cols_per_row = 10; my $colcount=0; + my $wordcount=0; + my $numkeywords = scalar(keys(%keywords)); - foreach (sort keys %keywords) { - $keywordout.=''; - if ($colcount>10) { - $keywordout.="\n"; - $colcount=0; - } - $colcount++; + foreach my $word (sort(keys(%keywords))) { + if ($colcount == 0) { + $keywordout .= &Apache::loncommon::start_data_table_row(); + } + $colcount++; + $wordcount++; + if (($wordcount == $numkeywords) && ($colcount < $cols_per_row)) { + my $colspan = 1+$cols_per_row-$colcount; + $keywordout .= ''; + if ($colcount == $cols_per_row) { + $keywordout.=&Apache::loncommon::end_data_table_row(); + $colcount=0; + } } + if ($colcount > 0) { + $keywordout .= &Apache::loncommon::end_data_table_row(); + } + $env{'form.keywords'}=~s/\,$//; - $keywordout.='
'; + } else { + $keywordout .= ''; + } + $keywordout.='
'; + $keywordout.=&Apache::loncommon::end_data_table_row() + .&Apache::loncommon::end_data_table() + .&Apache::lonhtmlcommon::row_closure(); $intr_scrout.=$keywordout; @@ -1225,28 +1312,24 @@ END $intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); - $intr_scrout.= - "\n

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


". - '

'; + $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Abstract')) + .'' + .&Apache::lonhtmlcommon::row_closure(); $source=~/\.(\w+)$/; + $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Grade Levels')) + .&mt('Lowest Grade Level:').' ' + .&select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel') +# .&Apache::lonhtmlcommon::row_closure(); +# $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Highest Grade Level')) + .' '.&mt('Highest Grade Level:').' ' + .&select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel') + .&Apache::lonhtmlcommon::row_closure(); - $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'}); - - - + $intr_scrout.=&textfield('Standards','standards',$metadatafields{'standards'}); $intr_scrout.=&hiddenfield('mime',$1); @@ -1269,15 +1352,21 @@ END $intr_scrout.=&hiddenfield('lastrevisiondate',time); - + my $pubowner_last; + if ($style eq 'prv') { + $pubowner_last = 1; + } $intr_scrout.=&textfield('Publisher/Owner','owner', - $metadatafields{'owner'}); + $metadatafields{'owner'},$pubowner_last); # ---------------------------------------------- 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'; } @@ -1294,33 +1383,32 @@ 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'); - $intr_scrout =~ s/Distribution:/'Distribution: ' . $copyright_help/ge; - $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights').$copyright_help; + &Apache::loncommon::help_open_topic('Publishing_Copyright'); + my $replace=&mt('Copyright/Distribution:'); + $intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge; + + $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights'); $intr_scrout.=&selectbox('Source Distribution','sourceavail', $defaultsourceoption, \&Apache::loncommon::source_copyrightdescription, (&Apache::loncommon::source_copyrightids)); # $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights'); my $uctitle=&mt('Obsolete'); - $intr_scrout.= - "\n

$uctitle:". - ' ' + .&Apache::lonhtmlcommon::row_closure(1); + $intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File', 'obsoletereplacement', - $metadatafields{'obsoletereplacement'}); + $metadatafields{'obsoletereplacement'},'',1); } else { $intr_scrout.=&hiddenfield('copyright','private'); } @@ -1346,11 +1434,15 @@ END &hiddenfield('obsolete',1). &text_with_browse_field('Suggested Replacement for Obsolete File', 'obsoletereplacement', - $metadatafields{'obsoletereplacement'}); + $metadatafields{'obsoletereplacement'},'',1); } if (!$batch) { - $scrout.=$intr_scrout.'

'; + $scrout.=$intr_scrout + .&Apache::lonhtmlcommon::end_pick_box() + .'

' + .''; } return($scrout,0); } @@ -1403,17 +1495,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('Filename of resource contains internal version number. Cannot publish such resources, FAIL').''); return 0; } } @@ -1425,17 +1517,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'}; @@ -1458,9 +1555,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'})) { @@ -1482,8 +1580,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; } } @@ -1492,8 +1590,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) { @@ -1543,10 +1641,11 @@ sub phasetwo { my $srcf=$2; my $srct=$3; my $srcd=$1; - unless ($srcd=~/^\/home\/httpd\/html\/res/) { + my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + unless ($srcd=~/^\Q$docroot\E\/res/) { print $logfile "\nPANIC: Target dir is ".$srcd; $r->print( - "Invalid target directory, FAIL"); + "".&mt('Invalid target directory, FAIL').""); return 0; } opendir(DIR,$srcd); @@ -1555,25 +1654,24 @@ sub phasetwo { unlink($srcd.'/'.$filename); unlink($srcd.'/'.$filename.'.meta'); } else { - if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) { + if ($filename=~/^\Q$srcf\E\.(\d+)\.\Q$srct\E$/) { $maxversion=($1>$maxversion)?$1:$maxversion; } } } closedir(DIR); $maxversion++; - $r->print('

Creating old version '.$maxversion.'

'); + $r->print('

'.&mt('Creating old version [_1]',$maxversion).'

'); print $logfile "\nCreating old version ".$maxversion."\n"; my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct; if (copy($target,$copyfile)) { print $logfile "Copied old target to ".$copyfile."\n"; - $r->print('

'.&mt('Copied old target file').'

'); + $r->print(&Apache::lonhtmlcommon::confirm_success(&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(&Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1)); return 0; } @@ -1583,13 +1681,13 @@ sub phasetwo { if (copy($target.'.meta',$copyfile)) { print $logfile "Copied old target metadata to ".$copyfile."\n"; - $r->print('

'.&mt('Copied old metadata').'

') + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata'))); } else { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { - $r->print( - "". -&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL').""); + $r->print(&Apache::lonhtmlcommon::confirm_success( + &mt('Failed to write old metadata copy').", $!",1)); + return 0; } } @@ -1611,32 +1709,38 @@ sub phasetwo { $path.="/$parts[$count]"; if ((-e $path)!=1) { print $logfile "\nCreating directory ".$path; - $r->print('

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

'); mkdir($path,0777); + $r->print('

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

' + ); } } if (copy($source,$copyfile)) { print $logfile "\nCopied original source to ".$copyfile."\n"; - $r->print('

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

'); + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied source file'))); } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - $r->print("". - &mt('Failed to copy source').", $!, ".&mt('FAIL').""); + $r->print(&Apache::lonhtmlcommon::confirm_success( + &mt('Failed to copy source').", $!",1)); return 0; } - + +# ---------------------------------------------- Delete local tmp-preview files + unlink($copyfile.'.tmp'); # --------------------------------------------------------------- Copy Metadata $copyfile=$copyfile.'.meta'; if (copy($source.'.meta',$copyfile)) { print $logfile "\nCopied original metadata to ".$copyfile."\n"; - $r->print('

'.&mt('Copied metadata').'

'); + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata'))); } else { print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; - $r->print( - "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL').""); + $r->print(&Apache::lonhtmlcommon::confirm_success( + &mt('Failed to write metadata copy').", $!",1)); return 0; } $r->rflush; @@ -1644,7 +1748,8 @@ sub phasetwo { # ------------------------------------------------------------- Trigger updates push(@{$modified_urls},[$target,$source]); unless ($registered_cleanup) { - $r->register_cleanup(\¬ify); + my $handlers = $r->get_handlers('PerlCleanupHandler'); + $r->set_handlers('PerlCleanupHandler' => [\¬ify,@{$handlers}]); $registered_cleanup=1; } @@ -1655,27 +1760,27 @@ sub phasetwo { &Apache::lonnet::devalidate_cache_new('meta', &Apache::lonnet::declutter($thisdistarget)); +# ------------------------------------------------------------- Everything done + $logfile->close(); + $r->print('

'.&mt('Done').'

'); + # ------------------------------------------------ Provide link to new resource 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/\/[^\/]+$/\//; - - + $r->print( '
'. &mt('View Published Version').''. - '

'. + '

'. &mt('Back to Source').'

'. '

'. &mt('Back to Source Directory').'

'); } - $logfile->close(); - $r->print('

'.&mt('Done').'

'); return 1; } @@ -1713,6 +1818,7 @@ sub notify { print $logfile "\n============ Done ============\n"; $logfile->close(); } + if ($lock) { &Apache::lonnet::remove_lock($lock); } return OK; } @@ -1741,7 +1847,11 @@ sub batchpublish { my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); - $r->print('

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

'); + $r->print('

' + .&mt('Publishing [_1]' + ,''.$thisdisfn.'') + .'

' + ); # phase one takes # my ($source,$target,$style,$batch)=@_; @@ -1768,21 +1878,37 @@ sub publishdirectory { my $resdir= $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'. $thisdisfn; - $r->print('

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

'. - &mt('Target').': '.$resdir.'
'); + $r->print(&Apache::lonhtmlcommon::start_pick_box() + .&Apache::lonhtmlcommon::row_title(&mt('Directory')) + .''.$thisdisfn.'' + .&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Target')) + .''.$resdir.'' + ); my $dirptr=16384; # Mask indicating a directory in stat.cmode. unless ($env{'form.phase'} eq 'two') { # ask user what they want + $r->print(&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Options')) + ); $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'). + &checkbox('obsolete','make file(s) obsolete'). + &checkbox('forceoverride','force directory level metadata over existing'). '
'); + $r->print(&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box() + ); + $lock=0; } else { + $r->print(&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box() + ); + unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); } # actually publish things opendir(DIR,$fn); my @files=sort(readdir(DIR)); @@ -1811,10 +1937,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 { @@ -1843,8 +1975,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('Metadata Publication')); # ---------------------------------------------------------------- Write Source my $copyfile=$target; @@ -1856,16 +1987,20 @@ sub defaultmetapublish { for ($count=5;$count<$#parts;$count++) { $path.="/$parts[$count]"; if ((-e $path)!=1) { - $r->print('

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

'); mkdir($path,0777); + $r->print('

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

' + ); } } 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 @@ -1879,8 +2014,8 @@ sub defaultmetapublish { # ------------------------------------------------------------------- Link back my $link=$fn; $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//; - $r->print("".&mt('Back to Catalog Information').''); - $r->print(''); + $r->print("".&mt('Back to Metadata').''); + $r->print(&Apache::loncommon::end_page()); return OK; } ######################################### @@ -1942,7 +2077,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')); @@ -1979,8 +2114,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'); @@ -2003,30 +2138,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. @@ -2034,11 +2165,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; @@ -2068,28 +2198,57 @@ sub handler { my $thistype=$1; my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); if ($thistype eq 'page') { $thisembstyle = 'rat'; } - $r->print('

'.&mt('Publishing').' '. - &Apache::loncommon::filedescription($thistype).' '); + $r->print('

' + .&mt('Publishing [_1]' + ,''.$thisdisfn.'') + .'

' + ); + + $r->print('

'.&mt('Resource Details').'

'); + + $r->print(&Apache::lonhtmlcommon::start_pick_box()); + + $r->print(&Apache::lonhtmlcommon::row_title(&mt('Type')) + .&Apache::loncommon::filedescription($thistype) + .&Apache::lonhtmlcommon::row_closure() + ); + + $r->print(&Apache::lonhtmlcommon::row_title(&mt('Link to Resource')) + .'' + ); $r->print(< $thisdisfn ENDCAPTION - $r->print('

'.&mt('Target').': '. - $thisdistarget.'
'); - + $r->print('' + .&Apache::lonhtmlcommon::row_closure() + ); + + $r->print(&Apache::lonhtmlcommon::row_title(&mt('Target')) + .''.$thisdistarget.'' + ); if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) { - $r->print('

'.&mt('Co-Author').': '. - $cuname.&mt(' at ').$cudom.'

'); + $r->print(&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Co-Author')) + .'' + .&Apache::loncommon::plainname($cuname,$cudom) .' ('.$cuname.':'.$cudom.')' + .'' + ); } if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { + $r->print(&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Diffs'))); $r->print(< ENDDIFF - $r->print(&mt('Diffs with Current Version').'
'); + $r->print(&mt('Diffs with Current Version').''); } + + $r->print(&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box() + ); # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. @@ -2102,9 +2261,9 @@ ENDDIFF unless ($errorcount) { my ($outstring,$error)= &publish($thisfn,$thistarget,$thisembstyle); - $r->print('
'.$outstring); + $r->print($outstring); } else { - $r->print('

'. + $r->print('

'. &mt('The document contains errors and cannot be published.'). '

'); } @@ -2113,7 +2272,7 @@ ENDDIFF $r->print('
'); } } - $r->print(''); + $r->print(&Apache::loncommon::end_page()); return OK; } 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.