view release on metacpan or  search on metacpan

lib/Module/Generic/File/Cache.pm  view on Meta::CPAN

    my $j = JSON->new->utf8->relaxed->allow_nonref->convert_blessed;
    # try-catch
    local $@;
    my $encoded = eval
    {
        $j->encode( $ref );
    };
    if( $@ )
    {
        return( $self->error( "An error occurred while trying to JSON encode data: $@" ) );
    };
    return( $encoded );
}

sub _fill
{
    my $self = shift( @_ );
    my $size = shift( @_ );
    my $file = shift( @_ ) || return( $self->error( "No file was provided." ) );
    return( $self->error( "Cache file found in our object is not a Module::Generic::File object." ) ) if( !$self->_is_a( $file => 'Module::Generic::File' ) );
    # The cache file does not exists; maybe it has been removed by a destroyed process ?
    if( !$file->exists )
    {
        $self->removed(1);
        return(0);
    }
    return( $self->error( "Size value provided ($size) is not an integer." ) ) if( $size !~ /^\d+$/ );
    return(1) if( $size <= 0 );
    return( $self->error( "File provided is not a Module::Generic::File file object." ) ) if( !$self->_is_a( $file => 'Module::Generic::File' ) );
    $file->seek(0,0);
    my $minimum = 32;
    my $range = 96;
    for( my $bytes = 0; $bytes < $size; $bytes += 4 )
    {
        my $rand = int( CORE::rand( $range ** 4 ) );
        my $string = '';
        for( 1..4 )
        {
            $string .= chr( $rand % $range + $minimum );
            $rand = int( $rand / $range );
        }
        $file->print( $string ) || return( $self->pass_error( $file->error ) );
    }
    $file->truncate( $file->tell );
    return(1);
}

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

sub _str2key
{
    my $self = shift( @_ );
    my $key  = shift( @_ );
    no strict 'subs';
    if( !defined( $key ) || $key eq '' )
    {
        return( Data::UUID->new->create_str );
    }
    # We do not actually use any path, but this is for standardisation with Module::Generic::SharedMem
    my $path;
    ( $key, $path ) = ref( $key ) eq 'ARRAY' ? @$key : ( $key, [getpwuid($>)]->[7] );
    $path = [getpwuid($path)]->[7] if( $path =~ /^\d+$/ );
    if( $key =~ /^\d+$/ )
    {
        my $id = $self->ftok( $key ) ||
            return( $self->error( "Unable to get a key using IPC::SysV::ftok: $!" ) );
        return( $id );
    }
    else
    {
        my $id = 0;
        $id += $_ for( unpack( "C*", $key ) );
        my $val = $self->ftok( $id );
        return( $val );
    }
}

sub DESTROY
{
    # <https://perldoc.perl.org/perlobj#Destructors>
    CORE::local( $., $@, $!, $^E, $? );
    CORE::return if( ${^GLOBAL_PHASE} eq 'DESTRUCT' );
    my $self = CORE::shift( @_ );
    CORE::return if( !CORE::defined( $self ) );
    CORE::return unless( CORE::exists( $self->{_cache_file} ) && CORE::defined( $self->{_cache_file} ) && CORE::length( $self->{_cache_file} ) );
    my $prefix = __PACKAGE__ . '::DESTROY';
    my $cache_file;
    $cache_file = $self->{_cache_file} if( CORE::length( $self->{_cache_file} ) );
    CORE::return if( !defined( $cache_file ) || !$self->_is_a( $cache_file => 'Module::Generic::File' ) );
    my $fname = "$cache_file";
    print( STDERR "\t${prefix}: Destroying object with cache file \"${fname}\"\n" ) if( $DEBUG >= 4 );
    $self->unlock;

    my $class         = CORE::ref( $self );
    my $repo          = Module::Generic::Global->new( 'cache' => $class, key => $class );
    my $file2obj_repo = Module::Generic::Global->new( 'file2object_repo' => $class, key => $class );
    $file2obj_repo->lock;
    my $f2o_data = $file2obj_repo->get;
    if( defined( $f2o_data ) && ref( $f2o_data // '' ) eq 'HASH' )
    {
        my $ref = $f2o_data->{ $fname };

        if( defined( $ref ) && ref( $ref // '' ) eq 'ARRAY' )
        {
            printf( STDERR "\t${prefix}: %d objects found for cache file \"${fname}\"\n", scalar( @$ref ) ) if( $DEBUG >= 4 );
            my $addr = Scalar::Util::refaddr( $self );
            for( my $i = 0; $i <= $#$ref; $i++ )
            {
                if( $ref->[$i] eq $addr )
                {
                    splice( @$ref, $i, 1 );
                    $i--;
                }
            }
            if( !scalar( @$ref ) )
            {
                CORE::delete( $f2o_data->{ $fname } );
            }
        }
        else
        {
            CORE::delete( $f2o_data->{ $fname } );