view release on metacpan or  search on metacpan

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

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

# uncomment this to run the ### lines
#use Smart::Comments;

sub longname  { __('Adjustments') }
sub shortname { __('Adj') }
sub manual    { __p('manual-node','Dividends and Splits') }

use constant { type      => 'special',
               parameter_info => [ { name => __('Splits'),
                                     key  => 'adj_splits',
                                     type => 'boolean',
                                     default => 1 },

                                   { name => __('Divs'),
                                     key  => 'adj_dividends',
                                     type => 'boolean',
                                     default => 1 },

                                   { name => __('Imp'),
                                     key  => 'adj_imputation',
                                     type => 'boolean',
                                     default => 1 },

                                   { name => __('Roll'),
                                     key  => 'adj_rollovers',
                                     type => 'boolean',
                                     default => 0 }],
             };

sub name {
  my ($self) = @_;
  return __x('{parent} - Adj {list}',
             parent => $self->{'parent'}->name,
             list =>
             join (',',
                   ($self->{'adjust_splits'}    ? __('Splits') : ()),
                   ($self->{'adjust_dividends'} ? __('Divs') : ()),
                   ($self->{'adjust_dividends'} && $self->{'adjust_imputation'}
                    ? __('Imp') : ())));
}
sub symbol_name {
  my ($self) = @_;
  if (my $parent = $self->{'parent'}) {
    if (defined (my $symbol = $parent->{'symbol'})) {
      return App::Chart::Database->symbol_name ($symbol);
    }
  }
  return undef;
}

sub derive {
  my ($class, $parent, %options) = @_;

  my $adjust_splits     = $options{'adjust_splits'};
  my $adjust_dividends  = $options{'adjust_dividends'};
  if (! $adjust_splits && ! $adjust_dividends) { return $parent; }

  # Only go up to today (in the symbol's timezone) for adjustments.  Stuff
  # in the future shouldn't be applied until then.  Decide this at init time
  # in case we live long enough for the time to reach a new day.
  #
  my $symbol = $parent->{'symbol'};
  my $timezone = App::Chart::TZ->for_symbol ($symbol);
  my $hi_iso = $timezone->iso_date;

  my $timebase = $parent->timebase;
  my $lo_iso = $timebase->to_iso (0);

  # if for each option it's either not wanted or there's no data for it,
  # then can just return unmodified $parent
  #
  if ((! $adjust_splits
       || ! App::Chart::DBI->read_single ('SELECT date FROM split
                          WHERE (symbol=? AND (date BETWEEN ? AND ?))
                          LIMIT 1', $symbol, $lo_iso, $hi_iso))
      &&
      (! $adjust_dividends
       || ! App::Chart::DBI->read_single ('SELECT ex_date FROM dividend
                          WHERE (symbol=? AND (ex_date BETWEEN ? AND ?))
                          LIMIT 1', $symbol, $lo_iso, $hi_iso))) {
    ### Adjust no splits or dividends to apply
    return $parent;
  }

  return $class->SUPER::new (parent     => $parent,
                             adj_hi_iso => $hi_iso,
                             %options);
}

sub fill_part {
  my ($self, $lo, $hi) = @_;
  ### Adjust fill_part() "$lo $hi"

  my $dbh = App::Chart::DBI->instance;
  my $timebase = $self->timebase;
  my $parent = $self->{'parent'};
  my $symbol = $parent->{'symbol'};
  my $lo_iso = $timebase->to_iso ($lo);  # requested $lo
  my $hi_iso = $self->{'adj_hi_iso'};    # all splits/divs to today

  my $splits = [];
  if ($self->{'adjust_splits'}) {
    my $sth = $dbh->prepare_cached
      ('SELECT date, new, old
        FROM split WHERE (symbol=? AND (date BETWEEN ? AND ?))
        ORDER BY date DESC');
    $splits = $dbh->selectall_arrayref ($sth, {Slice=>{}},
                                        $symbol, $lo_iso, $hi_iso);
    $sth->finish;
    foreach my $row (@$splits) {
      $row->{'date'} = $timebase->from_iso_floor ($row->{'date'});
    }
  }
  push @$splits, { date => $lo-1 }; # sentinel
  ### $splits

  my $dividends = [];
  if ($self->{'adjust_dividends'}) {
    my $sth = $dbh->prepare_cached