]>
Commit | Line | Data |
---|---|---|
e38f8ec4 TC |
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 | } |