--- loncom/publisher/lonpublisher.pm 2007/01/26 22:16:33 1.218
+++ loncom/publisher/lonpublisher.pm 2008/08/14 13:39:02 1.245
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.218 2007/01/26 22:16:33 raeburn Exp $
+# $Id: lonpublisher.pm,v 1.245 2008/08/14 13:39:02 onken Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -118,11 +118,14 @@ 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;
@@ -143,6 +146,8 @@ my $cudom;
my $registered_cleanup;
my $modified_urls;
+my $lock;
+
=pod
=item B $title:".
- " $title:".
- " $title:".
- ' '.&mt('New parameters or stored values').
+ $scrout.=' '.&mt('New parameters or saved values').
': '.$chparms.' '.&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('Processed file').': '.
- &Apache::loncfile::display($fn).'';
+ &Apache::loncfile::display($fn).'
';
}
#########################################
@@ -322,30 +328,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
".
- '';
+ 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
".
- ''.
- 'Select '.
- 'Search';
-
+ return "\n".&Apache::lonhtmlcommon::row_title($title)
+ .''
+ .'
'
+ .''
+ .&mt('Select')
+ .' '
+ .''
+ .&mt('Search')
+ .''
+ .&Apache::lonhtmlcommon::row_closure($noline);
}
sub hiddenfield {
@@ -369,8 +379,8 @@ sub selectbox {
} else {
$env{'form.'.$name}=$idlist[0];
}
- my $selout="\n
'.&Apache::lonhtmlcommon::row_closure();
+ return $selout;
}
sub select_level_form {
@@ -408,15 +419,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;
}
@@ -467,7 +477,7 @@ sub set_allow {
}
if (($newurl !~ /^javascript:/i) &&
($newurl !~ /^mailto:/i) &&
- ($newurl !~ /^http:/i) &&
+ ($newurl !~ /^(?:http|https|ftp):/i) &&
($newurl !~ /^\#/)) {
$$allow{&absoluteurl($newurl,$target)}=1;
}
@@ -494,11 +504,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\.($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);
}
@@ -650,7 +664,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) {
@@ -659,6 +673,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);
@@ -674,6 +689,10 @@ sub fix_ids_and_indices {
next;
}
if ($lctag eq 'base') { next; }
+ if (($lctag eq 'part') || ($lctag eq 'problem')) {
+ $responsecounter=0;
+ }
+ if ($lctag=~/response$/) { $responsecounter++; }
my %parms=%{$token->[2]};
$counter=$addid{$tag};
if (!$counter) { $counter=$addid{$lctag}; }
@@ -769,7 +788,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);
}
@@ -778,7 +797,12 @@ sub fix_ids_and_indices {
unless ($token->[1] eq 'allow') {
$outstring.=''.$token->[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];
}
@@ -821,31 +845,31 @@ 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);
}
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,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);
@@ -865,17 +889,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('');
+ if ($warningcount) {
+ $r->print('
');
} else {
#$r->print(''.&mt('ok').'');
}
@@ -933,7 +961,7 @@ 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";
@@ -947,7 +975,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
@@ -959,24 +987,29 @@ 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".'
';
- 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'
@@ -997,9 +1030,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);
}
@@ -1018,7 +1051,7 @@ sub publish {
unless ($batch) {
$scrout.=''.&mt('Metadata Information').' ' .
- Apache::loncommon::help_open_topic("Metadata_Description")
+ &Apache::loncommon::help_open_topic("Metadata_Description")
. '
';
}
@@ -1095,14 +1128,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('Warning!').
- '
';
+ $scrout.=''.&mt('Warning!').
+ '
';
+ }
+ if ($metadatafields{'copyright'} eq 'priv') {
+ $scrout.='
'. + &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.').'
$KEYWORDS: - $keywords_help - - -
-'; - if ($colcount>10) { - $keywordout.=" |
'; + $colcount++; + } + } + $env{'form.keywords'}=~s/\,$//; - $keywordout.=' |
".&mt('Abstract').":". - "
". - &mt('Lowest Grade Level').':'. - "
". - &mt('Highest Grade Level').':'. - "
'.&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"; @@ -1486,8 +1561,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; } } @@ -1496,8 +1571,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) { @@ -1550,7 +1625,7 @@ sub phasetwo { unless ($srcd=~/^\/home\/httpd\/html\/res/) { print $logfile "\nPANIC: Target dir is ".$srcd; $r->print( - "Invalid target directory, FAIL"); + "".&mt('Invalid target directory, FAIL').""); return 0; } opendir(DIR,$srcd); @@ -1576,8 +1651,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; } @@ -1592,8 +1667,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; } } @@ -1625,8 +1700,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; } @@ -1640,7 +1715,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; @@ -1672,7 +1747,7 @@ sub phasetwo { $r->print( ''.
+ ''.
' '.
@@ -1717,6 +1792,7 @@ sub notify {
print $logfile "\n============ Done ============\n";
$logfile->close();
}
+ if ($lock) { &Apache::lonnet::remove_lock($lock); }
return OK;
}
@@ -1786,7 +1862,9 @@ sub publishdirectory {
&checkbox('obsolete','make file(s) obsolete').
&checkbox('forceoverride','force directory level catalog information over existing').
' '.&mt('Copied source file').'
');
+ $lock=0;
} else {
+ unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
# actually publish things
opendir(DIR,$fn);
my @files=sort(readdir(DIR));
@@ -1873,8 +1951,8 @@ sub defaultmetapublish {
if (copy($fn,$copyfile)) {
$r->print(''.&mt('Publishing').' '.
- &Apache::loncommon::filedescription($thistype).' ');
+ $r->print('
ENDCAPTION
- $r->print(''.&mt('Target').': '.
- $thisdistarget.''.&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(<
');
-
+ $r->print(''
+ .&Apache::lonhtmlcommon::row_closure()
+ );
+
+ $r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))
+ .''.$thisdistarget.''
+ );
+# SB - ToDo:
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_title(''.&mt('Co-Author').'')
+ $r->print(&Apache::lonhtmlcommon::row_closure()
+ .&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))
+ .''
+ .&mt('[_1] at [_2]',$cuname,$cudom)
+ .''
+ );
}
if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
+ $r->print(&Apache::lonhtmlcommon::row_closure()
+ .&Apache::lonhtmlcommon::row_title(&mt('Diffs')));
$r->print(<
');
+ $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.
@@ -2108,7 +2213,7 @@ ENDDIFF
&publish($thisfn,$thistarget,$thisembstyle);
$r->print('
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.