Module-Generic
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Module/Generic/SharedMemXS.pm view on Meta::CPAN
sub DESTROY
{
my $self = shift( @_ );
return unless( $self->{_ipc_shared} );
my $shm = $self->{_ipc_shared};
return if( $shm->id );
$self->unlock;
$self->detach;
my $rv = $self->remove_semaphore;
if( $self->destroy )
{
my $stat = $self->shmstat();
# number of processes attached to the associated shared memory segment.
if( defined( $stat ) && ( $stat->nattch() == 0 ) )
{
$self->remove;
}
}
};
sub FREEZE
{
my $self = CORE::shift( @_ );
my $serialiser = CORE::shift( @_ ) // '';
my $class = CORE::ref( $self );
my %hash = %$self;
CORE::delete( @hash{ qw( owner ) } );
$hash{_was_opened} = $self->{_ipc_shared} ? 1 : 0;
# Return an array reference rather than a list so this works with Sereal and CBOR
# On or before Sereal version 4.023, Sereal did not support multiple values returned
CORE::return( [$class, \%hash] ) if( $serialiser eq 'Sereal' && Sereal::Encoder->VERSION <= version->parse( '4.023' ) );
# But Storable want a list with the first element being the serialised element
CORE::return( $class, \%hash );
}
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
# NOTE: CBOR will call the THAW method with the stored classname as first argument, the constant string CBOR as second argument, and all values returned by FREEZE as remaining arguments.
# NOTE: Storable calls it with a blessed object it created followed with $cloning and any other arguments initially provided by STORABLE_freeze
sub THAW
{
my( $self, undef, @args ) = @_;
my $ref = ( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' ) ? CORE::shift( @args ) : \@args;
my $class = ( CORE::defined( $ref ) && CORE::ref( $ref ) eq 'ARRAY' && CORE::scalar( @$ref ) > 1 ) ? CORE::shift( @$ref ) : ( CORE::ref( $self ) || $self );
my $hash = CORE::ref( $ref ) eq 'ARRAY' ? CORE::shift( @$ref ) : {};
my $was_opened = CORE::delete( $hash->{_was_opened} );
my $new;
# Storable pattern requires to modify the object it created rather than returning a new one
if( CORE::ref( $self ) )
{
foreach( CORE::keys( %$hash ) )
{
$self->{ $_ } = CORE::delete( $hash->{ $_ } );
}
$new = $self;
}
else
{
$new = CORE::bless( $hash => $class );
}
if( $was_opened )
{
my $size = ( defined( $new->{size} ) && length( $new->{size} ) ) ? $new->{size} : SHM_BUFSIZ;
my $flags = ( defined( $new->{flags} ) && length( $new->{flags} ) ) ? $new->{flags} : &IPC::SysV::S_IRWXU;
$flags |= &IPC::SysV::IPC_CREAT if( defined( $new->{create} ) && $new->{create} );
my $key = $new->{key};
# try-catch
local $@;
eval
{
my $shm;
if( defined( $key ) && length( $key ) )
{
$key = $self->_str2key( $key );
$shm = IPC::SharedMem->new( $key, $size, $flags );
}
else
{
$shm = IPC::SharedMem->new( &IPC::SysV::IPC_PRIVATE, $size, $flags );
}
$new->{_ipc_shared} = $shm;
};
if( $@ )
{
return( $self->error( "Error creating a new IPC::SharedMem object: $@" ) );
}
my $sem;
# try-catch
local $@;
eval
{
$sem = IPC::Semaphore->new( $key, 3, $flags );
};
if( $@ )
{
return( $self->error( "Error creating a new IPC::Semaphore object: $@" ) );
}
if( !defined( $sem ) )
{
return( $self->error( "Unable to create semaphore with key \"", ( $key // '' ), "\" and flags \"$flags\": $!" ) );
}
$new->{_sem} = $sem;
}
CORE::return( $new );
}
END
{
foreach my $id ( @$SHEM_REPO )
{
my $s = $ID2OBJ->{ $id } || next;
next if( $s->removed || !$s->id || !$s->destroy );
$s->detach;
$s->remove;
}
};
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.379 second using v1.00-cache-2.02-grep-82fe00e-cpan-dad7e4baca0 )