File Coverage

blib/lib/Queue/Q/ReliableFIFO/Item.pm
Criterion Covered Total %
statement 12 39 30.7
branch 0 14 0.0
condition 0 6 0.0
subroutine 4 14 28.5
pod 8 8 100.0
total 24 81 29.6


line stmt bran cond sub pod time code
1             package Queue::Q::ReliableFIFO::Item;
2 1     1   5 use strict;
  1         2  
  1         24  
3 1     1   5 use warnings;
  1         10  
  1         30  
4              
5 1     1   663 use Class::XSAccessor {getters => ['_serialized']};
  1         2619  
  1         8  
6              
7             # for reasons of debugging, JSON is easier, while Sereal::* is
8             # faster (about 7%) and delivers smaller serialized blobs.
9 1     1   1161 use JSON::XS; # use the real stuff, no fall back on pure Perl JSON please
  1         5766  
  1         527  
10             my $serializer = JSON::XS->new->utf8->pretty(0);
11             my $deserializer = JSON::XS->new->utf8->pretty(0);
12              
13             #use Sereal::Encoder;
14             #use Sereal::Decoder;
15             #my $serializer = Sereal::Encoder->new();
16             #my $deserializer = Sereal::Decoder->new();
17              
18             my @item_info = (
19             't', # time the item was created
20             'rc', # requeue counter (how often the item is requeued)
21             'fc', # fail counter (how often the item reached max-requeue)
22             'error', # last error message
23             );
24              
25             sub new {
26 0     0 1   my $class = shift;
27 0           my $self = bless { @_ }, $class;
28              
29             die "'data' or '_serialized' named parameters required for constructor"
30 0 0 0       if not exists $self->{data} and not exists $self->{_serialized};
31              
32 0 0         if (not exists $self->{_serialized}) {
33             $self->{_serialized} ||=
34             $serializer->encode({
35             t => time(),
36             b => $self->{data}
37 0   0       });
38             }
39 0           return $self;
40             }
41              
42             sub _get {
43 0     0     my ($self, $elem) = @_;
44             $self->_deserialize
45 0 0         if not exists $self->{data};
46 0           return $self->{$elem};
47             }
48              
49 0 0   0 1   sub time_created { $_[0]->_get('t_created') || $_[0]->_get('t') }
50 0     0 1   sub time_queued { $_[0]->_get('t') }
51 0     0 1   sub data { $_[0]->_get('data') }
52 0 0   0 1   sub requeue_count { $_[0]->_get('rc') || 0 }
53 0 0   0 1   sub fail_count { $_[0]->_get('fc') || 0 }
54 0     0 1   sub last_error { $_[0]->_get('error') }
55              
56             sub inc_nr_requeues {
57 0     0 1   my $self = shift;
58 0           my $plain = $deserializer->decode($self->{_serialized});
59 0           $self->{rc} = ++$plain->{rc};
60 0           $self->{_serialized} = $serializer->encode($plain);
61 0           return $self->{rc};
62             }
63              
64             sub _deserialize {
65 0     0     my $self = shift;
66 0           my $plain = $deserializer->decode($self->{_serialized});
67 0           $self->{data} = $plain->{b};
68 0           for my $k (@item_info) {
69 0 0         if (exists $plain->{$k}) {
70 0           $self->{$k} = $plain->{$k};
71             }
72             else {
73 0           delete $self->{$k};
74             }
75             }
76             }
77             1;
78             __END__