Changeset 15437

Timestamp:

07/08/08 11:20:49 (5 years ago)

Author:

daisuke

Message:

Add conditional benchmark

Location:

lang/perl/Queue-Q4M/trunk/misc/lib/Queue/Q4M

Files:

• Benchmark.pm (modified) (5 diffs)
• Benchmark/Plugin/Conditional.pm (added)
• Benchmark/Plugin/Default.pm (modified) (2 diffs)

lang/perl/Queue-Q4M/trunk/misc/lib/Queue/Q4M/Benchmark.pm

@@ -41 +41 @@
 
 has '__dbh' => (
-    accesor => 'dbh',
+    accessor => 'dbh',
     is => 'rw',
     isa => 'Maybe[DBI::db]',
-    around => 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);
-            }
+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;
-    },
-);
+    }
+    return $rv;
+};
 
 role_type 'Queue::Q4M::Benchmark::Plugin';
@@ -67 +67 @@
             foreach my $class (@$_) {
                 if ($class !~ s/^\+//) {
-                    $class = "Queue::Q4M::Benchmark::Plugin::$class";
+                    $class = "Queue::Q4M::Benchmark::Plugin::" . ucfirst $class;
                 }
                 Class::MOP::load_class($class);
@@ -85 +85 @@
 
 has '__tasks' => (
-    accessors => 'tasks',
+    accessor => 'tasks',
     is => 'rw',
     isa => 'HashRef',
     default => sub { +{} }
+);
+
+has 'items' => (
+    is => 'rw',
+    isa => 'Int',
+    default => 10_000
 );
 
@@ -96 +102 @@
     required => 1,
     default => 1,
+);
+
+has 'define' => (
+    is => 'rw',
+    isa => 'HashRef',
+    default => sub { +{} }
 );
 
@@ -119 +131 @@
 }
 
+sub add_task {
+    my ($self, %args) = @_;
+
+    $self->tasks->{$args{name}} = $args{coderef};
+}
+
 sub run_tasks {
     my $self = shift;
 
-    Benchmark::cmpthese(
-        $self->iterations,
-        $self->tasks
-    );
+    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);
 }
 

lang/perl/Queue-Q4M/trunk/misc/lib/Queue/Q4M/Benchmark/Plugin/Default.pm

@@ -3 +3 @@
 package Queue::Q4M::Benchmark::Plugin::Default;
 use Moose;
+use Time::HiRes qw(time);
 
 with 'Queue::Q4M::Benchmark::Plugin';
+
+has 'table' => (
+    is => 'rw',
+    isa => 'Str',
+    required => 1,
+    default => 'q4mbench_default'
+);
 
 no Moose;
@@ -12 +20 @@
     my ($self, $c) = @_;
 
+    my $table = $self->table;
+    my $dbh = $c->dbh;
+    $dbh->do(<<EOSQL);
+        CREATE TABLE IF NOT EXISTS $table (
+            data TEXT NOT NULL
+        ) ENGINE=queue;
+EOSQL
+    $dbh->do("DELETE FROM $table");
+
+    print "populating $table with ", $c->items, " items\n";
+    my $max = $c->items;
+    my $i = 0;
+    while ($max > $i) {
+        $i++;
+        $dbh->do("INSERT INTO $table (data) VALUES (?)", undef,
+            $c->random_string(64));
+        print " + $i\n" if $i % 100 == 0;
+    }
+
     $c->add_task(
         name => 'default',
         coderef => sub {
-            my $queue = Queue::Q4M->new(
+            my $queue = Queue::Q4M->connect(
                 connect_info => [ $c->connect_info ],
             );
 
-            while ( $queue->next ) {
-                my $h = $queue->fetchrow_hashref;
+            my $start = time();
+            print " + Start ", scalar(localtime($start)), "\n";
+            my $count = 0;
+            while ( $queue->next($table, 1) ) {
+                my $h = $queue->fetch_hashref;
+                $count++;
             }
+            my $end      = time();
+            my $duration = $end - $start;
+            my $avg      = $duration / $count;
+            print " + End ", scalar(localtime($end)), "\n";
+            print " + Processed $count messages in ", $duration, " secs, average $avg mess/sec\n";
         }
     );