[LON-CAPA-cvs] cvs: loncom /publisher lonpublisher.pm

albertel lon-capa-cvs@mail.lon-capa.org
Fri, 17 May 2002 22:08:01 -0000


albertel		Fri May 17 18:08:01 2002 EDT

  Modified files:              
    /loncom/publisher	lonpublisher.pm 
  Log:
  - supports the image <label>s in a <randomlabel> problem
  
  
Index: loncom/publisher/lonpublisher.pm
diff -u loncom/publisher/lonpublisher.pm:1.80 loncom/publisher/lonpublisher.pm:1.81
--- loncom/publisher/lonpublisher.pm:1.80	Tue May  7 14:07:46 2002
+++ loncom/publisher/lonpublisher.pm	Fri May 17 18:08:01 2002
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Publication Handler
 #
-# $Id: lonpublisher.pm,v 1.80 2002/05/07 18:07:46 matthew Exp $
+# $Id: lonpublisher.pm,v 1.81 2002/05/17 22:08:01 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -217,6 +217,24 @@
     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)=@_;
@@ -318,25 +336,25 @@
 
                   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";
-			      }
-			      if (($newurl !~ /^javascript:/i) &&
-				  ($newurl !~ /^mailto:/i) &&
-				  ($newurl !~ /^http:/i) &&
-				  ($newurl !~ /^\#/)) {
-				  $allow{&absoluteurl($newurl,$target)}=1;
-			      }
+			      print $logfile "calling set_allow\n";
+			      $parms{$key}=&set_allow(\%allow,$logfile,
+						      $target,$tag,
+						      $parms{$key});
 			  }
-			  last;
 		      }
                   }
-
+		  # probably a <randomlabel> image type <label>
+		  if ($lctag eq 'label' && defined($parms{'description'})) {
+		      my $next_token=$parser->get_token();
+		      if ($next_token->[0] eq 'T') {
+			  $next_token->[1]=&set_allow(\%allow,$logfile,
+						      $target,$tag,
+						      $next_token->[1]);
+		      }
+		      $parser->unget_token($next_token);
+		  }
                   if ($lctag eq 'applet') {
 		      my $codebase='';
                       if (defined($parms{'codebase'})) {