view release on metacpan or  search on metacpan

lib/App/Chart/Download.pm  view on Meta::CPAN

  foreach my $dividend (@{$h->{'dividends'}}) {
    my $latest_dividend_sth = $dbh->prepare_cached
      ('UPDATE latest SET dividend=? WHERE symbol=? AND last_date=?');
    my $symbol = $dividend->{'symbol'};
    if ($latest_dividend_sth->execute ($dividend->{'amount'},
                                       $symbol,
                                       $dividend->{'ex_date'})) {
      $latest_changed{$symbol} = 1;
    }
  }

  App::Chart::chart_dirbroadcast()->send ('latest-changed', \%latest_changed);

  require App::Chart::Annotation;
  foreach my $symbol (keys %latest_changed) {
    App::Chart::Annotation::Alert::update_alert ($symbol);
  }
}


#------------------------------------------------------------------------------

sub write_latest_group {
  my ($h) = @_;
  ### write_latest_group(): $h

  crunch_h ($h);
  ### crunched: $h

  my $fetch_timestamp = timestamp_now();
  my $prefer_decimals = $h->{'prefer_decimals'};
  my $source = $h->{'source'}
    or croak 'missing "source" for latest records';
  my %latest;

  my $dbh = App::Chart::DBI->instance;
  App::Chart::Database::call_with_transaction
      ($dbh, sub {

         my $sth = $dbh->prepare_cached
           ('INSERT OR REPLACE INTO latest
            (symbol, name, month, exchange, currency,
             quote_date, quote_time, bid, offer,
             last_date, last_time, open, high, low, last, change, volume,
             note, error, dividend, copyright, source,
             fetch_timestamp, url, etag, last_modified)
            VALUES (?,?,?,?,?, ?,?,?,?, ?,?,?,?,?,?,?,?, ?,?,?,?,?, ?,?,?,?)');

         my $resp = $h->{'resp'};
         my $etag = (defined $resp ? scalar $resp->header('ETag') : undef);
         my $last_modified = (defined $resp ? $resp->last_modified : undef);

         foreach my $data (@{$h->{'data'}}) {
           my $symbol = $data->{'symbol'};
           my $this_date = $data->{'date'};
           if ($latest{$symbol}) {
             my $got_date = $latest{$symbol}->{'date'};
             if (! defined $got_date || ! defined $this_date) {
               carp "write_latest_group: $source: two records for '$symbol', but no 'date' field";
               if (DEBUG || 1) {
                 require Data::Dumper;
                 print Data::Dumper->Dump([$data,$latest{$symbol}],
                                          ['data','latest-so-far']);
               }
               next;
             }
             if ($got_date ge $this_date) { next; }
           }
           $latest{$symbol} = $data;
         }

         my $error = $h->{'error'};
         if (! defined $error && defined $resp && ! $resp->is_success) {
           $error = $resp->status_line;
         }

         foreach my $data (values %latest) {
           my $symbol = $data->{'symbol'};

           my $bid     = $data->{'bid'};
           my $offer   = $data->{'offer'};

           # disallow 0 for prices
           if ($bid    && $bid   == 0)   { $bid   = undef; }
           if ($offer  && $offer == 0)   { $offer = undef; }

           my $quote_date = crunch_date ($data->{'quote_date'});
           my $quote_time = crunch_time ($data->{'quote_time'});
           if ($quote_time && ! $quote_date) {
             croak "quote_time without quote_date for $symbol";
           }
           # default quote date/time to now
           if (($bid || $offer) && ! $quote_date) {
             my $symbol_timezone = App::Chart::TZ->for_symbol ($symbol);
             ($quote_date, $quote_time)
               = $symbol_timezone->iso_date_time
                 (time() - 60 * ($data->{'quote_delay_minutes'} || 0));
           }

           my $last_date = crunch_date ($data->{'last_date'} || $data->{'date'});
           my $last_time = crunch_time ($data->{'last_time'});

           my $open    = $data->{'open'};
           my $high    = $data->{'high'};
           my $low     = $data->{'low'};
           my $last    = $data->{'last'} || $data->{'close'};
           my $change  = $data->{'change'};
           my $prev    = crunch_price ($data->{'prev'}, $prefer_decimals);
           my $volume  = $data->{'volume'};

           if (! defined $last) {
             # if there's no last price then try to use the prev
             $open = $high = $low = undef;
             $last = $prev;
             $prev = undef;
             $change = undef;
             $last_date = undef;
             $last_time = undef;

           } elsif (! defined $change) {
             # if no change given then try to calculate it from last and prev

lib/App/Chart/Download.pm  view on Meta::CPAN

  return $ret;
}

sub tdate_today_after {
  my ($after_hour, $after_minute, $timezone) = @_;

  { local $Tie::TZ::TZ = $timezone->tz;
    my ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) =
      Date::Calc::System_Clock();

    my $tdate = App::Chart::ymd_to_tdate_floor ($year, $month, $day);
    if ($dow <= 5  # is a weekday
        && (App::Chart::hms_to_seconds ($hour, $min, 0)
            < App::Chart::hms_to_seconds ($after_hour, $after_minute, 0))) {
      $tdate--;
    }
    return $tdate;
  }
}


#-----------------------------------------------------------------------------
# selecting among possibly overlapping files

# $files is an arrayref containing hash records with keys
#
#     lo_tdate,hi_tdate   inclusive coverage of the record
#     lo_year,hi_year     alterative form for date range
#     cost                size of the file in bytes
#
sub choose_files {
  my ($files, $lo_tdate, $hi_tdate) = @_;
  if ($lo_tdate > $hi_tdate) { return []; }

  if (DEBUG) { print "choose_files $lo_tdate to $hi_tdate\n"; }

  foreach my $f (@$files) {
    if (! defined $f->{'lo_tdate'}) {
      if (my $m = $f->{'month_iso'}) {
        $f->{'lo_tdate'} = App::Chart::Download::iso_to_tdate_ceil ($m);
      } elsif ($f->{'lo_year'}) {
        $f->{'lo_tdate'}
          = App::Chart::ymd_to_tdate_ceil ($f->{'lo_year'}, 1, 1);
      } else {
        croak 'choose_files: missing lo date';
      }
    }

    if (! defined $f->{'hi_tdate'}) {
      if (my $m = $f->{'month_iso'}) {
        $f->{'hi_tdate'}
          = tdate_end_of_month (App::Chart::Download::iso_to_tdate_ceil ($m));
      } elsif ($f->{'hi_year'}) {
        $f->{'hi_tdate'}
          = App::Chart::ymd_to_tdate_floor($f->{'hi_year'}, 12, 31);
      } else {
        croak 'choose_files: missing hi date';
      }
    }
  }
  if (DEBUG >= 2) { require Data::Dumper;
                    print Data::Dumper::Dumper($files); }

  # restrict wanted range to what's available
  my $lo_available = min (map {$_->{'lo_tdate'}} @$files);
  my $hi_available = max (map {$_->{'hi_tdate'}} @$files);
  $lo_tdate = max ($lo_tdate, $lo_available);
  $hi_tdate = min ($hi_tdate, $hi_available);
  if (DEBUG) { print "  available $lo_available to $hi_available\n";
               print "  restricted range $lo_tdate to $hi_tdate\n"; }
  if ($lo_tdate > $hi_tdate) { return []; }

  # ignore file elements not covering any of the desired range
  $files = [ grep {App::Chart::overlap_inclusive_p ($lo_tdate, $hi_tdate,
                                                    $_->{'lo_tdate'},
                                                    $_->{'hi_tdate'})}
             @$files ];

  # Algorithm::ChooseSubsets would be another way to iterate, or
  # Math::Subset::List to get all combinations
  my $best_cost;
  my $best_files;
  foreach my $this_files (all_combinations ($files)) {
    if (! cover_p ($this_files, $lo_tdate, $hi_tdate)) { next; }
    my $cost = List::Util::sum (map {$_->{'cost'}||0} @$this_files);
    $cost += $App::Chart::option{'http_get_cost'} * scalar(@$this_files);
    if (! defined $best_cost || $cost < $best_cost) {
      $best_cost = $cost;
      $best_files = $this_files;
    }
  }
  return $best_files;
}

# return true if the set of file records in arrayref $files covers all of
# $lo_tdate through $hi_tdate inclusive
#
sub cover_p {
  my ($files, $lo_tdate, $hi_tdate) = @_;
  require Set::IntSpan::Fast;
  my $set = Set::IntSpan::Fast->new;
  foreach my $f (@$files) {
    $set->add_range ($f->{'lo_tdate'}, $f->{'hi_tdate'});
  }
  $set->contains_all_range ($lo_tdate, $hi_tdate);
}

# return a list which is all the combinations of elements of @$aref
# for example $aref == [ 10, 20 ] would return ([], [10], [20], [10,20])
# there's 2**N combinations for aref length N
#
sub all_combinations {
  my ($aref) = @_;
  my @ret = ([]);
  foreach my $i (0 .. $#$aref) {
    push @ret, map {[ @$_, $aref->[$i] ]} @ret;
  }
  return @ret;
}

# return the last tdate in the month containing the given $tdate
sub tdate_end_of_month {