--- loncom/publisher/lonpublisher.pm 2002/01/08 21:14:53 1.68 +++ loncom/publisher/lonpublisher.pm 2002/03/06 22:58:45 1.74 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.68 2002/01/08 21:14:53 albertel Exp $ +# $Id: lonpublisher.pm,v 1.74 2002/03/06 22:58:45 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -43,6 +43,9 @@ # 12/06,12/07 Gerd Kortemeyer # 12/15,12/16 Scott Harrison # 12/25 Gerd Kortemeyer +# YEAR=2002 +# 1/16,1/17 Scott Harrison +# 1/17 Gerd Kortemeyer # ### @@ -146,8 +149,9 @@ sub metaread { # ---------------------------- convert 'time' format into a datetime sql format sub sqltime { + my $timef=shift @_; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = - localtime(@_[0]); + localtime($timef); $mon++; $year+=1900; return "$year-$mon-$mday $hour:$min:$sec"; } @@ -187,6 +191,7 @@ sub urlfixup { unless ($url) { return ''; } #javascript code needs no fixing if ($url =~ /^javascript:/i) { return $url; } + if ($url =~ /^mailto:/i) { return $url; } #internal document links need no fixing if ($url =~ /^\#/) { return $url; } my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); @@ -198,6 +203,13 @@ sub urlfixup { } if ($url=~/^http\:\/\//) { return $url; } $url=~s/\~$cuname/res\/$cudom\/$cuname/; + return $url; +} + + +sub absoluteurl { + my ($url,$target)=@_; + unless ($url) { return ''; } if ($target) { $target=~s/\/[^\/]+$//; $url=&Apache::lonnet::hreflocation($target,$url); @@ -302,19 +314,27 @@ sub publish { print $logfile 'Index: '.$tag.':'.$maxindex."\n"; } } - } - - foreach ('src','href','background') { - if (defined($parms{$_})) { - my $oldurl=$parms{$_}; - my $newurl=&urlfixup($oldurl,$target); - if ($newurl ne $oldurl) { - $parms{$_}=$newurl; - print $logfile 'URL: '.$tag.':'.$oldurl.' - '. - $newurl."\n"; + } + + foreach my $type ('src','href','background','bgimg') { + foreach my $key (keys(%parms)) { + if ($key =~ /^$type$/i) { + my $oldurl=$parms{$key}; + my $newurl=&urlfixup($oldurl,$target); + if ($newurl ne $oldurl) { + $parms{$key}=$newurl; + print $logfile 'URL: '.$tag.':'.$oldurl.' - '. + $newurl."\n"; + } + if (($newurl !~ /^javascript:/i) && + ($newurl !~ /^mailto:/i) && + ($newurl !~ /^http:/i) && + ($newurl !~ /^\#/)) { + $allow{&absoluteurl($newurl,$target)}=1; + } } - $allow{$newurl}=1; - } + last; + } } if ($lctag eq 'applet') { @@ -332,7 +352,7 @@ sub publish { $oldcodebase.' - '. $codebase."\n"; } - $allow{$codebase.'/*'}=1; + $allow{&absoluteurl($codebase,$target).'/*'}=1; } else { foreach ('archive','code','object') { if (defined($parms{$_})) { @@ -342,7 +362,7 @@ sub publish { print $logfile 'Allow: applet '.$_.':'. $oldurl.' allows '. $newurl."\n"; - $allow{$newurl}=1; + $allow{&absoluteurl($newurl,$target)}=1; } } } @@ -377,8 +397,9 @@ sub publish { $scrout.='

Dependencies

'; my $allowstr=''; - foreach (keys %allow) { + foreach (sort(keys(%allow))) { my $thisdep=$_; + if ($thisdep !~ /[^\s]/) { next; } unless ($style eq 'rat') { $allowstr.="\n".''; } @@ -405,6 +426,7 @@ sub publish { } } } + $allowstr=~s/\n+/\n/g; $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s; # ------------------------------------------------------------- Write modified @@ -514,7 +536,7 @@ sub publish { $chparms; } - my $chparms=''; + $chparms=''; foreach (sort keys %oldparmstores) { if (($_=~/^parameter/) || ($_=~/^stores/)) { unless (($metadatafields{$_.'.name'}) || @@ -576,7 +598,7 @@ sub publish { $keywordout.=' checked'; } } elsif (&Apache::loncommon::keyword($_)) { - $keywordout.=' checked'; + $keywordout.=' checked'; } $keywordout.='>'.$_.''; if ($colcount>10) { @@ -604,7 +626,7 @@ sub publish { $scrout.=&selectbox('Language','language', $metadatafields{'language'}, - \&{Apache::loncommon::languagedescription}, + \&Apache::loncommon::languagedescription, (&Apache::loncommon::languageids), ); @@ -625,13 +647,13 @@ sub publish { } $scrout.=&selectbox('Copyright/Distribution','copyright', $metadatafields{'copyright'}, - \&{Apache::loncommon::copyrightdescription}, + \&Apache::loncommon::copyrightdescription, (grep !/^public$/,(&Apache::loncommon::copyrightids))); } else { $scrout.=&selectbox('Copyright/Distribution','copyright', $metadatafields{'copyright'}, - \&{Apache::loncommon::copyrightdescription}, + \&Apache::loncommon::copyrightdescription, (&Apache::loncommon::copyrightids)); } return $scrout.