File Coverage

blib/lib/CHI/Cascade/Value.pm

Criterion	Covered	Total	%
statement	34	45	75.5
branch	4	10	40.0
condition	3	5	60.0
subroutine	10	12	83.3
pod	4	6	66.6
total	55	78	70.5

package CHI::Cascade::Value;

use strict;
use warnings;

my %states = (
    # value = undef                     -> no in cache
    CASCADE_NO_CACHE                    => 1 << 0,

    # value = undef | old_value         -> other process is computing this target or its any dependencies
    CASCADE_COMPUTING                   => 1 << 1,

    # value = undef | old_value         -> recomputing is deferred
    CASCADE_DEFERRED                    => 1 << 2,

    # value = old_value | actual_value  -> the value from cache (not computed now)
    CASCADE_FROM_CACHE                  => 1 << 3,

    # value = actual_value              -> this value is actual
    CASCADE_ACTUAL_VALUE                => 1 << 4,

    # value = actual_value & recomuted now      -> this value is recomputed right now
    CASCADE_RECOMPUTED                  => 1 << 5,

    # value = undef | old_value | value passed by exception -> code of target or code of any dependencies has raised an exception
    CASCADE_CODE_EXCEPTION              => 1 << 6,

    # value = old_value | actual_value - value may be actual or not but actual term isn valid (only if 'run' is run with 'actual_term' option)
    CASCADE_ACTUAL_TERM                 => 1 << 7,

    # Some dependencies are affected for recomputing, but no recomputing now - only TTL period and value from cache
    CASCADE_TTL_INVOLVED                => 1 << 8
);

for ( keys %states ) {
    no strict 'refs';
    no warnings 'redefine';

    my $bit = $states{$_};

    *{ $_ } = sub () { $bit }
}


use parent 'Exporter';

{
    no strict 'refs';

    our %EXPORT_TAGS = (
        state           => [ map { "$_" } grep { /^CASCADE_/ && *{$_}{CODE} } keys %{ __PACKAGE__ . "::" } ]
    );
    Exporter::export_ok_tags( keys %EXPORT_TAGS );
}

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

    my $self = bless { %opts }, ref($class) || $class;

    $self->{state} ||= 0;

    $self;
}

sub is_value {
    shift->{is_value};
}

sub state {
    my $self = shift;

    if (@_) {
        $self->{state} |= $_[0];
        return $self;
    }
    $self->{state};
}

sub state_as_str {
    my $state = $_[1];

    return '' if ! $state;

    my @names;

    for ( keys %states ) {
        push @names, $_
          if ( $state & $states{$_} );
    }

    join( " | ", sort @names );
}

sub value {
    my $self = shift;

    if (@_) {
        $self->{is_value} = 1;
        $self->{value} = $_[0];
        return $self;
    }
    $self->{value};
}

sub thrown_from_code {
    my $self = shift;

    if (@_) {
        $self->{thrown_from_code} = $_[0];
        return $self;
    }
    $self->{thrown_from_code};
}

1;

__END__