Changeset 1372

Timestamp:

02/14/08 22:31:01 (7 months ago)

Author:

bchoate

Message:

Initial work for performance logging.

Files:

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

branches/release-30/build/mt-dists/default.mk

@@ -1 +1 @@
-PRODUCT_NAME = Movable Type Core
-
-
+1
-SCHEMA_VERSION = 4.0037
-
+1
-
-# BUILD_LANGUAGE = en_US

branches/release-30/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/release-30/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 {
@@ -2252 +2258 @@
-        }
-    }
+
+    if ($timer) {
+        $timer->mark(ref($app) . '::run');
+    }
+
-    $app->takedown();
-}
@@ -2314 +2325 @@
-    require MT::Auth;
-    MT::Auth->release;
+
+    if ($app->config->PerformanceLogging) {
+        $app->log_times();
+    }
-
-    $app->request->finish;

branches/release-30/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) {
-
-
-
-
-
+
-                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) {
-:
+
-                    }
-                    else {
@@ -402 +403 @@
-                $res .= $out
-                    if defined $out;
-
-
-
+
+
+
+
-                }
-            } 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/release-30/lib/MT/Core.pm

@@ -499 +499 @@
-            # Basename settings
-            'AuthorBansenameLimit' => { default => 30 },
+            'PerformanceLogging' => { default => 0 },
+            'PerformanceLoggingThreshold' => { default => 0.1 },
+            'ProcessMemoryCommand' => { handler => \&ProcessMemoryCommand },
-        },
-        upgrade_functions => \&load_upgrade_fns,
@@ -801 +804 @@
-}
-
+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 = 'ps $$ -o rss=';
+        }
+        elsif ($os eq 'linux') {
+            $cmd = '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/release-30/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/release-30/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/release-30/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();
+    }
+    local $timer->{elapsed} = 0 if $timer;
+
-    local $ctx->{__stash}{template} = $tmpl;
-    my $tokens = $tmpl->tokens
@@ -243 +250 @@
-        $ctx->var( 'page_columns', $columns ) if $columns;
-    }
-
+
+
+
+
+
+
+
+
+
+
-        return $tmpl->error(MT->translate(
-            "Publish error in template '[_1]': [_2]",
-            $tmpl->name || $tmpl->{__file}, $build->errstr));
+    }
-    $res =~ s/^\s*//;
-    return $res;

branches/release-30/lib/MT/WeblogPublisher.pm

@@ -1210 +1210 @@
-    my ( $blog, $root_path, $map, $at, $ctx, $cond, $build_static, %specifier )
-      = @_;
+
-    my $finfo;
-    my $archiver = $mt->archiver($at);
@@ -1408 +1409 @@
-    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;
+    }
+    local $timer->{elapsed} = 0 if $timer;
-
-    if (
@@ -1451 +1458 @@
-
-        $html = $tmpl->build( $ctx, $cond );
-
-
+
+
+
-            (
-                $category ? MT->translate(
@@ -1473 +1481 @@
-            )
-          );
+        }
-        my $orig_html = $html;
-        MT->run_callbacks(
@@ -1506 +1515 @@
-        ## changed. If not, we won't update the published
-        ## file, so as not to modify the mtime.
-
+
+
+
+
-
-        ## Determine if we need to build directory structure,
@@ -1516 +1528 @@
-          unless $path eq '/'; ## OS X doesn't like / at the end in mkdir().
-        unless ( $fmgr->exists($path) ) {
-
-
-
+
+
+
+
+
-        }
-
@@ -1528 +1542 @@
-        my $use_temp_files = !$mt->{NoTempFiles};
-        my $temp_file = $use_temp_files ? "$file.new" : $file;
-
-
-
+
+
+
+
+
-        if ($use_temp_files) {
-
-
-
-
+
+
+
+
+
+
-        }
-        MT->run_callbacks(
@@ -1568 +1586 @@
-
-    }
+    $timer->mark("total:rebuild_file[template_id:" . $tmpl->id . "]")
+        if $timer;
-    1;
-}
@@ -1689 +1709 @@
-            $finfo->save();
-        }
+
+        my $timer = MT->get_timer;
+        if ($timer) {
+            $timer->pause_partial;
+        }
+        local $timer->{elapsed} = 0 if $timer;
-
-        my $ctx = MT::Template::Context->new;
@@ -1715 +1741 @@
-
-        my $html = $tmpl->build($ctx);
-
+
+
+
+
-
-        my $orig_html = $html;
@@ -1752 +1781 @@
-          unless $path eq '/';    ## OS X doesn't like / at the end in mkdir().
-        unless ( $fmgr->exists($path) ) {
-
-
-
+
+
+
+
+
-        }
-
@@ -1760 +1791 @@
-        my $use_temp_files = !$mt->{NoTempFiles};
-        my $temp_file = $use_temp_files ? "$file.new" : $file;
-
-
-
+
+
+
+
+
-        if ($use_temp_files) {
-
-
-
-
+
+
+
+
+
-        }
-        MT->run_callbacks(
@@ -1790 +1824 @@
-            file         => $file
-        );
+
+        $timer->mark("total:rebuild_indexes[template_id:" . $tmpl->id . ";file:$file]")
+            if $timer;
-    }
-    1;