[LON-CAPA-cvs] cvs: loncom /xml lonxml.pm run.pm

[albertel]

albertel		Thu Feb 26 18:39:05 2004 EDT

  Modified files:              
    /loncom/xml	lonxml.pm run.pm 
  Log:
  - BUG#2414, okay $$a should work when only $a is defined.
  - commented the regexp of doom some
  
  
Index: loncom/xml/lonxml.pm
diff -u loncom/xml/lonxml.pm:1.302 loncom/xml/lonxml.pm:1.303
--- loncom/xml/lonxml.pm:1.302	Thu Feb 19 14:29:40 2004
+++ loncom/xml/lonxml.pm	Thu Feb 26 18:39:03 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # XML Parser Module 
 #
-# $Id: lonxml.pm,v 1.302 2004/02/19 19:29:40 sakharuk Exp $
+# $Id: lonxml.pm,v 1.303 2004/02/26 23:39:03 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -760,6 +760,28 @@
   $safeinit .= ';$external::randomseed='.$rndseed.';';
   &Apache::lonxml::debug("Setting rndseed to $rndseed");
   &Apache::run::run($safeinit,$safeeval);
+
+  my $subroutine=<<'EVALUATESUB';
+sub __LC_INTERNAL_EVALUATE__ {
+    my ($__LC__a,$__LC__b,$__LC__c)=@_;
+    my $__LC__prefix;
+    my $__LC__msg;
+    while(1){
+	{ 
+	    use strict;
+	    if (eval(defined(eval($__LC__a.$__LC__b)))) {
+		return $__LC__msg.$__LC__prefix.eval($__LC__a.$__LC__b.$__LC__c);
+	    }
+	}
+	$__LC__prefix.=substr($__LC__a,0,1,"");
+	if ($__LC__a!~/^(\$|&|\#)/) { last; }
+    }
+    return $__LC__prefix.$__LC__a.$__LC__b.$__LC__c.$__LC__msg;
+}
+EVALUATESUB
+    $safeeval->permit("require");
+    $safeeval->reval($subroutine);
+    $safeeval->deny("require");
 }
 
 sub default_homework_load {
@@ -1326,10 +1348,6 @@
         "Error [$declutter]",join('<br />',@_));
       }
     }
-
-    #FIXME probably shouldn't have me get everything forever.
-    &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('<br />',@_));
-    #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
   }
 }
 
Index: loncom/xml/run.pm
diff -u loncom/xml/run.pm:1.44 loncom/xml/run.pm:1.45
--- loncom/xml/run.pm:1.44	Thu Feb 26 17:08:54 2004
+++ loncom/xml/run.pm	Thu Feb 26 18:39:04 2004
@@ -1,6 +1,6 @@
 package Apache::run;
 #
-# $Id: run.pm,v 1.44 2004/02/26 22:08:54 albertel Exp $
+# $Id: run.pm,v 1.45 2004/02/26 23:39:04 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -27,13 +27,28 @@
 
 use HTML::Entities;
 
-$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE';  
-  my %_LONCAPA_INTERNAL_oldexpressions=();
-  while (!$_LONCAPA_INTERNAL_oldexpressions{$_}) {
+$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE';
+my %_LONCAPA_INTERNAL_oldexpressions=();
+while (!$_LONCAPA_INTERNAL_oldexpressions{$_}) {
     $_LONCAPA_INTERNAL_oldexpressions{$_}=1;
-    $_ =~s/((?:\$|\&)(?:(?:\#\$|\#)?[A-Za-z][\w]*|\{[A-Za-z][\w]*\}))([\[\{][^\$\&\]\}]+[\]\}])*?(\([^\$\&\)]+\))*?(?=[^\[\{\(]|$)/eval(defined(eval($1.$2))?eval('$1.$2.$3'):'$1.$2.$3')/seg;
+    $_ =~s/  # $1 will be the variable reference or subroutine name
+            ((?:\$|\&) #look for a starting $ or &
+             (?:[\#|\$]* #support $$ or $#$ etc.
+              [A-Za-z][\w]*| # get variable name
+              \{[A-Za-z][\w]*\})) # for ${a}
+             # $2 is 0 or more array dereferences []
+             #             or  hash dereferences {}
+             # the ^$ and ^& is because we do this iteratively
+             #    $a[$c] becomes $a[3] which then evaluates
+             ([\[\{][^\$\&\]\}]+[\]\}])*?
+             # $3 is the list of arguments
+             (\([^\$\&\)]+\))*?
+                # only match the above if there is not { [ ( coming up
+                # Why? (I.e. this fails &a(1)[2]
+                (?=[^\[\{\(]|$)/
+         &__LC_INTERNAL_EVALUATE__($1,$2,$3)/sexg;
     if (scalar(values(%_LONCAPA_INTERNAL_oldexpressions))>10) {last;}
-  }
+}
 ENDEVALUATE
 
 sub evaluate {