view release on metacpan or  search on metacpan

lib/Memoize/Expire/ByInstance.pm  view on Meta::CPAN

{

    package Memoize::Expire::ByInstance;
    use 5.006002;
    use warnings;
    use strict;
    use Time::HiRes qw(time);
    use Scalar::Util qw(weaken);
    use constant FILE_SEPERATOR => chr(0x1C);

    our $VERSION = 0.500005;

    ############################################################################################
    ## Tie the hash to this class. Support passing a HASH => \$hashref argument to permit
    ## chaining various tied-hashes together
    ############################################################################################
    sub TIEHASH
    {
        my ( $proto, %opts ) = @_;
        my $class = ref($proto) || $proto;

        my $default_lifetime = $opts{LIFETIME} || 0;
        my $default_num_uses = $opts{NUM_USES} || 0;

        my $self =
          { _meta => { _hash_data => {}, _expire => { _default => { lifetime => $default_lifetime, num_uses => $default_num_uses, }, }, } };
        $self->{_hash} = ( exists( $opts{HASH} ) && ref( $opts{HASH} ) eq 'HASH' ) ? $opts{HASH} : {};
        bless( $self, $class );

        # Memoize doesn't deal well with "memoize('Package::method', ...)"; hence it must be tied and memoized
        # in the same package that its used in... kinda annoying for unit testing... but handy in that I can use caller
        $self->__insert_destroy_wrapper( (caller)[0] ) if( $opts{AUTO_DESTROY} );
        $self->_argument_seperator( $opts{ARGUMENT_SEPERATOR} || FILE_SEPERATOR );

        return $self;
    }

    ############################################################################################
    ## Reset num_uses and last_set_time, and store the new value.
    ############################################################################################
    sub STORE
    {
        my ( $self, $key, $value ) = @_;
        ( my $instance_id, $key ) = $self->_split_instance($key);
        return unless($key);

        $self->{_meta}->{_hash_data}->{$key}->{last_set_time} = time();
        $self->{_meta}->{_hash_data}->{$key}->{num_uses}      = 0;

        $self->{_hash}->{$key} = $value;
        return $value;
    }

    ############################################################################################
    ## Increment num_uses, and return the value for the specified key
    ############################################################################################
    sub FETCH
    {
        my ( $self, $key ) = @_;
        ( my $instance_id, $key ) = $self->_split_instance($key);
        return unless($key);

        $self->{_meta}->{_hash_data}->{$key}->{num_uses}++;

        return $self->{_hash}->{$key};
    }

    ############################################################################################
    ## Return a true value if the key both exists AND has not expired for the instance fetching
    ## it
    ############################################################################################
    sub EXISTS
    {
        my ( $self, $key ) = @_;
        ( my $instance_id, $key ) = $self->_split_instance($key);
        return unless($key);

        return if( $self->_key_has_expired( $instance_id, $key ) );
        return ( exists( $self->{_hash}->{$key} ) );
    }

    ############################################################################################
    ## Delete a member from the hash
    ############################################################################################
    sub DELETE
    {
        my ( $self, $key ) = @_;
        ( my $instance_id, $key ) = $self->_split_instance($key);
        return unless($key);

        delete( $self->{_meta}->{_hash_data}->{$key} ) if( exists( $self->{_meta}->{_hash_data}->{$key} ) );
        return ( delete( $self->{_hash}->{$key} ) );