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

[albertel]

albertel		Thu Dec  8 14:37:08 2005 EDT

  Modified files:              
    /loncom/xml	lonxml.pm 
  Log:
  - reenabling Math::Complex
  - cleanse any possbile sub namespaces under the Safe namespace to reduce memory usage
  
  
Index: loncom/xml/lonxml.pm
diff -u loncom/xml/lonxml.pm:1.392 loncom/xml/lonxml.pm:1.393
--- loncom/xml/lonxml.pm:1.392	Wed Dec  7 21:15:36 2005
+++ loncom/xml/lonxml.pm	Thu Dec  8 14:37:05 2005
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # XML Parser Module 
 #
-# $Id: lonxml.pm,v 1.392 2005/12/08 02:15:36 albertel Exp $
+# $Id: lonxml.pm,v 1.393 2005/12/08 19:37:05 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -52,6 +52,7 @@
 use Opcode();
 use POSIX qw(strftime);
 use Time::HiRes qw( gettimeofday tv_interval );
+use Symbol();
 
 sub register {
   my ($space,@taglist) = @_;
@@ -370,6 +371,9 @@
  }
  &do_registered_ssi();
  if ($Apache::lonxml::counter_changed) { &store_counter() }
+
+ &clean_safespace($safeeval);
+
  if ($env{'form.return_only_error_and_warning_counts'}) {
      return "$errorcount:$warningcount";
  }
@@ -665,6 +669,8 @@
 
 sub init_safespace {
   my ($target,$safeeval,$safehole,$safeinit) = @_;
+  $safeeval->deny_only(':dangerous');
+  $safeeval->reval('use Math::Complex;');
   $safeeval->permit_only(":default");
   $safeeval->permit("entereval");
   $safeeval->permit(":base_math");
@@ -793,6 +799,34 @@
   &initialize_rndseed($safeeval);
 }
 
+sub clean_safespace {
+    my ($safeeval) = @_;
+    delete_package_recurse($safeeval->{Root});
+}
+
+sub delete_package_recurse {
+     my ($package) = @_;
+     my @subp;
+     {
+	 no strict 'refs';
+	 while (my ($key,$val) = each(%{*{"$package\::"}})) {
+	     if (!defined($val)) { next; }
+	     local (*ENTRY) = $val;
+	     if (defined *ENTRY{HASH} && $key =~ /::$/ &&
+		 $key ne "main::" && $key ne "<none>::")
+	     {
+		 my ($p) = $package ne "main" ? "$package\::" : "";
+		 ($p .= $key) =~ s/::$//;
+		 push(@subp,$p);
+	     }
+	 }
+     }
+     foreach my $p (@subp) {
+	 delete_package_recurse($p);
+     }
+     Symbol::delete_package($package);
+}
+
 sub initialize_rndseed {
     my ($safeeval)=@_;
     my $rndseed;