File Coverage

blib/lib/Geo/Coder/Many/Scheduler/UniquenessScheduler.pm
Criterion Covered Total %
statement 49 50 98.0
branch 8 10 80.0
condition n/a
subroutine 10 11 90.9
pod 5 5 100.0
total 72 76 94.7


line stmt bran cond sub pod time code
1             package Geo::Coder::Many::Scheduler::UniquenessScheduler;
2              
3 2     2   11 use strict;
  2         5  
  2         61  
4 2     2   9 use warnings;
  2         6  
  2         57  
5              
6 2     2   10 use List::MoreUtils qw( first_index );
  2         4  
  2         106  
7              
8 2     2   10 use base 'Geo::Coder::Many::Scheduler';
  2         4  
  2         944  
9              
10             our $VERSION = '0.01';
11              
12             =head1 NAME
13              
14             Geo::Coder::Many::Scheduler::UniquenessScheduler - Scheduler base class which
15             ensures uniqueness
16              
17             =head1 DESCRIPTION
18              
19             A base class for enforcing correct behaviour of get_next_unique (and the other
20             methods) even when a scheduling scheme might not take this into account. Note:
21             this may alter the properties of the scheduling scheme!
22              
23             Subclasses should
24              
25             =head1 METHODS
26              
27             =head2 new
28              
29             Creates a UniquenessScheduler object and returns it. This should not be called
30             directly, but by any subclasses, via SUPER.
31              
32             =cut
33              
34             sub new {
35 280     280 1 550 my $class = shift;
36 280         398 my $args = shift;
37              
38             # (Map from geocoder+weight hash, for the time being)
39 280         436 my @items_copy = map { $_->{name} } @{$args->{items}};
  420         1478  
  280         777  
40              
41 280         723 my $self = { items => \@items_copy};
42 280         937 bless $self, $class;
43              
44             # Initialize available_items
45 280         810 $self->reset_available();
46 280         855 return $self;
47             };
48              
49             =head2 reset_available
50              
51             Update the set of currently available items to the full set of items initially
52             provided.
53              
54             =cut
55              
56             sub reset_available {
57 1680     1680 1 4284 my $self = shift;
58 1680         1890 @{$self->{available_items}} = @{$self->{items}};
  1680         5151  
  1680         2887  
59 1680         3820 return;
60             };
61              
62             =head2 get_next_unique
63              
64             Uses _get_next (which has been overridden) to obtain the next scheduled item,
65              
66             =cut
67              
68             sub get_next_unique {
69 3292     3292 1 3720 my $self = shift;
70              
71 3292         3286 my ($item, $item_pos);
72 3292         3402 while ( 0 < @{$self->{available_items}} ) {
  4026         10236  
73              
74             # Get the next element (possibly one we've seen before)
75 3468         11444 $item = $self->_get_next();
76              
77             # Return undef if _get_next has no more items
78 3468 50       7828 return if !defined $item;
79              
80             # Check whether we've seen this item before
81 3468     3859   10013 $item_pos = first_index { $_ eq $item } @{$self->{available_items}};
  3859         6957  
  3468         9455  
82              
83             # Finish if we haven't seen it
84 3468 100       11814 last if ($item_pos > -1);
85             }
86              
87             # If we ran out of items, return undef.
88 3292 100       3623 if ( !@{$self->{available_items}} ) {
  3292         8155  
89 558         1384 return;
90             }
91            
92             # Remember that we've seen this item, by removing it from the list of those
93             # available
94 2734 50       6469 if ( $item_pos > -1 ) {
95 2734         2880 splice @{$self->{available_items}},$item_pos,1;
  2734         5440  
96             }
97 2734         8424 return $item;
98             }
99              
100             =head2 next_available
101              
102             Zero if there are items remaining; undef if there aren't.
103              
104             =cut
105              
106             sub next_available {
107 3275     3275 1 4053 my $self = shift;
108 3275 100       3565 if ( 0 == @{$self->{available_items}} ) {
  3275         7711  
109 833         2669 return;
110             }
111             else {
112 2442         7482 return 0;
113             }
114             }
115              
116             =head2 _get_next
117              
118             Shoudl be implemented by a subclass
119              
120             =cut
121              
122             sub _get_next {
123 0     0   0 die "This method must be over-ridden.\n";
124             }
125            
126             =head2 process_feedback
127              
128             Does nothing by default; may be overridden
129              
130             =cut
131              
132             sub process_feedback {
133 1346     1346 1 3852 return;
134             }
135              
136             1;
137