view release on metacpan or  search on metacpan

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

##----------------------------------------------------------------------------
## Apache2 Server Side Include Parser - ~/lib/Apache2/SSI/Notes.pm
## Version v0.1.3
## Copyright(c) 2024 DEGUEST Pte. Ltd.
## Author: Jacques Deguest <jack@deguest.jp>
## Created 2021/01/18
## Modified 2025/03/22
## All rights reserved
## 
## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package Apache2::SSI::Notes;
BEGIN
{
    use strict;
    use warnings;
    use warnings::register;
    use parent qw( Module::Generic );
    use vars qw( $VERSION );
    # 512Kb
    use constant MAX_SIZE => 524288;
    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 );