bench2.perl

   1 #!perl -w
   2 use strict;
   3 use blib;
   4 use POE::XS::Queue::Array ();
   5 use POE::Queue::Array ();
   6 use Benchmark;
   7
   8 # 1000 items to queue
   9 my @items = map [ $_, $_ ], map rand(1000), 1..1000;
  10
  11 # test queues for timing adjust_priority
  12 my %adjust;
  13 my %adjust_ids;
  14 my @adjust_val;
  15 for my $impl (qw(POE::XS::Queue::Array POE::Queue::Array)) {
  16   my $queue = $impl->new;
  17
  18   my @ids = map $queue->enqueue(@$_), @items;
  19
  20   $adjust{$impl} = $queue;
  21   $adjust_ids{$impl} = \@ids;
  22 }
  23 for my $index (0..999) {
  24   $adjust_val[$index] = rand(100) - 50;
  25 }
  26
  27 timethese(-10,
  28           {
  29            xs_big => sub { big('POE::XS::Queue::Array') },
  30            perl_big => sub { big('POE::Queue::Array') },
  31            xs_enqueue => sub { enqueue('POE::XS::Queue::Array') },
  32            perl_enqueue => sub { enqueue('POE::Queue::Array') },
  33            xs_adjust => sub { adjust('POE::XS::Queue::Array') },
  34            perl_adjust => sub { adjust('POE::Queue::Array') },
  35           });
  36
  37 # does general queue work
  38 sub big {
  39   my $class = shift;
  40
  41   my $queue = $class->new;
  42
  43   my @ids = map $queue->enqueue(@$_), @items;
  44
  45   for my $id (@ids[1..100]) {
  46     $queue->adjust_priority($id, sub { 1 }, -5);
  47   }
  48   my %remove = map { $_ => 1 } @ids[-100..-1];
  49   $queue->remove_items(sub { $remove{$_[0]} });
  50
  51   for my $id (@ids[-200..-101]) {
  52     $queue->remove_item($id, sub { 1 });
  53   }
  54
  55   $queue->remove_items(sub { 0 });
  56
  57   $queue->dequeue_next while $queue->get_item_count;
  58 }
  59
  60 # enqueue a bunch
  61 sub enqueue {
  62   my $class = shift;
  63
  64   my $queue = $class->new;
  65
  66   my @ids = map $queue->enqueue(@$_), @items;
  67 }
  68
  69 # adjust the priorities on a bunch of items
  70 sub adjust {
  71   my $class = shift;
  72
  73   my $queue = $adjust{$class};
  74
  75   my $index = 0;
  76   for my $id (@{$adjust_ids{$class}}) {
  77     $queue->adjust_priority($id, sub { 1 }, $adjust_val[$index]);
  78     ++$index;
  79   }
  80 }