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

package Queue::Q::ReliableFIFO::Item;
use strict;
use warnings;

use Class::XSAccessor {getters => ['_serialized']};

# for reasons of debugging, JSON is easier, while Sereal::* is
# faster (about 7%) and delivers smaller serialized blobs.
use JSON::XS; # use the real stuff, no fall back on pure Perl JSON please
my $serializer   = JSON::XS->new->utf8->pretty(0);
my $deserializer = JSON::XS->new->utf8->pretty(0);

#use Sereal::Encoder;
#use Sereal::Decoder;
#my $serializer   = Sereal::Encoder->new();
#my $deserializer = Sereal::Decoder->new();

my @item_info = (
    't',        # time the item was created
    'rc',       # requeue counter (how often the item is requeued)
    'fc',       # fail counter (how often the item reached max-requeue)
    'error',    # last error message
);

sub new {
    my $class = shift;
    my $self = bless { @_ }, $class;

    die "'data' or '_serialized' named parameters required for constructor"
        if not exists $self->{data} and not exists $self->{_serialized};

    if (not exists $self->{_serialized}) {
        $self->{_serialized} ||=
            $serializer->encode({
                t => time(),
                b => $self->{data}
             });
    }
    return $self;
}

sub _get {
    my ($self, $elem) = @_;
    $self->_deserialize
        if not exists $self->{data};
    return $self->{$elem};
}

sub time_created  { $_[0]->_get('t_created') || $_[0]->_get('t') }
sub time_queued   { $_[0]->_get('t') }
sub data          { $_[0]->_get('data') }
sub requeue_count { $_[0]->_get('rc') || 0 }
sub fail_count    { $_[0]->_get('fc') || 0 }
sub last_error    { $_[0]->_get('error') }

sub inc_nr_requeues {
    my $self = shift;
    my $plain = $deserializer->decode($self->{_serialized});
    $self->{rc} = ++$plain->{rc};
    $self->{_serialized} =  $serializer->encode($plain);
    return $self->{rc};
}

sub _deserialize {
    my $self = shift;
    my $plain = $deserializer->decode($self->{_serialized});
    $self->{data} = $plain->{b};
    for my $k (@item_info) {
        if (exists $plain->{$k}) {
            $self->{$k} = $plain->{$k};
        }
        else {
            delete $self->{$k};
        }
    }
}
1;
__END__