--- loncom/publisher/lonpublisher.pm 2001/08/11 19:06:54 1.36
+++ loncom/publisher/lonpublisher.pm 2001/08/17 21:25:36 1.41
@@ -11,7 +11,7 @@
# 04/16/2001 Scott Harrison
# 05/03,05/05,05/07 Gerd Kortemeyer
# 05/28/2001 Scott Harrison
-# 06/23,08/07,08/11 Gerd Kortemeyer
+# 06/23,08/07,08/11,8/13,8/17 Gerd Kortemeyer
package Apache::lonpublisher;
@@ -71,7 +71,8 @@ sub metaeval {
} @{$token->[3]};
if ($metadatafields{$unikey}) {
my $newentry=$parser->get_text('/'.$entry);
- unless ($metadatafields{$unikey}=~/$newentry/) {
+ unless (($metadatafields{$unikey}=~/$newentry/) ||
+ ($newentry eq '')) {
$metadatafields{$unikey}.=', '.$newentry;
}
} else {
@@ -135,6 +136,7 @@ sub selectbox {
sub urlfixup {
my ($url,$target)=@_;
+ unless ($url) { return ''; }
my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
map {
if ($_ eq $host) {
@@ -142,6 +144,7 @@ sub urlfixup {
$url=~s/^$host//;
}
} values %Apache::lonnet::hostname;
+ if ($url=~/^http\:\/\//) { return $url; }
$url=~s/\~$cuname/res\/$cudom\/$cuname/;
if ($target) {
$target=~s/\/[^\/]+$//;
@@ -256,7 +259,38 @@ sub publish {
}
$allow{$newurl}=1;
}
- } ('src','href','codebase');
+ } ('src','href');
+
+ if ($tag eq 'applet') {
+ my $codebase='';
+ if (defined($parms{'codebase'})) {
+ my $oldcodebase=$parms{'codebase'};
+ unless ($oldcodebase=~/\/$/) {
+ $oldcodebase.='/';
+ }
+ $codebase=&urlfixup($oldcodebase,$target);
+ $codebase=~s/\/$//;
+ if ($codebase ne $oldcodebase) {
+ $parms{'codebase'}=$codebase;
+ print $logfile 'URL codebase: '.$tag.':'.
+ $oldcodebase.' - '.
+ $codebase."\n";
+ }
+ $allow{$codebase.'/*'}=1;
+ } else {
+ map {
+ if (defined($parms{$_})) {
+ my $oldurl=$parms{$_};
+ my $newurl=&urlfixup($oldurl,$target);
+ $newurl=~s/\/[^\/]+$/\/\*/;
+ print $logfile 'Allow: applet '.$_.':'.
+ $oldurl.' allows '.
+ $newurl."\n";
+ $allow{$newurl}=1;
+ }
+ } ('archive','code','object');
+ }
+ }
my $newparmstring='';
my $endtag='';
@@ -275,19 +309,22 @@ sub publish {
}
} elsif ($token->[0] eq 'E') {
unless ($token->[1] eq 'allow') {
- $outstring.=$token->[2];
+ $outstring.=''.$token->[1].'>';
}
} else {
$outstring.=$token->[1];
}
}
# ------------------------------------------------------------ Construct Allows
+ unless ($style eq 'rat') {
my $allowstr="\n";
map {
$allowstr.='
Obsolete parameters or stored values: '. $chparms; } - } + # ------------------------------------------------------- Now have all metadata $scrout.=