Bug 40933

Serious performance fixes


git-svn-id: svn://svn.office.custis.ru/3rdparty/bugzilla.org/trunk@283 6955db30-a419-402b-8a0d-67ecbb4d7f56

Bugzilla/Template.pm

@@ -220,16 +220,15 @@ sub quoteUrls {
               ~egox;
 
     # non-mailto protocols
-    my $safe_protocols = join('|', SAFE_PROTOCOLS);
-    my $protocol_re = qr/($safe_protocols)/i;
+    my $safe_protocols = join '|', SAFE_PROTOCOLS;
 
-    $text =~ s~\b(${protocol_re}:  # The protocol:
-                  [^\s<>\"]+       # Any non-whitespace
-                  [\w\/])          # so that we end in \w or /
+    $text =~ s~\b((?:$safe_protocols): # The protocol:
+                  [^\s<>\"]+        # Any non-whitespace
+                  [\w\/])           # so that we end in \w or /
               ~($tmp = html_quote($1)) &&
                ($things[$count++] = "<a href=\"$tmp\">$tmp</a>") &&
                ("\0\0" . ($count-1) . "\0\0")
-              ~egox;
+              ~gesox;
 
     if ($custom_proto && %$custom_proto)
     {
@@ -252,8 +251,7 @@ sub quoteUrls {
     $text =~ s~</span >\n<span class="quote">~\n~g;
 
     # mailto:
-    # Use |<nothing> so that $1 is defined regardless
-    $text =~ s~\b(mailto:|)?([\w\.\-\+\=]+\@[\w\-]+(?:\.[\w\-]+)+)\b
+    $text =~ s~\b(mailto:)?([\w\.\-\+\=]+\@[\w\-]+(?:\.[\w\-]+)+)\b
               ~<a href=\"mailto:$2\">$1$2</a>~igx;
 
     # attachment links - handle both cases separately for simplicity
@@ -274,7 +272,7 @@ sub quoteUrls {
     # we have to do this in one pattern, and so this is semi-messy.
     # Also, we can't use $bug_re?$comment_re? because that will match the
     # empty string
-    my $bug_word = get_text('term', { term => 'bug' });
+    my $bug_word = get_term('bug');
     my $bug_re = qr/\Q$bug_word\E$s*\#?$s*(\d+)/i;
     my $comment_re = qr/comment$s*\#?$s*(\d+)/i;
     $text =~ s~\b($bug_re(?:$s*,?$s*$comment_re)?|$comment_re)
@@ -286,10 +284,8 @@ sub quoteUrls {
 
     # Old duplicate markers. These don't use $bug_word because they are old
     # and were never customizable.
-    $text =~ s~(?<=^\*\*\*\ This\ bug\ has\ been\ marked\ as\ a\ duplicate\ of\ )
-               (\d+)
-               (?=\ \*\*\*\Z)
-              ~get_bug_link($1, $1)
+    $text =~ s~(^\*\*\*\ This\ bug\ has\ been\ marked\ as\ a\ duplicate\ of\ )(\d+)(\ \*\*\*\Z)
+              ~$1.get_bug_link($2, $2).$3
               ~egmx;
 
     # Now remove the encoding hacks

Bugzilla/Util.pm

@@ -44,7 +44,7 @@ use base qw(Exporter);
                              file_mod_time is_7bit_clean
                              bz_crypt generate_random_password
                              validate_email_syntax clean_text
-                             get_text disable_utf8 stem_text);
+                             get_term get_text disable_utf8 stem_text);
 
 use Bugzilla::Constants;
 
@@ -346,33 +346,29 @@ sub trim {
     return $str;
 }
 
-sub wrap_comment {
+sub wrap_comment
+{
     my ($comment, $cols) = @_;
     my $wrappedcomment = "";
 
-    # Use 'local', as recommended by Text::Wrap's perldoc.
-    local $Text::Wrap::columns = $cols || COMMENT_COLS;
-    # Make words that are longer than COMMENT_COLS not wrap.
-    local $Text::Wrap::huge    = 'overflow';
-    # Don't mess with tabs.
-    local $Text::Wrap::unexpand = 0;
+    $cols ||= COMMENT_COLS;
 
     # If the line starts with ">", don't wrap it. Otherwise, wrap.
-    foreach my $line (split(/\r\n|\r|\n/, $comment)) {
-      if ($line =~ qr/^>/) {
-        $wrappedcomment .= ($line . "\n");
-      }
-      else {
-        # Due to a segfault in Text::Tabs::expand() when processing tabs with
-        # Unicode (see http://rt.perl.org/rt3/Public/Bug/Display.html?id=52104),
-        # we have to remove tabs before processing the comment. This restriction
-        # can go away when we require Perl 5.8.9 or newer.
-        $line =~ s/\t/    /g;
-        $wrappedcomment .= (wrap('', '', $line) . "\n");
-      }
+    foreach my $line (split /\r\n?|\n/, $comment)
+    {
+        if ($line !~ /^>/so)
+        {
+            $line =~ s/\t/    /gso;
+            $cols = qr/^(.{1,$cols})\b/s;
+            while ($line =~ s/$cols//)
+            {
+                $wrappedcomment .= $1 . "\n";
+            }
+        }
+        $wrappedcomment .= $line . "\n";
     }
 
-    chomp($wrappedcomment); # Text::Wrap adds an extra newline at the end.
+    chomp $wrappedcomment;
     return $wrappedcomment;
 }
 
@@ -595,6 +591,30 @@ sub clean_text {
     return trim($dtext);
 }
 
+# Довольно некрасивый хак для бага см.ниже - на багах с длинным числом комментов
+# quoteUrls вызывает на каждый коммент get_text('term', { term => 'bug' }),
+# что приводит к ужасной производительности. например, на баге с 703
+# комментами в 10-15 раз ухудшение по сравнению с Bugzilla 2.x.
+# Избавляемся от этого.
+sub get_term
+{
+    my ($term) = @_;
+    my $tt;
+    unless ($tt = Bugzilla->request_cache->{_variables_none_tmpl})
+    {
+        # создаём отдельный шаблон
+        $tt = Bugzilla::Template->create();
+        # хакаемся внутрь контекста и делаем process без localise
+        $tt = $tt->{SERVICE}->context;
+        $tt->process('global/variables.none.tmpl');
+        Bugzilla->request_cache->{_variables_none_tmpl} = $tt;
+    }
+    return $tt->stash->get(['terms', 0, $term, 0]);
+}
+
+# CustIS Bug 40933 ФАКМОЙМОЗГ! ВРОТМНЕНОГИ! КТО ТАК ПИШЕТ?!!!!
+# ВОТ он, антипаттерн разработки на TT, ведущий к тормозам...
+# ALSO CustIS Bug3 52322
 sub get_text {
     my ($name, $vars) = @_;
     my $template = Bugzilla->template_inner;

HTTPServerSimple.pl

@@ -18,6 +18,7 @@ $server->run();
 
 package Bugzilla::HTTPServerSimple;
 
+use Time::HiRes qw(gettimeofday tv_interval);
 use IO::SendFile qw(sendfile);
 use base qw(HTTP::Server::Simple::CGI);
 
@@ -44,9 +45,6 @@ sub handle_request
         close $fd;
         return 200;
     }
-    delete $INC{$script};
-    require $script;
-    return 404;
     if (!$subs{$script})
     {
         my $content;
@@ -68,11 +66,14 @@ sub handle_request
     }
     if ($subs{$script})
     {
+        my $start = [gettimeofday];
         eval { &{$subs{$script}}(); };
         if ($@)
         {
             warn "Error while running $script:\n$@";
         }
+        my $elapsed = tv_interval($start) * 1000;
+        warn "Served $script in $elapsed ms";
     }
     return 404;
 }