File Coverage

blib/lib/Cache/Historical.pm

Criterion	Covered	Total	%
statement	105	111	94.5
branch	15	22	68.1
condition			n/a
subroutine	20	21	95.2
pod	7	13	53.8
total	147	167	88.0

###########################################
package Cache::Historical;
###########################################
use strict;
use warnings;
use Rose::DB::Object::Loader;
use File::Basename;
use File::Path;
use Log::Log4perl qw(:easy);
use DBI;
use DateTime::Format::Strptime;

our $VERSION = "0.05";

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my($home)     = glob "~";
    my $default_cache_dir = "$home/.cache-historical";

    my $self = {
        sqlite_file => "$default_cache_dir/cache-historical.dat",
        %options,
    };

    my $cache_dir = dirname( $self->{sqlite_file} );

    if(! -d $cache_dir ) {
        mkpath [ $cache_dir ] or
            die "Cannot mktree $cache_dir ($!)";
    }

    bless $self, $class;

    $self->{dsn} = "dbi:SQLite:dbname=$self->{sqlite_file}";

    if(! -f $self->{sqlite_file}) {
        $self->db_init();
    }

    my $loader =
    Rose::DB::Object::Loader->new(
        db_dsn        => $self->{dsn},
        db_options    => { AutoCommit => 1, RaiseError => 1 },
        class_prefix  => 'Cache::Historical',
        with_managers => 1,
    );

    $loader->make_classes();

    $self->{loader} = $loader;

    return $self;
}

###########################################
sub make_modules {
###########################################
    my($self, @options) = @_;

    DEBUG "Making modules in @options";
    $self->{loader}->make_modules( @options );
}

###########################################
sub dbh {
###########################################
    my($self) = @_;

    if(! $self->{dbh} ) {
        $self->{dbh} = DBI->connect($self->{dsn}, "", "");
    }

    return $self->{dbh};
}

###########################################
sub db_init {
###########################################
    my($self) = @_;

    my $dbh = $self->dbh();

    DEBUG "Creating new SQLite db $self->{sqlite_file}";

    $dbh->do(<<'EOT');
CREATE TABLE vals (
  id       INTEGER PRIMARY KEY,
  date     DATETIME,
  upd_time DATETIME,
  key      TEXT,
  value    TEXT,
  UNIQUE(date, key)
);
EOT

    $dbh->do(<<'EOT');
CREATE INDEX vals_date_idx ON vals(date);
EOT

    $dbh->do(<<'EOT');
CREATE INDEX vals_key_idx ON vals(key);
EOT

    return 1;
}

###########################################
sub set {
###########################################
    my($self, $dt, $key, $value) = @_;

    DEBUG "Setting $dt $key => $value";

    my $r = Cache::Historical::Val->new();
    $r->key( $key );
    $r->date( $dt );
    $r->upd_time( DateTime->now() );
    $r->load( speculative => 1 );
    $r->value( $value );
    $r->save();
}

###########################################
sub get {
###########################################
    my($self, $dt, $key, $interpolate) = @_;

    my @date_query = (date => $dt);
    @date_query = (date => {le => $dt}) if $interpolate;

    my $values = Cache::Historical::Val::Manager->get_vals(
        query => [
          @date_query,
          key   => $key,
        ],
        sort_by  => "date DESC",
        limit => 1,
    );

    if(@$values) {
        my $value = $values->[0]->value();
        DEBUG "Getting $dt $key => $value";
        return $value;
    }

    return undef;
}

###########################################
sub keys {
###########################################
    my($self) = @_;

    my @keys;
    my $keys = Cache::Historical::Val::Manager->get_vals(
        distinct => 1,
        select   => [ 'key' ],
    );

    for(@$keys) {
        push @keys, $_->key();
    }

    return @keys;
}

###########################################
sub values {
###########################################
    my($self, $key) = @_;

    my @values = ();
    my @key = ();
    @key = (key => $key) if defined $key;

    my $values = Cache::Historical::Val::Manager->get_vals(
        query => [ @key ],
        sort_by => ['date'],
    );

    for(@$values) {
        push @values, [$_->date(), $_->value()];
    }

    return @values;
}

###########################################
sub last_update {
###########################################
    my($self, $key) = @_;

    my @key = ();
    @key = (key => $key) if defined $key;

    my $values = Cache::Historical::Val::Manager->get_vals(
        query => [ @key ],
        sort_by => ['upd_time DESC'],
        limit   => 1,
    );

    if(@$values) {
        my $date = $values->[0]->upd_time();
        return $date;
    }

    return undef;
}

###########################################
sub since_last_update {
###########################################
    my($self, $key) = @_;

    my $date = $self->last_update($key);

    if(defined $date) {
        return DateTime->now() - $date;
    }

    return undef;
}

###########################################
sub get_interpolated {
###########################################
    my($self, $dtp, $key) = @_;

    return $self->get($dtp, $key, 1);
}

my $date_fmt = DateTime::Format::Strptime->new(
                  pattern => "%Y-%m-%d %H:%M:%S");

###########################################
sub time_range {
###########################################
    my($self, $key) = @_;

    my $dbh = $self->dbh();

    my($from, $to) = $dbh->selectrow_array(
       "SELECT MIN(date), MAX(date) FROM vals WHERE key = " .
       $dbh->quote( $key ));

    $from = $date_fmt->parse_datetime( $from );
    $to   = $date_fmt->parse_datetime( $to );

    return($from, $to);
}

###########################################
sub clear {
###########################################
    my($self, $key) = @_;

    my @params = (all => 1);

    if(defined $key) {
        @params = ("where" => [ key => $key ]);
    }

    my $values = Cache::Historical::Val::Manager->delete_vals( @params );
}

1;

__END__