Finance::QuoteDB - User database tools based on Finance::Quote

    perldoc Finance::QuoteDB

package Finance::QuoteDB;

use warnings;
use strict;

use Exporter ();
use vars qw/@EXPORT @EXPORT_OK @EXPORT_TAGS $VERSION/;
use Finance::Quote;

# Bug correction in Finance::QuoteHist
# reported on RT #64365
# This block can safely be removed once Finance::QuoteHist is corrected
BEGIN {
$Date::Manip::Backend = 'DM5';
}

use Finance::QuoteHist;
use LWP::UserAgent;
use HTML::TableExtract;

require Finance::QuoteDB::Geniustrader;

use Log::Log4perl qw(:easy);

@EXPORT = ();
@EXPORT_OK = qw /createdb updatedb addstock/ ;
@EXPORT_TAGS = ( all => [@EXPORT_OK] );
$VERSION = '0.15';

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;
}

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;
}

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}} ) ;
  }
}

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");
    }
  }
};

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 = () ;
      };
      $line = $tline ;
      if (!$symbols{$fqsymbol}) {
        $symbols{$fqsymbol}=1;
        INFO (" -> $fqsymbol") ;
      }
      my %data = ( symbolID => $symbolID{$fqsymbol},
                   date => $date,
                   day_open => $open,
                   day_high => $high,
                   day_low => $low,
                   day_close => $close,
                   volume => $volume
                 ) ;
      if ($overwrite) {
        $schema->resultset('Quote')->update_or_create( \%data ) ;
      } else {
        $schema->resultset('Quote')->find_or_create( \%data ) ;
      }
    }
  }
}

sub delstock {
  my ($self,$stocks) = @_ ;

  if (my @stocks = split(",",$stocks)) {
    my $schema = $self->schema();
    foreach my $stock (@stocks) {
      print ("Deleting stock $stock\n");
      my $rs = $schema -> resultset('Symbol')->
        search({'symbolID' => $stock});
      $rs->delete_all();
    }
  } else {
    print ("No stocks specified\n") ;
  }
};

sub addstock {
  my ($self,$market,$stocks) = @_ ;

  if (!$market) {
    print ("No market specified\n") ;
    return
  } else {
    print ("Getting stocks from $market\n") ;
  }
  if (my @stocks = split(",",$stocks)) {
    my %symbolIDs ;
    foreach my $stockItem (@stocks) {
      if ( $stockItem =~ m/([^\[]+)(\[(.+)\])?/ ) {
        my ($fqsymbol,$symbolID) = ($1,$3) ;
        $symbolID = $fqsymbol if (!$symbolID) ;
        INFO (" Stock $fqsymbol <- $symbolID") ;
        $symbolIDs{$fqsymbol}=$symbolID ;
      }
    }
    my @fqsymbols = keys %symbolIDs ;
    my $q = Finance::Quote->new();
    my %quotes = $q->fetch($market,@fqsymbols);
    foreach my $stock (@fqsymbols) {
      print ("Checking stock $stock\n");
      if ($quotes{$stock,"success"}) { # This quote was retrieved
        print (" --> $quotes{$stock,'name'}\n") ;
        my $schema = $self->schema();
        my $marketID = $schema->resultset('FQMarket')->find_or_create({name=>$market})->marketID();
        $schema->populate('Symbol',
                          [[qw /symbolID name fqmarket fqsymbol isin currency/],
                           [$symbolIDs{$stock}, $quotes{$stock,'name'}, $marketID, $stock, '', $quotes{$stock,'currency'} ]]);
      } else {
        print ("Could not retrieve $stock\n");
      }
    }
  } else {
    print ("No stocks specified\n") ;
  }
};

sub getquotes {
  my ($self,$USERsymbol,$date_start,$date_end) = @_ ;
  $date_end = $date_start if !($date_end) ;
  my $schema = $self->schema();

  my @q = $schema->resultset('Quote')
    ->search( { symbolID=>$USERsymbol,
                date=>{'BETWEEN',[$date_start, $date_end]} },
              { columns=> [qw/ date day_open day_high day_low day_close volume /],
                order_by=> [qw/ date /] });
  @q ? return \@q : 0 ;
}

sub dumpquotes {
  my ($self,$USERsymbols,$date_start,$date_end) = @_ ;
  $date_end = $date_start if !($date_end) ;
  my $schema = $self->schema();

  if (my @stocks = split(",",$USERsymbols)) {
    foreach my $USERsymbol (@stocks) {
      if ( my $quotesArray = $self->getquotes ( $USERsymbol, $date_start, $date_end ) ) {
        print "STOCK : $USERsymbol\n";
        print "DATE           OPEN     HIGH      LOW    CLOSE       VOLUME\n" ;
        foreach my $q (@$quotesArray) {
          printf "%10s %8.2f %8.2f %8.2f %8.2f %12d\n",
            $q->date(), $q->day_open(), $q->day_high(), $q->day_low(), $q->day_close(), $q->volume() ;
        }
      } else {
        print "NO DATA for stock $USERsymbol\n";
      }
    }
  }
}

sub dumpstocks {
  my $self = shift ;

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

  my $schema = $self->schema();
  my @stocks = $schema -> resultset('Symbol')->
    search(undef, { order_by => "symbolID,fqmarket,fqsymbol",
                    columns => [qw / symbolID fqmarket fqsymbol /] });
  print "     USERSYMBOL       FQMARKET         FQSYMBOL\n";
  foreach my $stock (@stocks) {
    my $fqmarket = $stock->fqmarket()->name() ;
    my $symbolID = $stock->symbolID() ;
    my $fqsymbol = $stock->fqsymbol() ;
    printf "%15s %15s %15s\n",$symbolID,$fqmarket,$fqsymbol;
  };
}

sub add_yahoo_stocks {
  # http://uk.biz.yahoo.com/p/uk/cpi/index.html -> list of european stocks
  my ($self,$exchanges,$refsearchlist) = @_ ;
  my $popquantity = 30 ; # number of stocks to add in 1 call of addstock

  if (!defined($exchanges)) {
    ERROR ("No exchanges specified");
  } else {
    my %exchanges ;
    foreach (split(',',$exchanges)) {
      $exchanges{$_}=1 ;
    }  ;

    no strict 'subs' ;
    if (!defined(@$refsearchlist)) {
      $refsearchlist = [AA .. ZZ] ;
      $$refsearchlist[$_] = "**".$$refsearchlist[$_] foreach (0 .. $#{@$refsearchlist}) ; # add ** in front of each list item
    }
    DEBUG ("$_") foreach (@$refsearchlist);

    my $ua = LWP::UserAgent->new;
    $ua->env_proxy;
    INFO("Adding symbols from $exchanges.") ;

    my %symbols ;

    foreach my $letter (@$refsearchlist) {
      my $yahoo_url = "http://finance.yahoo.com/lookup?s=$letter&t=S" ; # t=S means ONLY stocks

      my $b = 0 ; # counter in url
      my $cont ;
      do {
        $cont = 1; # continue increasing b
        my $url = $yahoo_url."&b=".$b ;
        DEBUG("URL: $url");
        my $req = HTTP::Request->new(GET => $url);
        my $reply = $ua->request($req);
        if ($reply->is_success) {
          my ($from,$to,$total)=(0,0,0) ;
          if ($reply->content=~ m|Showing\s+(\d)+ - (\d+) of\s+(\d+)|) { # check if this is last page for this market
            ($from,$to,$total)=($1,$2,$3);
            INFO ("For $letter: ".int($to*100/$total)." % completed");
            $b=$to; # next page should start at this symbol. actually starts at symbol+1
            $cont = ($to < $total);
          }
          # scrape the symbols from this page
          my $te = HTML::TableExtract->new( headers=>[qw /Symbol Exchange/ ] );
          $te->parse($reply->content);
          foreach my $ts ($te->tables) {
            my $countrows = 0;
            foreach my $tr ($ts->rows) {
              $countrows++;
              my $trsymb = @$tr[0] ;
              $trsymb =~ s/ //g ;
              my $exchsym = @$tr[1] ;
              $exchsym =~ s/ //g ;
              if (defined($exchanges{$exchsym})) {
                INFO (" Symbol: $trsymb - Exchange $exchsym");
                $symbols{$trsymb}+=1 ;                           # add the symbol as a key in the hash removes duplicates automatically
              }
            }
            DEBUG ("--> $countrows rows");
            if ($countrows && ($total==0)) {                  # there are rows on this page and we are on the last page (no total)
              INFO ("For $letter: 100 % completed");
              $cont=0 ;
            }
          }
        }
        if ($cont) {
          my $sleeptime = int(15+rand(5)) ;
          INFO("Sleeping $sleeptime");
          sleep $sleeptime;                                      # needed otherwise we might overload yahoo server
        }
      } while ($cont);
    }

    my @symbols = sort keys %symbols ;
    while ($#symbols>0) {                                      # still elements in the array
      my $sleeptime = int(10+rand(10)) ;
      INFO("Sleeping $sleeptime");
      sleep $sleeptime;                                        # needed otherwise we might overload yahoo server
      my $stocks = join (",",splice(@symbols,0,$popquantity)); # take $popquantity number of elements out
      # my $stocks = join (",",@symbols[0..$popquantity-1]);
      # @symbols = @symbols[$popquantity+1..$#symbols-1];
      INFO (" Adding stocks: $stocks");
      $self->addstock('yahoo',$stocks);                        # add stocks in database
    }
  }
  INFO("Finished adding stocks from yahoo");
}

sub schema {
  my $self = shift ;
  my $dsn = $self->{dsn};
  my $dsnuser = $self->{dsnuser};
  my $dsnpasswd = $self->{dsnpasswd};
  if (!$self->{schema}) {
    if (my $schema = Finance::QuoteDB::Schema->connect($dsn,$dsnuser,$dsnpasswd)) {
      INFO ("Connected to database $dsn\n");
      $self->{schema} = $schema ;
    } else {
      ERROR ("Could not connect to database $dsn\n") ;
      die ;
    }
  }
  return $self->{schema}
}

sub today {
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
  return ($year+1900)."-".sprintf('%02d',$mon+1)."-".sprintf('%02d',$mday) ;
}

1; # End of Finance::QuoteDB