--- loncom/publisher/lonpublisher.pm 2007/01/26 22:16:33 1.218
+++ loncom/publisher/lonpublisher.pm 2008/08/19 10:43:59 1.246
@@ -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.246 2008/08/19 10:43:59 bisitz 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('No file').': '.
- &Apache::loncfile::display($fn).'';
+ return '
'.&mt('Processed file').': '.
- &Apache::loncfile::display($fn).'';
+ return '
".
- '';
+ 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 +381,8 @@ sub selectbox {
} else {
$env{'form.'.$name}=$idlist[0];
}
- my $selout="\n
'.&Apache::lonhtmlcommon::row_closure();
+ return $selout;
}
sub select_level_form {
@@ -408,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;
}
@@ -467,7 +479,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 +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\.($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 +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) {
@@ -659,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);
@@ -674,6 +691,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 +790,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 +799,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 +847,34 @@ 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,undef,
\%metadata);
}
if (defined($status) && $status ne '') {
- $error='Error occured storing new values in '.
- 'metadata table in LON-CAPA database';
+ $error=''
+ .&mt('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 +894,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 +966,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 +980,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
@@ -957,26 +990,31 @@ 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('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<allow>')
+ ."
';
- if ($thisdep!~/\*/ && $thisdep!~m|^/adm/|) {
- $scrout.='';
+ $outdep.='
';
+ }
+
+ if ($outdep) {
+ $scrout.=''.&mt('Dependencies').'
'
+ .$outdep
}
$outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;
@@ -997,9 +1041,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 +1062,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 +1139,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 +1572,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 +1582,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 +1636,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 +1662,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 +1678,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 +1711,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 +1726,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 +1758,7 @@ sub phasetwo { $r->print( ''.
+ ''.
' '.
@@ -1717,6 +1803,7 @@ sub notify {
print $logfile "\n============ Done ============\n";
$logfile->close();
}
+ if ($lock) { &Apache::lonnet::remove_lock($lock); }
return OK;
}
@@ -1786,7 +1873,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 +1962,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.''
+ );
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'))
+ .''
+ .&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.
@@ -2106,9 +2220,9 @@ ENDDIFF
unless ($errorcount) {
my ($outstring,$error)=
&publish($thisfn,$thistarget,$thisembstyle);
- $r->print('