package RFC::Cache;
#$Id: Cache.pm,v 1.8 2015/10/06 11:46:32 sqko Exp $
###############################################################
#
# Package RFC::Cache
#
# this module defines the RFC::Cache class. the RFC::Cache class is
# intended to be used for caching device data in conjunction with
# objects derived from RFC::BaseDevice.
# 
# A RFC::Cache object can be obtained by calling the constructor:
#
# my $id = RFC::Cache->new();
#
# All RFC::Cache objects has the following public member functions:
#
# $id->clear()        Clears all data content in the data cache.
# $id->dump()         Returns a data dump of the cached data (using
#                     Data::Dumper).
# $id->stat()         Returns some statistics for the cache (number of 
#                     hits as well and tries as well as a dump of the cache).
# $id->set(@)         Sets a data value to be cached. The first n 
#                     arguments must be key names and the last argument
#                     must be the value to be set.
#                     Example: set('ttyS0','icp','1',453.56)
#                     Note that all keys are converted to lower case to minimise
#                     typing errors!
# $id->get(@)         Returns the value asociated with the specified
#                     keys (using the example above, 
#                     get('ttyS0','icp','1') would return 453.56
#                     If a value is not found or the keys are not encountered
#                     in the correct order, it returns undef.
#                     Thus remember to check if the return value of get(@)
#                     is defined before it is used!
# $id->get_time(@)    Returns the time the data was set asociated with the specified
#                     keys (using the example above, 
#                     get('ttyS0','icp','1') would return something like 1444130488.2388
#                     If a value is not found or the keys are not encountered
#                     in the correct order, it returns undef.
#                     Thus remember to check if the return value of get_time(@)
#                     is defined before it is used!
#
##############################################################


use strict;
use warnings;
use Debug;
use Data::Dumper;
use Clone qw(clone);
use Time::HiRes;
our @ISA = qw(Debug);


BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.0;
    %EXPORT_TAGS = (
        'standard'=>[],
                    );
    Exporter::export_ok_tags('standard');
    Exporter::export_tags('standard');
    @ISA = qw(Exporter);
}

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new();
    $self->{'_count'} = 0;
    $self->{'_success'} = 0;
    $self->{'_data'} = {};
    bless $self,$class;
    return $self;
}

return 1;

### Public member functions ###

sub stat()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Cache attempts: '.$self->{'_count'};
    push @arr,'Cache hits: '.$self->{'_success'};
    my $hit = 0;
    $hit = sprintf("%.2f",$self->{'_success'} *100/$self->{'_count'}) if ($self->{'_count'});
    push @arr,'Hit rate: '.$hit.'%';
    push @arr,$self->dump();
    return join("\n",@arr);
}

sub dump()
{
    my $self = shift;
    my $val = Dumper %{$self->{'_data'}};
    $self->writedebug($val) if ($self->debug > 4);
    return $val;
}

sub clear()
{
    my $self = shift;
    $self->{'_data'} = {};
}


sub get
{
    my $self = shift;
    $self->{'_count'}++;;
    ## handle extra hash at root ###
    my $ref = $self->{'_data'};
    my $key = (keys(%{$ref}))[0]; 
    return undef unless ($key);
    my $data = $self->search($$ref{$key},@_);
    return $$data[0] if ($data && ref($data) eq 'ARRAY');
    return undef;
}

sub get_time
{
    my $self = shift;
    $self->{'_count'}++;;
    ## handle extra hash at root ###
    my $ref = $self->{'_data'};
    my $key = (keys(%{$ref}))[0]; 
    return undef unless ($key);
    my $data = $self->search($$ref{$key},@_);
    return $$data[1] if ($data && ref($data) eq 'ARRAY');
    return undef;
}

sub set
{
    my $self = shift;
    return $self->put($self->{'_data'},@_);
}


### Private member functions ###

sub put
{
    my $self = shift;
    my $ref = $self->{'_data'};
    while (@_ > 2)
    {
	my $key = lc(shift);
	if (!exists($$ref{$key}) || !ref($$ref{$key}))
	{
	    ## allow overwrite of simple scalar with hash as this will only invalidate one cached value ##
	    $self->writedebug("Creating hash with key $key") if ($self->debug > 4);
	    $$ref{$key} = {};
	}
	$ref = $$ref{$key};
    }
    $self->writedebug("Setting key") if ($self->debug > 4);
    my $key = lc(shift);
    my $val = shift;
    ## Data structure for actual data: Array with 2 elements: value and time.
    my @data = ($val,Time::HiRes::time);
    $self->die("key $key already set and value not an array reference!") if (exists($$ref{$key}) && ref($$ref{$key}) && ref($$ref{$key}) ne 'ARRAY');
    $$ref{$key} = \@data;
    return $$ref{$key}[0];
}

sub search
{
    my $self = shift;
    my $ref = shift;
    $self->writedebug("Getting data for ".join(', ',@_)) if ($self->debug > 4);
    while (@_)
    {
	my $key = lc(shift);
	if (ref($ref) && exists($$ref{$key}) && ref($$ref{$key}) eq 'ARRAY' && !@_)
	{
	    $self->{'_success'}++;
	    return $$ref{$key};
	}
	return undef unless (exists($$ref{$key}) && $$ref{$key} && ref($$ref{$key}) && ref($$ref{$key}) ne 'ARRAY');
	$ref = $$ref{$key};
    }
    return undef;
}

    

