Apache2-SSI

 view release on metacpan or  search on metacpan

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

    $self->{exclusive}  = 0;
    $self->{key}        = &IPC::SysV::IPC_PRIVATE;
    $self->{mode}       = 0666;
    $self->{serial}     = '';
    # SHM_BUFSIZ
    $self->{size}       = SHM_BUFSIZ;
    $self->{_init_strict_use_sub} = 1;
    $self->SUPER::init( @_ ) || return;
    $self->{addr}       = undef();
    $self->{id}         = undef();
    $self->{locked}     = 0;
    $self->{owner}      = $$;
    $self->{removed}    = 0;
    $self->{semid}      = undef();
    return( $self );
}

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

sub attach
{

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

}

sub lock
{
    my $self = shift( @_ );
    my $type = shift( @_ );
    my $timeout = shift( @_ );
    # $type = LOCK_EX if( !defined( $type ) );
    $type = LOCK_SH if( !defined( $type ) );
    return( $self->unlock ) if( ( $type & LOCK_UN ) );
    return( 1 ) if( $self->locked & $type );
    $timeout = 0 if( !defined( $timeout ) || $timeout !~ /^\d+$/ );
    # If the lock is different, release it first
    $self->unlock if( $self->locked );
    my $semid = $self->semid ||
        return( $self->error( "No semaphore id set yet." ) );
    local $@;
    # try-catch
    my $rv = eval
    {
        local $SIG{ALRM} = sub{ die( "timeout" ); };
        alarm( $timeout );
        my $rc = $self->op( @{$SEMOP_ARGS->{ $type }} );
        alarm(0);
        return( $rc );
    };
    if( $@ )
    {
        return( $self->error( "Unable to set a lock: $@" ) );
    }
    if( $rv )
    {
        $self->locked( $type );
    }
    else
    {
        return( $self->error( "Failed to set a lock on semaphore id \"$semid\": $!" ) );
    }
    return( $self );
}

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

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

sub op
{
    my $self = shift( @_ );
    return( $self->error( "Invalid number of argument: '", join( ', ', @_ ), "'." ) ) if( @_ % 3 );
    my $data = pack( "s$N*", @_ );
    my $id = $self->semid;
    return( $self->error( "No semaphore set yet. You must open the shared memory first to set the semaphore." ) ) if( !length( $id ) );

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

            return( Apache2::SSI::SemStat->new->unpack( $data ) );
        }
    }
}

sub supported { return( $SYSV_SUPPORTED ); }

sub unlock
{
    my $self = shift( @_ );
    return( 1 ) if( !$self->locked );
    my $semid = $self->semid;
    return( $self->error( "No semaphore set yet. You must open the shared memory first to unlock semaphore." ) ) if( !length( $semid ) );
    my $type = $self->locked | LOCK_UN;
    $type ^= LOCK_NB if( $type & LOCK_NB );
    if( defined( $self->op( @{$SEMOP_ARGS->{ $type }} ) ) )
    {
        $self->locked( 0 );
    }
    return( $self );
}

sub write
{
    my $self = shift( @_ );
    my $data = ( @_ == 1 ) ? shift( @_ ) : join( '', @_ );
    my $id   = $self->id();
    my $size = int( $self->size() ) || SHM_BUFSIZ;

lib/Apache2/SSI/SharedMem.pod  view on Meta::CPAN

    my $id = $s->id;

    my $key = $s->key;

    # Get the actual key used in interacting with shared memory
    # You should not mess with this unless you know what you are doing
    my $shem_key = $s->serial;

    use Apache2::SSI::SharedMem qw( :all );
    $s->lock( LOCK_EX ) || die( $s->error );
    # Is it locked?
    my $is_locked = $s->locked;

    # example: 0666
    my $mode = $s->mode;
    my $s = $shmem->open || die( $shmem->error );

    # Actually the process pid
    my $owner = $s->owner;

    # The semaphore pid
    my $sempid = $s->pid;

lib/Apache2/SSI/SharedMem.pod  view on Meta::CPAN

=head2 lock

It takes an optional bitwise lock value, and defaults to C<LOCK_SH> if none is provided and issues a lock on the shared memory.

    use Apache2::SSI::SharedMem qw( :all );
    my $s = $shem->open || die( $shmem->error );
    $s->lock( LOCK_EX );
    # Do something
    $s->unlock;

=head2 locked

Returns a positive value when a lock is active or 0 when there is no active lock.

The value is the bitwise value of the lock used.

=head2 mode

Sets or gets the mode for the shared memory as used by L</open>

    $shmem->mode( 0666 );

t/80.notes.t  view on Meta::CPAN

        fail( 'shared data with separate process' );
    }
    my $data = $s->read;
    ok( ref( $data ) eq 'HASH', 'shared updated data type' );
    ok( $data->{year} == 2021, 'updated data value' );
    my $data2;
    $s->read( $data2 );
    ok( ref( $data2 ) eq 'HASH', 'different read usage' );
    ok( $data2->{year} == 2021, 'different read data check' );
    ok( defined( $s->lock ), 'lock' );
    ok( $s->locked, 'locked' );
    $data->{test} = 'ok';
    ok( defined( $s->write( $data ) ), 'updated data with lock' );
    ok( defined( $s->unlock ), 'unlock' );
    ok( defined( $s->remove ), 'remove' );
    ok( !$s->exists, 'exists after remove' );

    ## Notes

    my $n = Apache2::SSI::Notes->new( debug => $DEBUG, key => 'test_notes' );
    isa_ok( $n, 'Apache2::SSI::Notes' );