--- loncom/publisher/lonpublisher.pm 2002/02/14 22:01:39 1.73 +++ loncom/publisher/lonpublisher.pm 2002/05/17 22:08:01 1.81 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.73 2002/02/14 22:01:39 albertel Exp $ +# $Id: lonpublisher.pm,v 1.81 2002/05/17 22:08:01 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -68,7 +68,7 @@ use strict; use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); -use HTML::TokeParser; +use HTML::LCParser; use Apache::lonxml; use Apache::lonhomework; use Apache::loncacc; @@ -91,7 +91,7 @@ my $cudom; sub metaeval { my $metastring=shift; - my $parser=HTML::TokeParser->new(\$metastring); + my $parser=HTML::LCParser->new(\$metastring); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { @@ -217,6 +217,24 @@ sub absoluteurl { return $url; } +sub set_allow { + my ($allow,$logfile,$target,$tag,$oldurl)=@_; + my $newurl=&urlfixup($oldurl,$target); + my $return_url=$oldurl; + print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n"; + if ($newurl ne $oldurl) { + $return_url=$newurl; + print $logfile 'URL: '.$tag.':'.$oldurl.' - '.$newurl."\n"; + } + if (($newurl !~ /^javascript:/i) && + ($newurl !~ /^mailto:/i) && + ($newurl !~ /^http:/i) && + ($newurl !~ /^\#/)) { + $$allow{&absoluteurl($newurl,$target)}=1; + } + return $return_url +} + sub publish { my ($source,$target,$style)=@_; @@ -257,7 +275,7 @@ sub publish { $content=join('',<$org>); } { - my $parser=HTML::TokeParser->new(\$content); + my $parser=HTML::LCParser->new(\$content); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { @@ -288,7 +306,7 @@ sub publish { "Max Index: $maxindex (min 10)\n"; } my $outstring=''; - my $parser=HTML::TokeParser->new(\$content); + my $parser=HTML::LCParser->new(\$content); $parser->xml_mode(1); my $token; while ($token=$parser->get_token) { @@ -318,20 +336,25 @@ sub publish { foreach my $type ('src','href','background','bgimg') { foreach my $key (keys(%parms)) { + print $logfile "for $type, and $key\n"; 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"; - } - $allow{&absoluteurl($newurl,$target)}=1; + print $logfile "calling set_allow\n"; + $parms{$key}=&set_allow(\%allow,$logfile, + $target,$tag, + $parms{$key}); } - last; } } - + # probably a image type