File Coverage

blib/lib/Directory/Queue/Set.pm
Criterion Covered Total %
statement 65 65 100.0
branch 15 22 68.1
condition 4 6 66.6
subroutine 10 10 100.0
pod 6 6 100.0
total 100 109 91.7


line stmt bran cond sub pod time code
1             #+##############################################################################
2             # #
3             # File: Directory/Queue/Set.pm #
4             # #
5             # Description: object oriented interface to a set of Directory::Queue objects #
6             # #
7             #-##############################################################################
8              
9             #
10             # module definition
11             #
12              
13             package Directory::Queue::Set;
14 1     1   402 use strict;
  1         2  
  1         24  
15 1     1   3 use warnings;
  1         2  
  1         55  
16             our $VERSION = "2.0";
17             our $REVISION = sprintf("%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/);
18              
19             #
20             # used modules
21             #
22              
23 1     1   6 use No::Worries::Die qw(dief);
  1         1  
  1         5  
24              
25             #
26             # return true if the given thing is a Directory::Queue object
27             #
28              
29             sub _isdq ($) {
30 4     4   6 my($thing) = @_;
31              
32 4   33     26 return(ref($thing) && $thing->isa("Directory::Queue"));
33             }
34              
35             #
36             # object constructor
37             #
38              
39             sub new : method {
40 2     2 1 14 my($class, @list) = @_;
41 2         3 my($self);
42              
43 2         3 $self = {};
44 2         4 bless($self, $class);
45 2         6 $self->add(@list);
46 2         7 return($self);
47             }
48              
49             #
50             # add one or more queues to the set
51             #
52              
53             sub add : method {
54 3     3 1 6 my($self, @list) = @_;
55 3         4 my($id);
56              
57 3         6 foreach my $dirq (@list) {
58 3 50       6 dief("not a Directory::Queue object: %s", $dirq) unless _isdq($dirq);
59 3         10 $id = $dirq->id();
60             dief("duplicate queue in set: %s", $dirq->path())
61 3 50       8 if $self->{dirq}{$id};
62 3         8 $self->{dirq}{$id} = $dirq->copy();
63             }
64             # reset our iterator
65 3         20 delete($self->{elt});
66             }
67              
68             #
69             # remove one or more queues from the set
70             #
71              
72             sub remove : method {
73 1     1 1 6 my($self, @list) = @_;
74 1         2 my($id);
75              
76 1         2 foreach my $dirq (@list) {
77 1 50       3 dief("not a Directory::Queue object: %s", $dirq) unless _isdq($dirq);
78 1         4 $id = $dirq->id();
79             dief("missing queue in set: %s", $dirq->path())
80 1 50       3 unless $self->{dirq}{$id};
81 1         4 delete($self->{dirq}{$id});
82             }
83             # reset our iterator
84 1         2 delete($self->{elt});
85             }
86              
87             #
88             # get the next element of the queue set
89             #
90              
91             sub next : method { ## no critic 'ProhibitBuiltinHomonyms'
92 10     10 1 481 my($self) = @_;
93 10         14 my($name, $min_elt, $min_id);
94              
95 10 50       17 return() unless $self->{elt};
96 10         12 foreach my $id (keys(%{ $self->{elt} })) {
  10         24  
97 14         23 $name = substr($self->{elt}{$id}, -14);
98 14 100 100     39 next if defined($min_elt) and $min_elt le $name;
99 10         11 $min_elt = $name;
100 10         11 $min_id = $id;
101             }
102 10 100       19 unless ($min_id) {
103 2         3 delete($self->{elt});
104 2         6 return();
105             }
106 8         12 $min_elt = $self->{elt}{$min_id};
107 8         22 $self->{elt}{$min_id} = $self->{dirq}{$min_id}->next();
108 8 100       23 delete($self->{elt}{$min_id}) unless $self->{elt}{$min_id};
109 8         25 return($self->{dirq}{$min_id}, $min_elt);
110             }
111              
112             #
113             # get the first element of the queue set
114             #
115              
116             sub first : method {
117 2     2 1 938 my($self) = @_;
118              
119 2 50       6 return() unless $self->{dirq};
120 2         2 delete($self->{elt});
121 2         3 foreach my $id (keys(%{ $self->{dirq} })) {
  2         7  
122 4         18 $self->{elt}{$id} = $self->{dirq}{$id}->first();
123 4 50       10 delete($self->{elt}{$id}) unless $self->{elt}{$id};
124             }
125 2         6 return($self->next());
126             }
127              
128             #
129             # count the elements of the queue set
130             #
131              
132             sub count : method {
133 3     3 1 10 my($self) = @_;
134 3         3 my($count);
135              
136 3 100       9 return(0) unless $self->{dirq};
137 2         4 $count = 0;
138 2         3 foreach my $id (keys(%{ $self->{dirq} })) {
  2         5  
139 3         9 $count += $self->{dirq}{$id}->count();
140             }
141 2         9 return($count);
142             }
143              
144             1;
145              
146             __END__