Cache-Historical-0.05/0000755000175000017500000000000011556020604014731 5ustar mschillimschilliCache-Historical-0.05/Makefile.PL0000644000175000017500000000215511411272401016700 0ustar mschillimschilli###################################################################### # Makefile.PL for Cache::Historical # 2007, Mike Schilli ###################################################################### use ExtUtils::MakeMaker; my $meta_merge = { META_MERGE => { resources => { repository => 'http://github.com/mschilli/cache-historical-perl', }, } }; WriteMakefile( 'NAME' => 'Cache::Historical', 'VERSION_FROM' => 'Historical.pm', # finds $VERSION 'PREREQ_PM' => { DBD::SQLite => 1.14, DBI => 0, Rose::DB => 0.735, Rose::DB::Object::Loader => 0.764, Log::Log4perl => 1, }, # e.g., Module::Name => 1.1 $ExtUtils::MakeMaker::VERSION >= 6.50 ? (%$meta_merge) : (), ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'Historical.pm', AUTHOR => 'Mike Schilli ') : ()), ); Cache-Historical-0.05/MANIFEST.SKIP0000644000175000017500000000012111555077740016635 0ustar mschillimschilli.git blib ^Makefile$ ^Makefile.old$ CVS .cvsignore docs MANIFEST.bak adm/release Cache-Historical-0.05/adm/0000755000175000017500000000000011556020603015471 5ustar mschillimschilliCache-Historical-0.05/adm/make_modules0000755000175000017500000000052011411272401020054 0ustar mschillimschilli#!/usr/bin/perl -w ########################################### # make_modules - Make .pms for Rose abstraction # Mike Schilli, 2007 (m@perlmeister.com) ########################################### use strict; use Sysadm::Install qw(:all); use Cache::Historical; my $c = Cache::Historical->new(); $c->make_modules( module_dir => "." ); Cache-Historical-0.05/adm/podok0000755000175000017500000000077311411272401016535 0ustar mschillimschilli#!/usr/bin/perl use Test::Pod; use Test::More; use File::Find; podok(@ARGV); 0; ################################################## sub podok { ################################################## my ($dir) = @_; $dir ||= "."; my @pms = (); File::Find::find( sub { return unless -f $_; return unless /\.pm$/; push @pms, "$File::Find::name"; }, $dir); my $nof_tests = scalar @pms; plan tests => $nof_tests; for(@pms) { pod_ok($_); } } Cache-Historical-0.05/MANIFEST0000644000175000017500000000033211556020604016060 0ustar mschillimschilliadm/make_modules adm/podok Changes Historical.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP README t/001Basic.t t/002Timing.t META.yml Module meta-data (added by MakeMaker) Cache-Historical-0.05/t/0000755000175000017500000000000011556020603015173 5ustar mschillimschilliCache-Historical-0.05/t/002Timing.t0000755000175000017500000000153711411272401017035 0ustar mschillimschilli#!/usr/bin/perl -w use strict; use Cache::Historical; use File::Temp qw(tempfile); use DateTime::Format::Strptime; use Test::More tests => 4; my($fh, $tmpfile) = tempfile( UNLINK => 1 ); unlink $tmpfile; # unlink so db gets initialized my $c = Cache::Historical->new( cache_dir => "/tmp", sqlite_file => $tmpfile, ); my $fmt = DateTime::Format::Strptime->new( pattern => "%Y-%m-%d"); $c->set( $fmt->parse_datetime("2008-01-02"), "msft", 35.22 ); my $upd = $c->last_update(); ok(time() - $upd->epoch() >= 0, "last update time (global)"); $upd = $c->last_update( "msft" ); ok(time() - $upd->epoch() >= 0, "last update time (per key)"); my $dur = $c->since_last_update(); ok($dur->seconds() >= 0, "since last update (global)"); $dur = $c->since_last_update( 'msft' ); ok($dur->seconds() >= 0, "since last update (per key)"); Cache-Historical-0.05/t/001Basic.t0000755000175000017500000000451311556020375016636 0ustar mschillimschilli#!/usr/bin/perl -w use strict; use Cache::Historical; use File::Temp qw(tempfile); use DateTime::Format::Strptime; use Test::More tests => 15; my($fh, $tmpfile) = tempfile( UNLINK => 1 ); unlink $tmpfile; # unlink so db gets initialized my $c = Cache::Historical->new( cache_dir => "/tmp", sqlite_file => $tmpfile, ); my $fmt = DateTime::Format::Strptime->new( pattern => "%Y-%m-%d"); $c->set( $fmt->parse_datetime("2008-01-03"), "msft", 35.37 ); $c->set( $fmt->parse_datetime("2008-01-02"), "msft", 35.22 ); sleep 1; # so the update time is never the same for all the rows $c->set( $fmt->parse_datetime("2008-01-04"), "msft", 34.38 ); $c->set( $fmt->parse_datetime("2008-01-07"), "msft", 34.61 ); #print "tempfile=$tmpfile", "\n"; is( $c->get( $fmt->parse_datetime("2008-01-03"), "msft"), 35.37, "get value" ); is( $c->get( $fmt->parse_datetime("2008-01-05"), "msft"), undef, "get undef value" ); my($from, $to) = $c->time_range( "msft" ); is("$from", "2008-01-02T00:00:00", "time range from"); is("$to", "2008-01-07T00:00:00", "time range to"); # interpolated is( $c->get_interpolated( $fmt->parse_datetime("2008-01-06"), "msft"), 34.38, "get interpolated value" ); is( $c->get_interpolated( $fmt->parse_datetime("2008-01-09"), "msft"), 34.61, "get interpolated value" ); is( $c->get_interpolated( $fmt->parse_datetime("2008-01-01"), "msft"), undef, "get interpolated value" ); is( $c->get_interpolated( $fmt->parse_datetime("2007-01-01"), "msft"), undef, "get interpolated value" ); is( $c->get_interpolated( $fmt->parse_datetime("2009-01-01"), "twx"), undef, "get interpolated value" ); $c->set( $fmt->parse_datetime("2008-01-02"), "twx", 35.22 ); # keys/values my @values = $c->values('msft'); my $str; for (@values) { my($dt, $val) = @$_; $str .= $dt->day() . " " . $val . " "; } is($str, "2 35.22 3 35.37 4 34.38 7 34.61 ", "values()"); my @keys = $c->keys(); is($keys[0], "msft", "keys()"); is($keys[1], "twx", "keys()"); # clear $c->clear("msft"); is( $c->get_interpolated( $fmt->parse_datetime("2009-01-01"), "msft"), undef, "get after clear" ); is( $c->get_interpolated( $fmt->parse_datetime("2008-01-02"), "twx"), 35.22, "get after clear" ); $c->clear(); is( $c->get_interpolated( $fmt->parse_datetime("2009-01-02"), "twx"), undef, "get after clear" ); Cache-Historical-0.05/Changes0000644000175000017500000000167111556020333016230 0ustar mschillimschilli###################################################################### Revision history for Perl extension Cache::Historical 0.05 (2011/04/27) (ms) Removed debugging leftover Data::HexDump. 0.04 (2011/04/24) (ms) Stringifying DateTime object in test suite to make it works with is() in perl-5.10.1 (ms) Applied patch by Niko Tyni to correct values() sort order (http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=615882) (ms) Fixed POD error reported by Mats Erik Andersson 0.03 2008/02/09 (ms) Using DB features for faster get_interpolated() now. (ms) Added missing keys() method and test cases for keys()/values() 0.02 2008/01/23 (ms) Fixed bug with since_last_update(), which didn't pass the key along to last_update(). (ms) Bumped up SQLite version number to 1.14 to get rid of 'closing dbh with active statement handles' warning. 0.01 2008/01/12 (ms) Where it all began. Cache-Historical-0.05/README0000644000175000017500000000723211556020603015614 0ustar mschillimschilli###################################################################### Cache::Historical 0.05 ###################################################################### NAME Cache::Historical - Cache historical values SYNOPSIS use Cache::Historical; my $cache = Cache::Historical->new(); # Set a key's value on a specific date $cache->set( $dt, $key, $value ); # Get a key's value on a specific date my $value = $cache->get( $dt, $key ); # Same as 'get', but if we don't have a value at $dt, but we # do have values for dates < $dt, return the previous # historic value. $cache->get_interpolated( $dt, $key ); DESCRIPTION Cache::Historical caches historical values by key and date. If you have something like historical stock quotes, for example 2008-01-02 msft 35.22 2008-01-03 msft 35.37 2008-01-04 msft 34.38 2008-01-07 msft 34.61 then you can store them in Cache::Historical like my $cache = Cache::Historical->new(); my $fmt = DateTime::Format::Strptime->new( pattern => "%Y-%m-%d"); $cache->set( $fmt->parse_datetime("2008-01-02"), "msft", 35.22 ); $cache->set( $fmt->parse_datetime("2008-01-03"), "msft", 35.37 ); $cache->set( $fmt->parse_datetime("2008-01-04"), "msft", 34.38 ); $cache->set( $fmt->parse_datetime("2008-01-07"), "msft", 34.61 ); and retrieve them later by date: my $dt = $fmt->parse_datetime("2008-01-03"); # Returns 35.37 my $value = $cache->get( $dt, "msft" ); Even if there's no value available for a given date, but there are historical values that predate the requested date, "get_interpolated()" will return the next best historical value: my $dt = $fmt->parse_datetime("2008-01-06"); # Returns undef, no value available for 2008-01-06 my $value = $cache->get( $dt, "msft" ); # Returns 34.48, the value for 2008-01-04, instead. $value = $cache->get_interpolated( $dt, "msft" ); Methods new() Creates the object. Takes the SQLite file to put the date into as an additional parameter: my $cache = Cache::Historical->new( sqlite_file => "/tmp/mydata.dat", ); The SQLite file defaults to $HOME/.cache-historical/cache-historical.dat so if you have multiple caches, you need to use different SQLite files. time_range() # List the time range for which we have values for $key my($from, $to) = $cache->time_range( $key ); keys() # List all keys my @keys = $cache->keys(); values() # List all the values we have for $key, sorted by date # ([$dt, $value], [$dt, $value], ...) my @results = $cache->values( $key ); clear() # Remove all values for a specific key $cache->clear( $key ); # Clear the entire cache $cache->clear(); last_update() # Return a DateTime object of the last update of a given key my $when = $cache->last_update( $key ); since_last_update() # Return a DateTime::Duration object since the time of the last # update of a given key. my $since = $cache->since_last_update( $key ); LEGALESE Copyright 2007-2011 by Mike Schilli, all rights reserved. This program is free software, you can redistribute it and/or modify it under the same terms as Perl itself. AUTHOR 2007, Mike Schilli Cache-Historical-0.05/META.yml0000664000175000017500000000137611556020604016213 0ustar mschillimschilli--- #YAML:1.0 name: Cache-Historical version: 0.05 abstract: Cache historical values author: - Mike Schilli license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: DBD::SQLite: 1.14 DBI: 0 Log::Log4perl: 1 Rose::DB: 0.735 Rose::DB::Object::Loader: 0.764 resources: repository: http://github.com/mschilli/cache-historical-perl no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Cache-Historical-0.05/Historical.pm0000644000175000017500000002156311556020351017376 0ustar mschillimschilli########################################### 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__ =head1 NAME Cache::Historical - Cache historical values =head1 SYNOPSIS use Cache::Historical; my $cache = Cache::Historical->new(); # Set a key's value on a specific date $cache->set( $dt, $key, $value ); # Get a key's value on a specific date my $value = $cache->get( $dt, $key ); # Same as 'get', but if we don't have a value at $dt, but we # do have values for dates < $dt, return the previous # historic value. $cache->get_interpolated( $dt, $key ); =head1 DESCRIPTION Cache::Historical caches historical values by key and date. If you have something like historical stock quotes, for example 2008-01-02 msft 35.22 2008-01-03 msft 35.37 2008-01-04 msft 34.38 2008-01-07 msft 34.61 then you can store them in Cache::Historical like my $cache = Cache::Historical->new(); my $fmt = DateTime::Format::Strptime->new( pattern => "%Y-%m-%d"); $cache->set( $fmt->parse_datetime("2008-01-02"), "msft", 35.22 ); $cache->set( $fmt->parse_datetime("2008-01-03"), "msft", 35.37 ); $cache->set( $fmt->parse_datetime("2008-01-04"), "msft", 34.38 ); $cache->set( $fmt->parse_datetime("2008-01-07"), "msft", 34.61 ); and retrieve them later by date: my $dt = $fmt->parse_datetime("2008-01-03"); # Returns 35.37 my $value = $cache->get( $dt, "msft" ); Even if there's no value available for a given date, but there are historical values that predate the requested date, C will return the next best historical value: my $dt = $fmt->parse_datetime("2008-01-06"); # Returns undef, no value available for 2008-01-06 my $value = $cache->get( $dt, "msft" ); # Returns 34.48, the value for 2008-01-04, instead. $value = $cache->get_interpolated( $dt, "msft" ); =head2 Methods =over 4 =item new() Creates the object. Takes the SQLite file to put the date into as an additional parameter: my $cache = Cache::Historical->new( sqlite_file => "/tmp/mydata.dat", ); The SQLite file defaults to $HOME/.cache-historical/cache-historical.dat so if you have multiple caches, you need to use different SQLite files. =item time_range() # List the time range for which we have values for $key my($from, $to) = $cache->time_range( $key ); =item keys() # List all keys my @keys = $cache->keys(); =item values() # List all the values we have for $key, sorted by date # ([$dt, $value], [$dt, $value], ...) my @results = $cache->values( $key ); =item clear() # Remove all values for a specific key $cache->clear( $key ); # Clear the entire cache $cache->clear(); =item last_update() # Return a DateTime object of the last update of a given key my $when = $cache->last_update( $key ); =item since_last_update() # Return a DateTime::Duration object since the time of the last # update of a given key. my $since = $cache->since_last_update( $key ); =back =head1 LEGALESE Copyright 2007-2011 by Mike Schilli, all rights reserved. This program is free software, you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR 2007, Mike Schilli