File Coverage

lib/WWW/Crawler/Mojo/Queue/Memory.pm
Criterion Covered Total %
statement 31 35 88.5
branch 4 4 100.0
condition 8 8 100.0
subroutine 11 12 91.6
pod 6 6 100.0
total 60 65 92.3


line stmt bran cond sub pod time code
1             package WWW::Crawler::Mojo::Queue::Memory;
2 10     10   54 use strict;
  10         19  
  10         241  
3 10     10   44 use warnings;
  10         17  
  10         180  
4 10     10   38 use utf8;
  10         14  
  10         38  
5 10     10   213 use Mojo::Base 'WWW::Crawler::Mojo::Queue';
  10         19  
  10         47  
6 10     10   512 use List::Util;
  10         18  
  10         3654  
7              
8             has 'cap';
9             has jobs => sub { [] };
10             has redundancy_storage => sub { {} };
11              
12             sub dequeue {
13 46     46 1 18751 return shift(@{shift->jobs});
  46         111  
14             }
15              
16             sub enqueue {
17 59     59 1 129 return shift->_enqueue(@_);
18             }
19              
20             sub length {
21 25     25 1 1208 return scalar(@{shift->jobs});
  25         87  
22             }
23              
24             sub next {
25 20   100 20 1 6294 return shift->jobs->[shift || 0];
26             }
27              
28             sub requeue {
29 1     1 1 3 shift->_enqueue(@_, 1);
30             }
31              
32             sub shuffle {
33 0     0 1 0 my $self = shift;
34 0         0 @{$self->jobs} = List::Util::shuffle @{$self->jobs};
  0         0  
  0         0  
35             }
36              
37             sub _enqueue {
38 60     60   95 my ($self, $job, $requeue) = @_;
39 60         134 my $digest = $job->digest;
40 60         152 my $redund = $self->redundancy_storage;
41 60 100 100     324 return if !$requeue && $redund->{$digest};
42 53 100 100     110 return if $self->cap && $self->cap < $self->length;
43 52         197 push(@{$self->jobs}, $job);
  52         101  
44 52         225 $redund->{$digest} = 1;
45 52         188 return $job;
46             }
47              
48             1;
49              
50             =head1 NAME
51              
52             WWW::Crawler::Mojo::Queue::Memory - Crawler queue with memory
53              
54             =head1 SYNOPSIS
55              
56             =head1 DESCRIPTION
57              
58             Crawler queue with memory.
59              
60             =head1 ATTRIBUTES
61              
62             This class inherits all methods from L and implements
63             following new ones.
64              
65             =head2 cap
66              
67             Capacity of queue, indecating how many jobs can be kept in queue at a time.
68             If you enqueue over capacity, the oldest job will be automatically disposed.
69              
70             =head2 jobs
71              
72             jobs.
73              
74             =head2 redundancy_storage
75              
76             A hash ref in which the class keeps DONE flags for each jobs
77             in order to avoid to perform resembling jobs multiple times.
78              
79             # Mark a job as DONE
80             $queue->redundancy_storage->{$job->digest} = 1;
81            
82             # Delete the mark
83             delete($queue->redundancy_storage->{$job->digest});
84              
85             =head1 METHODS
86              
87             This class inherits all methods from L class and
88             implements following new ones.
89              
90             =head2 dequeue
91              
92             Implementation for L interface.
93              
94             =head2 enqueue
95              
96             Implementation for L interface.
97              
98             =head2 length
99              
100             Implementation for L interface.
101              
102             =head2 next
103              
104             Implementation for L interface.
105              
106             =head2 requeue
107              
108             Implementation for L interface.
109              
110             =head2 shuffle
111              
112             Implementation for L interface.
113              
114             =head1 AUTHOR
115              
116             Keita Sugama, Esugama@jamadam.comE
117              
118             =head1 COPYRIGHT AND LICENSE
119              
120             Copyright (C) Keita Sugama.
121              
122             This program is free software; you can redistribute it and/or
123             modify it under the same terms as Perl itself.
124              
125             =cut