root/trunk/tools/mt-tmpl-test

Revision 3148, 15.3 kB (checked in by breese, 13 months ago)

added test to see if Text::SimpleTable is installed when the --profile flag is used
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl
2
3# Use this line if you want to enable the NYTProf Perl profile:
4#!/usr/bin/perl -d:NYTProf
5
6package MT::CLITest;
7
8use strict;
9
10use Data::Dumper;
11$Data::Dumper::Deparse  = 1;
12$Data::Dumper::Terse    = 1;
13$Data::Dumper::Maxdepth = 4;
14$Data::Dumper::Sortkeys = 1;
15$Data::Dumper::Indent   = 1;
16
17use lib 'extlib', 'lib', '../extlib', '../lib';
18use base qw( MT::Tool );
19use Time::HiRes qw( tv_interval gettimeofday );
20
21my ($blog, $blog_name,
22    $template_name,
23    $template_obj,
24    $category_name,
25    $entry_title,
26    $author_name,
27    $archive_type,
28    $debug_mode, $profile_flag);
29
30sub options {
31    return (
32        'blog=s' => \$blog_name,
33        'template=s' => \$template_name,
34        'category=s' => \$category_name,
35        'entry=s' => \$entry_title,
36        'author=s' => \$author_name,
37        'archive=s' => \$archive_type,
38        'profile!' => \$profile_flag,
39        'debug=i' => \$debug_mode,
40    );
41}
42
43sub help {
44    return q{
45        --blog <name>      Specify a blog context by blog ID or name.
46        --template <name>  Specify a template to process by template ID or name.
47        --category <label> Specify a category to process by category ID or label.
48        --entry <title>    Specify an entry to process by entry ID or title.
49        --author <name>    Specify an author to process by ID or username.
50        --archive <type>   Specify a archive type.
51        --profile          Enables SQL and template tag profiling.
52        --debug <mode>     Sets MT's DebugMode.
53    };
54}
55
56sub usage {
57    return q{[template name]};
58}
59
60sub load_blog {
61    my $class = shift;
62
63    my $blog;
64    require MT::Blog;
65    if ($blog_name =~ m/^\d+$/) {
66        $blog = MT::Blog->load($blog_name)
67            or die "Could not load blog # $blog_name";
68    }
69    elsif (defined $blog_name) {
70        $blog = MT::Blog->load({ name => $blog_name })
71            or die "Could not locate blog by name '$blog_name'";
72    }
73    return $blog;
74}
75
76sub load_template {
77    my $class = shift;
78
79    require MT::Template;
80    my $template;
81
82    # Support for argument mode of template name
83    if (!defined($template_name) && @ARGV) {
84        $template_name = $ARGV[0];
85    }
86
87    if ($template_name =~ m/^\d+$/) {
88        # assume $template is an id
89        $template_obj = MT::Template->load($template_name)
90            or die "Could not load template # $template_name";
91        $blog_name = $template_obj->blog_id unless $blog;
92        $template = $template_obj->text;
93    }
94    elsif (defined $template_name) {
95        if ( -f $template_name ) {
96            local $/ = undef;
97            open FIN, "<$template_name";
98            $template = <FIN>;
99            close FIN;
100        }
101        else {
102            $template_obj = MT::Template->load({
103                identifier => $template_name,
104                ( $blog ? ( blog_id => $blog->id ) : () )
105            }) || MT::Template->load({
106                name => $template_name,
107                ( $blog ? ( blog_id => $blog->id ) : () )
108            }) or die "Could not locate template by name '$template_name'";
109            $blog_name = $template_obj->blog_id unless $blog;
110            $template = $template_obj->text;
111        }
112    }
113    return $template;
114}
115
116sub load_category {
117    my $class = shift;
118
119    my $cat;
120    require MT::Category;
121    if ($category_name =~ m/^\d+$/) {
122        $cat = MT::Category->load($category_name)
123            or die "Could not load category # $category_name";
124    }
125    elsif (defined $category_name) {
126        $cat = MT::Category->load({
127            label => $category_name,
128            ( $blog ? ( blog_id => $blog->id ) : () ),
129        }) or die "Could not locate category by name '$category_name'";
130    }
131    else {
132        # okay, select first available
133        require MT::Placement;
134        my $p = MT::Placement->load({
135            ( $blog ? ( blog_id => $blog->id ) : () ),
136            is_primary => 1,
137            },
138            { limit => 1,
139              join => MT::Entry->join_on( undef, {
140                  class => 'entry',
141                  id => \'= placement_entry_id',
142                  status => 2,
143              } ), }
144        );
145        if ( $p ) {
146            $cat = MT::Category->load( $p->category_id );
147        }
148    }
149    return $cat;
150}
151
152sub load_author {
153    my $class = shift;
154
155    require MT::Author;
156    if ($author_name =~ m/^\d+$/) {
157        $a = MT::Author->load($author_name)
158            or die "Could not load author # $author_name";
159    }
160    elsif (defined $author_name) {
161        $a = MT::Author->load({ name => $author_name })
162            or die "Could not locate author by name '$author_name'";
163    }
164    return $a;
165}
166
167sub load_entry {
168    my $class = shift;
169    my ($entry_class) = @_;
170
171    require MT::Entry;
172    my $e;
173    if ($entry_title =~ m/^\d+$/) {
174        $e = MT::Entry->load($entry_title)
175            or die "Could not load entry # $entry_title";
176    }
177    elsif (defined $entry_title) {
178        $e = MT::Entry->load({ title => $entry_title,
179            class => $entry_class,
180            ( $blog ? ( blog_id => $blog->id ) : () ),
181            status => 2 })
182            or die "Could not locate entry by title '$entry_title'";
183    }
184    else {
185        # load first available
186        $e = MT::Entry->load( {
187            class => $entry_class,
188            status => 2,
189            ( $blog ? ( blog_id => $blog->id ) : () )
190        }, { limit => 1, sort => 'authored_on', direction => 'descend' });
191    }
192    return $e;
193}
194
195sub main {
196    my $class = shift;
197
198    require MT::Template::Context;
199    require MT::Template::ContextHandlers;
200    require MT::Builder;
201    require MT::Util;
202
203    my ($verbose) = $class->SUPER::main(@_);
204
205    if ($profile_flag) {
206        $ENV{DOD_PROFILE} = 1;
207        $Data::ObjectDriver::PROFILE = 1;
208        eval "use Text::SimpleTable";
209        if ($@) {
210            die "You are missing the Text::SimpleTable perl module which is required when using the --profile flag.";
211        }
212        BuildProfiler->install;
213    }
214
215    if (defined $debug_mode) {
216        $MT::DebugMode = $debug_mode;
217    }
218
219    my $mt = MT->app;
220
221    my $d = MT::Object->driver->r_handle;
222    $d->{RaiseError} = 1;
223
224    $blog = $class->load_blog if defined $blog_name;
225
226    my $template = $class->load_template;
227    defined($template)
228        or die "A template has not been specified";
229
230    # blog context can be set by means of the template, if it hasn't
231    # already been loaded.
232    $blog = $class->load_blog if !$blog && defined $blog_name;
233
234    my $ctx = MT::Template::Context->new;
235
236    my $builder = MT::Builder->new;
237    $template = $mt->translate_templatized($template);
238
239    my $tokens = $builder->compile($ctx, $template);
240
241    if ($blog) {
242        printf STDERR "Context blog: %s (#%d)\n", $blog->name, $blog->id
243            if $verbose;
244    }
245
246    if ($template_obj) {
247        printf STDERR "Template: %s (#%d)\n", $template_obj->name, $template_obj->id
248            if $verbose;
249
250        unless (defined $archive_type) {
251            # determine archive type for this template
252            if ( $template_obj->type eq 'category' ) {
253                $archive_type = 'Category';
254            }
255            elsif ( $template_obj->type eq 'individual' ) {
256                $archive_type = 'Individual';
257            }
258            elsif ( $template_obj->type eq 'page' ) {
259                $archive_type = 'Page';
260            }
261            elsif ( $template_obj->type eq 'archive' ) {
262                my $map = MT::TemplateMap->load( { template_id => $template_obj->id, is_preferred => 1 });
263                $archive_type = $map->archive_type if $map;
264            }
265        }
266    } else {
267        print STDERR "Template: " . $template_name . "\n"
268            if $verbose;
269    }
270
271    if ($blog) {
272        $ctx->stash('blog', $blog);
273        $ctx->stash('blog_id', $blog->id);
274
275        if (defined $archive_type) {
276            my $t = $mt->publisher->archiver($archive_type)
277                or die "Invalid archive type '$archive_type'";
278
279            print STDERR "Context archive_type: $archive_type\n"
280                if $verbose;
281
282            $ctx->{current_archive_type} = $archive_type;
283            $ctx->{archive_type} = $archive_type;
284
285            my $e = $class->load_entry( $t->entry_class );
286
287            require MT::Promise;
288            if ($t->date_based) {
289                my ($ts_start, $ts_end) = $t->date_range($e->authored_on);
290                $ctx->{current_timestamp} = $ts_start;
291                $ctx->{current_timestamp_end} = $ts_end;
292                my $entries = sub { $t->dated_group_entries($ctx, $archive_type, $ts_start) };
293                $ctx->stash('entries', MT::Promise::delay($entries));
294                printf STDERR "Context current_timestamp: %s\nContext current_timestamp_end: %s\n",
295                    $ts_start, $ts_end
296                    if $verbose;
297            }
298            if ($t->author_based) {
299                my $a = $e->author || $class->load_author;
300                $ctx->stash('author') = $a;
301                my $entries = sub { $t->archive_group_entries($ctx) };
302                $ctx->stash('entries', MT::Promise::delay($entries));
303                printf STDERR "Context author: %s (#%d)\n", $a->name, $a->id
304                    if $verbose;
305            }
306            if ($t->category_based) {
307                my $cat = $class->load_category;
308                $ctx->stash('archive_category', $cat);
309                my $entries = sub { $t->archive_group_entries($ctx) };
310                $ctx->stash('entries', MT::Promise::delay($entries));
311                printf STDERR "Context archive_category: %s (#%d)\n", $cat->label, $cat->id
312                    if $verbose;
313            }
314            if ($t->entry_based) {
315                $ctx->stash('entry', $e);
316                printf STDERR "Context entry: %s (#%d)\n", $e->title, $e->id
317                    if $verbose;
318            }
319        }
320    }
321    else {
322        if (defined $archive_type) {
323            die "Cannot specify archive type without a blog.";
324        }
325    }
326
327    if ($ENV{DOD_PROFILE}) {
328        Data::ObjectDriver->profiler->reset;
329    }
330
331    my $start = [ gettimeofday ];
332    my $out = $builder->build($ctx, $tokens, {});
333    my $end = [ gettimeofday ];
334
335    if ( defined $out ) {
336        print $out . "\n";
337    } else {
338        print STDERR "Builder error: ".$builder->errstr if $builder->errstr;
339        print STDERR "Context error: ".$ctx->errstr if $ctx->errstr;
340    }
341
342    if ($profile_flag) {
343        print STDERR BuildProfiler->report();
344        print STDERR "  Total Build Time: " . tv_interval($start, $end) . "\n";
345    }
346    if ($ENV{DOD_PROFILE}) {
347        print STDERR Data::ObjectDriver->profiler->report_query_frequency();
348    }
349}
350
351#### Tag Profiling code from BuildTracer
352
353package BuildProfiler;
354
355use strict;
356
357use MT::Util qw( epoch2ts );
358use Time::HiRes;
359use Data::Dumper;
360
361my %PROFILES;
362my $BUILD_START_AT;
363my $BUILD_ELAPSED;
364our ( %EXDATA );
365
366sub report {
367    Data::ObjectDriver->profiler->reset;
368    my $driver = MT::Object->driver;
369
370    # Report Layout
371
372=pod
373  12345678   12345678901234567890   123456   1234567   123456   123456   12345
374+----------+----------------------+--------+---------+--------+--------+-------+
375| Time     | Tag                  | Calls  | Avg     | SQL    | Hits   | Miss  |
376+----------+----------------------+--------+---------+--------+--------+-------+
377| 1234.123 | EntriesWithSubCatego | 123456 | 1234567 | 123456 | 123456 | 12345 |
378=cut
379
380    eval 'require Text::SimpleTable; 1' or return '';
381    my $tbl = Text::SimpleTable->new( [ 8, 'Time' ], [ 20, 'Tag' ],
382        [ 6, 'Calls' ], [ 7, 'Avg' ], [ 6, 'SQL' ], [ 6, 'Hits' ], [ 5, 'Miss' ]);
383
384    print STDERR "Template Tag Utilization:\n";
385    my $total_time = 0;
386    my $total_query = 0;
387    foreach my $tag ( sort { $PROFILES{$b}{time} <=> $PROFILES{$a}{time} } keys %PROFILES ) {
388        my $queries = $PROFILES{$tag}{queries} || [];
389        my $time_avg = sprintf("%0.3f", $PROFILES{$tag}{time} / $PROFILES{$tag}{calls});
390        my $queries = $PROFILES{$tag}->{queries};
391        my $ramhit = map { $_ =~ m/RAMCACHE_GET/ } @$queries;
392        my $ramadd = map { $_ =~ m/RAMCACHE_ADD/ } @$queries;
393        my $query_count = scalar(@$queries) - ($ramhit + $ramadd);
394        $tbl->row(sprintf("%0.3f", $PROFILES{$tag}{time}),
395            $tag, $PROFILES{$tag}{calls},
396            $time_avg,
397            $query_count,
398            $ramhit, $ramadd);
399        $total_time += $PROFILES{$tag}{time};
400        $total_query += $query_count;
401        # Restore D::OD query profile so the report we will generate
402        # from it will be right:
403        foreach my $q (@$queries) {
404            Data::ObjectDriver->profiler->record_query($driver, $q);
405        }
406    }
407    return $tbl->draw
408        . sprintf("  Total Queries: %d\n", $total_query);
409}
410
411sub install {
412    my $all_tags = MT::Component->registry("tags");
413    for my $tag_set (@$all_tags) {
414        for my $type (qw( block function )) {
415            my $tags = $tag_set->{$type} or next;
416            for my $tagname ( keys %$tags ) {
417                $tags->{$tagname} = _make_tracker($tags->{$tagname});
418            }
419        }
420    }
421}
422
423sub _make_tracker {
424    my $original_method = shift;
425    return sub {
426        my ($ctx, $args, $cond) = @_;
427        my $tagname = lc $ctx->stash('tag');
428        pre_process_tag($ctx, $args, $cond);
429        my $meth = MT->handler_to_coderef($original_method)
430            unless $original_method eq 'CODEREF';
431        my $res = $meth->($ctx, $args, $cond);
432        post_process_tag($res);
433        return $res;
434    };
435}
436
437{
438    my $CURRENT_TAG;
439    my @PROFILE_STACK;
440
441    sub pre_process_tag {
442        my ($ctx, $args, $cond) = @_;
443        $BUILD_START_AT = [ Time::HiRes::gettimeofday() ]
444            unless defined $BUILD_START_AT;
445        if ( defined $CURRENT_TAG ) {
446            $CURRENT_TAG->pause;
447            push @PROFILE_STACK, $CURRENT_TAG;
448        }
449        my $tagname = lc $ctx->stash('tag');
450        $CURRENT_TAG = TagProfiler->new($tagname);
451    }
452
453    sub post_process_tag {
454        my ($res) = @_;
455        $CURRENT_TAG->end;
456        #save results to hash
457        my $results = $PROFILES{ $CURRENT_TAG->{tagname} };
458        if ( defined $results ) {
459            $results->{calls} += 1;
460            $results->{time} += $CURRENT_TAG->{time};
461            push @{$results->{queries}}, @{$CURRENT_TAG->{queries}};
462        }
463        else {
464            $PROFILES{ $CURRENT_TAG->{tagname} } = {
465                calls => 1,
466                time  => $CURRENT_TAG->{time},
467                queries => $CURRENT_TAG->{queries},
468            };
469        }
470        $CURRENT_TAG = pop @PROFILE_STACK;
471        $CURRENT_TAG->resume if defined $CURRENT_TAG;
472        $BUILD_ELAPSED = Time::HiRes::tv_interval($BUILD_START_AT);
473    }
474}
475
476package TagProfiler;
477
478use strict;
479use Time::HiRes;
480use Data::ObjectDriver;
481
482sub new {
483    my $class = shift;
484    my ($tagname) = @_;
485    my $now = [ Time::HiRes::gettimeofday() ];
486    Data::ObjectDriver->profiler->reset;
487    return bless {
488        tagname => $tagname,
489        last    => $now,
490        time    => 0,
491        queries => [],
492     }, $class;
493}
494
495sub pause {
496    my $self = shift;
497    $self->{time} += Time::HiRes::tv_interval($self->{last});
498    my $log = Data::ObjectDriver->profiler->query_log;
499    if ( defined $log && scalar @$log ) {
500        @{$self->{queries}} = (@{$self->{queries}}, @$log );
501    }
502}
503
504sub resume {
505    my $self = shift;
506    $self->{last} = [ Time::HiRes::gettimeofday() ];
507    Data::ObjectDriver->profiler->reset;
508}
509
510sub end {
511    my $self = shift;
512    $self->pause;
513}
514
515package MT::CLITest;
516
517__PACKAGE__->main() unless caller;
Note: See TracBrowser for help on using the browser.