--- loncom/xml/lonxml.pm	2001/08/23 19:41:52	1.124
+++ loncom/xml/lonxml.pm	2002/01/01 16:37:20	1.143
@@ -1,6 +1,41 @@
 # The LearningOnline Network with CAPA
 # XML Parser Module 
 #
+# $Id: lonxml.pm,v 1.143 2002/01/01 16:37:20 www Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
+# Copyright for TtHfunc and TtMfunc by Ian Hutchinson. 
+# TtHfunc and TtMfunc (the "Code") may be compiled and linked into 
+# binary executable programs or libraries distributed by the 
+# Michigan State University (the "Licensee"), but any binaries so 
+# distributed are hereby licensed only for use in the context
+# of a program or computational system for which the Licensee is the 
+# primary author or distributor, and which performs substantial 
+# additional tasks beyond the translation of (La)TeX into HTML.
+# The C source of the Code may not be distributed by the Licensee
+# to any other parties under any circumstances.
+#
 # last modified 06/26/00 by Alexander Sakharuk
 # 11/6 Gerd Kortemeyer
 # 6/1/1 Gerd Kortemeyer
@@ -13,7 +48,13 @@
 # 6/12,6/13 H. K. Ng
 # 6/16 Gerd Kortemeyer
 # 7/27 H. K. Ng
-# 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20 Gerd Kortemeyer
+# 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20,8/23,8/24 Gerd Kortemeyer
+# Guy Albertelli
+# 9/26 Gerd Kortemeyer
+# Dec Guy Albertelli
+# YEAR=2002
+# 1/1 Gerd Kortemeyer
+#
 
 package Apache::lonxml; 
 use vars 
@@ -28,15 +69,23 @@ use Math::Random qw(:all);
 use Opcode;
 
 sub register {
-  my $space;
-  my @taglist;
-  my $temptag;
-  ($space,@taglist) = @_;
-  foreach $temptag (@taglist) {
-    $Apache::lonxml::alltags{$temptag}=$space;
+  my ($space,@taglist) = @_;
+  foreach my $temptag (@taglist) {
+    push(@{ $Apache::lonxml::alltags{$temptag} },$space);
   }
 }
 
+sub deregister {
+  my ($space,@taglist) = @_;
+  foreach my $temptag (@taglist) {
+    my $tempspace = $Apache::lonxml::alltags{$temptag}[-1];
+    if ($tempspace eq $space) {
+      pop(@{ $Apache::lonxml::alltags{$temptag} });
+    }
+  }
+  #&printalltags();
+}
+
 use Apache::Constants qw(:common);
 use Apache::lontexconvert;
 use Apache::style;
@@ -46,6 +95,7 @@ use Apache::scripttag;
 use Apache::edit;
 use Apache::lonnet;
 use Apache::File;
+use Apache::loncommon;
 
 #==================================================   Main subroutine: xmlparse  
 #debugging control, to turn on debugging modify the correct handler
@@ -216,16 +266,17 @@ sub maketoken {
 }
 
 sub printtokenheader {
-    my ($target,$token,$symb,$tuname,$tudom,$tcrsid)=@_;
+    my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;
     unless ($token) { return ''; }
 
-    unless ($symb) {
-	$symb=&Apache::lonnet::symbread();
+    my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
+    unless ($tsymb) {
+	$tsymb=$symb;
     }
     unless ($tuname) {
-	$tuname=$ENV{'user.name'};
-        $tudom=$ENV{'user.domain'};
-        $tcrsid=$ENV{'request.course.id'};
+	$tuname=$name;
+        $tudom=$domain;
+        $tcrsid=$courseid;
     }
 
     my %reply=&Apache::lonnet::get('environment',
@@ -260,7 +311,11 @@ sub fontsettings() {
 
 sub registerurl {
     my $forcereg=shift;
-    if ($Apache::lonxml::registered) { return ''; }
+    if ($ENV{'request.publicaccess'}) {
+	return 
+         '<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';
+    }
+    if ($Apache::lonxml::registered && !$forcereg) { return ''; }
     $Apache::lonxml::registered=1;
     if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {
         my $hwkadd='';
@@ -322,9 +377,11 @@ ENDPARM
     function LONCAPAstale() {
 	  menu=window.open("","LONCAPAmenu");
           menu.currentStale=1;
-          //menu.clearbut(7,1);
-          //menu.clearbut(7,2);
-          //menu.clearbut(7,3);
+          menu.switchbutton
+             (3,1,'reload.gif','return','location','go(currentURL)');
+          menu.clearbut(7,1);
+          menu.clearbut(7,2);
+          menu.clearbut(7,3);
           menu.menucltim=menu.setTimeout(
  'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+
  'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3)',
@@ -379,7 +436,8 @@ sub unloadevents() {
 sub printalltags {
   my $temp;
   foreach $temp (sort keys %Apache::lonxml::alltags) {
-    &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
+    &Apache::lonxml::debug("$temp -- ".
+		  join(',',@{ $Apache::lonxml::alltags{$temp} }));
   }
 }
 
@@ -406,7 +464,9 @@ sub xmlparse {
 
  my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
 				   $safeeval,\%style_for_target);
-
+ if ($ENV{'request.uri'}) {
+    &writeallows($ENV{'request.uri'});
+ }
  return $finaloutput;
 }
 
@@ -415,11 +475,11 @@ sub htmlclean {
 
     my $tree = HTML::TreeBuilder->new;
     $tree->ignore_unknown(0);
-    
+
     $tree->parse($raw);
 
     my $output= $tree->as_HTML(undef,' ');
-     
+
     $output=~s/\<(br|hr|img|meta|allow)([^\>\/]*)\>/\<$1$2 \/\>/gis;
     $output=~s/\<\/(br|hr|img|meta|allow)\>//gis;
     unless ($full) {
@@ -447,14 +507,14 @@ sub inner_xmlparse {
 	  $result=$token->[2];
 	}
       } elsif ($token->[0] eq 'S') {
-	# add tag to stack 	    
+	# add tag to stack
 	push (@$stack,$token->[1]);
 	# add parameters list to another stack
 	push (@$parstack,&parstring($token));
-	&increasedepth($token);       
+	&increasedepth($token);
 	if (exists $$style_for_target{$token->[1]}) {
 	  if ($Apache::lonxml::redirection) {
-	    $Apache::lonxml::outputstack['-1'] .=  
+	    $Apache::lonxml::outputstack['-1'] .=
 	      &recurse($$style_for_target{$token->[1]},$target,$safeeval,
 		       $style_for_target,@$parstack);
 	  } else {
@@ -464,15 +524,15 @@ sub inner_xmlparse {
 	} else {
 	  $result = &callsub("start_$token->[1]", $target, $token, $stack,
 			     $parstack, $pars, $safeeval, $style_for_target);
-	}              
+	}
       } elsif ($token->[0] eq 'E') {
 	#clear out any tags that didn't end
 	while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
-	  &Apache::lonxml::warning("Unbalanced tags in resource $$stack['-1']");
+	  &Apache::lonxml::warning('Missing tag &lt;/'.$$stack['-1'].'&gt; in file');
 	  &end_tag($stack,$parstack,$token);
 	}
-		
-	if (exists $$style_for_target{'/'."$token->[1]"}) {
+
+	if (exists($$style_for_target{'/'."$token->[1]"})) {
 	  if ($Apache::lonxml::redirection) {
 	    $Apache::lonxml::outputstack['-1'] .=  
 	      &recurse($$style_for_target{'/'."$token->[1]"},
@@ -482,7 +542,6 @@ sub inner_xmlparse {
 				     $target,$safeeval,$style_for_target,
 				     @$parstack);
 	  }
-		    
 	} else {
 	  $result = &callsub("end_$token->[1]", $target, $token, $stack,
 			     $parstack, $pars,$safeeval, $style_for_target);
@@ -533,6 +592,7 @@ sub recurse {
   my $partstring = '';
   my $output='';
   my $decls='';
+  &Apache::lonxml::debug("Recursing");
   while ( $#pat > -1 ) {
     while  ($tokenpat = $pat[$#pat]->get_token) {
       if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {
@@ -550,7 +610,7 @@ sub recurse {
 	#clear out any tags that didn't end
 	while ($tokenpat->[1] ne $innerstack[$#innerstack] 
 	       && ($#innerstack > -1)) {
-	  &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
+	  &Apache::lonxml::warning('Missing tag &lt;/'.$innerstack['-1'].'&gt; in style');
 	  &end_tag(\@innerstack,\@innerparstack,$tokenpat);
 	}
 	$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,
@@ -584,6 +644,7 @@ sub recurse {
     pop @pat;
     pop @Apache::lonxml::pwd;
   }
+  &Apache::lonxml::debug("Exiting Recursing");
   return $output;
 }
 
@@ -595,11 +656,11 @@ sub callsub {
     my $sub1;
     no strict 'refs';
     my $tag=$token->[1];
-    my $space=$Apache::lonxml::alltags{$tag};
+    my $space=$Apache::lonxml::alltags{$tag}[-1];
     if (!$space) {
-	$tag=~tr/A-Z/a-z/;
+     	$tag=~tr/A-Z/a-z/;
 	$sub=~tr/A-Z/a-z/;
-	$space=$Apache::lonxml::alltags{$tag}
+	$space=$Apache::lonxml::alltags{$tag}[-1]
     }
 
     my $deleted=0;
@@ -660,6 +721,11 @@ sub setup_globals {
     $Apache::lonxml::metamode = 1;
     $Apache::lonxml::evaluate = 1;
     $Apache::lonxml::import = 0;
+  } elsif ($target eq 'answer') {
+    $Apache::lonxml::redirection = 0;
+    $Apache::lonxml::metamode = 1;
+    $Apache::lonxml::evaluate = 1;
+    $Apache::lonxml::import = 1;
   } elsif ($target eq 'grade') {
     &startredirection;
     $Apache::lonxml::metamode = 0;
@@ -790,7 +856,7 @@ sub decreasedepth {
     $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
   }
   if (  $Apache::lonxml::depth < -1) {
-    &Apache::lonxml::warning("Unbalanced tags in resource");   
+    &Apache::lonxml::warning("Missing tags, unable to properly run file.");
     $Apache::lonxml::depth='-1';
   }
   my $curdepth=join('_',@Apache::lonxml::depthcounter);
@@ -862,18 +928,19 @@ sub newparser {
 sub parstring {
   my ($token) = @_;
   my $temp='';
-  map {
+  foreach (@{$token->[3]}) {
     unless ($_=~/\W/) {
       my $val=$token->[2]->{$_};
       $val =~ s/([\%\@\\])/\\$1/g;
       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
       $temp .= "my \$$_=\"$val\";"
     }
-  } @{$token->[3]};
+  }
   return $temp;
 }
 
 sub writeallows {
+    unless ($#extlinks>=0) { return; }
     my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
     if ($ENV{'httpref.'.$thisurl}) {
 	$thisurl=$ENV{'httpref.'.$thisurl};
@@ -881,9 +948,11 @@ sub writeallows {
     my $thisdir=$thisurl;
     $thisdir=~s/\/[^\/]+$//;
     my %httpref=();
-    map {
+    foreach (@extlinks) {
        $httpref{'httpref.'.
- 	        &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;              } @extlinks;
+ 	        &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;
+    }
+    @extlinks=();
     &Apache::lonnet::appenv(%httpref);
 }
 
@@ -892,7 +961,7 @@ sub writeallows {
 #
 sub afterburn {
     my $result=shift;
-    map {
+    foreach (split(/&/,$ENV{'QUERY_STRING'})) {
        my ($name, $value) = split(/=/,$_);
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
@@ -901,22 +970,22 @@ sub afterburn {
               $ENV{'form.'.$name}=$value;
 	   }
        }
-    } (split(/&/,$ENV{'QUERY_STRING'}));
+    }
     if ($ENV{'form.highlight'}) {
-        map {
+       foreach (split(/\,/,$ENV{'form.highlight'})) {
            my $anchorname=$_;
 	   my $matchthis=$anchorname;
            $matchthis=~s/\_+/\\s\+/g;
            $result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
-       } split(/\,/,$ENV{'form.highlight'});
+       }
     }
     if ($ENV{'form.link'}) {
-        map {
+       foreach (split(/\,/,$ENV{'form.link'})) {
            my ($anchorname,$linkurl)=split(/\>/,$_);
 	   my $matchthis=$anchorname;
            $matchthis=~s/\_+/\\s\+/g;
            $result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
-       } split(/\,/,$ENV{'form.link'});
+       }
     }
     if ($ENV{'form.anchor'}) {
         my $anchorname=$ENV{'form.anchor'};
@@ -987,9 +1056,9 @@ sub handler {
   } else {
     $request->content_type('text/html');
   }
-  
+  &Apache::loncommon::no_cache($request);
   $request->send_http_header;
-  
+
   return OK if $request->header_only;
 
 
@@ -1032,10 +1101,11 @@ ENDNOTFOUND
   unless ($ENV{'request.state'} eq 'published') {
       $result=&inserteditinfo($result,$filecontents);
   }
+  
+  writeallows($request->uri);
 
   $request->print($result);
 
-  writeallows($request->uri);
   return OK;
 }
  
@@ -1055,9 +1125,11 @@ sub error {
     #notify course
     if ( $ENV{'request.course.id'} ) {
       my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
+      my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
       foreach my $user (split /\,/, $users) {
 	($user,my $domain) = split /:/, $user;
-	&Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
+	&Apache::lonmsg::user_normal_msg($user,$domain,
+        "Error [$declutter]",$_[0]);
       }
     }
 
@@ -1078,7 +1150,25 @@ sub get_param {
   if ( ! $context ) { $context = -1; }
   my $args ='';
   if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
-  return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
+  if ( $args =~ /my \$$param=\"/ ) {
+    return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
+  } else {
+    return undef;
+  }
+}
+
+sub get_param_var {
+  my ($param,$parstack,$safeeval,$context) = @_;
+  if ( ! $context ) { $context = -1; }
+  my $args ='';
+  if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
+  if ( $args !~ /my \$$param=\"/ ) { return undef; }
+  my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
+  if ($value =~ /^[\$\@\%]/) {
+    return &Apache::run::run("return $value",$safeeval,1);
+  } else {
+    return $value;
+  }
 }
 
 sub register_insert {
@@ -1091,13 +1181,16 @@ sub register_insert {
     if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
     if ( $line =~ /TABLE/ ) { last; }
     my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);
-    $insertlist{"$tagnum.tag"} = $tag;
-    $insertlist{"$tagnum.description"} = $descrip;
-    $insertlist{"$tagnum.color"} = $color;
-    $insertlist{"$tagnum.function"} = $function;
-    $insertlist{"$tagnum.show"}= $show;
-    $insertlist{"$tag.num"}=$tagnum;
-    $tagnum++;
+    if ($tag) {
+      $insertlist{"$tagnum.tag"} = $tag;
+      $insertlist{"$tagnum.description"} = $descrip;
+      $insertlist{"$tagnum.color"} = $color;
+      $insertlist{"$tagnum.function"} = $function;
+      if (!defined($show)) { $show='yes'; }
+      $insertlist{"$tagnum.show"}= $show;
+      $insertlist{"$tag.num"}=$tagnum;
+      $tagnum++;
+    }
   }
   $i++; #skipping TABLE line
   $tagnum = 0;
@@ -1118,7 +1211,15 @@ sub register_insert {
 
 sub description {
   my ($token)=@_;
-  return $insertlist{$insertlist{"$token->[1].num"}.'.description'};
+  my $tagnum;
+  my $tag=$token->[1];
+  foreach my $namespace (reverse @Apache::lonxml::namespace) {
+    my $testtag=$namespace.'::'.$tag;
+    $tagnum=$insertlist{"$testtag.num"};
+    if (defined($tagnum)) { last; }
+  }
+  if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
+  return $insertlist{$tagnum.'.description'};
 }
 
 # ----------------------------------------------------------------- whichuser
@@ -1126,10 +1227,7 @@ sub description {
 # calls to lonnet functions for this setup.
 # - looks for form.grade_ parameters
 sub whichuser {
-  my $symb=&Apache::lonnet::symbread();
-  my $courseid=$ENV{'request.course.id'};
-  my $domain=$ENV{'user.domain'};
-  my $name=$ENV{'user.name'};
+  my ($symb,$courseid,$domain,$name);
   if (defined($ENV{'form.grade_symb'})) {
     my $tmp_courseid=$ENV{'form.grade_courseid'};
     my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid);
@@ -1139,6 +1237,11 @@ sub whichuser {
       $domain=$ENV{'form.grade_domain'};
       $name=$ENV{'form.grade_username'};
     }
+  } else {
+    $symb=&Apache::lonnet::symbread();
+    $courseid=$ENV{'request.course.id'};
+    $domain=$ENV{'user.domain'};
+    $name=$ENV{'user.name'};
   }
   return ($symb,$courseid,$domain,$name);
 }