File Coverage

lib/Array/Queue/Priority.pm
Criterion Covered Total %
statement 21 21 100.0
branch 6 6 100.0
condition n/a
subroutine 3 3 100.0
pod 1 1 100.0
total 31 31 100.0


line stmt bran cond sub pod time code
1             package Array::Queue::Priority;
2             $Array::Queue::Priority::VERSION = '0.1.0';
3 1     1   72146 use Moose;
  1         295744  
  1         5  
4              
5             extends 'Array::Queue';
6              
7 1     1   4352 use namespace::autoclean;
  1         1  
  1         7  
8              
9              
10             =head1 NAME
11              
12             Array::Queue::Priority - An custom sorted queue
13              
14             =head1 VERSION
15              
16             version 0.1.0
17              
18             =head1 SYNOPSIS
19              
20             my $queue = Array::Queue::Priority->new(
21             sort_cb => sub {
22             $_[0]->{last_name} cmp $_[1]->{last_name}
23             });
24             $ar->add({ last_name => 'Rogers' });
25             $ar->add({ last_name => 'Stark' });
26             $ar->add({ last_name => 'Banner' });
27              
28             while ($node = $queue->first) {
29             # do things with node
30             $queue->remove;
31             }
32              
33             =head1 DESCRIPTION
34              
35             Array::Queue::Priority priority queue, sorted by whatever you desire.
36              
37             As values are inserted, they are sorted on the fly, ensuring the values
38             come out in the order you desire. You simply supply the sort_cb at the
39             time of construction.
40              
41             If no sort_cb is supplied, it will try to sort by values passed. You'll
42             probably get warnings if that's just a string, and who knows what you will
43             get if it's a hashref. Straight numbers will work just find though.
44              
45             Call first() then remove() for a little "transactional safety" if there's
46             an error processing the first item in the queue.
47              
48              
49             Inherits from Array::Queue.
50              
51             =head1 METHODS
52              
53             =head2 C<add>
54              
55             $ar->add( 99 );
56              
57             You can add any type of item to the queue.
58              
59             =head2 C<remove>
60              
61             $ar->remove;
62              
63             Remove the oldest item on the queue.
64              
65             Returns value removed.
66              
67             =head2 C<first>
68              
69             $ar->first;
70              
71             Returns the first / oldest item in the queue.
72              
73             Leaves the item in the queue.
74              
75             =head2 C<queue>
76              
77             $ar->queue;
78              
79             Reference directly the array used to store the queued items.
80              
81             =head2 C<size>
82              
83             $ar->size;
84              
85             How many elements are in the queue.
86              
87             =head2 C<empty>
88              
89             $ar->empty;
90              
91             Boolean, is queue empty?
92              
93             =head1 AUTHOR
94              
95             Dan Burke C<< dburke at addictmud.org >>
96              
97             =head1 BUGS
98              
99             If you encounter any bugs, or have feature requests, please create an issue
100             on github. https://github.com/dwburke/perl-Array-Queue/issues
101              
102             Pull requests also welcome.
103              
104             =head1 LICENSE AND COPYRIGHT
105              
106             L<http://www.perlfoundation.org/artistic_license_2_0>
107              
108             =cut
109              
110             sub add {
111 116     116 1 126 my ($self, $node) = @_;
112              
113 116 100       2738 if ($self->size == 0) {
114 22         540 $self->_insert(0, $node);
115             }
116             else {
117 94         1893 my $sort_cb = $self->sort_cb;
118              
119 94         80 my $found = 0;
120              
121 94         54 my $idx;
122 94         2191 for ($idx = 0; $idx < $self->size; $idx++) {
123              
124 195         4415 my $sort_it = $sort_cb->($node, $self->get($idx));
125              
126 195 100       3171 if ($sort_it == -1) {
127 74         1795 $self->_insert($idx, $node);
128 74         50 $found = 1;
129 74         61 last;
130             }
131              
132             }
133              
134 94 100       131 unless ($found) {
135 20         476 $self->_insert($idx, $node);
136             }
137              
138             }
139              
140 116         129 $node;
141             }
142              
143              
144             has sort_cb => (
145             is => 'ro',
146             isa => 'CodeRef',
147             default => sub { sub { $_[0] <=> $_[1] } },
148             );
149              
150              
151             __PACKAGE__->meta->make_immutable;
152              
153             1;