# $Id: /mirror/coderepos/lang/perl/Queue-Q4M/trunk/misc/lib/Queue/Q4M/Benchmark.pm 65253 2008-07-08T02:20:49.109770Z daisuke $
package Queue::Q4M::Benchmark;
use Moose;
use Moose::Util::TypeConstraints;
use Benchmark ();
use DBI;
use Queue::Q4M;
with 'MooseX::Getopt';
has 'dsn' => (
is => 'rw',
isa => 'Str',
required => 1,
trigger => sub { $_[0]->connect_info->[0] = $_[1] }
);
has 'username' => (
is => 'rw',
isa => 'Str',
required => 1,
default => sub { (getpwuid($>))[0] },
trigger => sub { $_[0]->connect_info->[1] = $_[1] }
);
has 'password' => (
is => 'rw',
isa => 'Str',
trigger => sub { $_[0]->connect_info->[2] = $_[1] }
);
has '__connect_info' => (
accessor => 'connect_info',
is => 'rw',
isa => 'ArrayRef',
auto_deref => 1,
default => sub { +[ undef, undef, undef, { RaiseError => 1 } ] },
);
has '__dbh' => (
accessor => 'dbh',
is => 'rw',
isa => 'Maybe[DBI::db]',
);
around 'dbh' => sub {
my ($next, $self, @args) = @_;
my $rv = $next->($self, @args);
if (! @args) {
if (! defined $rv || ! $rv->ping) {
$rv = DBI->connect( $self->connect_info );
$self->dbh($rv);
}
}
return $rv;
};
role_type 'Queue::Q4M::Benchmark::Plugin';
subtype 'PluginList'
=> as 'ArrayRef[Queue::Q4M::Benchmark::Plugin]';
coerce 'PluginList'
=> from 'ArrayRef'
=> via {
my @list;
foreach my $class (@$_) {
if ($class !~ s/^\+//) {
$class = "Queue::Q4M::Benchmark::Plugin::" . ucfirst $class;
}
Class::MOP::load_class($class);
push @list, $class->new;
}
\@list;
}
;
has 'plugins' => (
is => 'rw',
isa => 'PluginList',
auto_deref => 1,
coerce => 1,
default => sub { +[] }
);
has '__tasks' => (
accessor => 'tasks',
is => 'rw',
isa => 'HashRef',
default => sub { +{} }
);
has 'items' => (
is => 'rw',
isa => 'Int',
default => 10_000
);
has 'iterations' => (
is => 'rw',
isa => 'Int',
required => 1,
default => 1,
);
has 'define' => (
is => 'rw',
isa => 'HashRef',
default => sub { +{} }
);
__PACKAGE__->meta->make_immutable;
no Moose;
sub run {
my $self = shift;
my $dbh = DBI->connect( $self->connect_info );
$self->setup();
$self->run_tasks();
}
sub setup {
my $self = shift;
foreach my $plugin ( $self->plugins ) {
$plugin->setup( $self );
}
}
sub add_task {
my ($self, %args) = @_;
$self->tasks->{$args{name}} = $args{coderef};
}
sub run_tasks {
my $self = shift;
while (my ($name, $coderef) = each %{ $self->tasks }) {
print ">> executing $name\n";
$coderef->();
}
}
my @CHARS = ('a'..'z',0..9, 'A'..'Z');
sub random_string {
my ($self, $length) = @_;
join('', map { $CHARS[rand @CHARS] } 1..$length);
}
1;