view release on metacpan or  search on metacpan

lib/App/Chart/Series/Database.pm  view on Meta::CPAN

# Copyright 2007, 2008, 2009, 2010, 2011, 2012, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2023, 2024 Kevin Ryde

# This file is part of Chart.
#
# Chart is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3, or (at your option) any later version.
#
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Chart.  If not, see <http://www.gnu.org/licenses/>.

package App::Chart::Series::Database;
use 5.010;
use strict;
use warnings;
use Carp;
use Scalar::Util;

use App::Chart::Database;
use App::Chart::DBI;
use base 'App::Chart::Series::OHLCVI';

our $VERSION = 275;

use constant DEBUG => 0;

# %cache is keyed by symbol string, with value a App::Chart::Series::Database
# object.  The value reference is weakened so it becomes undef when
# otherwise unused.
#
our %cache = ();

sub _purge_cache_on_data_changed {
  my ($symbol_hash) = @_;
  if (DEBUG) {
    print "data-changed, purge series: ",
      join (', ', grep {exists $cache{$_}} keys %$symbol_hash),"\n";
  }
  delete @cache{keys %$symbol_hash}; # hash slice
}
use constant::defer _init_cache => sub {
  App::Chart::chart_dirbroadcast()->connect_first
      ('data-changed', \&_purge_cache_on_data_changed);
  return;
};

sub new {
  my ($class, $symbol) = @_;
  if (DEBUG) { print "Series new $symbol\n"; }

  my $self = $cache{$symbol};
  if ($self) { return $self; }

  my $base = App::Chart::DBI->read_single
    ('SELECT date FROM daily WHERE symbol=? ORDER BY date ASC LIMIT 1',
     $symbol);
  if (! $base) {
    require App::Chart::TZ;
    my $timezone = App::Chart::TZ->for_symbol ($symbol);
    $base = $timezone->iso_date;
  }
  if (DEBUG) { print "  base $base\n"; }
  require App::Chart::Timebase::Days;
  my $timebase = App::Chart::Timebase::Days->new_from_iso ($base);

  $self = $class->SUPER::new (symbol   => $symbol,
                              timebase => $timebase);

  # lose any cache entries which have gone undef through weaks destroyed
  delete @cache{grep {! $cache{$_}} keys %cache};

  # add new entry
  _init_cache();
  $cache{$symbol} = $self;
  Scalar::Util::weaken ($cache{$symbol});

  return $self;
}

sub hi {
  my ($self) = @_;
  if (! exists $self->{'hi'}) {
    if (DEBUG) { print "Series hi for $self->{'symbol'}\n"; }
    my $date = App::Chart::DBI->read_single
      ('SELECT date FROM daily WHERE symbol=? ORDER BY date DESC LIMIT 1',
       $self->{'symbol'});
    if (DEBUG) { print "  iso ",$date//'undef',"\n"; }
    my $timebase = $self->{'timebase'};
    $self->{'hi'} = ($date
                     ? $timebase->from_iso_floor ($date)
                     : 0);
    if (DEBUG) { print "  hi=$self->{'hi'}\n"; }
  }
  return $self->{'hi'};
}

sub fill_part {
  my ($self, $lo, $hi) = @_;
  if (DEBUG) { print "Database $self->{'symbol'} fill_part $lo $hi\n"; }

  my $dbh = App::Chart::DBI->instance;
  my $timebase = $self->{'timebase'};

  # date descending so first store pre-extends the respective arrays
  my $sth = $dbh->prepare_cached
    ('SELECT date, open, high, low, close, volume, openint
      FROM daily WHERE (symbol=? AND (date BETWEEN ? AND ?))
      ORDER BY date DESC');

  my $aref = $dbh->selectall_arrayref ($sth, undef,
                                       $self->{'symbol'},
                                       $timebase->to_iso ($lo),
                                       $timebase->to_iso ($hi));
  $sth->finish;

  my $opens    = $self->array('opens');
  my $highs    = $self->array('highs');
  my $lows     = $self->array('lows');
  my $closes   = $self->array('closes');
  my $volumes  = $self->array('volumes');
  my $openints = $self->array('openints');

  foreach my $row (@$aref) {
    my $i = $timebase->from_iso_floor ($row->[0]);
    next if ($i < 0);

    if (defined $row->[1]) { $opens->[$i]    = $row->[1]; }
    if (defined $row->[2]) { $highs->[$i]    = $row->[2]; }
    if (defined $row->[3]) { $lows->[$i]     = $row->[3]; }
    if (defined $row->[4]) { $closes->[$i]   = $row->[4]; }
    if (defined $row->[5]) { $volumes->[$i]  = $row->[5]; }
    if (defined $row->[6]) { $openints->[$i] = $row->[6]; }
  }
}