Index: /branches/release-35/tools/report-slow-request =================================================================== --- /branches/release-35/tools/report-slow-request (revision 1706) +++ /branches/release-35/tools/report-slow-request (revision 1950) @@ -7,9 +7,10 @@ # $Id$ +package MT::Tool::ReportSlowRequest; use strict; use lib "./lib"; +use base qw( MT::Tool ); -use Getopt::Long qw/:config no_ignore_case/; use List::Util qw( min ); use Time::HiRes qw( time ); @@ -18,62 +19,89 @@ use Data::Dumper; -GetOptions( - 'day=s' => \my ($arg_day), - 'logdir=s' => \my ($arg_logdir), - 'sample=i' => \my ($arg_sample), - 'slow=i' => \my ($arg_slow), - 'debug' => \my ($arg_debug), - 'dump' => \my ($arg_dump), -); +my ($arg_day, $arg_logdir, $arg_sample, $arg_slow, $arg_debug, $arg_dump); -$arg_slow ||= 2; - -my $proc = MT::Util::LogProcessor->new( - { - debug => $arg_debug, - logdir => $arg_logdir || '.', - sample => $arg_sample, - day => $arg_day || 'yesterday', - file_pattern => 'pl-\d{8}.log', - } -); - -my %stash = ( today => $proc->day ); -my ( $total_records, $elapsed ) = $proc->process_log_files( - sub { - my ($rec) = @_; - - my $secs = int $rec->{time_total}; - - my $bucket = $secs > 10 ? 10 : $secs; - $stash{by_seconds}[$bucket]++; - - $stash{total_requests}++; - - if ( $secs > $arg_slow - 1 ) { - push @{ $stash{slow} }, $rec; - } - } -); - -printf "Processed %d records in %.02f seconds; speed: %.02f recs/sec\n", - $total_records, $elapsed, $total_records / ( $elapsed || 1 ) - if $arg_debug; - -for my $bucket ( 0 .. $#{ $stash{by_seconds} } ) { - my $count = $stash{by_seconds}[$bucket] || 0; - $stash{restime_histogram}[$bucket] = { - count => $count, - range => $bucket == 10 - ? '10+ sec' - : $bucket . '-' . ( $bucket + 1 ) . 's', - percent => int( $count / $stash{total_requests} * 100 ) || 1, +sub help { + return q{ + --logdir Look for logs in directory . By default, logs + in the current directory are analyzed. + --sample ? + --slow Number of seconds after which a request is listed + as one of the slowest. By default, requests over 2 + seconds are considered the slowest. + --day The name of the day to examine; either 'today', + 'yesterday', or a date in the format YYYY-MM-DD. + --debug Enable debugging output. + --dump ? }; } -$stash{slow} = - [ sort { $b->{time_total} <=> $a->{time_total} } @{ $stash{slow} || [] } ]; +sub usage { +} -report( \%stash ); +sub options { + return ( + 'logdir=s' => \$arg_logdir, + 'sample=i' => \$arg_sample, + 'slow=i' => \$arg_slow, + 'day=s' => \$arg_day, + 'debug' => \$arg_debug, + 'dump' => \$arg_dump, + ); +} + +sub main { + my $class = shift; + my ($verbose) = $class->SUPER::main(@_); + + $arg_slow ||= 2; + + my $proc = MT::Util::LogProcessor->new( + { + debug => $arg_debug, + logdir => $arg_logdir || '.', + sample => $arg_sample, + day => $arg_day || 'yesterday', + file_pattern => 'pl-\d{8}.log', + } + ); + + my %stash = ( today => $proc->day ); + my ( $total_records, $elapsed ) = $proc->process_log_files( + sub { + my ($rec) = @_; + + my $secs = int $rec->{time_total}; + + my $bucket = $secs > 10 ? 10 : $secs; + $stash{by_seconds}[$bucket]++; + + $stash{total_requests}++; + + if ( $secs > $arg_slow - 1 ) { + push @{ $stash{slow} }, $rec; + } + } + ); + + printf "Processed %d records in %.02f seconds; speed: %.02f recs/sec\n", + $total_records, $elapsed, $total_records / ( $elapsed || 1 ) + if $arg_debug; + + for my $bucket ( 0 .. $#{ $stash{by_seconds} } ) { + my $count = $stash{by_seconds}[$bucket] || 0; + $stash{restime_histogram}[$bucket] = { + count => $count, + range => $bucket == 10 + ? '10+ sec' + : $bucket . '-' . ( $bucket + 1 ) . 's', + percent => int( $count / $stash{total_requests} * 100 ) || 1, + }; + } + + $stash{slow} = + [ sort { $b->{time_total} <=> $a->{time_total} } @{ $stash{slow} || [] } ]; + + report( \%stash ); +} sub report { @@ -100,2 +128,7 @@ } } + +__PACKAGE__->main() unless caller; + +1; + Index: /branches/release-35/tools/upgrade =================================================================== --- /branches/release-35/tools/upgrade (revision 1174) +++ /branches/release-35/tools/upgrade (revision 1950) @@ -7,58 +7,86 @@ # $Id$ +package MT::Tool::Upgrade; use strict; -use Getopt::Long; +use lib qw( extlib lib ); +use base qw( MT::Tool ); + use Carp qw(confess); -GetOptions("dryrun", \my($dryrun), "name:s", \my($name), "sql", \my($sqlonly)); - -use lib 'extlib'; -use lib 'lib'; - -use MT; use MT::Upgrade; -my $mt = new MT(Config => 'mt.cfg') or die MT->errstr; +sub usage { '[--dryrun] [--sql] [--name ]' } -MT->add_callback('MT::Upgrade::SQL', 1, undef, \&sql_cb) if $sqlonly; +sub help { + return q{ + Installs or upgrades a database to the current MT schema. -$dryrun = 1 if $sqlonly; - -if (!$sqlonly) { - print "upgrade -- A command line tool for upgrading the schema for Movable Type.\n"; - print "(Non-destructive mode)\n" if $dryrun; + --dryrun Determine the upgrade steps required without + executing any changes. + --sql Report the SQL that would be performed instead + of executing it. + --name The author as whom to perform the upgrade steps. + Required when performing an upgrade (not at + initial install). + }; } -my $install; -my $driver = MT::Object->driver; -if (!$driver || !$driver->table_exists('MT::Author')) { - $install = 1; +my ($dryrun, $name, $sqlonly); + +sub options { + return ( + 'dryrun!' => \$dryrun, + 'sql!' => \$sqlonly, + 'name=s' => \$name, + ); } -unless ($install || $name) { - print "Please set username to set superuser at upgrading. cf: upgrade --name Melody\n"; - exit; -} -my $author_id; -if (!$install && $name) { - require MT::BasicAuthor; - my $a = MT::BasicAuthor->load({name => $name}); - die "Not found user $name:" . MT::BasicAuthor->errstr if !$a; - $author_id = $a->id || 0; -} +sub main { + my $class = shift; + my ($verbose) = $class->SUPER::main(@_); -my $updated = MT::Upgrade->do_upgrade(App => 'main', - DryRun => $dryrun, - Install => $install, - SuperUser => $author_id, - CLI => 1, - ); + if ($sqlonly) { + $dryrun = 1; + MT->add_callback('MT::Upgrade::SQL', 1, undef, \&sql_cb); + } + else { + print "upgrade -- A command line tool for upgrading the schema for Movable Type.\n"; + print "(Non-destructive mode)\n" if $dryrun; + } -if ($install) { - print "Installation complete.\n"; -} else { - print "Upgrade complete!\n" if !$dryrun && $updated; - print "Your schema is up to date already.\n" if defined $updated && !$updated; + my $install; + my $driver = MT::Object->driver; + if (!$driver || !$driver->table_exists('MT::Author')) { + $install = 1; + } + + unless ($install || $name) { + print "Please set username to set superuser at upgrading. cf: upgrade --name Melody\n"; + exit; + } + + my $author_id; + if (!$install && $name) { + require MT::BasicAuthor; + my $a = MT::BasicAuthor->load({name => $name}) + or die "Not found user $name:" . MT::BasicAuthor->errstr; + $author_id = $a->id; + } + + my $updated = MT::Upgrade->do_upgrade( + App => __PACKAGE__, + DryRun => $dryrun, + Install => $install, + SuperUser => $author_id, + CLI => 1, + ); + + if ($install) { + print "Installation complete.\n"; + } else { + print "Upgrade complete!\n" if !$dryrun && $updated; + print "Your schema is up to date already.\n" if defined $updated && !$updated; + } } @@ -68,4 +96,5 @@ print "\t* " . $msg . "\n" unless $sqlonly; } + sub error { my $pkg = shift; @@ -73,4 +102,5 @@ confess $err; } + sub sql_cb { my $cb = shift; @@ -78,2 +108,8 @@ print "$stmt\n"; } + + +__PACKAGE__->main() unless caller; + +1; + Index: /branches/release-35/lib/MT/Tool.pm =================================================================== --- /branches/release-35/lib/MT/Tool.pm (revision 1950) +++ /branches/release-35/lib/MT/Tool.pm (revision 1950) @@ -0,0 +1,185 @@ +# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd. +# This program is distributed under the terms of the +# GNU General Public License, version 2. +# +# $Id$ + +package MT::Tool; + +use strict; +use warnings; +use charnames qw( :full ); + +use Carp qw( croak ); +use English qw( -no_match_vars ); +use Getopt::Long; + +sub show_help { + my $class = shift; + my $help = $class->help(); + # TODO: strip spaces more smartly for people who may format + # their help() methods differently. + $help =~ s/ ^ [\N{SPACE}]{4} //xmsg; + print $help; +} + +sub show_usage { + my $class = shift; + print qq{usage: $PROGRAM_NAME }, + join (qq{\n $PROGRAM_NAME }, $class->usage()), + qq{\n}; +} + +sub usage; +sub help; +sub options {} + +sub set_up_app { + # TODO: a Tool should probably be its own App, so we can use *all* + # the MT::App infrastructure. For now fake it like rpt does. + require MT; + my $mt = MT->new() or die MT->errstr; + + $mt->{vtbl} = { }; + $mt->{is_admin} = 0; + $mt->{template_dir} = 'cms'; + $mt->{user_class} = 'MT::Author'; + $mt->{plugin_template_path} = 'tmpl'; + $mt->run_callbacks('init_app', $mt); + + return $mt; +} + +sub main { + my $class = shift; + + $class->set_up_app(); + + my $verbose; + my $opts_good = GetOptions( + 'help!' => sub { $class->show_usage(); $class->show_help(); exit; }, + 'usage!' => sub { $class->show_usage(); exit; }, + 'verbose|v+' => \$verbose, + + $class->options(), + ); + usage(), exit if !$opts_good; + + return $verbose; +} + +1; + +__END__ + +=head1 NAME + +MT::Tool - shared infrastructure for command line tools + +=head1 SYNOPSIS + + package Foobar::Tool::MakeQuuxen + use strict; + + use lib qw( extlib lib ); + use base qw( MT::Tool ); + + sub help { + q{ + --special Make extra special quuxen. + }; + } + + sub usage { '[--special]' } + + my ($special); + + sub options { + return ( + 'special!' => \$special, + ); + } + + sub main { + my $class = shift; + ($verbose) = $class->SUPER::main(@_); + + ## Make those quuxen! + ... + } + + __PACKAGE__->main() unless caller; + + 1; + +=head1 DESCRIPTION + +I provides shared infrastructure around command line tools for MT +applications. With these, you can provide a standard interface for your tools +similar to MT's other command line applications. + +=head1 USAGE + +=head2 use base qw( MT::Tool ) + +Declares the current package is a new tool conforming to the MT::Tool +interface. The following class methods should be defined as appropriate for +your tool. + +=head2 $class-Ehelp() + +Return the text to use for your tool's C<--help> command. + +=head2 $class-Eusage() + +Return the option text to use for your tool's C<--usage> command. The text is +also used for the C<--help> synopsis and when invalid options are used. + +=head2 $class-Eoptions() + +Return the definition of your tool's additional options, as a hash suitable to +pass to Getopt::Long's C. The most common definitions for +Getopt::Long options are: + +=over 4 + +=item * C!> + +Your option is a flag users can specify up to once. A bound variable will be +set when the flag is found. + +The contrary option C<--noI