Changeset 1361

Timestamp:

02/13/08 02:24:59 (22 months ago)

Author:

bchoate

Message:

Initial work for performance logging.

Location:

branches/mt4.11

Files:

• build/mt-dists/default.mk (modified) (1 diff)
• lib/MT.pm.pre (modified) (5 diffs)
• lib/MT/App.pm (modified) (3 diffs)
• lib/MT/Builder.pm (modified) (5 diffs)
• lib/MT/Core.pm (modified) (2 diffs)
• lib/MT/Entry.pm (modified) (2 diffs)
• lib/MT/Tag.pm (modified) (4 diffs)
• lib/MT/Template.pm (modified) (3 diffs)
• lib/MT/WeblogPublisher.pm (modified) (13 diffs)

branches/mt4.11/build/mt-dists/default.mk

@@ -1 +1 @@
 PRODUCT_NAME = Movable Type Core
 
-PRODUCT_VERSION = 4.1
+PRODUCT_VERSION = 4.11
 SCHEMA_VERSION = 4.0036
-API_VERSION = 4.1
+API_VERSION = 4.11
 
 # BUILD_LANGUAGE = en_US

branches/mt4.11/lib/MT.pm.pre

@@ -856 +856 @@
     }
 
+    if ($cfg->ProcessMemoryCommand) {
+        $mt->log_times();
+    }
+
     $mt->set_language( $cfg->DefaultLanguage );
 
@@ -866 +870 @@
 
     1;
+}
+
+{
+my ($memory_start);
+sub log_times {
+    my $pkg = shift;
+
+    my $timer = $pkg->get_timer;
+    return unless $timer;
+
+    my $memory;
+    my $cmd = $pkg->config->ProcessMemoryCommand;
+    if ($cmd) {
+        my $re;
+        if (ref($cmd) eq 'HASH') {
+            $re = $cmd->{regex};
+            $cmd = $cmd->{command};
+        }
+        $cmd =~ s/\$\$/$$/g;
+        $memory = `$cmd`;
+        if ($re) {
+            if ($memory =~ m/$re/) {
+                $memory = $1;
+                $memory =~ s/\D//g;
+            }
+        } else {
+            $memory =~ s/\s+//gs;
+        }
+    }
+
+    # Called at the start of the process; so we're only recording
+    # the memory usage at the start of the app right now.
+    unless ($timer->{elapsed}) {
+        $memory_start = $memory;
+        return;
+    }
+
+    my $log_file;
+
+    # Log filename calcluation; changes daily, so we don't cache this
+    require File::Spec;
+    my $dir = File::Spec->catdir( MT->instance->static_file_path,
+        'support', 'logs');
+    if (! -d $dir) {
+        require File::Path;
+        eval { File::Path::mkpath([$dir], 0, 0777) };
+        if ($@) {
+            $log_file = 0;
+            return;
+        }
+    }
+    my @time = localtime(time);
+    my $file = sprintf("pl-%04d%02d%02d.log", $time[5] + 1900, $time[4]+1, $time[3]);
+    $log_file = File::Spec->catfile( $dir, $file );
+
+    my $first_write = ! -f $log_file;
+
+    local *PERFLOG;
+    open PERFLOG, ">>$log_file";
+    require Fcntl;
+    flock(PERFLOG, Fcntl::LOCK_EX());
+
+    if ($first_write) {
+        require Config;
+        my ($osname, $osvers) = ($Config::Config{osname}, $Config::Config{osvers});
+        print PERFLOG "# Operating System: $osname/$osvers\n";
+        print PERFLOG "# Platform: $^O\n";
+        my $ver = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] );
+        print PERFLOG "# Perl Version: $ver\n";
+        print PERFLOG "# Web Server: $ENV{SERVER_SOFTWARE}\n";
+        require MT::Object;
+        my $driver = MT::Object->driver;
+        if ($driver) {
+            my $dbh = $driver->r_handle;
+            if ($dbh) {
+                my $dbname = $dbh->get_info( 17 ); # SQL_DBMS_NAME
+                my $dbver = $dbh->get_info( 18 ); # SQL_DBMS_VER
+                if ($dbname && $dbver) {
+                    print PERFLOG "# Database: $dbname/$dbver\n";
+                }
+            }
+        }
+        my ($drname, $drh) = each %DBI::installed_drh;
+        print PERFLOG "# Database Library: DBI/" . $DBI::VERSION . "; DBD/" . $drh->{Version} . "\n";
+        if ($ENV{MOD_PERL}) {
+            print PERFLOG "# App Mode: mod_perl\n";
+        }
+        elsif ($ENV{FAST_CGI}) {
+            print PERFLOG "# App Mode: FastCGI\n";
+        }
+        else {
+            print PERFLOG "# App Mode: CGI\n";
+        }
+    }
+
+    if ($memory) {
+        print PERFLOG $timer->dump_line("mem_start=$memory_start", "mem_end=$memory");
+    } else {
+        print PERFLOG $timer->dump_line();
+    }
+
+    close PERFLOG;
+}
+}
+
+sub get_timer {
+    my $mt = shift;
+    $mt = MT->instance unless ref $mt;
+    my $timer = $mt->request('timer');
+    unless ($timer) {
+        my $uri;
+        if ($mt->isa('MT::App')) {
+            $uri = $mt->uri( args => { $mt->param_hash } );
+        }
+        require MT::Util::ReqTimer;
+        $timer = MT::Util::ReqTimer->new( $uri );
+        $mt->request('timer', $timer);
+    }
+    return $timer;
+}
+
+sub time_this {
+    my $mt = shift;
+    my ($str, $code) = @_;
+    my $timer = $mt->get_timer();
+    my $ret;
+    if ($timer) {
+        $timer->pause_partial();
+        $ret = $code->();
+        $timer->mark($str);
+    } else {
+        $ret = $code->();
+    }
+    return $ret;
 }
 
@@ -1077 +1215 @@
     my $mt = shift;
     my ($PluginSwitch, $use_plugins, $PluginPaths) = @_;
+
+    my $timer;
+    if ($mt->config->PerformanceLogging) {
+        $timer = $mt->get_timer();
+    }
 
     foreach my $PluginPath (@$PluginPaths) {
@@ -1108 +1251 @@
                     return 0 if exists $Plugins{$plugin_sig};
                     $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
+                    $timer->pause_partial if $timer;
                     eval { require $plugin };
+                    $timer->mark("Loaded plugin " . $sig) if $timer;
                     if ($@) {
                         $Plugins{$plugin_sig}{error} = $@;
@@ -1867 +2012 @@
     return $mt->error(
         $mt->translate("Loading template '[_1]' failed.", $file)) unless $tmpl;
-    $tmpl->{__file} = $file if $type eq 'filename';
     $mt->set_default_tmpl_params($tmpl);
     $tmpl->param($param) if $param;

branches/mt4.11/lib/MT/App.pm

@@ -2049 +2049 @@
     my $q = $app->param;
 
+    my $timer;
+    if ($app->config->PerformanceLogging) {
+        $timer = $app->get_timer();
+        $timer->pause_partial();
+    }
+
     my($body);
     eval {
@@ -2251 +2257 @@
         }
     }
+
+    if ($timer) {
+        $timer->mark(ref($app) . '::run');
+    }
+
     $app->takedown();
 }
@@ -2313 +2324 @@
     require MT::Auth;
     MT::Auth->release;
+
+    if ($app->config->PerformanceLogging) {
+        $app->log_times();
+    }
 
     $app->request->finish;

branches/mt4.11/lib/MT/Builder.pm

@@ -283 +283 @@
     #print STDERR syntree2str($tokens,0) unless $count++ == 1;
 
+    my $timer;
+    if ($MT::DebugMode & 8) {
+        $timer = MT->get_timer();
+    }
+
     if ($cond) {
         my %lcond;
@@ -331 +336 @@
             my($h, $type) = $ctx->handler_for($t->[0]);
             if ($h) {
-                my $start;
-                if ($MT::DebugMode & 8) {
-                    require Time::HiRes;
-                    $start = [ Time::HiRes::gettimeofday() ];
-                }
+                $timer->pause_partial if $timer;
                 local($ctx->{__stash}{tag}) = $t->[0];
                 local($ctx->{__stash}{tokens}) = ref($tokens) ? bless $tokens, 'MT::Template::Tokens' : undef;
@@ -382 +383 @@
                     my $err = $ctx->errstr;
                     if (defined $err) {
-                        return $build->error(MT->translate("Error in <mt:[_1]> tag: [_2]", $t->[0], $ctx->errstr));
+                        return $build->error(MT->translate("Error in <mt[_1]> tag: [_2]", $t->[0], $ctx->errstr));
                     }
                     else {
@@ -402 +403 @@
                 $res .= $out
                     if defined $out;
-                if ($MT::DebugMode & 8) {
-                    my $elapsed = Time::HiRes::tv_interval($start);
-                    print STDERR "Builder: Tag [" . $t->[0] . "] - $elapsed seconds\n" if $elapsed > 0.25;
+
+                if ($timer) {
+                    $timer->mark("tag_"
+                        . lc($t->[0]) . args_to_string(\%args));
                 }
             } else {
@@ -417 +419 @@
 }
 
+sub args_to_string {
+    my ($args) = @_;
+    my $str = '';
+    foreach my $a (keys %$args) {
+        next if $a eq '@';
+        next unless defined $args->{$a};
+        next if $args->{$a} eq '';
+        $str .= ';' . $a . ':';
+        if (ref $args->{$a} eq 'ARRAY') {
+            foreach my $aa (@{ $args->{$a} }) {
+                $aa = '...' if $aa =~ m/ /;
+                $str .= $aa . ';';
+            }
+            chop($str);
+        } else {
+            $str .= $args->{$a} =~ m/ / ? '...' : $args->{$a};
+        }
+    }
+    my $more_args = $args->{'@'};
+    if ($more_args && @$more_args) {
+        foreach my $a (@$more_args) {
+            if (ref $a->[1] eq 'ARRAY') {
+                $str .= ' ' . $a->[0] . '=';
+                foreach my $aa (@{ $a->[1] }) {
+                    $aa = '...' if $aa =~ m/ /;
+                    $str .= $aa . ';';
+                }
+                chop($str);
+            } else {
+                next if exists $args->{$a->[0]}
+                    && ($args->{$a->[0]} eq $a->[1]);
+                next unless defined $args->[1];
+                next if $args->[1] eq '';
+                $str .= ';' . $a->[0] . ':';
+                $str .= $a->[1];
+            }
+        }
+    }
+    return $str ne '' ? '[' . substr($str,1) . ']' : '';
+}
 1;
 __END__

branches/mt4.11/lib/MT/Core.pm

@@ -496 +496 @@
             'UserpicMaxUpload' => { default => 0 },
             'UserpicThumbnailSize' => { default => 100 },
+
+            'PerformanceLogging' => { default => 0 },
+            'PerformanceLoggingThreshold' => { default => 0.1 },
+            'ProcessMemoryCommand' => { handler => \&ProcessMemoryCommand },
         },
         upgrade_functions => \&load_upgrade_fns,
@@ -795 +799 @@
 }
 
+sub ProcessMemoryCommand {
+    my $cfg = shift;
+    $cfg->set_internal( 'ProcessMemoryCommand', @_ ) if @_;
+    my $cmd = $cfg->get_internal('ProcessMemoryCommand');
+    unless ($cmd) {
+        my $os = $^O;
+        if ($os eq 'darwin') {
+            $cmd = '/usr/bin/ps $$ -o rss=';
+        }
+        elsif ($os eq 'linux') {
+            $cmd = '/usr/bin/ps -p $$ -o rss=';
+        }
+        elsif ($os eq 'MSWin32') {
+            $cmd = { command => q{tasklist /FI "PID eq $$" /FO TABLE /NH},
+                regex => qr/([\d,]+) K/ };
+        }
+    }
+    return $cmd;
+}
+
 sub SecretToken {
     my $cfg = shift;

branches/mt4.11/lib/MT/Entry.pm

@@ -222 +222 @@
 sub __load_category_data {
     my $entry = shift;
+    my $t = MT->get_timer;
+    $t->pause_partial if $t;
     my $cache = MT::Memcached->instance;
     my $memkey = $entry->cache_key('categories');
@@ -231 +233 @@
         $cache->set($memkey, $rows, CATEGORY_CACHE_TIME);
     }
+    $t->mark('MT::Entry::__load_category_data') if $t;
     return $rows;
 }

branches/mt4.11/lib/MT/Tag.pm

@@ -325 +325 @@
 sub __load_tags {
     my $obj = shift;
+    my $t = MT->get_timer;
+    $t->pause_partial if $t;
+
     if (!$obj->id) {
         $obj->{__tags} = [];
@@ -347 +350 @@
     }
     $obj->{__tags} = [ map { $_->name } @tags ];
+    $t->mark('MT::Tag::__load_tags') if $t;
     $obj->{__tag_objects} = \@tags;
 }
@@ -375 +379 @@
     my @tags = @{ $obj->{__tags} };
     return 1 unless @tags;
+
+    my $t = MT->get_timer;
+    $t->pause_partial if $t;
+
     $obj->{__tag_objects} = [];
     my $blog_id = $obj->has_column('blog_id') ? $obj->blog_id : 0;
@@ -427 +435 @@
         MT::Memcached->instance->delete( $obj->tag_cache_key );
     }
+    $t->mark('MT::Tag::save_tags') if $t;
     1;
 }

branches/mt4.11/lib/MT/Template.pm

@@ -91 +91 @@
     $tmpl->{include_path} = $param{path};
     $tmpl->{include_filter} = $param{filter};
+    $tmpl->{__file} = $file;
     my $contents = $tmpl->load_file($file);
     if (defined $contents) {
@@ -211 +212 @@
     $ctx ||= $tmpl->context;
 
+    my ($timer, $start);
+    if (MT->config->PerformanceLogging) {
+        $timer = MT->get_timer();
+        # $start = Time::HiRes::time();
+    } else {
+        $timer = {};
+    }
+    local $timer->{elapsed} = 0;
+
     local $ctx->{__stash}{template} = $tmpl;
     my $tokens = $tmpl->tokens
@@ -243 +253 @@
         $ctx->var( 'page_columns', $columns ) if $columns;
     }
-    defined(my $res = $build->build($ctx, $tokens, $cond)) or
+
+    $timer->pause_partial if $timer;
+
+    my $res = $build->build($ctx, $tokens, $cond);
+
+    if ($timer) {
+        # $timer->{prev} = $start;
+        $timer->mark("MT::Template::build[" . ($tmpl->name || $tmpl->{__file}).']');
+    }
+
+    unless (defined($res)) {
         return $tmpl->error(MT->translate(
             "Publish error in template '[_1]': [_2]",
             $tmpl->name || $tmpl->{__file}, $build->errstr));
+    }
     $res =~ s/^\s*//;
     return $res;

branches/mt4.11/lib/MT/WeblogPublisher.pm

@@ -1195 +1195 @@
     my ( $blog, $root_path, $map, $at, $ctx, $cond, $build_static, %specifier )
       = @_;
+
     my $finfo;
     my $archiver = $mt->archiver($at);
@@ -1393 +1394 @@
     return 1 if ( $tmpl->build_dynamic );
     return 1 if ( $entry && $entry->status != MT::Entry::RELEASE() );
+
+    my $timer = MT->get_timer;
+    if ($timer) {
+        $timer->pause_partial;
+    } else {
+        $timer = {};
+    }
+    local $timer->{elapsed} = 0;
 
     if (
@@ -1436 +1445 @@
 
         $html = $tmpl->build( $ctx, $cond );
-        defined($html)
-          or return $mt->error(
+        unless (defined($html)) {
+            $timer->unpause if $timer;
+            return $mt->error(
             (
                 $category ? MT->translate(
@@ -1458 +1468 @@
             )
           );
+        }
         my $orig_html = $html;
         MT->run_callbacks(
@@ -1491 +1502 @@
         ## changed. If not, we won't update the published
         ## file, so as not to modify the mtime.
-        return 1 unless $fmgr->content_is_updated( $file, \$html );
+        unless ($fmgr->content_is_updated( $file, \$html )) {
+            $timer->unpause if $timer;
+            return 1;
+        }
 
         ## Determine if we need to build directory structure,
@@ -1501 +1515 @@
           unless $path eq '/'; ## OS X doesn't like / at the end in mkdir().
         unless ( $fmgr->exists($path) ) {
-            $fmgr->mkpath($path)
-              or return $mt->trans_error( "Error making path '[_1]': [_2]",
-                $path, $fmgr->errstr );
+            if (!$fmgr->mkpath($path)) {
+                $timer->unpause if $timer;
+                return $mt->trans_error( "Error making path '[_1]': [_2]",
+                    $path, $fmgr->errstr );
+            }
         }
 
@@ -1513 +1529 @@
         my $use_temp_files = !$mt->{NoTempFiles};
         my $temp_file = $use_temp_files ? "$file.new" : $file;
-        defined( $fmgr->put_data( $html, $temp_file ) )
-          or return $mt->trans_error( "Writing to '[_1]' failed: [_2]",
-            $temp_file, $fmgr->errstr );
+        unless ( defined $fmgr->put_data( $html, $temp_file ) ) {
+            $timer->unpause if $timer;
+            return $mt->trans_error( "Writing to '[_1]' failed: [_2]",
+                $temp_file, $fmgr->errstr );
+        }
         if ($use_temp_files) {
-            $fmgr->rename( $temp_file, $file )
-              or return $mt->trans_error(
-                "Renaming tempfile '[_1]' failed: [_2]",
-                $temp_file, $fmgr->errstr );
+            if (!$fmgr->rename( $temp_file, $file )) {
+                $timer->unpause if $timer;
+                return $mt->trans_error(
+                    "Renaming tempfile '[_1]' failed: [_2]",
+                    $temp_file, $fmgr->errstr );
+            }
         }
         MT->run_callbacks(
@@ -1553 +1573 @@
 
     }
+    $timer->mark("total:rebuild_file[template_id:" . $tmpl->id . "]")
+        if $timer;
     1;
 }
@@ -1674 +1696 @@
             $finfo->save();
         }
+
+        my $timer = MT->get_timer;
+        if ($timer) {
+            $timer->pause_partial;
+        } else {
+            $timer = {};
+        }
+        local $timer->{elapsed} = 0;
 
         my $ctx = MT::Template::Context->new;
@@ -1700 +1730 @@
 
         my $html = $tmpl->build($ctx);
-        return $mt->error( $tmpl->errstr ) unless defined $html;
+        unless (defined $html) {
+            $timer->unpause if $timer;
+            return $mt->error( $tmpl->errstr );
+        }
 
         my $orig_html = $html;
@@ -1737 +1770 @@
           unless $path eq '/';    ## OS X doesn't like / at the end in mkdir().
         unless ( $fmgr->exists($path) ) {
-            $fmgr->mkpath($path)
-              or return $mt->trans_error( "Error making path '[_1]': [_2]",
-                $path, $fmgr->errstr );
+            if (! $fmgr->mkpath($path) ) {
+                $timer->unpause if $timer;
+                return $mt->trans_error( "Error making path '[_1]': [_2]",
+                    $path, $fmgr->errstr );
+            }
         }
 
@@ -1745 +1780 @@
         my $use_temp_files = !$mt->{NoTempFiles};
         my $temp_file = $use_temp_files ? "$file.new" : $file;
-        defined( $fmgr->put_data( $html, $temp_file ) )
-          or return $mt->trans_error( "Writing to '[_1]' failed: [_2]",
-            $temp_file, $fmgr->errstr );
+        unless (defined( $fmgr->put_data( $html, $temp_file ) )) {
+            $timer->unpause if $timer;
+            return $mt->trans_error( "Writing to '[_1]' failed: [_2]",
+                $temp_file, $fmgr->errstr );
+        }
         if ($use_temp_files) {
-            $fmgr->rename( $temp_file, $file )
-              or
-              return $mt->trans_error( "Renaming tempfile '[_1]' failed: [_2]",
-                $temp_file, $fmgr->errstr );
+            if (!$fmgr->rename( $temp_file, $file )) {
+                $timer->unpause if $timer;
+                return $mt->trans_error( "Renaming tempfile '[_1]' failed: [_2]",
+                    $temp_file, $fmgr->errstr );
+            }
         }
         MT->run_callbacks(
@@ -1775 +1813 @@
             file         => $file
         );
+
+        $timer->mark("total:rebuild_indexes[template_id:" . $tmpl->id . ";file:$file]")
+            if $timer;
     }
     1;