File Coverage

blib/lib/Cache/Memcached/Fast/Logger.pm

Criterion	Covered	Total	%
statement	6	35	17.1
branch	0	10	0.0
condition	0	13	0.0
subroutine	2	8	25.0
pod	2	4	50.0
total	10	70	14.2

package Cache::Memcached::Fast::Logger;

use strict;
use warnings;

our $VERSION = 0.15;

sub store_namespace (&$);

sub new {
    my ( $class, %opts ) = @_;

    $opts{namespace} ||= 'logger:';
    bless \%opts, $class;

    \%opts;
}

sub log {
    my ( $self, $log ) = @_;

    store_namespace {
	my $new_counter;

	warn "Cannot increment counter - maybe the connect to memcached was loosed"
	  if (   ! defined $self->{cache}->add( 'log_counter', "0" )
	      || ! defined ( $new_counter = $self->{cache}->incr('log_counter') )
	      || ! defined $self->{cache}->set( "log_" . $new_counter, $log ) );
    } $self;
}

sub read_all {
    my ( $self, $sub ) = @_;

    store_namespace {
	my $start = 0;
	my $cache = $self->{cache};
	my ( $log, $ret );

	TERMINATE: while (1) {
	    my ($lc) = $cache->gets('log_counter');
	    last unless defined $lc;

	    for ( my $i = $start; $i <= $lc->[1]; $i++ ) {
		$sub->($log) && ( $cache->delete("log_$i"), 1 ) || last TERMINATE
		  if ( defined( $log = $cache->get("log_$i") ) );
	    }

	    $ret = $cache->cas( 'log_counter', $lc->[0], "0" );
	    last if ! defined($ret) || $ret;

	    # If we are here so some other process has modified a log queue
	    # We try reparse queue again

	    $start = $lc->[1] + 1;
	}
    } $self;
}

sub store_namespace (&$) {
    my ( $code, $self ) = @_;

    my $old_namespace = $self->{cache}->namespace( $self->{namespace} );
    my $ret = eval { $code->() };

    my $error = $@;
    $self->{cache}->namespace( $old_namespace );
    die if $@;

    $ret;
}

1;
__END__