view release on metacpan or  search on metacpan

lib/Finance/QuoteDB.pm  view on Meta::CPAN

=head1 METHODS

=head2 new

new({dsn=>$dsn})

=cut

sub new {
  my $self = shift;
  my $class = ref($self) || $self;

  my $this = {} ;
  bless $this, $class;

  my $config = shift ;

  foreach (keys %$config) {
    $this->{$_} = $$config{$_};
  }
  $this->{logger} = Log::Log4perl::get_logger();
  if ($ENV{"FQDBDEBUG"}) { # enable debug logging if FQDBDEBUG is set
    $this->{logger}->level($DEBUG)
  } else {
    $this->{logger}->level($INFO)
  } ;
  if (my $dsn = $this->{dsn}) {
    INFO ("CREATED FQDB object based on $dsn\n");
  } else {
    ERROR ("No dsn specified\n") ;
    die;
  }

  return $this;
}

=head2 createdb

createdb()

=cut

sub createdb {
  my $self = shift;

  my $dsn = $self->{dsn};
  my $dsnuser = $self->{dsnuser};
  my $dsnpasswd = $self->{dsnpasswd};

  INFO ("COMMAND: Create database $dsn with user $dsnuser\n");
  my $schema = Finance::QuoteDB::Schema->connect_and_deploy($dsn,$dsnuser,$dsnpasswd); # creates the database
  return $schema;
}

=head2 updatedb

updatedb()

=cut

sub updatedb {
  my $self = shift ;

  my $dsn = $self->{dsn};
  INFO ("COMMAND: Update database $dsn\n");

  my $schema = $self->schema();
  my @stocks = $schema -> resultset('Symbol')->
    search(undef, { order_by => "fqmarket,fqsymbol",
                    columns => [qw / symbolID fqmarket fqsymbol /] });
  my %symbolIDs ;
  my %fqsymbols ;
  foreach my $stock (@stocks) {
    my $fqmarket = $stock->fqmarket()->name() ;
    my $symbolID = $stock->symbolID() ;
    my $fqsymbol = $stock->fqsymbol() ;
    ${$symbolIDs{$fqmarket}}{ $fqsymbol } = $symbolID ;
    print ("SCANNING : $fqmarket - $fqsymbol -> $symbolID\n");
  };
  foreach my $market (keys %symbolIDs) {
    DEBUG "$market -->" .join( "," , keys(%{$symbolIDs{$market}}) ) ."\n" ;
    $self->updatedbMarketStock ( $market , \%{$symbolIDs{$market}} ) ;
  }
}

=head2 updatedbMarketStock

updatedbMarketStock($market,\%symbolIDs)

=cut

sub updatedbMarketStock {
  my ($self,$market,$stockHash) = @_ ;
  my $schema = $self->schema();
  my @fqsymbols = keys(%{$stockHash}) ;
  DEBUG "UPDATEDBMARKETSTOCK: $market -->" .join(",",@fqsymbols)."\n" ;
  my $q = Finance::Quote->new();
  my %quotes = $q->fetch($market,@fqsymbols);
  foreach my $stock (@fqsymbols) {
    if ($quotes{$stock,"success"}) { # This quote was retrieved
      my $symbolID = ${$stockHash}{$stock} ;
      print ("Updating stock $stock ($symbolID) --> $quotes{$stock,'last'}\n");
      my $quoters = $schema->resultset('Quote')->update_or_create(
        { symbolID => $symbolID,
          date => $quotes{$stock,'isodate'},
          previous_close => $quotes{$stock,'close'},
          day_open => $quotes{$stock,'open'},
          day_high => $quotes{$stock,'high'},
          day_low => $quotes{$stock,'low'},
          day_close => $quotes{$stock,'last'},
          bid => $quotes{$stock,'bid'},
          ask => $quotes{$stock,'ask'},
          volume => $quotes{$stock,'volume'}
        });
    } else {
      print ("Could not retrieve $stock\n");
    }
  }
};

=head2 backpopulate

backpopulate($start_date, $end_date, $overwrite, $stocks)

=cut

sub backpopulate {
  my ($self, $start_date, $end_date, $overwrite, $stocks) = @_;
  $end_date = $self->today() if (!$end_date);
  if (my @symbolIDs = split(",",$stocks)) {
    print ("Retrieving data...\n");
    my $schema = $self->schema();
    my %symbolID ;
    foreach my $symbolID (@symbolIDs) {
      my $fqsymbol = $schema -> resultset('Symbol')->single({symbolID => $symbolID})->fqsymbol() ;
      $symbolID{$fqsymbol} = $symbolID ;
    }
    my @fqsymbols = keys (%symbolID);

    my $q = Finance::QuoteHist->new( symbols => \@fqsymbols,
                                     start_date => $start_date,
                                     end_date => $end_date );
    my $line = "" ;
    my %symbols ;
    foreach my $row ($q->quotes()) {
      my ($fqsymbol, $date, $open, $high, $low, $close, $volume) = @$row;
      $date =~ tr|/|-|;
      my $tline = substr($date,0,7) ;
      if ($line ne $tline) {
        INFO ("$tline") ;
        %symbols = () ;
      };