--- loncom/publisher/lonpublisher.pm 2001/08/13 12:53:06 1.37 +++ loncom/publisher/lonpublisher.pm 2001/10/03 11:04:57 1.46 @@ -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,8/13 Gerd Kortemeyer +# 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26 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/\/[^\/]+$//; @@ -151,7 +154,6 @@ sub urlfixup { } sub publish { - my ($source,$target,$style)=@_; my $logfile; my $scrout=''; @@ -256,7 +258,38 @@ sub publish { } $allow{$newurl}=1; } - } ('src','href','codebase'); + } ('src','href','background'); + + 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,7 +308,7 @@ sub publish { } } elsif ($token->[0] eq 'E') { unless ($token->[1] eq 'allow') { - $outstring.=$token->[2]; + $outstring.='[1].'>'; } } else { $outstring.=$token->[1]; @@ -283,9 +316,18 @@ sub publish { } # ------------------------------------------------------------ Construct Allows unless ($style eq 'rat') { + $scrout.='

Dependencies

'; my $allowstr="\n"; map { $allowstr.=''."\n"; + $scrout.='
'; + unless ($_=~/\*/) { + $scrout.=''; + } + $scrout.=''.$_.''; + unless ($_=~/\*/) { + $scrout.=''; + } } keys %allow; $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s; } @@ -318,6 +360,8 @@ sub publish { %metadatakeys=(); my %oldparmstores=(); + + $scrout.='

Metadata Information

'; # ------------------------------------------------ First, check out environment unless (-e $source.'.meta') { @@ -368,7 +412,11 @@ sub publish { # -------------------------------------------------- Parse content for metadata if ($style eq 'ssi') { + my $oldenv=$ENV{'request.uri'}; + + $ENV{'request.uri'}=$target; $allmeta=Apache::lonxml::xmlparse('meta',$content); + $ENV{'request.uri'}=$oldenv; &metaeval($allmeta); } @@ -431,12 +479,29 @@ sub publish { $textonly=~s/[^a-z\s]//g; my %keywords=(); - map { - unless ($nokey{$_}) { - $keywords{$_}=1; - } - } ($textonly=~m/(\w+)/g); + my $j=0; + my $word; + for (my $i=0; $idir_config('lonDocRoot');