--- loncom/publisher/lonpublisher.pm 2003/09/24 19:38:18 1.135
+++ loncom/publisher/lonpublisher.pm 2003/10/21 20:18:45 1.140
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.135 2003/09/24 19:38:18 albertel Exp $
+# $Id: lonpublisher.pm,v 1.140 2003/10/21 20:18:45 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -181,45 +181,49 @@ nothing
#########################################
#########################################
sub metaeval {
- my $metastring=shift;
+ my ($metastring,$prefix)=@_;
- my $parser=HTML::LCParser->new(\$metastring);
- my $token;
- while ($token=$parser->get_token) {
- if ($token->[0] eq 'S') {
- my $entry=$token->[1];
- my $unikey=$entry;
- if (defined($token->[2]->{'package'})) {
- $unikey.='_package_'.$token->[2]->{'package'};
- }
- if (defined($token->[2]->{'part'})) {
- $unikey.='_'.$token->[2]->{'part'};
- }
- if (defined($token->[2]->{'id'})) {
- $unikey.='_'.$token->[2]->{'id'};
- }
- if (defined($token->[2]->{'name'})) {
- $unikey.='_'.$token->[2]->{'name'};
- }
- foreach (@{$token->[3]}) {
- $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
- if ($metadatakeys{$unikey}) {
- $metadatakeys{$unikey}.=','.$_;
- } else {
- $metadatakeys{$unikey}=$_;
- }
- }
- if ($metadatafields{$unikey}) {
- my $newentry=$parser->get_text('/'.$entry);
- unless (($metadatafields{$unikey}=~/\Q$newentry\E/) ||
- ($newentry eq '')) {
- $metadatafields{$unikey}.=', '.$newentry;
- }
- } else {
- $metadatafields{$unikey}=$parser->get_text('/'.$entry);
- }
- }
- }
+ my $parser=HTML::LCParser->new(\$metastring);
+ my $token;
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'S') {
+ my $entry=$token->[1];
+ my $unikey=$entry;
+ if (defined($token->[2]->{'package'})) {
+ $unikey.='_package_'.$token->[2]->{'package'};
+ }
+ if (defined($token->[2]->{'part'})) {
+ $unikey.='_'.$token->[2]->{'part'};
+ }
+ if (defined($token->[2]->{'id'})) {
+ $unikey.='_'.$token->[2]->{'id'};
+ }
+ if (defined($token->[2]->{'name'})) {
+ $unikey.='_'.$token->[2]->{'name'};
+ }
+ foreach (@{$token->[3]}) {
+ $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
+ if ($metadatakeys{$unikey}) {
+ $metadatakeys{$unikey}.=','.$_;
+ } else {
+ $metadatakeys{$unikey}=$_;
+ }
+ }
+ my $newentry=$parser->get_text('/'.$entry);
+ if ($entry eq 'customdistributionfile') {
+ $newentry=~s/^\s*//;
+ if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }
+ }
+ if ($metadatafields{$unikey}) {
+ unless (($metadatafields{$unikey}=~/\Q$newentry\E/) ||
+ ($newentry eq '')) {
+ $metadatafields{$unikey}.=', '.$newentry;
+ }
+ } else {
+ $metadatafields{$unikey}=$newentry;
+ }
+ }
+ }
}
#########################################
@@ -260,7 +264,7 @@ XHTML text that indicates successful rea
#########################################
#########################################
sub metaread {
- my ($logfile,$fn)=@_;
+ my ($logfile,$fn,$prefix)=@_;
unless (-e $fn) {
print($logfile 'No file '.$fn."\n");
return '
No file: '.$fn.'';
@@ -268,10 +272,10 @@ sub metaread {
print($logfile 'Processing '.$fn."\n");
my $metastring;
{
- my $metafh=Apache::File->new($fn);
- $metastring=join('',<$metafh>);
+ my $metafh=Apache::File->new($fn);
+ $metastring=join('',<$metafh>);
}
- &metaeval($metastring);
+ &metaeval($metastring,$prefix);
return '
Processed file: '.$fn.'';
}
@@ -897,16 +901,20 @@ sub publish {
}
$outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s;
+### FIXME: is this really what we want?
+# I dont' think so, to will corrupt any UTF-8 resources at least,
+# and any encoding other than ISO-8859-1 will probably break
#Encode any High ASCII characters
- $outstring=&HTML::Entities::encode($outstring,"\200-\377");
+ #$outstring=&HTML::Entities::encode($outstring,"\200-\377");
# ------------------------------------------------------------- Write modified.
{
my $org;
unless ($org=Apache::File->new('>'.$source)) {
print $logfile "No write permit to $source\n";
- return ('No write permission to '.$source.
- ', FAIL',1);
+ return (''.&mt('No write permission to').
+ ' '.$source.
+ ', '.&mt('FAIL').'',1);
}
print($org $outstring);
}
@@ -923,7 +931,7 @@ sub publish {
my %oldparmstores=();
unless ($batch) {
- $scrout.='
New parameters or stored values: '.$chparms.'
'; + $scrout.=''.&mt('New parameters or stored values'). + ': '.$chparms.'
'; } $chparms=''; @@ -1017,7 +1028,7 @@ sub publish { } } if ($chparms) { - $scrout.='Obsolete parameters or stored values: '. + $scrout.='
'.&mt('Obsolete parameters or stored values').': '. $chparms.'
'; } @@ -1170,10 +1181,22 @@ END $scrout.=&textfield('Custom Distribution File','customdistributionfile', $metadatafields{'customdistributionfile'}). $copyright_help; + my $uctitle=uc(&mt('Obsolete')); + $scrout.= + "\n$uctitle:". + '
'. + &textfield('Suggested Replacement for Obsolete File', + 'obsoletereplacement', + $metadatafields{'obsoletereplacement'}); } else { $scrout.=&hiddenfield('copyright','private'); } - return ($scrout.'',0); + return ($scrout.'',0); # ============================================================================= # BATCH MODE # @@ -1251,14 +1274,16 @@ sub phasetwo { if ($target=~/\_\_\_/) { $r->print( - 'Unsupported character combination "___" in filename, FAIL'); + ''.&mt('Unsupported character combination'). + ' "___" '.&mt('in filename, FAIL').''); return 0; } $distarget=~s/\/+/\//g; my $logfile; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { $r->print( - 'No write permission to user directory, FAIL'); + ''. + &mt('No write permission to user directory, FAIL').''); return 0; } print $logfile @@ -1282,6 +1307,9 @@ sub phasetwo { $metadatafields{'copyright'}=$ENV{'form.copyright'}; $metadatafields{'customdistributionfile'}= $ENV{'form.customdistributionfile'}; + $metadatafields{'obsolete'}=$ENV{'form.obsolete'}; + $metadatafields{'obsoletereplacement'}= + $ENV{'form.obsoletereplacement'}; $metadatafields{'dependencies'}=$ENV{'form.dependencies'}; my $allkeywords=$ENV{'form.addkey'}; @@ -1301,7 +1329,8 @@ sub phasetwo { my $mfh; unless ($mfh=Apache::File->new('>'.$source.'.meta')) { return - 'Could not write metadata, FAIL'; + ''.&mt('Could not write metadata, FAIL'). + ''; } foreach (sort keys %metadatafields) { unless ($_=~/\./) { @@ -1320,7 +1349,7 @@ sub phasetwo { .''.$tag.'>'; } } - $r->print('Wrote Metadata
'); + $r->print(''.&mt('Wrote Metadata').'
'); print $logfile "\nWrote metadata"; } @@ -1331,14 +1360,15 @@ sub phasetwo { unless ($metadatafields{'copyright'} eq 'priv') { my ($error,$success) = &store_metadata(\%metadatafields); if ($success) { - $r->print('Synchronized SQL metadata database
'); + $r->print(''.&mt('Synchronized SQL metadata database').'
'); print $logfile "\nSynchronized SQL metadata database"; } else { $r->print($error); print $logfile "\n".$error; } } else { - $r->print('Private Publication - did not synchronize database
'); + $r->print(''. + &mt('Private Publication - did not synchronize database').'
'); print $logfile "\nPrivate: Did not synchronize data into ". "SQL metadata database"; } @@ -1375,10 +1405,11 @@ sub phasetwo { if (copy($target,$copyfile)) { print $logfile "Copied old target to ".$copyfile."\n"; - $r->print('Copied old target file
'); + $r->print(''.&mt('Copied old target file').'
'); } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; - return "Failed to copy old target, $!, FAIL"; + return "".&mt('Failed to copy old target'). + ", $!, ".&mt('FAIL').""; } # --------------------------------------------------------------- Copy Metadata @@ -1387,18 +1418,19 @@ sub phasetwo { if (copy($target.'.meta',$copyfile)) { print $logfile "Copied old target metadata to ".$copyfile."\n"; - $r->print('Copied old metadata
') + $r->print(''.&mt('Copied old metadata').'
') } else { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { return - "Failed to write old metadata copy, $!, FAIL"; + "". +&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL').""; } } } else { - $r->print('Initial version
'); + $r->print(''.&mt('Initial version').'
'); print $logfile "\nInitial version"; } @@ -1413,17 +1445,18 @@ sub phasetwo { $path.="/$parts[$count]"; if ((-e $path)!=1) { print $logfile "\nCreating directory ".$path; - $r->print('Created directory '.$parts[$count].'
'); + $r->print(''.&mt('Created directory').' '.$parts[$count].'
'); mkdir($path,0777); } } if (copy($source,$copyfile)) { print $logfile "\nCopied original source to ".$copyfile."\n"; - $r->print('Copied source file
'); + $r->print(''.&mt('Copied source file').'
'); } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - return "Failed to copy source, $!, FAIL"; + return "". + &mt('Failed to copy source').", $!, ".&mt('FAIL').""; } # --------------------------------------------------------------- Copy Metadata @@ -1432,18 +1465,18 @@ sub phasetwo { if (copy($source.'.meta',$copyfile)) { print $logfile "\nCopied original metadata to ".$copyfile."\n"; - $r->print('Copied metadata
'); + $r->print(''.&mt('Copied metadata').'
'); } else { print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; return - "Failed to write metadata copy, $!, FAIL"; + "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL').""; } $r->rflush; # --------------------------------------------------- Send update notifications my @subscribed=&get_subscribed_hosts($target); foreach my $subhost (@subscribed) { - $r->print('Notifying host '.$subhost.':');$r->rflush; + $r->print('
'.&mt('Notifying host').' '.$subhost.':');$r->rflush; print $logfile "\nNotifying host ".$subhost.':'; my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); $r->print($reply.'
Notifying host for metadata only '.$subhost.':');$r->rflush; + $r->print('
'. +&mt('Notifying host for metadata only').' '.$subhost.':');$r->rflush; print $logfile "\nNotifying host for metadata only ".$subhost.':'; my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', $subhost); @@ -1466,7 +1500,7 @@ sub phasetwo { my %courses=&coursedependencies($target); my $now=time; foreach (keys %courses) { - $r->print('
Notifying course '.$_.':');$r->rflush; + $r->print('
'.&mt('Notifying course').' '.$_.':');$r->rflush; print $logfile "\nNotifying host ".$_.':'; my ($cdom,$cname)=split(/\_/,$_); my $reply=&Apache::lonnet::cput @@ -1488,10 +1522,12 @@ sub phasetwo { $r->print( '