view release on metacpan or  search on metacpan

lib/DB/Object/Cache/Tables.pm  view on Meta::CPAN

## 
## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package DB::Object::Cache::Tables;
BEGIN
{
    use strict;
    use warnings;
    use parent qw( Module::Generic );
    use vars qw( $VERSION $EXCEPTION_CLASS );
    use JSON;
    use Fcntl qw( :flock );
    use Module::Generic::File qw( sys_tmpdir );
    our $EXCEPTION_CLASS = $DB::Object::EXCEPTION_CLASS;
    our $VERSION = 'v0.101.0';
};

use strict;
use warnings;

sub init
{
    my $self = shift( @_ );
    $self->{cache}              = {};
    $self->{cache_dir}          = sys_tmpdir();
    $self->{cache_file}         = "$self->{cache_dir}/sql_tables.json";
    $self->{timeout}            = 86400;
    $self->{_exception_class}   = $EXCEPTION_CLASS;
    $self->SUPER::init( @_ ) || return( $self->pass_error );
    $self->{updated} = '';
    $self->cache_dir( $self->{cache_dir} ) if( $self->{cache_dir} );
    $self->cache_file( $self->{cache_file} ) if( $self->{cache_file} );
    return( $self );
}

sub cache { return( shift->_set_get_hash( 'cache', @_ ) ); }

sub cache_dir
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $v = shift( @_ );
        $self->{cache_dir} = $v;
        $self->cache_file( "$v/sql_tables.json" );
    }
    return( $self->{cache_dir} );
}

sub cache_file
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $f = shift( @_ ) || return( $self->error( "No tables cache file path was provided." ) );
        # No change
        return( $f ) if( $f eq $self->{cache_file} );
        if( -e( $f ) )
        {
            my $mtime = ( stat( $f ) )[9];
            $self->updated( $mtime );
            my $hash = $self->read( $f ) || return;
            $self->cache( $hash );
        }
        $self->{cache_file} = $f;
    }
    return( $self->{cache_file} );
}

sub get
{
    my $self = shift( @_ );
    my $opts = {};
    $opts = shift( @_ ) if( @_ && $self->_is_hash( $_[0] => 'strict' ) );
    foreach my $k ( qw( host port driver ) )
    {
        return( $self->error( "Parameter \"$k\" is missing." ) ) if( !length( $opts->{ $k } ) );
    }
    my $cache = $self->cache;
    my $timeout = $self->timeout;
    my $part  = {};
    return( [] ) if( !exists( $cache->{ $opts->{host} }->{ $opts->{driver} }->{ $opts->{port} }->{ $opts->{database} }->{tables} ) );
    $part = $cache->{ $opts->{host} }->{ $opts->{driver} }->{ $opts->{port} }->{ $opts->{database} };
    my $ts = $part->{timestamp};
    return( $part->{tables} ) if( $opts->{ignore_ttl} || ( $ts && ( time() - $ts < $timeout ) ) );
    return( [] );
}

sub read
{
    my $self = shift( @_ );
    my $tables_cache_file = shift( @_ ) || $self->cache_file || return( {} );
    $tables_cache_file = $self->new_file( $tables_cache_file );
    my $hash = {};
    my $j = JSON->new->relaxed;
    if( $tables_cache_file->exists && !$tables_cache_file->is_empty )
    {
        $hash = $tables_cache_file->load_json ||
            warn( "An error occured while decoding json data from the table cache file: ", $tables_cache_file->error );
    }
    return( $hash );
}

sub set
{
    my $self = shift( @_ );
    my $hash = shift( @_ ) || return( $self->error( "No hash reference was provided to add to tables cache." ) );
    return( $self->error( "Hash reference provided for tables cache ($hash) is not a hash reference." ) ) if( !$self->_is_hash( $hash => 'strict' ) );
    foreach my $k ( qw( host port driver tables ) )
    {
        return( $self->error( "Tables cache provided is missing the \"$k\" key." ) ) if( !length( $hash->{ $k } ) );
    }
    return( $self->error( "\"tables\" property in cache data is not an array reference." ) ) if( !$self->_is_array( $hash->{tables} ) );
    ## Possibly reload the cache if the modification date changed
    my $cache = $self->cache;
    my $f = $self->cache_file;
    my $last_update = $self->updated;
    if( -s( $f ) && $last_update && ( stat( $f ) )[9] != $last_update )
    {
        $cache = $self->read( $f ) || return;
    }
    $cache->{ $hash->{host} }->{ $hash->{driver} }->{ $hash->{port} }->{ $hash->{database} } = {} if( ref( $cache->{ $hash->{host} }->{ $hash->{driver} }->{ $hash->{port} }->{ $hash->{database} } ) ne 'HASH' );
    $cache->{ $hash->{host} }->{ $hash->{driver} }->{ $hash->{port} }->{ $hash->{database} }->{tables} = $hash->{tables};
    $cache->{ $hash->{host} }->{ $hash->{driver} }->{ $hash->{port} }->{ $hash->{database} }->{timestamp} = time();
    if( !defined( $self->write( $cache ) ) )
    {
        return;
    }
    return( $self );
}

sub timeout { return( shift->_set_get_number( 'timeout', @_ ) ); }

sub updated { return( shift->_set_get_number( 'updated', @_ ) ); }

sub write
{
    my $self = shift( @_ );
    my $hash = shift( @_ ) || return( $self->error( "No table cache data was provided to write to cache file \"", $self->cache_file, "\"." ) );
    my $tables_cache_file = shift( @_ ) || $self->cache_file || return( $self->error( "No cache file was set to write data to it." ) );
    $tables_cache_file = $self->new_file( $tables_cache_file );
    return( $self->error( "Tables cache data provided is not an hash reference." ) ) if( ref( $hash ) ne 'HASH' );
    $tables_cache_file->unload_json( $hash ) ||
        return( $self->pass_error( $tables_cache_file->error ) );
    $self->updated( $tables_cache_file->finfo->mtime );
    return( -s( $tables_cache_file ) );
}

1;
# NOTE: POD
__END__

=encoding utf-8

=head1 NAME

DB::Object::Cache::Tables - Table Cache

=head1 SYNOPSIS

    my $cache = DB::Object::Cache::Tables->new({
        timeout => 86400,
        # This is automatically set
        # cache_file => '/some/dir/sql_tables.json',
    });
    $dbh->cache_tables( $cache_tables );
    $tables = $dbh->tables_info;
    my $cache = 
    {
    host => $host,
    driver => $driver,
    port => $port,
    database => $database,
    tables => $tables,
    };
    if( !defined( $cache->set( $cache ) ) )
    {
        warn( "Unable to write to tables cache: ", $cache->error, "\n" );