use strictures 1; use Benchmark qw/:hireswallclock cmpthese/; use Getopt::Long::Descriptive; my ($opts, $usage); BEGIN { ($opts, $usage) = describe_options( '%c: %o' => [ 'help|h' => 'Print usage message and exit' ], [ 'classes|c:i' => 'How many classes to create per benchmark cycle (def 10)', { default => 10 } ], [ 'accessors|a:i' => 'How many accessors to create per class (def 100)', { default => 100 } ], [ 'pregenerate|p:i' => 'For how many maximum benchmark cycles should we prepare (def 1000)', { default => 1000 } ], [ 'unique|u' => 'Make accessor names globally unique (instead of just per class)' ], [ 'bench|b:s' => 'Which benchmarks to run (all|xs|pp)', { default => 'all', regex => qr/^(?:all|xs|pp)$/ } ], { getopt_conf => [qw/gnu_getopt bundling_override no_ignore_case/] }, ); # can not change this runtime, thus in-block $ENV{MOUSE_PUREPERL} = 1 if $opts->{bench} eq 'pp'; my @missing; for (qw/ Moose Moo Mouse /) { eval "require $_" or push @missing, $_; } if (@missing) { die sprintf "Missing modules necessary for benchmark:\n\n%s\n\n", join ("\n", @missing); } } use Method::Generate::Accessor; # need to pre-load for the XS shutoff to work $usage->die if $opts->{help}; my $counters; my $tasks = {}; if ($opts->{bench} =~ /all|pp/) { { local $Method::Generate::Accessor::CAN_HAZ_XS = 0; _add_moosey_has (moo => 'Moo'); } _add_moosey_has (moose => 'Moose'); _add_moosey_has (mouse => 'Mouse') if $ENV{MOUSE_PUREPERL}; } if ($opts->{bench} =~ /all|xs/) { { local $Method::Generate::Accessor::CAN_HAZ_XS = 1; _add_moosey_has (moo_XS => 'Moo'); } _add_moosey_has (mouse_XS => 'Mouse') unless $ENV{MOUSE_PUREPERL}; } # run each task once, prime whatever caches there may be $_->() for values %$tasks; # Actual Benchmarking for (1, 2) { print "Perl $], take $_:\n"; cmpthese ( -1, $tasks ); print "\n"; } exit 0; # the end sub _add_moosey_has { my ($name, $base) = @_; my @for_eval; # need to pre-gen stuff so that the class names will differ for every bench run for (1 .. $opts->{pregenerate}) { my $perl; for ( 1.. $opts->{classes} ) { my $class = "Bench::${base}::" . ++$counters->{class}; $perl .= "package $class; use $base;"; for ( 1.. $opts->{accessors} ) { my $attr = 'attribute_' . ++$counters->{acc}; $perl .= "has $attr => ( is => rw );"; } $counters->{accessors} = 0 unless $opts->{unique}; } push @for_eval, $perl; } $tasks->{$name} = sub { my $code = shift @for_eval or die "Ran out of pre-generated stuff, raise -p\n"; eval $code; }; }