view release on metacpan or  search on metacpan

lib/Apache2/SSI/Notes.pm  view on Meta::CPAN

    use Apache2::SSI::SharedMem ':all';
    our $VERSION = 'v0.1.3';
};

use strict;
use warnings;

sub init
{
    my $self = shift( @_ );
    $self->{key}  = 'ap2_ssi_notes';
    $self->{size} = MAX_SIZE;
    $self->{_init_strict_use_sub} = 1;
    $self->SUPER::init( @_ );
    return( $self->error( "Notes under this system $^O are unsupported." ) ) if( !Apache2::SSI::SharedMem->supported );
    my $mem = Apache2::SSI::SharedMem->new(
        key => ( length( $self->{key} ) ? $self->{key} : 'ap2_ssi_notes' ),
        # 512 Kb max
        size => $self->{size},
        # Create if necessary
        create => 1,
        debug => $self->debug,
    ) || return( $self->pass_error( Apache2::SSI::SharedMem->error ) );
    my $shem = $mem->open || return( $self->pass_error( $mem->error ) );
    $self->shem( $shem );
    return( $self );
};

sub add { return( shift->set( @_ ) ); }

sub clear
{
    my $self = shift( @_ );
    my $data = {};
    $self->write_mem( $data ) || return;
    return( $self );
}

sub do
{
    my $self = shift( @_ );
    my $code = shift( @_ );
    my @keys = @_;
    return( $self->error( "Code provided ($code) is not actually a code reference." ) ) if( ref( $code ) ne 'CODE' );
    my $data = $self->read_mem || return;
    @keys = sort( keys( %$data ) ) unless( scalar( @keys ) );
    local $@;
    foreach my $k ( @keys )
    {
        my $k_orig = $k;
        my $v = $data->{ $k };
        # try-catch
        eval
        {
            # Code can modify values in-place like:
            # sub
            # {
            #     $_[1] = 'new value' if( $_[0] eq 'some_key_name' );
            # }
            $code->( $k, $v );
            # Store possibly updated value
            $data->{ $k_orig } = $v;
        };
        if( $@ )
        {
            return( $self->error( "Callback died with error: $@" ) );
        }
    }
    # No need to bother if there was no keys in the first place
    if( scalar( @keys ) )
    {
        $self->write_mem( $data ) || return;
    }
    return( $self );
}

sub get
{
    my $self = shift( @_ );
    my $key;
    if( @_ )
    {
        $key = shift( @_ );
        return( $self->error( "Key provided to retrieve is empty." ) ) if( !length( $key ) );
    }
    my $data = $self->read_mem || return;
    # As it is the case for the first time, before any write
    $data = {} if( !ref( $data ) );
    return( $data ) if( !defined( $key ) );
    return( $data->{ $key } );
}

sub key { return( shift->_set_get_scalar( 'key', @_ ) ); }

sub read_mem
{
    my $self = shift( @_ );
    my $shem = $self->shem ||
        return( $self->error( "Oh no, the shared memory object is gone! That should not happen." ) );
    my $data;
    my $len = $shem->read( $data );
    return( $self->pass_error( $shem->error ) ) if( !defined( $len ) );
    $data = {} unless( ref( $data ) eq 'HASH' );
    return( $data );
}

sub remove
{
    my $self = shift( @_ );
    my $shem = $self->shem ||
        return( $self->error( "Oh no, the shared memory object is gone! That should not happen." ) );
    my $rv;
    if( !defined( $rv = $shem->remove ) )
    {
        return( $self->pass_error( $shem->error ) );
    }
    return( $rv );
}

sub set
{