File Coverage

blib/lib/Mo/Benchmarks.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

##
# name:      Mo::Benchmarks
# abstract:  Benchmarks for Moose Family Modules
# author:    Ingy döt Net <[e-mail]>
# license:   perl
# copyright: 2011

use 5.010;

use Mouse 0.93 ();
use MouseX::App::Cmd 0.08 ();

#------------------------------------------------------------------------------#
package Mo::Benchmarks;

our $VERSION = '0.10';

#------------------------------------------------------------------------------#
package Mo::Benchmarks::Command;
use App::Cmd::Setup -command;
use Mouse;
extends 'MouseX::App::Cmd::Command';

sub validate_args {}

# Semi-brutal hack to suppress extra options I don't care about.
around usage => sub {
    my $orig = shift;
    my $self = shift;
    my $opts = $self->{usage}->{options};
    @$opts = grep { $_->{name} ne 'help' } @$opts;
    return $self->$orig(@_);
};

#-----------------------------------------------------------------------------#
package Mo::Benchmarks;
use App::Cmd::Setup -app;
use Mouse;
extends 'MouseX::App::Cmd';

use Module::Pluggable
  require     => 1,
  search_path => [ 'Mo::Benchmarks::Command' ];
Mo::Benchmarks->plugins;

#------------------------------------------------------------------------------#
package Mo::Benchmarks::Command::constructor;
Mo::Benchmarks->import( -command );
use Mouse;
extends 'Mo::Benchmarks::Command';

use Benchmark ':all';

use constant abstract => 'Run constructor benchmarks';
use constant usage_desc =>
    'mo-benchmarks constructor --count=1000000 Moose Mouse Moo Mo';

has count => (
    is => 'ro',
    isa => 'Num',
    documentation => 'Number of times to run a test',
);

sub execute {
    my ($self, $opt, $args) = @_;
    my @mo = map lc, grep !/^--/, @$args;
    @mo = qw'mo moo mouse moose' unless @mo;
    my $tests = {
        map {
            my $t = $_;
            my $l = lc($t);
            my $m =
            eval <<"...";
package $l;
use $t;
has good => (is => 'ro');
has bad => (is => 'ro');
has ugly => (is => 'rw');
$l->new(good => 'Perl', bad => 'Python', ugly => 'Ruby');
...
            my $v = do { no strict 'refs'; ${$t."::VERSION"} };
            ($l => [ "$t $v" =>
                sub {
#                     my $m =
                    $l->new(good => 'Perl', bad => 'Python', ugly => 'Ruby');
#                     $m->good;
#                     $m->bad;
#                     $m->ugly;
#                     $m->ugly('Bunny');
                }
            ])
        } qw(Mo Moo Mouse Moose)
    };

    my $count = $self->count || 1000;
    my $num = 1;
    timethese($count, {
        map {
            (
                $num++ . ") $_->[0]",
                $_->[1]
            )
        } map $tests->{$_}, @mo
    });
}

#------------------------------------------------------------------------------#
package Mo::Benchmarks::Command;

# Common subroutines:

1;

=head1 SYNOPSIS

...

=head1 DESCRIPTION

...