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

[albertel]

albertel		Wed Jul  7 16:43:21 2004 EDT

  Modified files:              
    /loncom/publisher	lonpublisher.pm 
    /loncom/xml	lonxml.pm 
  Log:
  - BUG#3177, silly regexp was causing massize slowdown on large <script> blocks
  
  
Index: loncom/publisher/lonpublisher.pm
diff -u loncom/publisher/lonpublisher.pm:1.175 loncom/publisher/lonpublisher.pm:1.176
--- loncom/publisher/lonpublisher.pm:1.175	Fri Jul  2 23:32:30 2004
+++ loncom/publisher/lonpublisher.pm	Wed Jul  7 16:43:20 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Publication Handler
 #
-# $Id: lonpublisher.pm,v 1.175 2004/07/03 03:32:30 albertel Exp $
+# $Id: lonpublisher.pm,v 1.176 2004/07/07 20:43:20 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -584,10 +584,10 @@
 	    $result.=$token->[2];
 	}
 	if ($result =~ /(.*)\Q$tag\E(.*)/s) {
+	    ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is;
 	    #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);
 	    #&Apache::lonnet::logthis('Result is :'.$1);
-	    $result=$1;
-	    my $redo=$tag.$2;
+	    $redo=$tag.$redo;
 	    push (@$pars,HTML::LCParser->new(\$redo));
 	    $$pars[-1]->xml_mode('1');
 	    last;
Index: loncom/xml/lonxml.pm
diff -u loncom/xml/lonxml.pm:1.325 loncom/xml/lonxml.pm:1.326
--- loncom/xml/lonxml.pm:1.325	Fri Jun 11 21:09:31 2004
+++ loncom/xml/lonxml.pm	Wed Jul  7 16:43:20 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # XML Parser Module 
 #
-# $Id: lonxml.pm,v 1.325 2004/06/12 01:09:31 www Exp $
+# $Id: lonxml.pm,v 1.326 2004/07/07 20:43:20 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -844,30 +844,30 @@
 
 sub get_all_text_unbalanced {
 #there is a copy of this in lonpublisher.pm
- my($tag,$pars)= @_;
- my $token;
- my $result='';
- $tag='<'.$tag.'>';
- while ($token = $$pars[-1]->get_token) {
-   if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
-     $result.=$token->[1];
-   } elsif ($token->[0] eq 'PI') {
-     $result.=$token->[2];
-   } elsif ($token->[0] eq 'S') {
-     $result.=$token->[4];
-   } elsif ($token->[0] eq 'E')  {
-     $result.=$token->[2];
-   }
-   if ($result =~ /(.*)\Q$tag\E(.*)/is) {
-     &Apache::lonxml::debug('Got a winner with leftovers ::'.$2);
-     &Apache::lonxml::debug('Result is :'.$1);
-     $result=$1;
-     my $redo=$tag.$2;
-     &Apache::lonxml::newparser($pars,\$redo);
-     last;
-   }
- }
- return $result
+    my($tag,$pars)= @_;
+    my $token;
+    my $result='';
+    $tag='<'.$tag.'>';
+    while ($token = $$pars[-1]->get_token) {
+	if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
+	    $result.=$token->[1];
+	} elsif ($token->[0] eq 'PI') {
+	    $result.=$token->[2];
+	} elsif ($token->[0] eq 'S') {
+	    $result.=$token->[4];
+	} elsif ($token->[0] eq 'E')  {
+	    $result.=$token->[2];
+	}
+	if ($result =~ /\Q$tag\E/is) {
+	    ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is;
+	    #&Apache::lonxml::debug('Got a winner with leftovers ::'.$2);
+	    #&Apache::lonxml::debug('Result is :'.$1);
+	    $redo=$tag.$redo;
+	    &Apache::lonxml::newparser($pars,\$redo);
+	    last;
+	}
+    }
+    return $result
 }
 
 sub increment_counter {